asc26 amss-ncku initialized

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
+                                   
+#################################################
+                                   

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(                                                                                    )
+
+##################################################################
+
+

AMSS_NCKU_source/ABE.C

@@ -0,0 +1,508 @@
+
+#ifdef newc
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <cstdlib>
+#include <cstdio>
+#include <string>
+#include <cmath>
+#include <map>
+using namespace std;
+#else
+#include <iostream.h>
+#include <iomanip.h>
+#include <fstream.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <math.h>
+#include <map.h>
+#endif
+
+#include <mpi.h>
+
+#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<string, int> int_par;
+      map<string, double> dou_par;
+      map<string, string> 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<string, string>::value_type("inputpar", sttr));
+      }
+      else
+      {
+            string sttr("input.par");
+            parameters::str_par.insert(map<string, string>::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<string, string>::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<string, string>::value_type("output dir", out_dir));
+            }
+      }
+
+      if (myrank == 0)
+      {
+            string out_dir;
+            char filename[50];
+            map<string, string>::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);
+}
+
+//===================================================================================================
+//===================================================================================================

AMSS_NCKU_source/Ansorg.C

@@ -0,0 +1,690 @@
+
+#ifdef newc
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <strstream>
+#include <cmath>
+#include <cstdio>
+using namespace std;
+#else
+#include <iostream.h>
+#include <iomanip.h>
+#include <fstream.h>
+#include <string.h>
+#include <math.h>
+#include <stdio.h>
+#endif
+
+#include "Ansorg.h"
+#include <cstring>
+/* 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 ("<<x<<","<<y<<","<<z
+              <<") t u v w "<<t<<","<<u<<","<<v<<","<<w<<endl;
+          cout<<2*sw*(rr + st + 1 - xx)<<","<< s2*sv*(st -  rr - 1 + 2*sw - xx)<<"LAST"<<endl;
+          MPI_Abort(MPI_COMM_WORLD,1);
+                }
+}
+#endif
+#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);
+  const double exp = 3.0/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)
+    *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 ("<<x<<","<<y<<","<<z
+              <<") t u v w "<<t<<","<<u<<","<<v<<","<<w<<endl;
+          cout<<2*sw*(rr + st + 1 - xx)<<","<< s2*sv*(st -  rr - 1 + 2*sw - xx)<<"LAST"<<endl;
+          MPI_Abort(MPI_COMM_WORLD,1);
+                }
+}
+#endif
+#if 1
+// adopting the coordinate transformation in TwoPunctures Thorn on Jan 23, 2011
+void Ansorg::xyz_to_ABp(double x, double y, double z,
+                        double *A, double *B, double *phi)
+{
+  const double s2 = sqrt(2.0);
+  const double exp = 3.0 / 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;
+  /* this work worse than the next one
+    *phi = atan2(z, y);
+    if (*phi < 0) *phi += 2 * PI;
+  */
+  if (r > 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;
+}

AMSS_NCKU_source/Ansorg.h

@@ -0,0 +1,53 @@
+
+#ifndef Ansorg_H
+#define Ansorg_H
+
+#ifdef newc
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <cstdlib>
+#include <string>
+#include <cmath>
+using namespace std;
+#else
+#include <iostream.h>
+#include <iomanip.h>
+#include <fstream.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#endif
+
+#include <mpi.h>
+
+#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 */

AMSS_NCKU_source/BH_diagnostics.C

@@ -0,0 +1,724 @@
+#include <stdio.h>
+#include <assert.h>
+#include <math.h>
+
+#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<fp> 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<fp> x_norms;
+		jtutil::norm<fp> y_norms;
+		jtutil::norm<fp> 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

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 */

AMSS_NCKU_source/Block.C

@@ -0,0 +1,199 @@
+
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <cstdlib>
+#include <cstdio>
+#include <string>
+#include <cmath>
+#include <new>
+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<var> *VarList1, MyList<var> *VarList2, int myrank)
+{
+  if (rank == myrank)
+  {
+    MyList<var> *varl1 = VarList1, *varl2 = VarList2;
+    while (varl1 && varl2)
+    {
+      misc::swap<double *>(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);
+    }
+  }
+}

AMSS_NCKU_source/Block.h

@@ -0,0 +1,34 @@
+
+#ifndef BLOCK_H
+#define BLOCK_H
+
+#include <mpi.h>
+#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<var> *VarList1, MyList<var> *VarList2, int myrank);
+};
+
+#endif /* BLOCK_H */

AMSS_NCKU_source/DataCT.C

@@ -0,0 +1,283 @@
+
+//-----------------------------------------------------------------------
+// Read binary files and do fancy things with them...
+//-----------------------------------------------------------------------
+#ifdef newc
+#include <cmath>
+#include <iostream>
+#include <iomanip>
+#include <cstdlib>
+#include <cstdio>
+#include <cstring>
+#include <fstream>
+using namespace std;
+#else
+#include <math.h>
+#include <iostream.h>
+#include <iomanip.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <fstream.h>
+#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);
+  }
+}

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

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 <math.h>
+#include <stdio.h>
+
+#include <iostream>
+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

AMSS_NCKU_source/IntPnts0.C

@@ -0,0 +1,43 @@
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+
+#include <mpi.h>
+
+#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;
+}

AMSS_NCKU_source/Jacobian.C

@@ -0,0 +1,270 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <assert.h>
+#include <math.h>
+#include <string.h>
+
+#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<const struct matrix_element *>(x);
+		const struct matrix_element *const py = static_cast<const struct matrix_element *>(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<void *>(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

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 */

AMSS_NCKU_source/MPatch.h

@@ -0,0 +1,51 @@
+
+#ifndef PATCH_H
+#define PATCH_H
+
+#include <mpi.h>
+#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<Block> *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<var> *VarList,
+                      int NN, double **XX,
+                      double *Shellf, int Symmetry);
+   bool Interp_ONE_Point(MyList<var> *VarList, double *XX,
+                         double *Shellf, int Symmetry);
+   double getdX(int dir);
+
+   void Find_Maximum(MyList<var> *VarList, double *XX,
+                     double *Shellf);
+
+   bool Find_Point(double *XX);
+
+   void Interp_Points(MyList<var> *VarList,
+                      int NN, double **XX,
+                      double *Shellf, int Symmetry, MPI_Comm Comm_here);
+   bool Interp_ONE_Point(MyList<var> *VarList, double *XX,
+                         double *Shellf, int Symmetry, MPI_Comm Comm_here);
+   void Find_Maximum(MyList<var> *VarList, double *XX,
+                     double *Shellf, MPI_Comm Comm_here);
+};
+
+#endif /* PATCH_H */

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 T>
+class MyList
+{
+
+public:
+  MyList *next;
+  T *data;
+
+public:
+  MyList();
+  MyList(T *p);
+  ~MyList();
+  void insert(T *p);
+  void clearList();
+  void destroyList();
+  void catList(MyList<T> *p);
+  void CloneList(MyList<T> *p);
+};
+
+template <class T>
+MyList<T>::MyList()
+{
+  data = 0;
+  next = 0;
+}
+template <class T>
+MyList<T>::MyList(T *p)
+{
+  data = p;
+  next = 0;
+}
+
+template <class T>
+MyList<T>::~MyList()
+{
+}
+template <class T>
+void MyList<T>::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 <class T>
+void MyList<T>::clearList()
+{
+  MyList *ct = this, *n;
+  while (ct)
+  {
+    n = ct->next;
+    delete ct;
+    ct = n;
+  }
+}
+template <class T>
+void MyList<T>::destroyList()
+{
+  MyList *ct = this, *n;
+  while (ct)
+  {
+    n = ct->next;
+    delete ct->data;
+    delete ct;
+    ct = n;
+  }
+}
+template <class T>
+void MyList<T>::catList(MyList<T> *p)
+{
+  MyList *ct = this;
+  while (ct->next)
+  {
+    ct = ct->next;
+  }
+  ct->next = p;
+}
+template <class T>
+void MyList<T>::CloneList(MyList<T> *p)
+{
+  MyList *ct = this;
+  p = 0;
+  while (ct)
+  {
+    if (!p)
+      p = new MyList<T>(ct->data);
+    else
+      p->insert(ct->data);
+    ct = ct->next;
+  }
+}
+#endif /* MyList_H */

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 <stdio.h>
+#include <assert.h>
+#include <limits.h>
+#include <float.h>
+#include <math.h>
+#include <mpi.h>
+
+#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<type_>(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<fp> 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<fp> 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<double>(0, N_active_procs - 1,
+																	  0, N_buffer_vars - 1);
+					isb.receive_buffer_ptr = new jtutil::array2d<double>(0, N_active_procs - 1,
+																		 0, N_buffer_vars - 1);
+				}
+			jtutil::array2d<double> &send_buffer = *isb.send_buffer_ptr;
+			jtutil::array2d<double> &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<void *>(send_buffer.data_array()),
+													   static_cast<void *>(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<int>(
+					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<int>(
+					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<enum expansion_status>(
+					static_cast<int>(
+						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<fp> 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

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 */

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

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 */

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

AMSS_NCKU_source/NullShellPatch.h

@@ -0,0 +1,189 @@
+
+#ifndef NULLSHELLPATCH_H
+#define NULLSHELLPATCH_H
+
+#ifdef newc
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <cstdlib>
+#include <cstdio>
+#include <string>
+#include <cmath>
+#include <complex>
+using namespace std;
+#else
+#include <iostream.h>
+#include <iomanip.h>
+#include <fstream.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <math.h>
+#include <complex.h>
+#endif
+
+#include <mpi.h>
+#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<double> 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<var> *StateList, *SynchList_pre, *SynchList_cor, *RHSList;
+   MyList<var> *OldStateList, *DumpList, *CheckList;
+
+   MyList<var> *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<ss_patch> *PatL;
+
+   MyList<pointstru> **ss_src, **ss_dst;
+   MyList<pointstru> **cs_src, **cs_dst;
+
+public:
+   NullShellPatch(int *shapei, double Rmini, double xmini, double xmaxi, int Symmetry, int myranki);
+
+   ~NullShellPatch();
+
+   void destroypsuList(MyList<pointstru> *ct);
+   void fill_symmetric_boundarybuffer(MyList<var> *VarList, int *Varwt);
+   MyList<Block> *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<double> get_swtf(double *pox, int tsst, int ssst);
+   void prolongpointstru(MyList<pointstru> *&psul, MyList<ss_patch> *sPpi, double DH[dim],
+                         MyList<Patch> *Ppi, double CDH[dim], MyList<pointstru> *pss);
+   bool prolongpointstru(MyList<pointstru> *&psul, bool ssyn, int tsst, MyList<ss_patch> *sPp, double DH[dim],
+                         MyList<Patch> *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in);
+   bool prolongpointstru_ss(MyList<pointstru> *&psul, int tsst, MyList<ss_patch> *sPp, double DH[dim],
+                            MyList<Patch> *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in);
+   void setupintintstuff(int cpusize, MyList<Patch> *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<var> *DumpListi, char *tag, double time, double dT);
+   void intertransfer(MyList<pointstru> **src, MyList<pointstru> **dst,
+                      MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /*target */,
+                      int Symmetry, int *Varwt);
+   int interdata_packer(double *data, MyList<pointstru> *src, MyList<pointstru> *dst, int rank_in, int dir,
+                        MyList<var> *VarLists /* source */, MyList<var> *VarListd /* target */, int Symmetry, int *Varwt);
+   void Synch(MyList<var> *VarList, int Symmetry, int *Varwt);
+   void CS_Inter(MyList<var> *VarList, int Symmetry, int *Varwt);
+   void check_pointstrul(MyList<pointstru> *pp, bool first_only);
+   void check_pointstrul2(MyList<pointstru> *pp, int first_last_only);
+   void matchcheck(MyList<Patch> *CPatL);
+   void Interp_Points(MyList<var> *VarList,
+                      int NN, double **XX, /*input global Cartesian coordinate*/
+                      double *Shellf, int Symmetry);
+   void Interp_Points_2D(MyList<var> *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 */

AMSS_NCKU_source/NullShellPatch2.h

@@ -0,0 +1,183 @@
+
+#ifndef NULLSHELLPATCH2_H
+#define NULLSHELLPATCH2_H
+
+#ifdef newc
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <cstdlib>
+#include <cstdio>
+#include <string>
+#include <cmath>
+#include <complex>
+using namespace std;
+#else
+#include <iostream.h>
+#include <iomanip.h>
+#include <fstream.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <math.h>
+#include <complex.h>
+#endif
+
+#include <mpi.h>
+#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<var> *StateList, *SynchList_pre, *SynchList_cor, *RHSList;
+   MyList<var> *OldStateList, *DumpList, *CheckList;
+   MyList<var> *NewsList;
+
+   MyList<var> *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<ss_patch> *PatL;
+
+   MyList<pointstru> **ss_src, **ss_dst;
+   MyList<pointstru> **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<pointstru> *ct);
+   MyList<Block> *compose_sh(int cpusize);
+   void Dump_xyz(char *tag, double time, double dT);
+   void Dump_Data(MyList<var> *DumpListi, char *tag, double time, double dT);
+   void setupintintstuff(int cpusize, MyList<Patch> *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<pointstru> *&psul, MyList<ss_patch> *sPpi, double DH[dim],
+                         MyList<Patch> *Ppi, double CDH[dim], MyList<pointstru> *pss);
+   bool prolongpointstru(MyList<pointstru> *&psul, bool ssyn, int tsst, MyList<ss_patch> *sPp, double DH[dim],
+                         MyList<Patch> *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in, const int iz);
+   bool prolongpointstru_ss(MyList<pointstru> *&psul, int tsst, MyList<ss_patch> *sPp, double DH[dim],
+                            MyList<Patch> *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<var> *VarList, int Symmetry, double **Varwt, const short int svt);
+   void fill_symmetric_boundarybuffer(MyList<var> *VarList, double **Varwt);
+   void intertransfer(MyList<pointstru> **src, MyList<pointstru> **dst,
+                      MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /*target */,
+                      int Symmetry, double **Varwt, const short int svt);
+   int interdata_packer(double *data, MyList<pointstru> *src, MyList<pointstru> *dst, int rank_in, int dir,
+                        MyList<var> *VarLists /* source */, MyList<var> *VarListd /* target */, int Symmetry, double **Varwt,
+                        const short int svt);
+   int interdata_packer_pre(double *data, MyList<pointstru> *src, MyList<pointstru> *dst, int rank_in, int dir,
+                            MyList<var> *VarLists /* source */, MyList<var> *VarListd /* target */, int Symmetry, double **Varwt,
+                            const short int svt);
+   int interdata_packer_pot(double *data, MyList<pointstru> *src, MyList<pointstru> *dst, int rank_in, int dir,
+                            MyList<var> *VarLists /* source */, MyList<var> *VarListd /* target */, int Symmetry, double **Varwt,
+                            const short int svt);
+   void check_pointstrul(MyList<pointstru> *pp, bool first_only);
+   void checkBlock(int sst);
+   void Null_Boundary(double PhysTime);
+   void Compute_News(double PhysTime);
+   void Interp_Points_2D(MyList<var> *VarList,
+                         int NN, double **XX, /*input fake global Cartesian coordinate*/
+                         double *Shellf, int Symmetry);
+   double Error_Check(double PhysTime);
+};
+
+#endif /* NULLSHELLPATCH2_H */

AMSS_NCKU_source/Parallel.h

@@ -0,0 +1,167 @@
+
+#ifndef PARALLEL_H
+#define PARALLEL_H
+
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <cstdlib>
+#include <cstdio>
+#include <string>
+#include <cmath>
+#include <new>
+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<Block> *distribute(MyList<Patch> *PatchLIST, int cpusize, int ingfsi, int fngfs, bool periodic, int nodes = 0); // produce corresponding Blocks
+  void KillBlocks(MyList<Patch> *PatchLIST);
+
+  void setfunction(MyList<Block> *BlL, var *vn, double func(double x, double y, double z));
+  void setfunction(int rank, MyList<Block> *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<Block> *BlL, MyList<var> *DumpList, char *tag, double time, double dT);
+  void Dump_Data(MyList<Patch> *PL, MyList<var> *DumpList, char *tag, double time, double dT);
+  void Dump_Data(Patch *PP, MyList<var> *DumpList, char *tag, double time, double dT, int grd);
+  double *Collect_Data(Patch *PP, var *VP);
+  void d2Dump_Data(MyList<Patch> *PL, MyList<var> *DumpList, char *tag, double time, double dT);
+  void d2Dump_Data(Patch *PP, MyList<var> *DumpList, char *tag, double time, double dT, int grd);
+  void Dump_Data0(Patch *PP, MyList<var> *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<gridseg> *build_complete_gsl(Patch *Pat);
+  MyList<gridseg> *build_complete_gsl(MyList<Patch> *PatL);
+  MyList<gridseg> *build_complete_gsl_virtual(MyList<Patch> *PatL);
+  MyList<gridseg> *build_complete_gsl_virtual2(MyList<Patch> *PatL);        // - buffer
+  MyList<gridseg> *build_owned_gsl0(Patch *Pat, int rank_in);               // - ghost without extension, special for Sync usage
+  MyList<gridseg> *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<gridseg> *build_owned_gsl2(Patch *Pat, int rank_in);               // - buffer - ghost
+  MyList<gridseg> *build_owned_gsl3(Patch *Pat, int rank_in, int Symmetry); // - ghost - BD ghost
+  MyList<gridseg> *build_owned_gsl4(Patch *Pat, int rank_in, int Symmetry); // - buffer - ghost - BD ghost
+  MyList<gridseg> *build_owned_gsl5(Patch *Pat, int rank_in);               // similar to build_owned_gsl2 but no extension
+  MyList<gridseg> *build_owned_gsl(MyList<Patch> *PatL, int rank_in, int type, int Symmetry);
+  void build_gstl(MyList<gridseg> *srci, MyList<gridseg> *dsti, MyList<gridseg> **out_src, MyList<gridseg> **out_dst);
+  int data_packer(double *data, MyList<gridseg> *src, MyList<gridseg> *dst, int rank_in, int dir,
+                  MyList<var> *VarLists, MyList<var> *VarListd, int Symmetry);
+  void transfer(MyList<gridseg> **src, MyList<gridseg> **dst,
+                MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /*target */,
+                int Symmetry);
+  int data_packermix(double *data, MyList<gridseg> *src, MyList<gridseg> *dst, int rank_in, int dir,
+                     MyList<var> *VarLists, MyList<var> *VarListd, int Symmetry);
+  void transfermix(MyList<gridseg> **src, MyList<gridseg> **dst,
+                   MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /*target */,
+                   int Symmetry);
+  void Sync(Patch *Pat, MyList<var> *VarList, int Symmetry);
+  void Sync(MyList<Patch> *PatL, MyList<var> *VarList, int Symmetry);
+  void OutBdLow2Hi(Patch *Patc, Patch *Patf,
+                   MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                   int Symmetry);
+  void OutBdLow2Hi(MyList<Patch> *PatcL, MyList<Patch> *PatfL,
+                   MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                   int Symmetry);
+  void OutBdLow2Himix(Patch *Patc, Patch *Patf,
+                      MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                      int Symmetry);
+  void OutBdLow2Himix(MyList<Patch> *PatcL, MyList<Patch> *PatfL,
+                      MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                      int Symmetry);
+  void Prolong(Patch *Patc, Patch *Patf,
+               MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+               int Symmetry);
+  void Prolongint(Patch *Patc, Patch *Patf,
+                  MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                  int Symmetry);
+  void Restrict(MyList<Patch> *PatcL, MyList<Patch> *PatfL,
+                MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                int Symmetry);
+  void Restrict_after(MyList<Patch> *PatcL, MyList<Patch> *PatfL,
+                      MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                      int Symmetry); // for -ghost - BDghost
+  MyList<Parallel::gridseg> *build_PhysBD_gsl(Patch *Pat);
+  MyList<Parallel::gridseg> *build_ghost_gsl(MyList<Patch> *PatL);
+  MyList<Parallel::gridseg> *build_ghost_gsl(Patch *Pat);
+  MyList<Parallel::gridseg> *build_buffer_gsl(Patch *Pat);
+  MyList<Parallel::gridseg> *build_buffer_gsl(MyList<Patch> *PatL);
+  MyList<Parallel::gridseg> *gsl_subtract(MyList<Parallel::gridseg> *A, MyList<Parallel::gridseg> *B);
+  MyList<Parallel::gridseg> *gs_subtract(MyList<Parallel::gridseg> *A, MyList<Parallel::gridseg> *B);
+  MyList<Parallel::gridseg> *gsl_and(MyList<Parallel::gridseg> *A, MyList<Parallel::gridseg> *B);
+  MyList<Parallel::gridseg> *gs_and(MyList<Parallel::gridseg> *A, MyList<Parallel::gridseg> *B);
+  MyList<Parallel::gridseg> *clone_gsl(MyList<Parallel::gridseg> *p, bool first_only);
+  MyList<Parallel::gridseg> *build_bulk_gsl(Patch *Pat); // similar to build_owned_gsl0 but does not care rank issue
+  MyList<Parallel::gridseg> *build_bulk_gsl(Block *bp, Patch *Pat);
+  void build_PhysBD_gstl(Patch *Pat, MyList<Parallel::gridseg> *srci, MyList<Parallel::gridseg> *dsti,
+                         MyList<Parallel::gridseg> **out_src, MyList<Parallel::gridseg> **out_dst);
+  void PeriodicBD(Patch *Pat, MyList<var> *VarList, int Symmetry);
+  double L2Norm(Patch *Pat, var *vf);
+  void checkgsl(MyList<Parallel::gridseg> *pp, bool first_only);
+  void checkvarl(MyList<var> *pp, bool first_only);
+  MyList<Parallel::gridseg> *divide_gsl(MyList<Parallel::gridseg> *p, Patch *Pat);
+  MyList<Parallel::gridseg> *divide_gs(MyList<Parallel::gridseg> *p, Patch *Pat);
+  void prepare_inter_time_level(Patch *Pat,
+                                MyList<var> *VarList1 /* source (t+dt) */, MyList<var> *VarList2 /* source (t) */,
+                                MyList<var> *VarList3 /* target (t+a*dt) */, int tindex);
+  void prepare_inter_time_level(Patch *Pat,
+                                MyList<var> *VarList1 /* source (t+dt) */, MyList<var> *VarList2 /* source (t) */,
+                                MyList<var> *VarList3 /* source (t-dt) */, MyList<var> *VarList4 /* target (t+a*dt) */, int tindex);
+  void prepare_inter_time_level(MyList<Patch> *PatL,
+                                MyList<var> *VarList1 /* source (t+dt) */, MyList<var> *VarList2 /* source (t) */,
+                                MyList<var> *VarList3 /* target (t+a*dt) */, int tindex);
+  void prepare_inter_time_level(MyList<Patch> *Pat,
+                                MyList<var> *VarList1 /* source (t+dt) */, MyList<var> *VarList2 /* source (t) */,
+                                MyList<var> *VarList3 /* source (t-dt) */, MyList<var> *VarList4 /* target (t+a*dt) */, int tindex);
+  void merge_gsl(MyList<gridseg> *&A, const double ratio);
+  bool merge_gs(MyList<gridseg> *D, MyList<gridseg> *B, MyList<gridseg> *&C, const double ratio);
+  // Add ghost region to tangent plane
+  // we assume the grids have the same resolution
+  void add_ghost_touch(MyList<gridseg> *&A);
+  void cut_gsl(MyList<gridseg> *&A);
+  bool cut_gs(MyList<gridseg> *D, MyList<gridseg> *B, MyList<gridseg> *&C);
+  MyList<Parallel::gridseg> *gs_subtract_virtual(MyList<Parallel::gridseg> *A, MyList<Parallel::gridseg> *B);
+  void fill_level_data(MyList<Patch> *PatLd, MyList<Patch> *PatLs, MyList<Patch> *PatcL,
+                       MyList<var> *OldList, MyList<var> *StateList, MyList<var> *FutureList,
+                       MyList<var> *tmList, int Symmetry, bool BB, bool CC);
+  bool PatList_Interp_Points(MyList<Patch> *PatL, MyList<var> *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<Parallel::gridseg> *gsl);
+  void checkpatchlist(MyList<Patch> *PatL, bool buflog);
+
+  double L2Norm(Patch *Pat, var *vf, MPI_Comm Comm_here);
+  bool PatList_Interp_Points(MyList<Patch> *PatL, MyList<var> *VarList,
+                             int NN, double **XX,
+                             double *Shellf, int Symmetry, MPI_Comm Comm_here);
+#if (PSTR == 1 || PSTR == 2 || PSTR == 3)
+  MyList<Block> *distribute(MyList<Patch> *PatchLIST, int cpusize, int ingfsi, int fngfsi,
+                            bool periodic, int start_rank, int end_rank, int nodes = 0);
+#endif
+}
+#endif /*PARALLEL_H */

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<Patch> *PLc, MyList<Patch> *PLf,
+                               MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                               int Symmetry)
+{
+   MyList<Parallel::pointstru_bam> *bdsul;
+   Constr_pointstr_OutBdLow2Hi(PLf, PLc, bdsul);
+
+   intertransfer(bdsul, VarList1, VarList2, Symmetry);
+
+   destroypsuList_bam(bdsul);
+}
+void Parallel::Restrict_bam(MyList<Patch> *PLc, MyList<Patch> *PLf,
+                            MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                            int Symmetry)
+{
+   MyList<Parallel::pointstru_bam> *rsul;
+   Constr_pointstr_Restrict(PLf, PLc, rsul);
+
+   intertransfer(rsul, VarList1, VarList2, Symmetry);
+
+   destroypsuList_bam(rsul);
+}
+void Parallel::OutBdLow2Hi_bam(MyList<Patch> *PLc, MyList<Patch> *PLf,
+                               MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                               MyList<Parallel::pointstru_bam> *bdsul, int Symmetry)
+{
+   intertransfer(bdsul, VarList1, VarList2, Symmetry);
+}
+void Parallel::Restrict_bam(MyList<Patch> *PLc, MyList<Patch> *PLf,
+                            MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                            MyList<Parallel::pointstru_bam> *rsul, int Symmetry)
+{
+   intertransfer(rsul, VarList1, VarList2, Symmetry);
+}
+void Parallel::Constr_pointstr_OutBdLow2Hi(MyList<Patch> *PLf, MyList<Patch> *PLc,
+                                           MyList<Parallel::pointstru_bam> *&bdsul)
+{
+   MyList<Patch> *PL;
+
+   MyList<Parallel::pointstru_bam> *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<Parallel::pointstru_bam>;
+                     ps = ps->next;
+                     ps->data = new Parallel::pointstru_bam;
+                  }
+                  else
+                  {
+                     bdsul = ps = new MyList<Parallel::pointstru_bam>;
+                     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<Block> *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<Block> *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<Patch> *PLf, MyList<Patch> *PLc,
+                                        MyList<Parallel::pointstru_bam> *&rsul)
+{
+   MyList<Parallel::gridseg> *gdlf = 0, *gs;
+   MyList<Patch> *PL = PLf;
+   while (PL)
+   {
+      if (gdlf)
+      {
+         gs->next = new MyList<Parallel::gridseg>;
+         gs = gs->next;
+         gs->data = new Parallel::gridseg;
+      }
+      else
+      {
+         gdlf = gs = new MyList<Parallel::gridseg>;
+         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<Parallel::pointstru_bam> *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<Parallel::pointstru_bam>;
+                     ps = ps->next;
+                     ps->data = new Parallel::pointstru_bam;
+                  }
+                  else
+                  {
+                     rsul = ps = new MyList<Parallel::pointstru_bam>;
+                     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<Block> *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<Block> *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<Parallel::pointstru_bam> *&sul,
+                             MyList<var> *VarList1 /* source */, MyList<var> *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<Parallel::pointstru_bam> *sul, int myrank, int node, int dir,
+                               MyList<var> *VarLists /* source */, MyList<var> *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<var> *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<pointstru_bam> *ct)
+{
+   MyList<pointstru_bam> *n;
+   while (ct)
+   {
+      n = ct->next;
+      if (ct->data->coef)
+         delete[] ct->data->coef;
+      delete ct->data;
+      delete ct;
+      ct = n;
+   }
+}

AMSS_NCKU_source/Parallel_bam.h

@@ -0,0 +1,53 @@
+
+#ifndef PARALLEL_BAM_H
+#define PARALLEL_BAM_H
+
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <cstdlib>
+#include <cstdio>
+#include <string>
+#include <cmath>
+#include <new>
+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<pointstru_bam> *ct);
+  void OutBdLow2Hi_bam(MyList<Patch> *PLc, MyList<Patch> *PLf,
+                       MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                       int Symmetry);
+  void OutBdLow2Hi_bam(MyList<Patch> *PLc, MyList<Patch> *PLf,
+                       MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                       MyList<Parallel::pointstru_bam> *bdsul, int Symmetry);
+  void Constr_pointstr_OutBdLow2Hi(MyList<Patch> *PLf, MyList<Patch> *PLc,
+                                   MyList<Parallel::pointstru_bam> *&bdsul);
+  void Restrict_bam(MyList<Patch> *PLc, MyList<Patch> *PLf,
+                    MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                    int Symmetry);
+  void Restrict_bam(MyList<Patch> *PLc, MyList<Patch> *PLf,
+                    MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /* target */,
+                    MyList<Parallel::pointstru_bam> *rsul, int Symmetry);
+  void Constr_pointstr_Restrict(MyList<Patch> *PLf, MyList<Patch> *PLc,
+                                MyList<Parallel::pointstru_bam> *&rsul);
+  void intertransfer(MyList<Parallel::pointstru_bam> *&sul,
+                     MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /*target */,
+                     int Symmetry);
+  int interdata_packer(double *data, MyList<Parallel::pointstru_bam> *sul, int myrank, int node, int dir,
+                       MyList<var> *VarLists /* source */, MyList<var> *VarListd /* target */, int Symmetry);
+}
+#endif /*PARALLEL_BAM_H */

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

AMSS_NCKU_source/ShellPatch.h

@@ -0,0 +1,204 @@
+
+#ifndef SHELLPATCH_H
+#define SHELLPATCH_H
+
+#include <mpi.h>
+#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<Block> *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<var> *VarList, int Symmetry);
+   MyList<Parallel::gridseg> *build_bulk_gsl(Block *bp);
+   MyList<Parallel::gridseg> *build_ghost_gsl();
+   MyList<Parallel::gridseg> *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<ss_patch> *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<pointstru> **ss_src, **ss_dst;
+   // at means target
+   MyList<pointstru> **csatc_src, **csatc_dst;
+   MyList<pointstru> **csats_src, **csats_dst;
+
+public:
+   ShellPatch(int ingfsi, int fngfsi, char *filename, int Symmetry, int myranki, monitor *ErrorMonitor);
+
+   ~ShellPatch();
+
+   MyList<Block> *compose_sh(int cpusize, int nodes = 0);
+   MyList<Block> *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<pointstru> *pp, bool first_only);
+   void check_pointstrul2(MyList<pointstru> *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<var> *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<pointstru> *&psul, MyList<ss_patch> *sPp, double DH[dim],
+                         MyList<Patch> *Pp, double CDH[dim], MyList<pointstru> *pss);
+   bool prolongpointstru(MyList<pointstru> *&psul, bool ssyn, int tsst, MyList<ss_patch> *sPp, double DH[dim],
+                         MyList<Patch> *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in);
+   void setupintintstuff(int cpusize, MyList<Patch> *CPatL, int Symmetry);
+   void intertransfer(MyList<pointstru> **src, MyList<pointstru> **dst,
+                      MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /*target */,
+                      int Symmetry);
+   int interdata_packer(double *data, MyList<pointstru> *src, MyList<pointstru> *dst,
+                        int rank_in, int dir,
+                        MyList<var> *VarLists /* source */, MyList<var> *VarListd /* target */,
+                        int Symmetry);
+   void Synch(MyList<var> *VarList, int Symmetry);
+   void CS_Inter(MyList<var> *VarList, int Symmetry);
+   void destroypsuList(MyList<pointstru> *ct);
+   int getdumydimension(int acsst, int posst); // -1 means no dumy dimension
+   void matchcheck(MyList<Patch> *CPatL);
+   void shellname(char *sn, int i);
+   void Interp_Points(MyList<var> *VarList,
+                      int NN, double **XX, /*input global Cartesian coordinate*/
+                      double *Shellf, int Symmetry);
+   bool Interp_One_Point(MyList<var> *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<var> *VarList, double *XX, double *Shellf);
+};
+
+#endif /* SHELLPATCH_H */

AMSS_NCKU_source/TwoPunctureABE.C

@@ -0,0 +1,221 @@
+
+#ifdef newc
+#include <algorithm>
+#include <functional>
+#include <vector>
+#include <cstring>
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <cstdlib>
+#include <cstdio>
+#include <string>
+#include <cmath>
+#include <strstream>
+using namespace std;
+#else
+#include <iostream.h>
+#include <iomanip.h>
+#include <fstream.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <math.h>
+#endif
+
+#include "TwoPunctures.h"
+
+inline string &lTrim(string &ss)
+{
+  string::iterator p = find_if(ss.begin(), ss.end(), not1(ptr_fun<int, int>(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<int, int>(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);
+}

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 */

AMSS_NCKU_source/Z4c_class.h

@@ -0,0 +1,64 @@
+
+#ifndef Z4c_CLASS_H
+#define Z4c_CLASS_H
+
+#ifdef newc
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <cstdlib>
+#include <string>
+#include <cmath>
+using namespace std;
+#else
+#include <iostream.h>
+#include <iomanip.h>
+#include <fstream.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#endif
+
+#include <mpi.h>
+
+#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 */

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

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

AMSS_NCKU_source/array.C

@@ -0,0 +1,186 @@
+#include <assert.h>
+#include <stddef.h> // NULL
+#include <stdlib.h> // size_t
+
+#include "cctk.h"
+
+#include "stdc.h"
+#include "util.h"
+#include "array.h"
+
+namespace AHFinderDirect
+{
+	namespace jtutil
+	{
+
+		template <typename T>
+		array1d<T>::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 <typename T>
+		array1d<T>::~array1d()
+		{
+			if (we_own_array_)
+				then delete[] array_;
+		}
+
+		//
+		// This function constructs an  array2d  object.
+		//
+		template <typename T>
+		array2d<T>::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 <typename T>
+		array2d<T>::~array2d()
+		{
+			if (we_own_array_)
+				then delete[] array_;
+		}
+
+		//
+		// This function constructs an  array3d  object.
+		//
+		template <typename T>
+		array3d<T>::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 <typename T>
+		array3d<T>::~array3d()
+		{
+			if (we_own_array_)
+				then delete[] array_;
+		}
+
+		template class array1d<int>;
+
+		// FIXME: we shouldn't have to instantiate these both, the const one
+		//	  is actually trivially derivable from the non-const one. :(
+		template class array1d<void *>;
+		template class array1d<const void *>;
+
+		template class array1d<CCTK_REAL>;
+		template class array2d<CCTK_INT>;
+		template class array2d<CCTK_REAL>;
+		template class array3d<CCTK_REAL>;
+
+	} // namespace jtutil
+} // namespace AHFinderDirect

AMSS_NCKU_source/array.h

@@ -0,0 +1,292 @@
+#ifndef AHFINDERDIRECT__ARRAY_HH
+#define AHFINDERDIRECT__ARRAY_HH
+
+namespace AHFinderDirect
+{
+	namespace jtutil
+	{
+
+		//******************************************************************************
+
+		template <typename T>
+		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<const T *>(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<T> &rhs);
+			array1d<T> &operator=(const array1d<T> &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 <typename T>
+		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<const T *>(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<T> &rhs);
+			array2d<T> &operator=(const array2d<T> &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 <typename T>
+		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<const T *>(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<T> &rhs);
+			array3d<T> &operator=(const array3d<T> &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 */

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

AMSS_NCKU_source/bssnEM_class.h

@@ -0,0 +1,69 @@
+
+#ifndef BSSNEM_CLASS_H
+#define BSSNEM_CLASS_H
+
+#ifdef newc
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <cstdlib>
+#include <string>
+#include <cmath>
+using namespace std;
+#else
+#include <iostream.h>
+#include <iomanip.h>
+#include <fstream.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#endif
+
+#include <mpi.h>
+
+#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 */

AMSS_NCKU_source/bssnEScalar_class.h

@@ -0,0 +1,70 @@
+
+#ifndef BSSNESCALAR_CLASS_H
+#define BSSNESCALAR_CLASS_H
+
+#ifdef newc
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <cstdlib>
+#include <string>
+#include <cmath>
+using namespace std;
+#else
+#include <iostream.h>
+#include <iomanip.h>
+#include <fstream.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#endif
+
+#include <mpi.h>
+
+#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 */
+

AMSS_NCKU_source/bssn_class.h

@@ -0,0 +1,198 @@
+
+#ifndef BSSN_CLASS_H
+#define BSSN_CLASS_H
+
+#ifdef newc
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <cstdlib>
+#include <string>
+#include <cmath>
+using namespace std;
+#else
+#include <iostream.h>
+#include <iomanip.h>
+#include <fstream.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#endif
+
+#include <mpi.h>
+
+#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<var> *StateList, *SynchList_pre, *SynchList_cor, *RHSList;
+       MyList<var> *OldStateList, *DumpList;
+       MyList<var> *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<var> *SL, MyList<var> *OL, MyList<var> *corL);
+       void RestrictProlong_aux(int lev, int YN, bool BB, MyList<var> *SL, MyList<var> *OL, MyList<var> *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<var> *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<var> *VarList,
+                             int NN, double **XX,
+                             double *Shellf, int Symmetryi);
+       void AH_Step_Find(int lev, double dT_lev);
+#endif
+};
+#endif /* BSSN_CLASS_H */

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

AMSS_NCKU_source/bssn_gpu.h

@@ -0,0 +1,73 @@
+
+#ifndef BSSN_GPU_H_
+#define BSSN_GPU_H_
+#include "bssn_macro.h"
+#include "macrodef.fh"
+
+#define DEVICE_ID 0
+// #define DEVICE_ID_BY_MPI_RANK
+#define GRID_DIM 256
+#define BLOCK_DIM 128
+
+#define _FH2_(i, j, k) fh[(i) + (j) * _1D_SIZE[2] + (k) * _2D_SIZE[2]]
+#define _FH3_(i, j, k) fh[(i) + (j) * _1D_SIZE[3] + (k) * _2D_SIZE[3]]
+#define pow2(x) ((x) * (x))
+#define TimeBetween(a, b) ((b.tv_sec - a.tv_sec) + (b.tv_usec - a.tv_usec) / 1000000.0f)
+#define M_ metac.
+#define Mh_ meta->
+#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

AMSS_NCKU_source/bssn_gpu_class.h

@@ -0,0 +1,210 @@
+
+#ifndef BSSN_GPU_CLASS_H
+#define BSSN_GPU_CLASS_H
+
+#ifdef newc
+#include <iostream>
+#include <iomanip>
+#include <fstream>
+#include <cstdlib>
+#include <string>
+#include <cmath>
+using namespace std;
+#else
+#include <iostream.h>
+#include <iomanip.h>
+#include <fstream.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#endif
+
+#include <mpi.h>
+
+#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<var> *StateList, *SynchList_pre, *SynchList_cor, *RHSList;
+       MyList<var> *OldStateList, *DumpList;
+       MyList<var> *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<var> *SL, MyList<var> *OL, MyList<var> *corL);
+       void RestrictProlong_aux(int lev, int YN, bool BB, MyList<var> *SL, MyList<var> *OL, MyList<var> *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<var> *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<var> *VarList,
+                             int NN, double **XX,
+                             double *Shellf, int Symmetryi);
+       void AH_Step_Find(int lev, double dT_lev);
+#endif
+};
+#endif /* BSSN_GPU_CLASS_H */

AMSS_NCKU_source/bssn_macro.C

@@ -0,0 +1,124 @@
+#include "bssn_macro.h"
+#include <iostream>
+#include <fstream>
+#include <cstring>
+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<<test_output_g[i+j*(cg->shape[0]) + k*(_2d_size)] <<' ';
+				// fout2<<test_fh_f    [i+j*(cg->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<<d1[i]<<" "<<d2[i]<<endl;
+	}
+	if (is_match)
+		cout << ftag1 << "::matched." << endl;
+
+	if (ftag1 == 0)
+	{
+		printMatrix(1, 2, d1, d2, 3);
+	}
+	free(d1);
+	file1.close();
+	return 0;
+}

AMSS_NCKU_source/bssn_macro.h

@@ -0,0 +1,94 @@
+#ifndef BSSN_STEP_H
+#define BSSN_STEP_H
+//1---------------------FLAGS---------------------
+
+#define USE_GPU
+#define MAX_GPU_PROCESS_NUM 1
+#define COUNT_CPU_RHS_TIME
+
+
+//2---------------------TIMER---------------------
+//2.1 TIMER_INIT
+//2.2 TIMER_TIC_WITHOUT_OUTPUT
+//2.3 TIMER_TIC(tag,order,label)
+//2.4 TIMER_TIC_TAIL_OF_FUNC(tag,label)
+
+#define TIME_COUNT_EACH_RANK 0
+
+#define TIMER_INIT \
+double clock_prev,clock_curr,step_begin_clock;\
+if(1 == 1){\
+	clock_curr =MPI_Wtime();\
+	step_begin_clock = MPI_Wtime();\
+}else{\
+if(myrank == 0){\
+	clock_curr= MPI_Wtime();\
+	step_begin_clock = MPI_Wtime();\
+}\
+}
+      
+#define TIMER_TIC(tag,order,label) \
+if(TIME_COUNT_EACH_RANK == 1){\
+	  clock_prev= clock_curr;\
+      clock_curr = MPI_Wtime();\
+      cout<<#tag <<order <<":MPI Rank: "<<myrank<<" "<<#label <<" "<<(clock_curr-clock_prev)<<endl;\
+}else{\
+  if(myrank==0){\
+      clock_prev= clock_curr;\
+      clock_curr = MPI_Wtime();\
+      cout<<#tag <<order <<" "<<#label " "<<(clock_curr-clock_prev)<<endl;\
+  }\
+}
+
+#define TIMER_TIC_EACH_PROC(tag,order,label) \
+	  clock_prev= clock_curr;\
+      clock_curr = MPI_Wtime();\
+      cout<<#tag <<order <<":MPI Rank: "<<myrank<<" "<<#label <<" "<<(clock_curr-clock_prev)<<endl;\
+}
+
+#define TIMER_TIC_WITHOUT_OUTPUT \
+if(TIME_COUNT_EACH_RANK == 1){\
+      clock_curr = MPI_Wtime();\
+}else{\
+  if(myrank==0){\
+      clock_curr = MPI_Wtime();\
+  }\
+}
+
+#define TIMER_TIC_TAIL_OF_FUNC(tag,label) \
+if(TIME_COUNT_EACH_RANK == 1){\
+	 cout<<#tag <<"MPI Rank: "<<myrank<<" "<<#label <<" "<<(MPI_Wtime()-step_begin_clock)<<" seconds!"<<endl;\
+}else{\
+     if(myrank==0)\
+     {\
+      cout<<#tag <<#label <<" "<<(MPI_Wtime()-step_begin_clock)<<" seconds!"<<endl;\
+     }\
+}
+
+//3---------------------GPU---------------------
+#define CALLED_BY_STEP 0
+#define CALLED_BY_CONSTRAINT 1
+
+#define RHS_PARA_CALLED_FIRST_TIME 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_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

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 */

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 <stddef.h>
+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

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_ */

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_ */
+

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_ */
+

AMSS_NCKU_source/cgh.h

@@ -0,0 +1,92 @@
+
+#ifndef CGH_H
+#define CGH_H
+
+#include <mpi.h>
+#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<Patch> **PatL;
+
+// information of OutBdLow2Hi point list and Restrict point list
+#if (RPB == 1)
+   MyList<Parallel::pointstru_bam> **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<Patch> *PatL, bool buflog);
+   void Regrid(int Symmetry, int BH_num, double **Porgbr, double **Porg0,
+               MyList<var> *OldList, MyList<var> *StateList,
+               MyList<var> *FutureList, MyList<var> *tmList, bool BB,
+               monitor *ErrorMonitor);
+   void Regrid_fake(int Symmetry, int BH_num, double **Porgbr, double **Porg0,
+                    MyList<var> *OldList, MyList<var> *StateList,
+                    MyList<var> *FutureList, MyList<var> *tmList, bool BB,
+                    monitor *ErrorMonitor);
+   void recompose_cgh(int nprocs, bool *lev_flag,
+                      MyList<var> *OldList, MyList<var> *StateList,
+                      MyList<var> *FutureList, MyList<var> *tmList,
+                      int Symmetry, bool BB);
+   void recompose_cgh_fake(int nprocs, bool *lev_flag,
+                           MyList<var> *OldList, MyList<var> *StateList,
+                           MyList<var> *FutureList, MyList<var> *tmList,
+                           int Symmetry, bool BB);
+   void read_bbox(int Symmetry, char *filename);
+   MyList<Patch> *construct_patchlist(int lev, int Symmetry);
+   bool Interp_One_Point(MyList<var> *VarList,
+                         double *XX, /*input global Cartesian coordinate*/
+                         double *Shellf, int Symmetry);
+   void recompose_cgh_Onelevel(int nprocs, int lev,
+                               MyList<var> *OldList, MyList<var> *StateList,
+                               MyList<var> *FutureList, MyList<var> *tmList,
+                               int Symmetry, bool BB);
+   void Regrid_Onelevel(int lev, int Symmetry, int BH_num, double **Porgbr, double **Porg0,
+                        MyList<var> *OldList, MyList<var> *StateList,
+                        MyList<var> *FutureList, MyList<var> *tmList, bool BB,
+                        monitor *ErrorMonitor);
+   void Regrid_Onelevel_aux(int lev, int Symmetry, int BH_num, double **Porgbr, double **Porg0,
+                            MyList<var> *OldList, MyList<var> *StateList,
+                            MyList<var> *FutureList, MyList<var> *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 */

AMSS_NCKU_source/checkpoint.C

@@ -0,0 +1,893 @@
+
+#ifdef newc
+#include <cstdio>
+using namespace std;
+#else
+#include <stdio.h>
+#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<string, string>::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<string, string>::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<string, string>::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<var>(VV);
+}
+void checkpoint::addvariablelist(MyList<var> *VL)
+{
+	while (VL)
+	{
+		if (CheckList)
+			CheckList->insert(VL->data);
+		else
+			CheckList = new MyList<var>(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<Patch> *PL = GH->PatL[lev];
+		while (PL)
+		{
+			Patch *PP = PL->data;
+			int nn = PP->shape[0] * PP->shape[1] * PP->shape[2];
+			MyList<var> *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<Patch> *[GH->levels];
+	GH->Lt = new double[GH->levels];
+	GH->Porgls = new double **[GH->levels];
+#if (RPB == 1)
+	GH->bdsul = new MyList<Parallel::pointstru_bam> *[GH->levels];
+	GH->rsul = new MyList<Parallel::pointstru_bam> *[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<Patch> *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<var> *VL = CheckList;
+			while (VL)
+			{
+				infile.read((char *)databuffer, sizeof(double) * nn);
+
+				{
+					MyList<Block> *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<ss_patch> *Pp = SH->PatL;
+	while (Pp)
+	{
+		int nn = Pp->data->shape[0] * Pp->data->shape[1] * Pp->data->shape[2];
+		MyList<var> *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<ss_patch> *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<var> *VL = CheckList;
+		while (VL)
+		{
+			infile.read((char *)databuffer, sizeof(double) * nn);
+			MyList<Block> *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<Patch> *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<Block> *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<var> *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<Patch> *[GH->levels];
+	GH->Lt = new double[GH->levels];
+	GH->Porgls = new double **[GH->levels];
+#if (RPB == 1)
+	GH->bdsul = new MyList<Parallel::pointstru_bam> *[GH->levels];
+	GH->rsul = new MyList<Parallel::pointstru_bam> *[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<Patch> *gp;
+		// loop of patach
+		for (int cj = 0; cj < cnt; cj++)
+		{
+			if (GH->PatL[lev])
+			{
+				gp->next = new MyList<Patch>;
+				gp = gp->next;
+			}
+			else
+			{
+				GH->PatL[lev] = gp = new MyList<Patch>;
+			}
+			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<Block> *cg;
+			for (int bj = 0; bj < bnt; bj++)
+			{
+				if (gp->data->blb)
+				{
+					cg->next = new MyList<Block>;
+					cg = cg->next;
+				}
+				else
+				{
+					gp->data->blb = cg = new MyList<Block>;
+				}
+				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<var> *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

AMSS_NCKU_source/checkpoint.h

@@ -0,0 +1,60 @@
+
+#ifndef CHECKPOINT_H
+#define CHECKPOINT_H
+
+#ifdef newc
+#include <iostream>
+#include <iomanip>
+#include <strstream>
+#include <fstream>
+#include <string>
+using namespace std;
+#else
+#include <iostream.h>
+#include <iomanip.h>
+#include <strstream>
+#include <fstream.h>
+#include <string.h>
+#endif
+#include <time.h>
+#include <stdlib.h>
+
+#include <mpi.h>
+
+#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<var> *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<var> *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 */

AMSS_NCKU_source/config.h

@@ -0,0 +1,16 @@
+#ifndef AHFINDERDIRECT__CONFIG_H
+#define AHFINDERDIRECT__CONFIG_H
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+
+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 */

AMSS_NCKU_source/coords.C

@@ -0,0 +1,533 @@
+#include <math.h>
+#include <float.h>
+#include <assert.h>
+#include <limits.h>
+
+#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<fp>::is_integer((ang2 - ang1) / (2.0 * PI));
+		}
+
+		bool fuzzy_EQ_dang(fp dang1, fp dang2)
+		{
+			return jtutil::fuzzy<fp>::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<fp>::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<fp>::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<fp>::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<fp>::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<fp>::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<fp>::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<fp>::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<fp>::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<fp>::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

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  */

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 */

AMSS_NCKU_source/cpm_map.C

@@ -0,0 +1,93 @@
+#include <assert.h>
+#include <stdio.h>
+
+#include "stdc.h"
+#include "util.h"
+#include "cpm_map.h"
+
+namespace AHFinderDirect
+{
+	namespace jtutil
+	{
+
+		template <typename fp_t>
+		cpm_map<fp_t>::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<fp_t>::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<fp_t>::to_integer(d_offset);
+
+			assert(
+				map_unchecked(fuzzy<fp_t>::floor(fixed_point)) ==
+				fuzzy<fp_t>::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 <typename fp_t>
+		cpm_map<fp_t>::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 <typename fp_t>
+		cpm_map<fp_t>::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<fp_t>::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<fp_t>::to_integer(fp_offset);
+
+			// verify that we have setup correct
+			assert(
+				map_unchecked(fuzzy<fp_t>::floor(sample_i)) ==
+				(map_is_plus_in ? fuzzy<fp_t>::floor(sample_j)
+								: fuzzy<fp_t>::ceiling(sample_j)));
+		}
+
+		template class cpm_map<float>;
+		template class cpm_map<double>;
+
+	} // namespace jtutil
+} // namespace AHFinderDirect

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 <typename fp_t>
+		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 */

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 */

AMSS_NCKU_source/driver.h

@@ -0,0 +1,108 @@
+#ifndef DRIVER_H
+#define DRIVER_H
+#include <stdio.h>
+#include <assert.h>
+#include <math.h>
+#include <string.h>
+
+#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<CCTK_REAL> *send_buffer_ptr;
+		jtutil::array2d<CCTK_REAL> *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    */

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

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 */

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

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 */

AMSS_NCKU_source/error_exit.C

@@ -0,0 +1,38 @@
+#include <stdio.h>
+#include <stdarg.h>
+#include <stdlib.h>
+#include <string.h>
+
+#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

AMSS_NCKU_source/expansion_Jacobian.C

@@ -0,0 +1,386 @@
+
+
+#include "macrodef.h"
+#ifdef With_AHF
+
+#include <stdio.h>
+#include <assert.h>
+#include <math.h>
+
+#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<fp> 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

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

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 */