diff --git a/Examples/ComplexMatrix/main.f90 b/Examples/ComplexMatrix/main.f90 index 54823dae..30f9b000 100644 --- a/Examples/ComplexMatrix/main.f90 +++ b/Examples/ComplexMatrix/main.f90 @@ -15,7 +15,8 @@ PROGRAM ComplexMatrix & PrintMatrix, CopyMatrix, WriteMatrixToMatrixMarket USE ProcessGridModule, ONLY : ConstructProcessGrid, DestructProcessGrid, & & IsRoot - USE SolverParametersModule, ONLY : SolverParameters_t + USE SolverParametersModule, ONLY : SolverParameters_t, & + & ConstructSolverParameters, DestructSolverParameters USE TripletListModule, ONLY : TripletList_r, DestructTripletList, & & GetTripletAt, TripletList_c, ConstructTripletList, & & AppendToTripletList, SymmetrizeTripletList @@ -35,16 +36,16 @@ PROGRAM ComplexMatrix !! Temporary Variables CHARACTER(len=80) :: argument CHARACTER(len=80) :: argument_value - INTEGER :: counter + INTEGER :: II INTEGER :: provided, ierr !! Setup MPI CALL MPI_Init_thread(MPI_THREAD_SERIALIZED, provided, ierr) !! Process The Input - DO counter=1,COMMAND_ARGUMENT_COUNT(),2 - CALL GET_COMMAND_ARGUMENT(counter,argument) - CALL GET_COMMAND_ARGUMENT(counter+1,argument_value) + DO II = 1, COMMAND_ARGUMENT_COUNT(), 2 + CALL GET_COMMAND_ARGUMENT(II, argument) + CALL GET_COMMAND_ARGUMENT(II + 1, argument_value) SELECT CASE(argument) CASE('--input_file') input_file = argument_value @@ -85,7 +86,7 @@ PROGRAM ComplexMatrix CALL ScaleMatrix(GMat, 0.5_NTREAL) !! Compute The Exponential - solver_parameters = SolverParameters_t(threshold_in=threshold) + CALL ConstructSolverParameters(solver_parameters, threshold_in=threshold) CALL ComputeExponential(GMat, ExMat, solver_parameters) !! Write To File @@ -96,6 +97,7 @@ PROGRAM ComplexMatrix CALL DestructMatrix(GMat) !! Cleanup + CALL DestructSolverParameters(solver_parameters) IF (IsRoot()) THEN CALL DeactivateLogger END IF diff --git a/Examples/GraphTheory/main.f90 b/Examples/GraphTheory/main.f90 index a60e28bd..fc8af019 100644 --- a/Examples/GraphTheory/main.f90 +++ b/Examples/GraphTheory/main.f90 @@ -11,7 +11,8 @@ PROGRAM GraphTheory & ConstructEmptyMatrix, FillMatrixFromTripletList, DestructMatrix, & & CopyMatrix, FillMatrixIdentity USE PSMatrixAlgebraModule, ONLY: IncrementMatrix - USE SolverParametersModule, ONLY : SolverParameters_t + USE SolverParametersModule, ONLY : SolverParameters_t, & + & ConstructSolverParameters, DestructSolverParameters USE TripletListModule, ONLY : TripletList_r, ConstructTripletList, & & SetTripletAt, AppendToTripletList USE TripletModule, ONLY : Triplet_r @@ -42,7 +43,7 @@ PROGRAM GraphTheory !! Temporary Values CHARACTER(len=80) :: argument CHARACTER(len=80) :: argument_value - INTEGER :: counter + INTEGER :: II !! Setup MPI CALL MPI_Init_thread(MPI_THREAD_SERIALIZED, provided, ierr) @@ -50,9 +51,9 @@ PROGRAM GraphTheory CALL MPI_Comm_size(MPI_COMM_WORLD, total_processors, ierr) !! Process the input parameters. - DO counter=1,COMMAND_ARGUMENT_COUNT(),2 - CALL GET_COMMAND_ARGUMENT(counter,argument) - CALL GET_COMMAND_ARGUMENT(counter+1,argument_value) + DO II = 1, COMMAND_ARGUMENT_COUNT(), 2 + CALL GET_COMMAND_ARGUMENT(II, argument) + CALL GET_COMMAND_ARGUMENT(II + 1, argument_value) SELECT CASE(argument) CASE('--output_file') output_file = argument_value @@ -97,7 +98,7 @@ PROGRAM GraphTheory CALL ExitSubLog !! Set Up The Solver Parameters. - solver_parameters = SolverParameters_t( be_verbose_in=.TRUE., & + CALL ConstructSolverParameters(solver_parameters, be_verbose_in=.TRUE., & & converge_diff_in=convergence_threshold, threshold_in=threshold) CALL DivideUpWork @@ -121,6 +122,7 @@ PROGRAM GraphTheory IF (IsRoot()) THEN CALL DeactivateLogger END IF + CALL DestructSolverParameters(solver_parameters) CALL DestructProcessGrid CALL MPI_Finalize(ierr) CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -132,8 +134,8 @@ SUBROUTINE DivideUpWork() number_of_local_nodes = number_of_nodes - rank*number_of_local_nodes END IF ALLOCATE(local_nodes(number_of_local_nodes)) - fillrow: DO counter=1,number_of_local_nodes - local_nodes(counter) = starting_node + (counter-1) + fillrow: DO II = 1, number_of_local_nodes + local_nodes(II) = starting_node + (II-1) END DO fillrow ending_node = local_nodes(number_of_local_nodes) END SUBROUTINE DivideUpWork @@ -142,7 +144,7 @@ SUBROUTINE FillMatrix TYPE(TripletList_r) :: triplet_list TYPE(Triplet_r) :: temp_triplet INTEGER :: num_of_edges - INTEGER :: counter + INTEGER :: II INTEGER, DIMENSION(:), ALLOCATABLE :: extra_scratch REAL :: temporary INTEGER :: extra_source_node, extra_destination_node @@ -150,31 +152,31 @@ SUBROUTINE FillMatrix CALL ConstructTripletList(triplet_list) !! First add the connection between each node and itself. - fill_diagonal: DO counter=1, number_of_local_nodes - temp_triplet%index_row = local_nodes(counter) - temp_triplet%index_column = local_nodes(counter) + fill_diagonal: DO II = 1, number_of_local_nodes + temp_triplet%index_row = local_nodes(II) + temp_triplet%index_column = local_nodes(II) temp_triplet%point_value = 1 CALL AppendToTripletList(triplet_list,temp_triplet) END DO fill_diagonal !! Now connections between nearest neighbors. - fill_neighbor: DO counter=1, number_of_local_nodes - temp_triplet%index_row = local_nodes(counter) + fill_neighbor: DO II = 1, number_of_local_nodes + temp_triplet%index_row = local_nodes(II) temp_triplet%point_value = 0.1 - IF (local_nodes(counter) .EQ. 1) THEN + IF (local_nodes(II) .EQ. 1) THEN !! Right value - temp_triplet%index_column = local_nodes(counter) + 1 + temp_triplet%index_column = local_nodes(II) + 1 CALL AppendToTripletList(triplet_list,temp_triplet) - ELSE IF (local_nodes(counter) .EQ. number_of_nodes) THEN + ELSE IF (local_nodes(II) .EQ. number_of_nodes) THEN !! Left value - temp_triplet%index_column = local_nodes(counter) - 1 + temp_triplet%index_column = local_nodes(II) - 1 CALL AppendToTripletList(triplet_list,temp_triplet) ELSE !! Left value - temp_triplet%index_column = local_nodes(counter) - 1 + temp_triplet%index_column = local_nodes(II) - 1 CALL AppendToTripletList(triplet_list,temp_triplet) !! Right value - temp_triplet%index_column = local_nodes(counter) + 1 + temp_triplet%index_column = local_nodes(II) + 1 CALL AppendToTripletList(triplet_list,temp_triplet) END IF END DO fill_neighbor @@ -182,8 +184,8 @@ SUBROUTINE FillMatrix !! Finally the random extra connections. ALLOCATE(extra_scratch(number_of_nodes)) extra_scratch = 0 - counter = 1 - DO WHILE(counter .LE. extra_connections) + II = 1 + DO WHILE(II .LE. extra_connections) CALL RANDOM_NUMBER(temporary) extra_source_node = CEILING(temporary*number_of_nodes) CALL RANDOM_NUMBER(temporary) @@ -195,7 +197,7 @@ SUBROUTINE FillMatrix & extra_source_node .NE. extra_destination_node .AND. & & extra_source_node .NE. extra_destination_node - 1 .AND. & & extra_source_node .NE. extra_destination_node + 1) THEN - counter = counter + 1 + II = II + 1 extra_scratch(extra_source_node) = 1 extra_scratch(extra_destination_node) = 1 diff --git a/Examples/HydrogenAtom/main.f90 b/Examples/HydrogenAtom/main.f90 index 35e8fc21..c374af1b 100644 --- a/Examples/HydrogenAtom/main.f90 +++ b/Examples/HydrogenAtom/main.f90 @@ -11,7 +11,8 @@ PROGRAM HydrogenAtom & ConstructEmptyMatrix, FillMatrixFromTripletList, CopyMatrix, & & FillMatrixIdentity USE PSMatrixAlgebraModule, ONLY : IncrementMatrix - USE SolverParametersModule, ONLY : SolverParameters_t + USE SolverParametersModule, ONLY : SolverParameters_t, & + & ConstructSolverParameters, DestructSolverParameters USE SquareRootSolversModule, ONLY : InverseSquareRoot USE TripletListModule, ONLY : TripletList_r, ConstructTripletList, & & AppendToTripletList @@ -46,7 +47,7 @@ PROGRAM HydrogenAtom !! Temporary Variables CHARACTER(len=80) :: argument CHARACTER(len=80) :: argument_value - INTEGER :: counter + INTEGER :: II !! Setup MPI CALL MPI_Init_thread(MPI_THREAD_SERIALIZED, provided, ierr) @@ -54,9 +55,9 @@ PROGRAM HydrogenAtom CALL MPI_Comm_size(MPI_COMM_WORLD, total_processors, ierr) !! Process the input parameters. - DO counter=1,COMMAND_ARGUMENT_COUNT(),2 - CALL GET_COMMAND_ARGUMENT(counter,argument) - CALL GET_COMMAND_ARGUMENT(counter+1,argument_value) + DO II = 1, COMMAND_ARGUMENT_COUNT(), 2 + CALL GET_COMMAND_ARGUMENT(II, argument) + CALL GET_COMMAND_ARGUMENT(II+1, argument_value) SELECT CASE(argument) CASE('--convergence_threshold') READ(argument_value,*) convergence_threshold @@ -95,7 +96,7 @@ PROGRAM HydrogenAtom CALL ExitSubLog !! Set Up The Solver Parameters. - solver_parameters = SolverParameters_t( be_verbose_in=.TRUE., & + CALL ConstructSolverParameters(solver_parameters, be_verbose_in=.TRUE., & & converge_diff_in=convergence_threshold, threshold_in=threshold) !! Divide The Work Amongst Processors. @@ -131,6 +132,7 @@ PROGRAM HydrogenAtom IF (IsRoot()) THEN CALL DeactivateLogger END IF + CALL DestructSolverParameters(solver_parameters) CALL DestructProcessGrid CALL MPI_Finalize(ierr) CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -142,8 +144,8 @@ SUBROUTINE DivideUpWork() local_grid_points = grid_points - rank*local_grid_points END IF ALLOCATE(local_rows(local_grid_points)) - fillrow: DO counter=1,local_grid_points - local_rows(counter) = start_row + (counter-1) + fillrow: DO II = 1, local_grid_points + local_rows(II) = start_row + (II-1) END DO fillrow END SUBROUTINE DivideUpWork !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -156,23 +158,23 @@ SUBROUTINE ConstructLinearSpace() !! Fill in the x_values local_x_start = x_start + (start_row-1) * grid_spacing - fill: DO counter=1,local_grid_points - x_values(counter) = local_x_start + (counter-1)*grid_spacing + fill: DO II = 1, local_grid_points + x_values(II) = local_x_start + (II-1)*grid_spacing END DO fill END SUBROUTINE ConstructLinearSpace !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE FillKineticEnergy() !! Local Variables TYPE(TripletList_r) :: triplet_list - INTEGER :: counter + INTEGER :: II TYPE(Triplet_r) :: temp_value CALL ConstructTripletList(triplet_list) !! Fill The Triplet List. - fill: DO counter = 1, local_grid_points + fill: DO II = 1, local_grid_points !! Stencil point 1. - temp_value%index_row = start_row + counter - 1 + temp_value%index_row = start_row + II - 1 IF (temp_value%index_row .GT. 2) THEN temp_value%index_column = temp_value%index_row - 2 temp_value%point_value = (-0.5)*(-1.0/(12.0*grid_spacing**2)) @@ -207,14 +209,14 @@ END SUBROUTINE FillKineticEnergy SUBROUTINE FillPotentialEnergy() !! Local Variables TYPE(TripletList_r) :: triplet_list - INTEGER :: counter + INTEGER :: II TYPE(Triplet_r) :: temp_value CALL ConstructTripletList(triplet_list) - fill: DO counter = 1, local_grid_points - temp_value%index_row = start_row + counter - 1 - temp_value%index_column = start_row + counter - 1 - temp_value%point_value = -1.0/ABS(x_values(counter)) + fill: DO II = 1, local_grid_points + temp_value%index_row = start_row + II - 1 + temp_value%index_column = start_row + II - 1 + temp_value%point_value = -1.0/ABS(x_values(II)) CALL AppendToTripletList(triplet_list, temp_value) END DO fill CALL FillMatrixFromTripletList(PotentialEnergy, triplet_list) diff --git a/Examples/MatrixMaps/main.f90 b/Examples/MatrixMaps/main.f90 index 1cda234a..4e9d8c23 100644 --- a/Examples/MatrixMaps/main.f90 +++ b/Examples/MatrixMaps/main.f90 @@ -19,7 +19,7 @@ PROGRAM MatrixMapsProgram !! Temporary Variables CHARACTER(len=80) :: argument CHARACTER(len=80) :: argument_value - INTEGER :: counter + INTEGER :: II INTEGER :: provided, ierr INTEGER :: rank @@ -28,9 +28,9 @@ PROGRAM MatrixMapsProgram CALL MPI_Comm_rank(MPI_COMM_WORLD,rank, ierr) !! Process the input parameters. - DO counter=1,COMMAND_ARGUMENT_COUNT(),2 - CALL GET_COMMAND_ARGUMENT(counter,argument) - CALL GET_COMMAND_ARGUMENT(counter+1,argument_value) + DO II = 1, COMMAND_ARGUMENT_COUNT(), 2 + CALL GET_COMMAND_ARGUMENT(II, argument) + CALL GET_COMMAND_ARGUMENT(II+1, argument_value) SELECT CASE(argument) CASE('--input_matrix') input_matrix = argument_value diff --git a/Examples/OverlapMatrix/main.f90 b/Examples/OverlapMatrix/main.f90 index 4ef7a1c0..4fadc9d5 100644 --- a/Examples/OverlapMatrix/main.f90 +++ b/Examples/OverlapMatrix/main.f90 @@ -10,7 +10,8 @@ PROGRAM OverlapExample & DestructProcessGrid USE PSMatrixModule, ONLY : Matrix_ps, ConstructEmptyMatrix, & & WriteMatrixToMatrixMarket, FillMatrixFromTripletList, DestructMatrix - USE SolverParametersModule, ONLY : SolverParameters_t + USE SolverParametersModule, ONLY : SolverParameters_t, & + & ConstructSolverParameters, DestructSolverParameters USE SquareRootSolversModule, ONLY : InverseSquareRoot USE TimerModule, ONLY : RegisterTimer, StartTimer, StopTimer, PrintAllTimers USE TripletListModule, ONLY : TripletList_r, ConstructTripletList, & @@ -41,7 +42,7 @@ PROGRAM OverlapExample CHARACTER(len=80) :: argument CHARACTER(len=80) :: argument_value INTEGER :: column_counter, row_counter - INTEGER :: counter + INTEGER :: ARGII REAL(ntreal) :: integral_value !! Setup MPI @@ -49,9 +50,9 @@ PROGRAM OverlapExample CALL MPI_Comm_rank(MPI_COMM_WORLD,rank, ierr) !! Process the input parameters. - DO counter=1,COMMAND_ARGUMENT_COUNT(),2 - CALL GET_COMMAND_ARGUMENT(counter,argument) - CALL GET_COMMAND_ARGUMENT(counter+1,argument_value) + DO ARGII = 1, COMMAND_ARGUMENT_COUNT(), 2 + CALL GET_COMMAND_ARGUMENT(ARGII, argument) + CALL GET_COMMAND_ARGUMENT(ARGII + 1, argument_value) SELECT CASE(argument) CASE('--basis_functions') READ(argument_value,*) basis_functions @@ -126,7 +127,7 @@ PROGRAM OverlapExample !! Set Up The Solver Parameters. CALL ConstructRandomPermutation(permutation, & & Overlap%logical_matrix_dimension) - solver_parameters = SolverParameters_t(& + CALL ConstructSolverParameters(solver_parameters, & & converge_diff_in=convergence_threshold, threshold_in=threshold, & & BalancePermutation_in=permutation, be_verbose_in=.TRUE.) @@ -144,6 +145,7 @@ PROGRAM OverlapExample CALL DestructPermutation(permutation) CALL DestructMatrix(Overlap) CALL DestructMatrix(ISQOverlap) + CALL DestructSolverParameters(solver_parameters) !! Cleanup IF (IsRoot()) THEN diff --git a/Examples/PremadeMatrix/main.f90 b/Examples/PremadeMatrix/main.f90 index 9423115a..2b4417a9 100644 --- a/Examples/PremadeMatrix/main.f90 +++ b/Examples/PremadeMatrix/main.f90 @@ -11,7 +11,8 @@ PROGRAM PremadeMatrixProgram & DestructProcessGrid, WriteProcessGridInfo USE PSMatrixModule, ONLY : Matrix_ps, ConstructMatrixFromMatrixMarket, & & WriteMatrixToMatrixMarket, DestructMatrix - USE SolverParametersModule, ONLY : SolverParameters_t + USE SolverParametersModule, ONLY : SolverParameters_t, & + & ConstructSolverParameters, DestructSolverParameters USE SquareRootSolversModule, ONLY : InverseSquareRoot USE MPI IMPLICIT NONE @@ -32,7 +33,7 @@ PROGRAM PremadeMatrixProgram !! Temporary Variables CHARACTER(len=80) :: argument CHARACTER(len=80) :: argument_value - INTEGER :: counter + INTEGER :: II INTEGER :: provided, ierr INTEGER :: rank REAL(NTREAL) :: chemical_potential @@ -42,9 +43,9 @@ PROGRAM PremadeMatrixProgram CALL MPI_Comm_rank(MPI_COMM_WORLD,rank, ierr) !! Process the input parameters. - DO counter=1,COMMAND_ARGUMENT_COUNT(),2 - CALL GET_COMMAND_ARGUMENT(counter,argument) - CALL GET_COMMAND_ARGUMENT(counter+1,argument_value) + DO II = 1, COMMAND_ARGUMENT_COUNT(), 2 + CALL GET_COMMAND_ARGUMENT(II, argument) + CALL GET_COMMAND_ARGUMENT(II+1, argument_value) SELECT CASE(argument) CASE('--hamiltonian') hamiltonian_file = argument_value @@ -73,10 +74,12 @@ PROGRAM PremadeMatrixProgram CALL ConstructProcessGrid(MPI_COMM_WORLD, process_rows, process_columns, & & process_slices) - !! Write Out Parameters + !! Only Activate the Logger on Root IF (IsRoot()) THEN CALL ActivateLogger END IF + + !! Write Out Parameters CALL WriteHeader("Command Line Parameters") CALL EnterSubLog CALL WriteElement(key="hamiltonian", VALUE=hamiltonian_file) @@ -93,13 +96,13 @@ PROGRAM PremadeMatrixProgram CALL WriteProcessGridInfo !! Read in the matrices from file. - CALL ConstructMatrixFromMatrixMarket(Hamiltonian,hamiltonian_file) - CALL ConstructMatrixFromMatrixMarket(Overlap,overlap_file) + CALL ConstructMatrixFromMatrixMarket(Hamiltonian, hamiltonian_file) + CALL ConstructMatrixFromMatrixMarket(Overlap, overlap_file) !! Set Up The Solver Parameters. CALL ConstructRandomPermutation(permutation, & & Hamiltonian%logical_matrix_dimension) - solver_parameters = SolverParameters_t(& + CALL ConstructSolverParameters(solver_parameters, & & converge_diff_in=converge_overlap, threshold_in=threshold, & & BalancePermutation_in=permutation, be_verbose_in=.TRUE.) @@ -107,27 +110,28 @@ PROGRAM PremadeMatrixProgram CALL InverseSquareRoot(Overlap, ISQOverlap, solver_parameters) !! Change the solver variable for computing the density matrix. - solver_parameters%converge_diff=converge_density + solver_parameters%converge_diff = converge_density !! Compute the density matrix. CALL TRS2(Hamiltonian, ISQOverlap, number_of_electrons, & - & Density, solver_parameters_in=solver_parameters, & - & chemical_potential_out=chemical_potential) + & Density, solver_parameters_in = solver_parameters, & + & chemical_potential_out = chemical_potential) !! Print the density matrix to file. - CALL WriteMatrixToMatrixMarket(Density,density_file_out) + CALL WriteMatrixToMatrixMarket(Density, density_file_out) - !! Cleanup + !! Cleanup Derived Types + IF (IsRoot()) THEN + CALL DeactivateLogger + END IF + CALL DestructSolverParameters(solver_parameters) CALL DestructPermutation(permutation) CALL DestructMatrix(Overlap) CALL DestructMatrix(ISQOverlap) CALL DestructMatrix(Hamiltonian) CALL DestructMatrix(Density) - !! Cleanup - IF (IsRoot()) THEN - CALL DeactivateLogger - END IF + !! Cleanup MPI CALL DestructProcessGrid CALL MPI_Finalize(ierr) END PROGRAM PremadeMatrixProgram diff --git a/Source/Fortran/AnalysisModule.F90 b/Source/Fortran/AnalysisModule.F90 index 4c1ea7a0..e045002d 100644 --- a/Source/Fortran/AnalysisModule.F90 +++ b/Source/Fortran/AnalysisModule.F90 @@ -17,7 +17,8 @@ MODULE AnalysisModule & GetMatrixSlice USE SMatrixModule, ONLY : Matrix_lsr USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters IMPLICIT NONE PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -37,7 +38,7 @@ SUBROUTINE PivotedCholeskyDecomposition(AMat, LMat, rank_in, & !> Tarameters for the solver TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params !! For Pivoting INTEGER, DIMENSION(:), ALLOCATABLE :: pivot_vector REAL(NTREAL), DIMENSION(:), ALLOCATABLE :: diag @@ -70,22 +71,23 @@ SUBROUTINE PivotedCholeskyDecomposition(AMat, LMat, rank_in, & !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - solver_parameters = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF !! Print out parameters - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Linear Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Pivoted Cholesky Decomposition") - CALL WriteElement(key="Target_Rank", VALUE=rank_in) + CALL WriteElement(key = "Method", & + & VALUE = "Pivoted Cholesky Decomposition") + CALL WriteElement(key = "Target_Rank", VALUE = rank_in) CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("aquilante2006fast") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF CALL ConstructEmptyMatrix(LMat, AMat) @@ -134,11 +136,10 @@ SUBROUTINE PivotedCholeskyDecomposition(AMat, LMat, rank_in, & CALL GetPivot(AMat, LMat%process_grid, JJ, pivot_vector, diag, pi_j, & & insert_value, local_pivots, num_local_pivots) - !! l[pi[j],j] = sqrt(d[pi[j]]) IF (pi_j .GE. AMat%start_column .AND. pi_j .LT. AMat%end_column) THEN local_pi_j = pi_j - AMat%start_column + 1 insert_value = SQRT(insert_value) - inverse_factor = 1.0_NTREAL/insert_value + inverse_factor = 1.0_NTREAL / insert_value !! Insert IF (JJ .GE. AMat%start_row .AND. JJ .LT. AMat%end_row) THEN CALL AppendToVector(values_per_column_l(local_pi_j), & @@ -159,7 +160,7 @@ SUBROUTINE PivotedCholeskyDecomposition(AMat, LMat, rank_in, & & LMat%process_grid%row_comm, ierr) !! Extract the row of A to a dense matrix for easy lookup - DO II = MAX(acol%outer_index(pi_j),1), acol%outer_index(pi_j+1) + DO II = MAX(acol%outer_index(pi_j), 1), acol%outer_index(pi_j + 1) a_buf(acol%inner_index(II)) = acol%values(II) END DO @@ -174,10 +175,10 @@ SUBROUTINE PivotedCholeskyDecomposition(AMat, LMat, rank_in, & local_pi_i = local_pivots(II) Aval = a_buf(local_pi_i) insert_value = inverse_factor * (Aval - dot_values(II)) - IF (ABS(insert_value) .GT. solver_parameters%threshold) THEN + IF (ABS(insert_value) .GT. params%threshold) THEN IF (JJ .GE. AMat%start_row .AND. JJ .LT. AMat%end_row) THEN CALL AppendToVector(values_per_column_l(local_pi_i), & - & index_l(:,local_pi_i), values_l(:, local_pi_i), & + & index_l(:, local_pi_i), values_l(:, local_pi_i), & & local_JJ, insert_value) END IF END IF @@ -186,7 +187,7 @@ SUBROUTINE PivotedCholeskyDecomposition(AMat, LMat, rank_in, & END DO !! Clear up the A buffer - DO II = MAX(acol%outer_index(pi_j),1), acol%outer_index(pi_j+1) + DO II = MAX(acol%outer_index(pi_j), 1), acol%outer_index(pi_j + 1) a_buf(acol%inner_index(II)) = 0 END DO @@ -196,7 +197,7 @@ SUBROUTINE PivotedCholeskyDecomposition(AMat, LMat, rank_in, & CALL UnpackCholesky(values_per_column_l, index_l, values_l, LMat) !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL PrintMatrixInformation(LMat) CALL ExitSubLog END IF @@ -238,9 +239,9 @@ SUBROUTINE ReduceDimension(this, dim, ReducedMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF !! Identity matrix passed instead of ISQ @@ -248,12 +249,12 @@ SUBROUTINE ReduceDimension(this, dim, ReducedMat, solver_parameters_in) CALL FillMatrixIdentity(Identity) !! Purify - CALL TRS4(this, Identity, REAL(dim, KIND=NTREAL), PMat, & - & solver_parameters_in=params) + CALL TRS4(this, Identity, REAL(dim, KIND = NTREAL), PMat, & + & solver_parameters_in = params) !! Compute Eigenvectors of the Density Matrix CALL PivotedCholeskyDecomposition(PMat, PVec, dim, & - & solver_parameters_in=params) + & solver_parameters_in = params) CALL TransposeMatrix(PVec, PVecT) IF (PVecT%is_complex) THEN CALL ConjugateMatrix(PVecT) @@ -261,7 +262,7 @@ SUBROUTINE ReduceDimension(this, dim, ReducedMat, solver_parameters_in) !! Rotate to the divided subspace CALL SimilarityTransform(this, PVecT, PVec, VAV, & - & threshold_in=params%threshold) + & threshold_in = params%threshold) !! Extract CALL GetMatrixSlice(VAV, ReducedMat, 1, dim, 1, dim) diff --git a/Source/Fortran/ChebyshevSolversModule.F90 b/Source/Fortran/ChebyshevSolversModule.F90 index 7d5d37b2..7ceee7d2 100644 --- a/Source/Fortran/ChebyshevSolversModule.F90 +++ b/Source/Fortran/ChebyshevSolversModule.F90 @@ -3,8 +3,7 @@ MODULE ChebyshevSolversModule USE DataTypesModule, ONLY : NTREAL USE LoadBalancerModule, ONLY : PermuteMatrix, UndoPermuteMatrix - USE LoggingModule, ONLY : WriteElement, WriteHeader, EnterSubLog, & - & ExitSubLog + USE LoggingModule, ONLY : WriteElement, WriteHeader, EnterSubLog, ExitSubLog USE PMatrixMemoryPoolModule, ONLY : MatrixMemoryPool_p, & & DestructMatrixMemoryPool USE PSMatrixAlgebraModule, ONLY : MatrixMultiply, IncrementMatrix, ScaleMatrix @@ -12,7 +11,8 @@ MODULE ChebyshevSolversModule & PrintMatrixInformation, ConstructEmptyMatrix, DestructMatrix, & & CopyMatrix USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters IMPLICIT NONE PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -90,7 +90,7 @@ SUBROUTINE Compute_cheby(InputMat, OutputMat, poly, solver_parameters_in) !> Parameters for the solver. TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: param + TYPE(SolverParameters_t) :: params !! Local Matrices TYPE(Matrix_ps) :: Identity TYPE(Matrix_ps) :: BalancedInput @@ -100,23 +100,23 @@ SUBROUTINE Compute_cheby(InputMat, OutputMat, poly, solver_parameters_in) TYPE(MatrixMemoryPool_p) :: pool !! Local Variables INTEGER :: degree - INTEGER :: counter + INTEGER :: II !! Handle The Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - param = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - param = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF degree = SIZE(poly%coefficients) - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Chebyshev Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Standard") - CALL WriteElement(key="Degree", VALUE=degree-1) - CALL PrintParameters(param) + CALL WriteElement(key = "Method", VALUE = "Standard") + CALL WriteElement(key = "Degree", VALUE = degree - 1) + CALL PrintParameters(params) END IF !! Initial values for matrices @@ -125,11 +125,11 @@ SUBROUTINE Compute_cheby(InputMat, OutputMat, poly, solver_parameters_in) CALL CopyMatrix(InputMat,BalancedInput) !! Load Balancing Step - IF (param%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(Identity, Identity, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(BalancedInput, BalancedInput, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! First Term @@ -142,39 +142,38 @@ SUBROUTINE Compute_cheby(InputMat, OutputMat, poly, solver_parameters_in) CALL CopyMatrix(Tkminus2, OutputMat) CALL ScaleMatrix(OutputMat, poly%coefficients(1)) CALL IncrementMatrix(Tkminus1, OutputMat, & - & alpha_in=poly%coefficients(2)) - IF (degree > 2) THEN + & alpha_in = poly%coefficients(2)) + IF (degree .GT. 2) THEN CALL MatrixMultiply(BalancedInput, Tkminus1, Tk, & - & alpha_in=REAL(2.0, NTREAL), & - & threshold_in=param%threshold, memory_pool_in=pool) - CALL IncrementMatrix(Tkminus2, Tk, REAL(-1.0,NTREAL)) + & alpha_in = 2.0_NTREAL, threshold_in = params%threshold, & + & memory_pool_in = pool) + CALL IncrementMatrix(Tkminus2, Tk, alpha_in = -1.0_NTREAL) CALL IncrementMatrix(Tk, OutputMat, & - & alpha_in=poly%coefficients(3)) - DO counter = 4, degree + & alpha_in = poly%coefficients(3)) + DO II = 4, degree CALL CopyMatrix(Tkminus1, Tkminus2) CALL CopyMatrix(Tk, Tkminus1) CALL MatrixMultiply(BalancedInput, Tkminus1, Tk, & - & alpha_in=REAL(2.0,NTREAL), & - & threshold_in=param%threshold, & - & memory_pool_in=pool) - CALL IncrementMatrix(Tkminus2, Tk, REAL(-1.0,NTREAL)) + & alpha_in = 2.0_NTREAL, threshold_in = params%threshold, & + & memory_pool_in = pool) + CALL IncrementMatrix(Tkminus2, Tk, alpha_in = -1.0_NTREAL) CALL IncrementMatrix(Tk, OutputMat, & - & alpha_in=poly%coefficients(counter)) + & alpha_in = poly%coefficients(II)) END DO END IF END IF - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL PrintMatrixInformation(OutputMat) END IF !! Undo Load Balancing Step - IF (param%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Cleanup - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF CALL DestructMatrix(Identity) @@ -183,7 +182,7 @@ SUBROUTINE Compute_cheby(InputMat, OutputMat, poly, solver_parameters_in) CALL DestructMatrix(Tkminus2) CALL DestructMatrix(BalancedInput) CALL DestructMatrixMemoryPool(pool) - CALL DestructSolverParameters(param) + CALL DestructSolverParameters(params) END SUBROUTINE Compute_cheby !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute The Chebyshev Polynomial of the matrix. @@ -201,7 +200,7 @@ SUBROUTINE FactorizedCompute_cheby(InputMat, OutputMat, poly, & !> Parameters for the solver. TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: param + TYPE(SolverParameters_t) :: params !! Local Matrices TYPE(Matrix_ps) :: Identity TYPE(Matrix_ps) :: BalancedInput @@ -210,23 +209,23 @@ SUBROUTINE FactorizedCompute_cheby(InputMat, OutputMat, poly, & !! Local Variables INTEGER :: degree INTEGER :: log2degree - INTEGER :: counter + INTEGER :: II !! Handle The Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - param = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - param = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF degree = SIZE(poly%coefficients) - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Chebyshev Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Recursive") - CALL WriteElement(key="Degree", VALUE=degree-1) - CALL PrintParameters(param) + CALL WriteElement(key = "Method", VALUE = "Recursive") + CALL WriteElement(key = "Degree", VALUE = degree-1) + CALL PrintParameters(params) END IF !! Initial values for matrices @@ -235,11 +234,11 @@ SUBROUTINE FactorizedCompute_cheby(InputMat, OutputMat, poly, & CALL CopyMatrix(InputMat, BalancedInput) !! Load Balancing Step - IF (param%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(Identity, Identity, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(BalancedInput, BalancedInput, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Construct The X Powers Array @@ -256,44 +255,42 @@ SUBROUTINE FactorizedCompute_cheby(InputMat, OutputMat, poly, & CALL CopyMatrix(T_Powers(1), OutputMat) ELSE CALL CopyMatrix(BalancedInput, T_Powers(2)) - DO counter=3,log2degree - CALL MatrixMultiply(T_Powers(counter-1), T_Powers(counter-1), & - & T_Powers(counter), threshold_in=param%threshold, & - & alpha_in=REAL(2.0,NTREAL), memory_pool_in=pool) - CALL IncrementMatrix(Identity, T_Powers(counter), & - & alpha_in=REAL(-1.0,NTREAL)) + DO II = 3, log2degree + CALL MatrixMultiply(T_Powers(II - 1), T_Powers(II - 1), & + & T_Powers(II), threshold_in = params%threshold, & + & alpha_in = 2.0_NTREAL, memory_pool_in = pool) + CALL IncrementMatrix(Identity, T_Powers(II), alpha_in = -1.0_NTREAL) END DO - !! Call Recursive - CALL ComputeRecursive(T_Powers, poly, OutputMat, pool, 1, param) + CALL ComputeRecursive(T_Powers, poly, OutputMat, pool, 1, params) END IF - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL PrintMatrixInformation(OutputMat) END IF !! Undo Load Balancing Step - IF (param%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Cleanup - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF - DO counter=1,log2degree - CALL DestructMatrix(T_Powers(counter)) + DO II = 1, log2degree + CALL DestructMatrix(T_Powers(II)) END DO DEALLOCATE(T_Powers) CALL DestructMatrix(Identity) CALL DestructMatrix(BalancedInput) CALL DestructMatrixMemoryPool(pool) - CALL DestructSolverParameters(param) + CALL DestructSolverParameters(params) END SUBROUTINE FactorizedCompute_cheby !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> The workhorse routine for the factorized chebyshev computation function. RECURSIVE SUBROUTINE ComputeRecursive(T_Powers, poly, OutputMat, pool, & - & depth, param) + & depth, params) !> The precomputed Chebyshev polynomials. TYPE(Matrix_ps), DIMENSION(:), INTENT(IN) :: T_Powers !> Polynomial coefficients. @@ -303,18 +300,18 @@ RECURSIVE SUBROUTINE ComputeRecursive(T_Powers, poly, OutputMat, pool, & !> The depth of recursion. INTEGER, INTENT(in) :: depth !> Parameters for the solver. - TYPE(SolverParameters_t), INTENT(IN) :: param + TYPE(SolverParameters_t), INTENT(IN) :: params !> The memory pool. TYPE(MatrixMemoryPool_p), INTENT(INOUT) :: pool !! Local Data INTEGER :: coefficient_midpoint INTEGER :: left_length, right_length INTEGER :: full_midpoint - INTEGER :: counter TYPE(ChebyshevPolynomial_t) :: left_poly TYPE(ChebyshevPolynomial_t) :: right_poly TYPE(Matrix_ps) :: LeftMat TYPE(Matrix_ps) :: RightMat + INTEGER :: II !! First Handle The Base Case IF (SIZE(poly%coefficients) .EQ. 1) THEN @@ -324,38 +321,38 @@ RECURSIVE SUBROUTINE ComputeRecursive(T_Powers, poly, OutputMat, pool, & CALL CopyMatrix(T_Powers(1), OutputMat) CALL ScaleMatrix(OutputMat, poly%coefficients(1)) CALL IncrementMatrix(T_Powers(2), OutputMat, & - & alpha_in=poly%coefficients(2)) + & alpha_in = poly%coefficients(2)) ELSE !! Adjust the coefficients. - coefficient_midpoint = SIZE(poly%coefficients)/2 + coefficient_midpoint = SIZE(poly%coefficients) / 2 left_length = coefficient_midpoint right_length = SIZE(poly%coefficients) - coefficient_midpoint ALLOCATE(left_poly%coefficients(left_length)) ALLOCATE(right_poly%coefficients(right_length)) left_poly%coefficients(:) = poly%coefficients(:coefficient_midpoint) right_poly%coefficients(:) = poly%coefficients(coefficient_midpoint+1:) - DO counter=2,SIZE(left_poly%coefficients) - left_poly%coefficients(counter) = left_poly%coefficients(counter) - & - & poly%coefficients(SIZE(poly%coefficients) - counter + 2) + DO II = 2, SIZE(left_poly%coefficients) + left_poly%coefficients(II) = left_poly%coefficients(II) - & + & poly%coefficients(SIZE(poly%coefficients) - II + 2) END DO !! Left recursion - CALL ComputeRecursive(T_Powers, left_poly, LeftMat, pool, depth+1, & - & param) + CALL ComputeRecursive(T_Powers, left_poly, LeftMat, pool, depth + 1, & + & params) !! Right recursion full_midpoint = SIZE(T_Powers) - depth + 1 - CALL ComputeRecursive(T_Powers, right_poly, RightMat, pool, depth+1, & - & param) + CALL ComputeRecursive(T_Powers, right_poly, RightMat, pool, depth + 1, & + & params) !! Sum Together CALL MatrixMultiply(T_Powers(full_midpoint), RightMat, & - & OutputMat, threshold_in=param%threshold, & - & alpha_in=REAL(2.0,NTREAL), memory_pool_in=pool) + & OutputMat, threshold_in = params%threshold, & + & alpha_in = 2.0_NTREAL, memory_pool_in = pool) CALL IncrementMatrix(LeftMat, OutputMat) CALL IncrementMatrix(T_Powers(full_midpoint), & - & OutputMat, alpha_in=-1.0*right_poly%coefficients(1)) + & OutputMat, alpha_in = -1.0*right_poly%coefficients(1)) !! Cleanup DEALLOCATE(left_poly%coefficients) diff --git a/Source/Fortran/DMatrixModule.F90 b/Source/Fortran/DMatrixModule.F90 index ed2b9525..ac5a8b69 100644 --- a/Source/Fortran/DMatrixModule.F90 +++ b/Source/Fortran/DMatrixModule.F90 @@ -5,10 +5,7 @@ !! performance. MODULE DMatrixModule USE DataTypesModule, ONLY : NTREAL, NTCOMPLEX - USE SMatrixModule, ONLY : Matrix_lsr, Matrix_lsc, & - & ConstructMatrixFromTripletList - USE TripletListModule, ONLY : TripletList_r, TripletList_c, & - & AppendToTripletList, ConstructTripletList, DestructTripletList + USE SMatrixModule, ONLY : Matrix_lsr, Matrix_lsc, ConstructEmptyMatrix USE TripletModule, ONLY : Triplet_r, Triplet_c IMPLICIT NONE PRIVATE @@ -111,7 +108,7 @@ PURE SUBROUTINE ConstructMatrixDFromS_ldr(sparse_matrix, dense_matrix) !> Output. Must be preallocated. TYPE(Matrix_ldr), INTENT(INOUT) :: dense_matrix !! Helper Variables - TYPE(Triplet_r) :: temporary + TYPE(Triplet_r) :: temp #include "dense_includes/ConstructMatrixDFromS.f90" @@ -126,9 +123,6 @@ PURE SUBROUTINE ConstructMatrixSFromD_ldr(dense_matrix, sparse_matrix, & TYPE(Matrix_lsr), INTENT(INOUT) :: sparse_matrix !> Value for pruning values to zero. REAL(NTREAL), INTENT(IN), OPTIONAL :: threshold_in - !! Local Variables - TYPE(Triplet_r) :: temporary - TYPE(TripletList_r) :: temporary_list #include "dense_includes/ConstructMatrixSFromD.f90" @@ -182,7 +176,7 @@ FUNCTION MatrixNorm_ldr(this) RESULT(norm) norm = 0 DO II =1, this%rows DO JJ = 1, this%columns - norm = norm + this%DATA(II,JJ)**2 + norm = norm + this%DATA(II, JJ)**2 END DO END DO END FUNCTION MatrixNorm_ldr @@ -340,7 +334,7 @@ SUBROUTINE EigenDecomposition_ldr(MatA, MatV, MatW) CALL ConstructEmptyMatrix(MatV, MatA%rows, MatA%columns) MatV%DATA = MatA%DATA - N = SIZE(MatA%DATA,DIM=1) + N = SIZE(MatA%DATA, DIM = 1) LDA = N !! Allocations @@ -365,7 +359,7 @@ SUBROUTINE EigenDecomposition_ldr(MatA, MatV, MatW) CALL ConstructEmptyMatrix(MatW, MatA%rows, MatA%columns) MatW%DATA = 0 DO II = 1, N - MatW%DATA(II,II) = W(II) + MatW%DATA(II, II) = W(II) END DO END IF @@ -394,7 +388,7 @@ PURE SUBROUTINE ConstructMatrixDFromS_ldc(sparse_matrix, dense_matrix) !> Dense matrix output. Must be preallocated. TYPE(Matrix_ldc), INTENT(INOUT) :: dense_matrix !! Helper Variables - TYPE(Triplet_c) :: temporary + TYPE(Triplet_c) :: temp #include "dense_includes/ConstructMatrixDFromS.f90" @@ -409,9 +403,6 @@ PURE SUBROUTINE ConstructMatrixSFromD_ldc(dense_matrix, sparse_matrix, & TYPE(Matrix_lsc), INTENT(INOUT) :: sparse_matrix !> Value for pruning values to zero. REAL(NTREAL), INTENT(IN), OPTIONAL :: threshold_in - !! Local Variables - TYPE(Triplet_c) :: temporary - TYPE(TripletList_c) :: temporary_list #include "dense_includes/ConstructMatrixSFromD.f90" @@ -466,9 +457,9 @@ FUNCTION MatrixNorm_ldc(this) RESULT(norm) norm = 0 DO II =1, this%rows DO JJ = 1, this%columns - val = this%DATA(II,JJ) + val = this%DATA(II, JJ) conjval = CONJG(val) - norm = norm + REAL(val*conjval,KIND=NTREAL) + norm = norm + REAL(val*conjval, KIND = NTREAL) END DO END DO END FUNCTION MatrixNorm_ldc @@ -630,7 +621,7 @@ SUBROUTINE EigenDecomposition_ldc(MatA, MatV, MatW) CALL ConstructEmptyMatrix(MatV, MatA%rows, MatA%columns) MatV%DATA = MatA%DATA - N = SIZE(MatA%DATA,DIM=1) + N = SIZE(MatA%DATA, DIM = 1) LDA = N !! Allocations @@ -657,7 +648,7 @@ SUBROUTINE EigenDecomposition_ldc(MatA, MatV, MatW) CALL ConstructEmptyMatrix(MatW, MatA%rows, MatA%columns) MatW%DATA = 0 DO II = 1, N - MatW%DATA(II,II) = W(II) + MatW%DATA(II, II) = W(II) END DO END IF diff --git a/Source/Fortran/DensityMatrixSolversModule.F90 b/Source/Fortran/DensityMatrixSolversModule.F90 index a118527f..315cea60 100644 --- a/Source/Fortran/DensityMatrixSolversModule.F90 +++ b/Source/Fortran/DensityMatrixSolversModule.F90 @@ -16,7 +16,8 @@ MODULE DensityMatrixSolversModule & CopyMatrix, PrintMatrixInformation, FillMatrixIdentity, & & TransposeMatrix USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters IMPLICIT NONE PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -49,7 +50,7 @@ SUBROUTINE PM(H, ISQ, trace, K, & !> Parameters for the solver (optional). TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: param + TYPE(SolverParameters_t) :: params !! Local Matrices TYPE(Matrix_ps) :: WH TYPE(Matrix_ps) :: IMat @@ -64,7 +65,7 @@ SUBROUTINE PM(H, ISQ, trace, K, & REAL(NTREAL) :: trace_value REAL(NTREAL) :: trace_value2 REAL(NTREAL) :: norm_value - REAL(NTREAL) :: energy_value, energy_value2 + REAL(NTREAL) :: energy_value, energy_value_old !! For computing the chemical potential REAL(NTREAL) :: zero_value, midpoint, interval_a, interval_b !! Temporary Variables @@ -74,23 +75,23 @@ SUBROUTINE PM(H, ISQ, trace, K, & !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - param = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - param = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Density Matrix Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="PM") + CALL WriteElement(key = "Method", VALUE = "PM") CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("palser1998canonical") CALL ExitSubLog - CALL PrintParameters(param) + CALL PrintParameters(params) END IF - ALLOCATE(sigma_array(param%max_iterations)) + ALLOCATE(sigma_array(params%max_iterations)) !! Construct All The Necessary Matrices CALL ConstructEmptyMatrix(K, H) @@ -105,14 +106,14 @@ SUBROUTINE PM(H, ISQ, trace, K, & !! Compute the working hamiltonian. CALL TransposeMatrix(ISQ, ISQT) CALL SimilarityTransform(H, ISQ, ISQT, WH, pool, & - & threshold_in=param%threshold) + & threshold_in = params%threshold) !! Load Balancing Step - IF (param%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(WH, WH, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(IMat, IMat, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Compute the lambda scaling value. @@ -123,40 +124,40 @@ SUBROUTINE PM(H, ISQ, trace, K, & !! Compute lambda CALL MatrixTrace(X_k, trace_value) - lambda = trace_value/X_k%actual_matrix_dimension + lambda = trace_value / X_k%actual_matrix_dimension !! Compute alpha - alpha1 = trace/(e_max-lambda) - alpha2 = (X_k%actual_matrix_dimension-trace)/(lambda-e_min) + alpha1 = trace / (e_max-lambda) + alpha2 = (X_k%actual_matrix_dimension-trace) / (lambda-e_min) alpha = MIN(alpha1,alpha2) - factor = -alpha/X_k%actual_matrix_dimension + factor = -alpha / X_k%actual_matrix_dimension CALL ScaleMatrix(X_k, factor) - factor = (alpha*lambda+trace)/X_k%actual_matrix_dimension - CALL IncrementMatrix(IMat, X_k, alpha_in=factor) + factor = (alpha * lambda+trace) / X_k%actual_matrix_dimension + CALL IncrementMatrix(IMat, X_k, alpha_in = factor) !! Iterate - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF II = 1 - norm_value = param%converge_diff + 1.0_NTREAL + norm_value = params%converge_diff + 1.0_NTREAL energy_value = 0.0_NTREAL - DO II = 1, param%max_iterations + DO II = 1, params%max_iterations !! Compute X_k2 CALL MatrixMultiply(X_k, X_k, X_k2, & - & threshold_in=param%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) !! Compute X_k3 CALL MatrixMultiply(X_k, X_k2, X_k3, & - & threshold_in=param%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) !! Compute X_k - X_k2 CALL CopyMatrix(X_k, Temp) CALL IncrementMatrix(X_k2, Temp, & - & alpha_in=-1.0_NTREAL, threshold_in=param%threshold) + & alpha_in = -1.0_NTREAL, threshold_in = params%threshold) !! Compute Sigma CALL MatrixTrace(Temp, trace_value) @@ -165,49 +166,48 @@ SUBROUTINE PM(H, ISQ, trace, K, & IF (trace_value .LE. TINY(trace_value)) THEN sigma_array(II) = 1.0_NTREAL ELSE - sigma_array(II) = trace_value2/trace_value + sigma_array(II) = trace_value2 / trace_value END IF IF (sigma_array(II) .GT. 0.5_NTREAL) THEN a1 = 0.0_NTREAL - a2 = 1.0_NTREAL + 1.0_NTREAL/sigma_array(II) - a3 = -1.0_NTREAL/sigma_array(II) + a2 = 1.0_NTREAL + 1.0_NTREAL / sigma_array(II) + a3 = -1.0_NTREAL / sigma_array(II) ELSE - a1 = (1.0_NTREAL - 2.0_NTREAL*sigma_array(II)) & - & / (1.0_NTREAL - sigma_array(II)) - a2 = (1.0_NTREAL + sigma_array(II)) & + a1 = (1.0_NTREAL - 2.0_NTREAL * sigma_array(II)) & & / (1.0_NTREAL - sigma_array(II)) - a3 = -1.0_NTREAL/(1.0_NTREAL - sigma_array(II)) + a2 = (1.0_NTREAL + sigma_array(II)) / (1.0_NTREAL - sigma_array(II)) + a3 = -1.0_NTREAL / (1.0_NTREAL - sigma_array(II)) END IF !! Update X_k CALL ScaleMatrix(X_k, a1) CALL IncrementMatrix(X_k2, X_k, & - & alpha_in=a2, threshold_in=param%threshold) + & alpha_in = a2, threshold_in = params%threshold) CALL IncrementMatrix(X_k3, X_k, & - & alpha_in=a3, threshold_in=param%threshold) + & alpha_in = a3, threshold_in = params%threshold) !! Energy value based convergence - energy_value2 = energy_value + energy_value_old = energy_value CALL DotMatrix(X_k, WH, energy_value) - energy_value = 2.0_NTREAL*energy_value - norm_value = ABS(energy_value - energy_value2) + energy_value = 2.0_NTREAL * energy_value + norm_value = ABS(energy_value - energy_value_old) - IF (param%be_verbose) THEN - CALL WriteListElement(key="Convergence", VALUE=norm_value) + IF (params%be_verbose) THEN + CALL WriteListElement(key = "Convergence", VALUE = norm_value) CALL EnterSubLog - CALL WriteElement("Energy_Value", VALUE=energy_value) + CALL WriteElement("Energy Value", VALUE = energy_value) CALL ExitSubLog END IF - IF (norm_value .LE. param%converge_diff) THEN + IF (norm_value .LE. params%converge_diff) THEN EXIT END IF END DO - total_iterations = II-1 - IF (param%be_verbose) THEN + total_iterations = II - 1 + IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=II) + CALL WriteElement(key = "Total Iterations", VALUE = II) CALL PrintMatrixInformation(X_k) END IF @@ -216,14 +216,14 @@ SUBROUTINE PM(H, ISQ, trace, K, & END IF !! Undo Load Balancing Step - IF (param%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(X_k, X_k, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Compute the density matrix in the non-orthogonalized basis CALL SimilarityTransform(X_k, ISQT, ISQ, K, pool, & - & threshold_in=param%threshold) + & threshold_in = params%threshold) !! Cleanup CALL DestructMatrix(WH) @@ -240,21 +240,21 @@ SUBROUTINE PM(H, ISQ, trace, K, & interval_a = 0.0_NTREAL interval_b = 1.0_NTREAL midpoint = 0.0_NTREAL - midpoints: DO II = 1, param%max_iterations - midpoint = (interval_b - interval_a)/2.0_NTREAL + interval_a + midpoints: DO II = 1, params%max_iterations + midpoint = (interval_b - interval_a) / 2.0_NTREAL + interval_a zero_value = midpoint !! Compute polynomial function at the guess point. polynomial: DO JJ = 1, total_iterations IF (sigma_array(JJ) .GT. 0.5_NTREAL) THEN zero_value = ((1.0_NTREAL + sigma_array(JJ)) & & *zero_value**2) - (zero_value**3) - zero_value = zero_value/sigma_array(JJ) + zero_value = zero_value / sigma_array(JJ) ELSE zero_value = ((1.0_NTREAL - 2.0_NTREAL* & & sigma_array(JJ))*zero_value) & & + ((1.0_NTREAL + sigma_array(JJ))* & & zero_value**2) - (zero_value**3) - zero_value = zero_value/(1.0_NTREAL - sigma_array(JJ)) + zero_value = zero_value / (1.0_NTREAL - sigma_array(JJ)) END IF END DO polynomial !! Change bracketing. @@ -264,23 +264,22 @@ SUBROUTINE PM(H, ISQ, trace, K, & interval_b = midpoint END IF !! Check convergence. - IF (ABS(zero_value - 0.5_NTREAL) .LT. param%converge_diff) THEN + IF (ABS(zero_value - 0.5_NTREAL) .LT. params%converge_diff) THEN EXIT END IF END DO midpoints !! Undo scaling. chemical_potential_out = lambda - & - & (H%actual_matrix_dimension*midpoint - trace) & - & /alpha + & (H%actual_matrix_dimension*midpoint - trace) / alpha END IF - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF !! Cleanup DEALLOCATE(sigma_array) - CALL DestructSolverParameters(param) + CALL DestructSolverParameters(params) END SUBROUTINE PM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the density matrix from a Hamiltonian using the TRS2 method. @@ -302,18 +301,18 @@ SUBROUTINE TRS2(H, ISQ, trace, K, & !> Parameters for the solver (optional). TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: param + TYPE(SolverParameters_t) :: params !! Local Matrices TYPE(Matrix_ps) :: WH TYPE(Matrix_ps) :: IMat TYPE(Matrix_ps) :: ISQT - TYPE(Matrix_ps) :: X_k, X_k2, Temp + TYPE(Matrix_ps) :: X_k, X_k2 !! Local Variables REAL(NTREAL) :: e_min, e_max REAL(NTREAL), DIMENSION(:), ALLOCATABLE :: sigma_array REAL(NTREAL) :: trace_value REAL(NTREAL) :: norm_value - REAL(NTREAL) :: energy_value, energy_value2 + REAL(NTREAL) :: energy_value, energy_value_old !! For computing the chemical potential REAL(NTREAL) :: zero_value, midpoint, interval_a, interval_b !! Temporary Variables @@ -323,44 +322,43 @@ SUBROUTINE TRS2(H, ISQ, trace, K, & !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - param = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - param = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Density Matrix Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="TRS2") + CALL WriteElement(key = "Method", VALUE = "TRS2") CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("niklasson2002expansion") CALL ExitSubLog - CALL PrintParameters(param) + CALL PrintParameters(params) END IF - ALLOCATE(sigma_array(param%max_iterations)) + ALLOCATE(sigma_array(params%max_iterations)) !! Construct All The Necessary Matrices CALL ConstructEmptyMatrix(K, H) CALL ConstructEmptyMatrix(WH, H) CALL ConstructEmptyMatrix(X_k, H) CALL ConstructEmptyMatrix(X_k2, H) - CALL ConstructEmptyMatrix(Temp, H) CALL ConstructEmptyMatrix(IMat, H) CALL FillMatrixIdentity(IMat) !! Compute the working hamiltonian. CALL TransposeMatrix(ISQ, ISQT) CALL SimilarityTransform(H, ISQ, ISQT, WH, pool, & - & threshold_in=param%threshold) + & threshold_in = params%threshold) !! Load Balancing Step - IF (param%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(WH, WH, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(IMat, IMat, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Compute the lambda scaling value. @@ -369,18 +367,18 @@ SUBROUTINE TRS2(H, ISQ, trace, K, & !! Initialize CALL CopyMatrix(WH, X_k) CALL ScaleMatrix(X_k, -1.0_NTREAL) - CALL IncrementMatrix(IMat, X_k, alpha_in=e_max) - CALL ScaleMatrix(X_k, 1.0_NTREAL/(e_max - e_min)) + CALL IncrementMatrix(IMat, X_k, alpha_in = e_max) + CALL ScaleMatrix(X_k, 1.0_NTREAL / (e_max - e_min)) !! Iterate - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF II = 1 - norm_value = param%converge_diff + 1.0_NTREAL + norm_value = params%converge_diff + 1.0_NTREAL energy_value = 0.0_NTREAL - DO II = 1, param%max_iterations + DO II = 1, params%max_iterations !! Compute Sigma CALL MatrixTrace(X_k, trace_value) IF (trace - trace_value .LT. 0.0_NTREAL) THEN @@ -391,38 +389,38 @@ SUBROUTINE TRS2(H, ISQ, trace, K, & !! Compute X_k2 CALL MatrixMultiply(X_k, X_k, X_k2, & - & threshold_in=param%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) !! Update X_k IF (sigma_array(II) .GT. 0.0_NTREAL) THEN CALL ScaleMatrix(X_k, 2.0_NTREAL) CALL IncrementMatrix(X_k2, X_k, & - & alpha_in=-1.0_NTREAL, threshold_in=param%threshold) + & alpha_in = -1.0_NTREAL, threshold_in = params%threshold) ELSE CALL CopyMatrix(X_k2,X_k) END IF !! Energy value based convergence - energy_value2 = energy_value + energy_value_old = energy_value CALL DotMatrix(X_k, WH, energy_value) - energy_value = 2.0_NTREAL*energy_value - norm_value = ABS(energy_value - energy_value2) + energy_value = 2.0_NTREAL * energy_value + norm_value = ABS(energy_value - energy_value_old) - IF (param%be_verbose) THEN - CALL WriteListElement(key="Convergence", VALUE=norm_value) + IF (params%be_verbose) THEN + CALL WriteListElement(key = "Convergence", VALUE = norm_value) CALL EnterSubLog - CALL WriteElement("Energy_Value", VALUE=energy_value) + CALL WriteElement("Energy Value", VALUE = energy_value) CALL ExitSubLog END IF - IF (norm_value .LE. param%converge_diff) THEN + IF (norm_value .LE. params%converge_diff) THEN EXIT END IF END DO total_iterations = II - 1 - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=II) + CALL WriteElement(key = "Total Iterations", VALUE = II) CALL PrintMatrixInformation(X_k) END IF @@ -431,21 +429,20 @@ SUBROUTINE TRS2(H, ISQ, trace, K, & END IF !! Undo Load Balancing Step - IF (param%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(X_k, X_k, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Compute the density matrix in the non-orthogonalized basis CALL SimilarityTransform(X_k, ISQT, ISQ, K, pool, & - & threshold_in=param%threshold) + & threshold_in = params%threshold) !! Cleanup CALL DestructMatrix(WH) CALL DestructMatrix(ISQT) CALL DestructMatrix(X_k) CALL DestructMatrix(X_k2) - CALL DestructMatrix(Temp) CALL DestructMatrix(IMat) CALL DestructMatrixMemoryPool(pool) @@ -454,15 +451,15 @@ SUBROUTINE TRS2(H, ISQ, trace, K, & interval_a = 0.0_NTREAL interval_b = 1.0_NTREAL midpoint = 0.0_NTREAL - midpoints: DO II = 1, param%max_iterations - midpoint = (interval_b - interval_a)/2.0_NTREAL + interval_a + midpoints: DO II = 1, params%max_iterations + midpoint = (interval_b - interval_a) / 2.0_NTREAL + interval_a zero_value = midpoint !! Compute polynomial function at the guess point. polynomial: DO JJ = 1, total_iterations IF (sigma_array(JJ) .LT. 0.0_NTREAL) THEN - zero_value = zero_value*zero_value + zero_value = zero_value * zero_value ELSE - zero_value = 2.0_NTREAL*zero_value - zero_value*zero_value + zero_value = 2.0_NTREAL * zero_value - zero_value * zero_value END IF END DO polynomial !! Change bracketing. @@ -472,21 +469,21 @@ SUBROUTINE TRS2(H, ISQ, trace, K, & interval_b = midpoint END IF !! Check convergence. - IF (ABS(zero_value-0.5_NTREAL) .LT. param%converge_diff) THEN + IF (ABS(zero_value - 0.5_NTREAL) .LT. params%converge_diff) THEN EXIT END IF END DO midpoints !! Undo scaling. - chemical_potential_out = e_max + (e_min - e_max)*midpoint + chemical_potential_out = e_max + (e_min - e_max) * midpoint END IF - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF !! Cleanup DEALLOCATE(sigma_array) - CALL DestructSolverParameters(param) + CALL DestructSolverParameters(params) END SUBROUTINE TRS2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the density matrix from a Hamiltonian using the TRS4 method. @@ -510,7 +507,7 @@ SUBROUTINE TRS4(H, ISQ, trace, K, & REAL(NTREAL), PARAMETER :: sigma_min = 0.0_NTREAL REAL(NTREAL), PARAMETER :: sigma_max = 6.0_NTREAL !! Handling Optional Parameters - TYPE(SolverParameters_t) :: param + TYPE(SolverParameters_t) :: params !! Local Matrices TYPE(Matrix_ps) :: WH TYPE(Matrix_ps) :: IMat @@ -520,10 +517,10 @@ SUBROUTINE TRS4(H, ISQ, trace, K, & REAL(NTREAL) :: e_min, e_max REAL(NTREAL), DIMENSION(:), ALLOCATABLE :: sigma_array REAL(NTREAL) :: norm_value - REAL(NTREAL) :: energy_value, energy_value2 + REAL(NTREAL) :: energy_value, energy_value_old !! For computing the chemical potential REAL(NTREAL) :: zero_value, midpoint, interval_a, interval_b - REAL(NTREAL) :: tempfx,tempgx + REAL(NTREAL) :: tempfx, tempgx !! Temporary Variables TYPE(MatrixMemoryPool_p) :: pool INTEGER :: II, JJ @@ -532,23 +529,23 @@ SUBROUTINE TRS4(H, ISQ, trace, K, & !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - param = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - param = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Density Matrix Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="TRS4") + CALL WriteElement(key = "Method", VALUE = "TRS4") CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("niklasson2002expansion") CALL ExitSubLog - CALL PrintParameters(param) + CALL PrintParameters(params) END IF - ALLOCATE(sigma_array(param%max_iterations)) + ALLOCATE(sigma_array(params%max_iterations)) !! Construct All The Necessary Matrices CALL ConstructEmptyMatrix(K, H) @@ -564,44 +561,44 @@ SUBROUTINE TRS4(H, ISQ, trace, K, & !! Compute the working hamiltonian. CALL TransposeMatrix(ISQ, ISQT) CALL SimilarityTransform(H, ISQ, ISQT, WH, pool, & - & threshold_in=param%threshold) + & threshold_in = params%threshold) !! Load Balancing Step - IF (param%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(WH, WH, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(IMat, IMat, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Compute the lambda scaling value. - CALL GershgorinBounds(WH,e_min,e_max) + CALL GershgorinBounds(WH, e_min, e_max) !! Initialize CALL CopyMatrix(WH,X_k) CALL ScaleMatrix(X_k, -1.0_NTREAL) - CALL IncrementMatrix(IMat, X_k, alpha_in=e_max) - CALL ScaleMatrix(X_k, 1.0_NTREAL/(e_max - e_min)) + CALL IncrementMatrix(IMat, X_k, alpha_in = e_max) + CALL ScaleMatrix(X_k, 1.0_NTREAL / (e_max - e_min)) !! Iterate - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF II = 1 - norm_value = param%converge_diff + 1.0_NTREAL + norm_value = params%converge_diff + 1.0_NTREAL energy_value = 0.0_NTREAL - DO II = 1, param%max_iterations + DO II = 1, params%max_iterations !! Compute X_k2 CALL MatrixMultiply(X_k, X_k, X_k2, & - & threshold_in=param%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) !! Compute Fx_right CALL CopyMatrix(X_k2, Fx_right) CALL ScaleMatrix(Fx_right, -3.0_NTREAL) - CALL IncrementMatrix(X_k, Fx_right, alpha_in=4.0_NTREAL) + CALL IncrementMatrix(X_k, Fx_right, alpha_in = 4.0_NTREAL) !! Compute Gx_right CALL CopyMatrix(IMat, Gx_right) - CALL IncrementMatrix(X_k, Gx_right, alpha_in=-2.0_NTREAL) + CALL IncrementMatrix(X_k, Gx_right, alpha_in = -2.0_NTREAL) CALL IncrementMatrix(X_k2, Gx_right) !! Compute Traces @@ -614,46 +611,46 @@ SUBROUTINE TRS4(H, ISQ, trace, K, & END IF !! Compute Sigma - sigma_array(II) = (trace - trace_fx)/trace_gx + sigma_array(II) = (trace - trace_fx) / trace_gx !! Update The Matrix IF (sigma_array(II) .GT. sigma_max) THEN CALL CopyMatrix(X_k, TempMat) CALL ScaleMatrix(TempMat, 2.0_NTREAL) - CALL IncrementMatrix(X_k2, TempMat, alpha_in=-1.0_NTREAL) + CALL IncrementMatrix(X_k2, TempMat, alpha_in = -1.0_NTREAL) ELSE IF (sigma_array(II) .LT. sigma_min) THEN CALL CopyMatrix(X_k2, TempMat) ELSE CALL ScaleMatrix(Gx_right, sigma_array(II)) CALL IncrementMatrix(Fx_right, Gx_right) CALL MatrixMultiply(X_k2, Gx_right, TempMat, & - & threshold_in=param%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) END IF - CALL IncrementMatrix(TempMat, X_k, alpha_in=-1.0_NTREAL) + CALL IncrementMatrix(TempMat, X_k, alpha_in = -1.0_NTREAL) CALL CopyMatrix(TempMat, X_k) !! Energy value based convergence - energy_value2 = energy_value + energy_value_old = energy_value CALL DotMatrix(X_k, WH, energy_value) - energy_value = 2.0_NTREAL*energy_value - norm_value = ABS(energy_value - energy_value2) + energy_value = 2.0_NTREAL * energy_value + norm_value = ABS(energy_value - energy_value_old) - IF (param%be_verbose) THEN - CALL WriteListElement(key="Convergence", VALUE=norm_value) + IF (params%be_verbose) THEN + CALL WriteListElement(key = "Convergence", VALUE = norm_value) CALL EnterSubLog - CALL WriteElement("Energy_Value", VALUE=energy_value) + CALL WriteElement(key = "Energy Value", VALUE = energy_value) CALL ExitSubLog END IF - IF (norm_value .LE. param%converge_diff) THEN + IF (norm_value .LE. params%converge_diff) THEN EXIT END IF END DO total_iterations = II - 1 - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=II) + CALL WriteElement(key = "Total Iterations", VALUE = II) CALL PrintMatrixInformation(X_k) END IF @@ -662,14 +659,14 @@ SUBROUTINE TRS4(H, ISQ, trace, K, & END IF !! Undo Load Balancing Step - IF (param%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(X_k, X_k, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Compute the density matrix in the non-orthogonalized basis CALL SimilarityTransform(X_k, ISQT, ISQ, K, pool, & - & threshold_in=param%threshold) + & threshold_in = params%threshold) !! Cleanup CALL DestructMatrix(WH) @@ -687,22 +684,22 @@ SUBROUTINE TRS4(H, ISQ, trace, K, & interval_a = 0.0_NTREAL interval_b = 1.0_NTREAL midpoint = 0.0_NTREAL - midpoints: DO II = 1, param%max_iterations - midpoint = (interval_b - interval_a)/2.0_NTREAL + interval_a + midpoints: DO II = 1, params%max_iterations + midpoint = (interval_b - interval_a) / 2.0_NTREAL + interval_a zero_value = midpoint !! Compute polynomial function at the guess point. polynomial: DO JJ = 1, total_iterations IF (sigma_array(JJ) .GT. sigma_max) THEN - zero_value = 2.0_NTREAL*zero_value - zero_value*zero_value + zero_value = 2.0_NTREAL * zero_value - zero_value*zero_value ELSE IF (sigma_array(JJ) .LT. sigma_min) THEN - zero_value = zero_value*zero_value + zero_value = zero_value * zero_value ELSE - tempfx = (zero_value*zero_value) * & - & (4.0_NTREAL*zero_value - & - & 3.0_NTREAL*zero_value*zero_value) + tempfx = (zero_value * zero_value) * & + & (4.0_NTREAL * zero_value - & + & 3.0_NTREAL * zero_value * zero_value) tempgx = (zero_value*zero_value) * (1.0_NTREAL - zero_value) & & * (1.0_NTREAL - zero_value) - zero_value = tempfx + sigma_array(JJ)*tempgx + zero_value = tempfx + sigma_array(JJ) * tempgx END IF END DO polynomial !! Change bracketing. @@ -712,21 +709,21 @@ SUBROUTINE TRS4(H, ISQ, trace, K, & interval_b = midpoint END IF !! Check convergence. - IF (ABS(zero_value-0.5_NTREAL) .LT. param%converge_diff) THEN + IF (ABS(zero_value-0.5_NTREAL) .LT. params%converge_diff) THEN EXIT END IF END DO midpoints !! Undo scaling. - chemical_potential_out = e_max + (e_min - e_max)*midpoint + chemical_potential_out = e_max + (e_min - e_max) * midpoint END IF !! Cleanup - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF DEALLOCATE(sigma_array) - CALL DestructSolverParameters(param) + CALL DestructSolverParameters(params) END SUBROUTINE TRS4 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the density matrix from a Hamiltonian using the HPCP method. @@ -748,7 +745,7 @@ SUBROUTINE HPCP(H, ISQ, trace, K, & !> Parameters for the solver (optional). TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: param + TYPE(SolverParameters_t) :: params !! Local Matrices TYPE(Matrix_ps) :: WH TYPE(Matrix_ps) :: TempMat @@ -763,8 +760,8 @@ SUBROUTINE HPCP(H, ISQ, trace, K, & REAL(NTREAL) :: mu REAL(NTREAL), DIMENSION(:), ALLOCATABLE :: sigma_array REAL(NTREAL) :: trace_value - REAL(NTREAL) :: norm_value, norm_value2 - REAL(NTREAL) :: energy_value, energy_value2 + REAL(NTREAL) :: norm_value + REAL(NTREAL) :: energy_value, energy_value_old !! For computing the chemical potential REAL(NTREAL) :: zero_value, midpoint, interval_a, interval_b !! Temporary Variables @@ -775,23 +772,23 @@ SUBROUTINE HPCP(H, ISQ, trace, K, & !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - param = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - param = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Density Matrix Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="HPCP") + CALL WriteElement(key = "Method", VALUE = "HPCP") CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("truflandier2016communication") CALL ExitSubLog - CALL PrintParameters(param) + CALL PrintParameters(params) END IF - ALLOCATE(sigma_array(param%max_iterations)) + ALLOCATE(sigma_array(params%max_iterations)) matrix_dimension = H%actual_matrix_dimension @@ -809,26 +806,26 @@ SUBROUTINE HPCP(H, ISQ, trace, K, & !! Compute the working hamiltonian. CALL TransposeMatrix(ISQ, ISQT) CALL SimilarityTransform(H, ISQ, ISQT, WH, pool, & - & threshold_in=param%threshold) + & threshold_in = params%threshold) !! Load Balancing Step - IF (param%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(WH, WH, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(IMat, IMat, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Compute the initial matrix. CALL GershgorinBounds(WH, e_min, e_max) CALL MatrixTrace(WH, mu) mu = mu/matrix_dimension - sigma_bar = (matrix_dimension - trace)/matrix_dimension + sigma_bar = (matrix_dimension - trace) / matrix_dimension sigma = 1.0_NTREAL - sigma_bar - beta = sigma/(e_max - mu) - beta_bar = sigma_bar/(mu - e_min) + beta = sigma / (e_max - mu) + beta_bar = sigma_bar / (mu - e_min) beta_1 = sigma - beta_2 = MIN(beta,beta_bar) + beta_2 = MIN(beta, beta_bar) !! Initialize CALL CopyMatrix(IMat, D1) @@ -841,65 +838,64 @@ SUBROUTINE HPCP(H, ISQ, trace, K, & trace_value = 0.0_NTREAL !! Iterate - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF II = 1 - norm_value = param%converge_diff + 1.0_NTREAL - norm_value2 = norm_value + norm_value = params%converge_diff + 1.0_NTREAL energy_value = 0.0_NTREAL - DO II = 1, param%max_iterations + DO II = 1, params%max_iterations !! Compute the hole matrix DH CALL CopyMatrix(D1, DH) - CALL IncrementMatrix(IMat, DH, alpha_in=-1.0_NTREAL) + CALL IncrementMatrix(IMat, DH, alpha_in = -1.0_NTREAL) CALL ScaleMatrix(DH, -1.0_NTREAL) !! Compute DDH, as well as convergence check CALL MatrixMultiply(D1, DH, DDH, & - & threshold_in=param%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL MatrixTrace(DDH, trace_value) norm_value = ABS(trace_value) !! Compute D2DH CALL MatrixMultiply(D1, DDH, D2DH, & - & threshold_in=param%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) !! Compute Sigma CALL MatrixTrace(D2DH, sigma_array(II)) - sigma_array(II) = sigma_array(II)/trace_value + sigma_array(II) = sigma_array(II) / trace_value CALL CopyMatrix(D1, TempMat) !! Compute D1 + 2*D2DH - CALL IncrementMatrix(D2DH, D1, alpha_in=2.0_NTREAL) + CALL IncrementMatrix(D2DH, D1, alpha_in = 2.0_NTREAL) !! Compute D1 + 2*D2DH -2*Sigma*DDH CALL IncrementMatrix(DDH, D1, & - & alpha_in=-1.0_NTREAL*2.0_NTREAL*sigma_array(II)) + & alpha_in = -1.0_NTREAL * 2.0_NTREAL * sigma_array(II)) !! Energy value based convergence - energy_value2 = energy_value + energy_value_old = energy_value CALL DotMatrix(D1, WH, energy_value) - energy_value = 2.0_NTREAL*energy_value - norm_value = ABS(energy_value - energy_value2) + energy_value = 2.0_NTREAL * energy_value + norm_value = ABS(energy_value - energy_value_old) - IF (param%be_verbose) THEN - CALL WriteListElement(key="Convergence", VALUE=norm_value) + IF (params%be_verbose) THEN + CALL WriteListElement(key = "Convergence", VALUE = norm_value) CALL EnterSubLog - CALL WriteElement("Energy_Value", VALUE=energy_value) + CALL WriteElement("Energy Value", VALUE = energy_value) CALL ExitSubLog END IF - IF (norm_value .LE. param%converge_diff) THEN + IF (norm_value .LE. params%converge_diff) THEN EXIT END IF END DO total_iterations = II - 1 - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=II) + CALL WriteElement(key = "Total Iterations", VALUE = II) CALL PrintMatrixInformation(D1) END IF @@ -908,14 +904,14 @@ SUBROUTINE HPCP(H, ISQ, trace, K, & END IF !! Undo Load Balancing Step - IF (param%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(D1, D1, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Compute the density matrix in the non-orthogonalized basis CALL SimilarityTransform(D1, ISQT, ISQ, K, pool, & - & threshold_in=param%threshold) + & threshold_in = params%threshold) !! Cleanup CALL DestructMatrix(WH) @@ -933,15 +929,15 @@ SUBROUTINE HPCP(H, ISQ, trace, K, & interval_a = 0.0_NTREAL interval_b = 1.0_NTREAL midpoint = 0.0_NTREAL - midpoints: DO II = 1, param%max_iterations - midpoint = (interval_b - interval_a)/2.0_NTREAL + interval_a + midpoints: DO II = 1, params%max_iterations + midpoint = (interval_b - interval_a) / 2.0_NTREAL + interval_a zero_value = midpoint !! Compute polynomial function at the guess point. polynomial: DO JJ = 1, total_iterations zero_value = zero_value + & - & 2.0_NTREAL*((zero_value**2)*(1.0_NTREAL-zero_value) & - & - sigma_array(JJ)* & - & zero_value*(1.0_NTREAL-zero_value)) + & 2.0_NTREAL * ((zero_value**2)*(1.0_NTREAL - zero_value) & + & - sigma_array(JJ) * & + & zero_value * (1.0_NTREAL - zero_value)) END DO polynomial !! Change bracketing. IF (zero_value .LT. 0.5_NTREAL) THEN @@ -950,19 +946,19 @@ SUBROUTINE HPCP(H, ISQ, trace, K, & interval_b = midpoint END IF !! Check convergence. - IF (ABS(zero_value-0.5_NTREAL) .LT. param%converge_diff) THEN + IF (ABS(zero_value - 0.5_NTREAL) .LT. params%converge_diff) THEN EXIT END IF END DO midpoints !! Undo scaling. - chemical_potential_out = mu + (beta_1 - midpoint)/beta_2 + chemical_potential_out = mu + (beta_1 - midpoint) / beta_2 END IF !! Cleanup - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF DEALLOCATE(sigma_array) - CALL DestructSolverParameters(param) + CALL DestructSolverParameters(params) END SUBROUTINE HPCP !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the density matrix from a Hamiltonian using the Scale and Fold @@ -989,7 +985,7 @@ SUBROUTINE ScaleAndFold(H, ISQ, trace, K, & !> Parameters for the solver (optional). TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: param + TYPE(SolverParameters_t) :: params !! Local Matrices TYPE(Matrix_ps) :: WH TYPE(Matrix_ps) :: IMat @@ -1000,27 +996,27 @@ SUBROUTINE ScaleAndFold(H, ISQ, trace, K, & REAL(NTREAL) :: Beta, BetaBar, alpha REAL(NTREAL) :: trace_value REAL(NTREAL) :: norm_value - REAL(NTREAL) :: energy_value, energy_value2 + REAL(NTREAL) :: energy_value, energy_value_old !! Temporary Variables TYPE(MatrixMemoryPool_p) :: pool INTEGER :: II !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - param = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - param = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Density Matrix Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Scale and Fold") + CALL WriteElement(key = "Method", VALUE = "Scale and Fold") CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("rubensson2011nonmonotonic") CALL ExitSubLog - CALL PrintParameters(param) + CALL PrintParameters(params) END IF !! Construct All The Necessary Matrices @@ -1035,14 +1031,14 @@ SUBROUTINE ScaleAndFold(H, ISQ, trace, K, & !! Compute the working hamiltonian. CALL TransposeMatrix(ISQ, ISQT) CALL SimilarityTransform(H, ISQ, ISQT, WH, pool, & - & threshold_in=param%threshold) + & threshold_in = params%threshold) !! Load Balancing Step - IF (param%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(WH, WH, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(IMat, IMat, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Compute the lambda scaling value. @@ -1051,61 +1047,61 @@ SUBROUTINE ScaleAndFold(H, ISQ, trace, K, & !! Initialize CALL CopyMatrix(WH, X_k) CALL ScaleMatrix(X_k, -1.0_NTREAL) - CALL IncrementMatrix(IMat, X_k, alpha_in=e_max) - CALL ScaleMatrix(X_k, 1.0_NTREAL/(e_max - e_min)) + CALL IncrementMatrix(IMat, X_k, alpha_in = e_max) + CALL ScaleMatrix(X_k, 1.0_NTREAL / (e_max - e_min)) Beta = (e_max - lumo) / (e_max - e_min) BetaBar = (e_max - homo) / (e_max - e_min) !! Iterate - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF II = 1 - norm_value = param%converge_diff + 1.0_NTREAL + norm_value = params%converge_diff + 1.0_NTREAL energy_value = 0.0_NTREAL - DO II = 1, param%max_iterations + DO II = 1, params%max_iterations !! Determine the path CALL MatrixTrace(X_k, trace_value) IF (trace_value .GT. trace) THEN - alpha = 2.0/(2.0 - Beta) + alpha = 2.0 / (2.0 - Beta) CALL ScaleMatrix(X_k, alpha) CALL IncrementMatrix(IMat, X_k, alpha_in=(1.0_NTREAL-alpha)) CALL MatrixMultiply(X_k, X_k, X_k2, & - & threshold_in=param%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL CopyMatrix(X_k2, X_k) Beta = (alpha * Beta + 1 - alpha)**2 BetaBar = (alpha * BetaBar + 1 - alpha)**2 ELSE - alpha = 2.0/(1.0 + BetaBar) + alpha = 2.0 / (1.0 + BetaBar) CALL MatrixMultiply(X_k, X_k, X_k2, & - & threshold_in=param%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL ScaleMatrix(X_k, 2*alpha) - CALL IncrementMatrix(X_k2, X_k, alpha_in=-1.0_NTREAL*alpha**2) + CALL IncrementMatrix(X_k2, X_k, alpha_in = -1.0_NTREAL * alpha**2) Beta = 2.0 * alpha * Beta - alpha**2 * Beta**2 BetaBar = 2.0 * alpha * BetaBar - alpha**2 * BetaBar ** 2 END IF !! Energy value based convergence - energy_value2 = energy_value + energy_value_old = energy_value CALL DotMatrix(X_k, WH, energy_value) energy_value = 2.0_NTREAL*energy_value - norm_value = ABS(energy_value - energy_value2) + norm_value = ABS(energy_value - energy_value_old) - IF (param%be_verbose) THEN - CALL WriteListElement(key="Convergence", VALUE=norm_value) + IF (params%be_verbose) THEN + CALL WriteListElement(key = "Convergence", VALUE = norm_value) CALL EnterSubLog - CALL WriteElement("Energy_Value", VALUE=energy_value) + CALL WriteElement("Energy Value", VALUE = energy_value) CALL ExitSubLog END IF - IF (norm_value .LE. param%converge_diff) THEN + IF (norm_value .LE. params%converge_diff) THEN EXIT END IF END DO - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=II) + CALL WriteElement(key = "Total Iterations", VALUE = II) CALL PrintMatrixInformation(X_k) END IF @@ -1114,14 +1110,14 @@ SUBROUTINE ScaleAndFold(H, ISQ, trace, K, & END IF !! Undo Load Balancing Step - IF (param%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(X_k, X_k, & - & param%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Compute the density matrix in the non-orthogonalized basis CALL SimilarityTransform(X_k, ISQT, ISQ, K, pool, & - & threshold_in=param%threshold) + & threshold_in = params%threshold) !! Cleanup CALL DestructMatrix(WH) @@ -1132,11 +1128,11 @@ SUBROUTINE ScaleAndFold(H, ISQ, trace, K, & CALL DestructMatrix(IMat) CALL DestructMatrixMemoryPool(pool) - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF - CALL DestructSolverParameters(param) + CALL DestructSolverParameters(params) END SUBROUTINE ScaleAndFold !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the density matrix using a dense routine. @@ -1162,15 +1158,15 @@ SUBROUTINE DenseDensity(H, ISQ, trace, K, & !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF !! Call the unified routine. - CALL ComputeDenseFOE(H, ISQ, trace, K, energy_value_out=energy_value, & - & chemical_potential_out=chemical_potential, & - & solver_parameters_in=params) + CALL ComputeDenseFOE(H, ISQ, trace, K, energy_value_out = energy_value, & + & chemical_potential_out = chemical_potential, & + & solver_parameters_in = params) !! Optional out variables. IF (PRESENT(energy_value_out)) THEN @@ -1205,7 +1201,7 @@ SUBROUTINE EnergyDensityMatrix(H, D, ED, threshold_in) END IF !! EDM = DM * H * DM - CALL SimilarityTransform(H, D, D, ED, threshold_in=threshold) + CALL SimilarityTransform(H, D, D, ED, threshold_in = threshold) END SUBROUTINE EnergyDensityMatrix !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -1235,17 +1231,17 @@ SUBROUTINE McWeenyStep(D, DOut, S_in, threshold_in) !! Form the matrix DS IF (PRESENT(S_in)) THEN CALL MatrixMultiply(D, S_in, DS, & - & threshold_in=threshold, memory_pool_in=pool) + & threshold_in = threshold, memory_pool_in = pool) ELSE CALL CopyMatrix(D, DS) END IF !! Compute CALL MatrixMultiply(DS, D, DSD, & - & threshold_in=threshold, memory_pool_in=pool) - CALL MatrixMultiply(DS, DSD, DOut, alpha_in=-2.0_NTREAL, & - & threshold_in=threshold, memory_pool_in=pool) - CALL IncrementMatrix(DSD, DOut, alpha_in=3.0_NTREAL) + & threshold_in = threshold, memory_pool_in = pool) + CALL MatrixMultiply(DS, DSD, DOut, alpha_in = -2.0_NTREAL, & + & threshold_in = threshold, memory_pool_in = pool) + CALL IncrementMatrix(DSD, DOut, alpha_in = 3.0_NTREAL) !! Cleanup CALL DestructMatrix(DS) diff --git a/Source/Fortran/EigenBoundsModule.F90 b/Source/Fortran/EigenBoundsModule.F90 index 8e72e65b..2fa3e1c8 100644 --- a/Source/Fortran/EigenBoundsModule.F90 +++ b/Source/Fortran/EigenBoundsModule.F90 @@ -11,7 +11,8 @@ MODULE EigenBoundsModule USE PSMatrixModule, ONLY : Matrix_ps, ConstructEmptyMatrix, CopyMatrix, & & DestructMatrix, GetMatrixTripletList, FillMatrixFromTripletList USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters USE TripletListModule, ONLY : TripletList_r, TripletList_c, & & AppendToTripletList, DestructTripletList, ConstructTripletList USE TripletModule, ONLY : Triplet_r @@ -32,24 +33,24 @@ SUBROUTINE GershgorinBounds(this, min_value, max_value) !> An uppder bound on the eigenspectrum. REAL(NTREAL), INTENT(OUT) :: max_value !! Local Data - TYPE(TripletList_r) :: triplet_list_r - TYPE(TripletList_c) :: triplet_list_c + TYPE(TripletList_r) :: tlist_r + TYPE(TripletList_c) :: tlist_c !! Local Data REAL(NTREAL), DIMENSION(:), ALLOCATABLE :: per_column_min REAL(NTREAL), DIMENSION(:), ALLOCATABLE :: per_column_max !! Counters/Temporary - INTEGER :: counter + INTEGER :: II INTEGER :: local_column INTEGER :: ierr IF (this%is_complex) THEN -#define triplet_list triplet_list_c +#define tlist tlist_c #include "solver_includes/GershgorinBounds.f90" -#undef triplet_list +#undef tlist ELSE -#define triplet_list triplet_list_r +#define tlist tlist_r #include "solver_includes/GershgorinBounds.f90" -#undef triplet_list +#undef tlist END IF END SUBROUTINE GershgorinBounds !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -65,7 +66,7 @@ SUBROUTINE PowerBounds(this, max_value, solver_parameters_in) !! Handling Optional Parameters TYPE(SolverParameters_t) :: param !! Local Data - TYPE(Matrix_ps) :: vector, vector2, TempMat + TYPE(Matrix_ps) :: vector, vector2 REAL(NTREAL) :: scale_value REAL(NTREAL) :: norm_value TYPE(TripletList_r) :: temp_list @@ -75,9 +76,9 @@ SUBROUTINE PowerBounds(this, max_value, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - param = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, param) ELSE - param = SolverParameters_t() + CALL ConstructSolverParameters(param) param%max_iterations = 10 END IF @@ -97,9 +98,9 @@ SUBROUTINE PowerBounds(this, max_value, solver_parameters_in) temp_triplet%index_row = 1 temp_triplet%index_column = 1 temp_triplet%point_value = 1.0_NTREAL - CALL AppendToTripletList(temp_list,temp_triplet) + CALL AppendToTripletList(temp_list, temp_triplet) END IF - CALL FillMatrixFromTripletList(vector,temp_list) + CALL FillMatrixFromTripletList(vector, temp_list) !! Iterate IF (param%be_verbose) THEN @@ -110,18 +111,18 @@ SUBROUTINE PowerBounds(this, max_value, solver_parameters_in) norm_value = param%converge_diff + 1.0_NTREAL DO II = 1, param%max_iterations IF (param%be_verbose .AND. II .GT. 1) THEN - CALL WriteListElement(key="Convergence", VALUE=norm_value) + CALL WriteListElement(key = "Convergence", VALUE = norm_value) END IF !! x = Ax CALL MatrixMultiply(this, vector, vector2, & - & threshold_in=param%threshold, memory_pool_in=pool) + & threshold_in = param%threshold, memory_pool_in = pool) !! x = x/||x|| - scale_value = 1.0/MatrixNorm(vector2) + scale_value = 1.0 / MatrixNorm(vector2) CALL ScaleMatrix(vector2, scale_value) !! Check if Converged - CALL IncrementMatrix(vector2, vector, -1.0_NTREAL) + CALL IncrementMatrix(vector2, vector, alpha_in = -1.0_NTREAL) norm_value = MatrixNorm(vector) CALL CopyMatrix(vector2, vector) @@ -132,25 +133,24 @@ SUBROUTINE PowerBounds(this, max_value, solver_parameters_in) END DO IF (param%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=II - 1) + CALL WriteElement(key = "Total Iterations", VALUE = II - 1) END IF !! Compute The Largest Eigenvalue CALL DotMatrix(vector, vector, scale_value) CALL MatrixMultiply(this, vector, vector2, & - & threshold_in=param%threshold, memory_pool_in=pool) + & threshold_in = param%threshold, memory_pool_in = pool) CALL DotMatrix(vector, vector2, max_value) max_value = max_value / scale_value IF (param%be_verbose) THEN - CALL WriteElement(key="Max_Eigen_Value",VALUE=max_value) + CALL WriteElement(key = "Max Eigen Value", VALUE = max_value) CALL ExitSubLog END IF !! Cleanup CALL DestructMatrix(vector) CALL DestructMatrix(vector2) - CALL DestructMatrix(TempMat) CALL DestructMatrixMemoryPool(pool) CALL DestructSolverParameters(param) END SUBROUTINE PowerBounds diff --git a/Source/Fortran/EigenExaModule.F90 b/Source/Fortran/EigenExaModule.F90 index 77c49ee6..c94b3e91 100644 --- a/Source/Fortran/EigenExaModule.F90 +++ b/Source/Fortran/EigenExaModule.F90 @@ -8,8 +8,8 @@ MODULE EigenExaModule USE PSMatrixModule, ONLY : Matrix_ps, ConstructEmptyMatrix, & & FillMatrixFromTripletList, GetMatrixTripletList, PrintMatrixInformation USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters - USE TimerModule, ONLY : StartTimer, StopTimer + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters USE TripletModule, ONLY : Triplet_r, Triplet_c, SetTriplet USE TripletListModule, ONLY : TripletList_r, TripletList_c, & & AppendToTripletList, GetTripletAt, ConstructTripletList, & @@ -74,17 +74,17 @@ SUBROUTINE EigenExa_s(A, eigenvalues, nvals, & !! Process Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF !! Write info about the solver IF (params%be_verbose) THEN CALL WriteHeader("Eigen Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="EigenExa") - CALL WriteElement(key="NVALS", VALUE=nvals) + CALL WriteElement(key = "Method", VALUE = "EigenExa") + CALL WriteElement(key = "NVALS", VALUE = nvals) CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("imamura2011development") @@ -338,7 +338,7 @@ SUBROUTINE Compute_r(A, V, W, exa) #include "eigenexa_includes/Compute.f90" !! Call - CALL eigen_sx(N, exa%nvals, A, LDA, W, V, LDZ, mode=exa%MODE) + CALL eigen_sx(N, exa%nvals, A, LDA, W, V, LDZ, mode = exa%MODE) END SUBROUTINE Compute_r !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -356,7 +356,7 @@ SUBROUTINE Compute_c(A, V, W, exa) #include "eigenexa_includes/Compute.f90" !! Call - CALL eigen_h(N, exa%nvals, A, LDA, W, V, LDZ, mode=exa%MODE) + CALL eigen_h(N, exa%nvals, A, LDA, W, V, LDZ, mode = exa%MODE) END SUBROUTINE Compute_c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/Source/Fortran/EigenSolversModule.F90 b/Source/Fortran/EigenSolversModule.F90 index 755aff51..8944352f 100644 --- a/Source/Fortran/EigenSolversModule.F90 +++ b/Source/Fortran/EigenSolversModule.F90 @@ -14,7 +14,8 @@ MODULE EigenSolversModule & DestructMatrix, CopyMatrix, GetMatrixTripletList, TransposeMatrix, & & ConjugateMatrix USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters USE SMatrixModule, ONLY : Matrix_lsr, Matrix_lsc, MatrixToTripletList, & & DestructMatrix USE TripletListModule, ONLY : TripletList_r, TripletList_c, & @@ -46,9 +47,9 @@ SUBROUTINE EigenDecomposition(this, eigenvalues, eigenvectors_in, nvals_in, & !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (PRESENT(nvals_in)) THEN nvals = nvals_in @@ -59,10 +60,10 @@ SUBROUTINE EigenDecomposition(this, eigenvalues, eigenvectors_in, nvals_in, & #if EIGENEXA IF (PRESENT(eigenvectors_in)) THEN CALL EigenExa_s(this, eigenvalues, nvals, eigenvectors_in, & - & solver_parameters_in=params) + & solver_parameters_in = params) ELSE CALL EigenExa_s(this, eigenvalues, nvals, & - & solver_parameters_in=params) + & solver_parameters_in = params) END IF #else IF (PRESENT(eigenvectors_in)) THEN @@ -88,9 +89,9 @@ SUBROUTINE DenseMatrixFunction(this, ResultMat, func, solver_parameters_in) FUNCTION func(val) RESULT(outval) USE DataTypesModule, ONLY : NTREAL !> The actual value of an element. - REAL(KIND=NTREAL), INTENT(IN) :: val + REAL(KIND = NTREAL), INTENT(IN) :: val !> The transformed value. - REAL(KIND=NTREAL) :: outval + REAL(KIND = NTREAL) :: outval END FUNCTION func END INTERFACE !> Parameters for computing @@ -104,14 +105,14 @@ END FUNCTION func !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF !! Perform the eigendecomposition - CALL EigenDecomposition(this, vals, solver_parameters_in=params, & - & eigenvectors_in=vecs) + CALL EigenDecomposition(this, vals, solver_parameters_in = params, & + & eigenvectors_in = vecs) !! Convert to a triplet list, map the triplet list, fill. CALL GetMatrixTripletList(vals, tlist) @@ -121,13 +122,13 @@ END FUNCTION func !! Fill CALL ConstructEmptyMatrix(ResultMat, this) - CALL FillMatrixFromTripletList(ResultMat, tlist, preduplicated_in=.TRUE.) + CALL FillMatrixFromTripletList(ResultMat, tlist, preduplicated_in = .TRUE.) !! Multiply Back Together - CALL MatrixMultiply(vecs, ResultMat, temp, threshold_in=params%threshold) + CALL MatrixMultiply(vecs, ResultMat, temp, threshold_in = params%threshold) CALL TransposeMatrix(vecs, vecsT) CALL ConjugateMatrix(vecsT) - CALL MatrixMultiply(temp, vecsT, ResultMat, threshold_in=params%threshold) + CALL MatrixMultiply(temp, vecsT, ResultMat, threshold_in = params%threshold) !! Cleanup CALL DestructMatrix(vecs) @@ -156,8 +157,8 @@ SUBROUTINE EigenSerial(this, eigenvalues, nvals, solver_params, & IF (solver_params%be_verbose) THEN CALL WriteHeader("Eigen Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="LAPACK") - CALL WriteElement(key="NVALS", VALUE=nvals) + CALL WriteElement(key = "Method", VALUE = "LAPACK") + CALL WriteElement(key = "NVALS", VALUE = nvals) CALL ExitSubLog CALL PrintParameters(solver_params) END IF diff --git a/Source/Fortran/ErrorModule.F90 b/Source/Fortran/ErrorModule.F90 index 2332e231..a5492ec3 100644 --- a/Source/Fortran/ErrorModule.F90 +++ b/Source/Fortran/ErrorModule.F90 @@ -1,5 +1,5 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!> A (under development) module to do handle error passing. +!> A module to do handle error passing. MODULE ErrorModule USE NTMPIModule IMPLICIT NONE @@ -7,6 +7,7 @@ MODULE ErrorModule !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PUBLIC :: ConstructError PUBLIC :: SetGenericError + PUBLIC :: SetCustomError PUBLIC :: CheckMPIError PUBLIC :: CheckAllocError PUBLIC :: ErrorOccurred @@ -19,13 +20,19 @@ MODULE ErrorModule !> Flag for whether or not an error has occurred. LOGICAL :: error_set !> Detailed description of the error. - CHARACTER(len=1000) :: error_description - !> Store an error caused by a failed MPI call. + CHARACTER(LEN = 1000) :: error_description + !> Store a failed MPI call error. INTEGER :: mpi_error - LOGICAL :: mpi_error_set !< flag for whether mpi error occurred. - !> Store an error caused by a bad allocation call. + !> Flag for whether mpi error occurred. + LOGICAL :: mpi_error_set + !> Store a bad allocation call error. INTEGER :: alloc_error - LOGICAL :: alloc_error_set !< flag for whether alloc error occurred. + !> Flag for whether alloc error occurred. + LOGICAL :: alloc_error_set + !> Store a custom error. + INTEGER :: custom_error + !> Flag for whether a custom error occurred. + LOGICAL :: custom_error_set END TYPE Error_t CONTAINS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Default constructor for an error type. @@ -43,18 +50,15 @@ SUBROUTINE SetGenericError(this, error_description, immediate_cleanup_in) !> The error variable to be set. TYPE(Error_t), INTENT(inout) :: this !> Some string describing the details of the error. - CHARACTER(len=*), INTENT(in) :: error_description + CHARACTER(LEN = *), INTENT(in) :: error_description !> If true, the cleanup error handler is called. LOGICAL, INTENT(in), OPTIONAL :: immediate_cleanup_in !! Local Data LOGICAL :: immediate_cleanup !! Process Optional Arguments - IF (.NOT. PRESENT(immediate_cleanup_in)) THEN - immediate_cleanup = .FALSE. - ELSE - immediate_cleanup = immediate_cleanup_in - END IF + immediate_cleanup = .FALSE. + IF (PRESENT(immediate_cleanup_in)) immediate_cleanup = immediate_cleanup_in !! Set Flags and Variables this%error_description = error_description @@ -64,6 +68,28 @@ SUBROUTINE SetGenericError(this, error_description, immediate_cleanup_in) CALL Cleanup(this) END IF END SUBROUTINE SetGenericError +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE SetCustomError(this, error_code, error_description, & + & immediate_cleanup_in) + TYPE(Error_t), INTENT(INOUT) :: this + INTEGER, INTENT(IN) :: error_code + CHARACTER(LEN = *), INTENT(IN) :: error_description + LOGICAL, INTENT(IN), OPTIONAL :: immediate_cleanup_in + !! Local Data + LOGICAL :: immediate_cleanup + + immediate_cleanup = .FALSE. + IF (PRESENT(immediate_cleanup_in)) immediate_cleanup = immediate_cleanup_in + + this%error_description = error_description + this%error_set = .TRUE. + this%custom_error = error_code + this%custom_error_set = .TRUE. + + IF (immediate_cleanup) THEN + CALL Cleanup(this) + END IF + END SUBROUTINE SetCustomError !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Routine to call to check if an MPI error has occurred. FUNCTION CheckMPIError(this, error_description, mpi_error, & @@ -71,7 +97,7 @@ FUNCTION CheckMPIError(this, error_description, mpi_error, & !> The error variable to be set. TYPE(Error_t), INTENT(inout) :: this !> Some string describing the details of the error. - CHARACTER(len=*), INTENT(in) :: error_description + CHARACTER(LEN = *), INTENT(in) :: error_description !> The error variable produced by mpi. INTEGER, INTENT(in) :: mpi_error !> If true, the cleanup error handler is called. @@ -82,17 +108,14 @@ FUNCTION CheckMPIError(this, error_description, mpi_error, & LOGICAL :: immediate_cleanup !! Process Optional Arguments - IF (.NOT. PRESENT(immediate_cleanup_in)) THEN - immediate_cleanup = .FALSE. - ELSE - immediate_cleanup = immediate_cleanup_in - END IF + immediate_cleanup = .FALSE. + IF (PRESENT(immediate_cleanup_in)) immediate_cleanup = immediate_cleanup_in !! Check Error IF (.NOT. mpi_error .EQ. MPI_SUCCESS) THEN this%mpi_error_set = .TRUE. this%mpi_error = mpi_error - CALL SetGenericError(this,error_description) + CALL SetGenericError(this, error_description, immediate_cleanup) END IF error_occurred = ErrorOccurred(this) END FUNCTION CheckMPIError @@ -103,7 +126,7 @@ FUNCTION CheckAllocError(this, error_description, alloc_error, & !> This the error variable to be set. TYPE(Error_t), INTENT(inout) :: this !> Some string describing the details of the error. - CHARACTER(len=*), INTENT(in) :: error_description + CHARACTER(LEN = *), INTENT(in) :: error_description !> The error variable produced by alloc. INTEGER, INTENT(in) :: alloc_error !> If true, the cleanup error handler is called. @@ -114,17 +137,13 @@ FUNCTION CheckAllocError(this, error_description, alloc_error, & LOGICAL :: immediate_cleanup !! Process Optional Arguments - IF (.NOT. PRESENT(immediate_cleanup_in)) THEN - immediate_cleanup = .FALSE. - ELSE - immediate_cleanup = immediate_cleanup_in - END IF + IF (PRESENT(immediate_cleanup_in)) immediate_cleanup = immediate_cleanup_in !! Check Error IF (.NOT. alloc_error .EQ. 0) THEN this%alloc_error_set = .TRUE. this%alloc_error = alloc_error - CALL SetGenericError(this,error_description) + CALL SetGenericError(this, error_description, immediate_cleanup) END IF error_occurred = ErrorOccurred(this) END FUNCTION CheckAllocError @@ -140,36 +159,33 @@ FUNCTION ErrorOccurred(this) RESULT(occurred) END FUNCTION ErrorOccurred !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Print out that an error has occurred. - RECURSIVE SUBROUTINE PrintError(this) + SUBROUTINE PrintError(this) !> The error to print out. TYPE(Error_t), INTENT(in) :: this !! Local Data - CHARACTER(len=80) :: error_string + CHARACTER(LEN = 80) :: error_string INTEGER :: error_string_len INTEGER :: error_string_error - TYPE(Error_t) :: temp_error !! Print Out Information About The Error IF (ErrorOccurred(this)) THEN - WRITE(*,'(A)') "#An error has occurred." + WRITE(*,'(A)') "# An error has occurred." IF (this%alloc_error_set) THEN - WRITE(*,'(A)') "#Of type: alloc error." + WRITE(*,'(A)') "# Of type: alloc error." WRITE(*,'(I3)') this%alloc_error ELSE IF (this%mpi_error_set) THEN - WRITE(*,'(A)') "#Of type: mpi error." - CALL MPI_Error_String(this%mpi_error,error_string,error_string_len, & - & error_string_error) + WRITE(*,'(A)') "# Of type: mpi error." + CALL MPI_Error_String(this%mpi_error, error_string, & + & error_string_len, error_string_error) WRITE(*,'(A)') TRIM(error_string) ELSE - WRITE(*,'(A)') "#Of type: generic error." + WRITE(*,'(A)') "# Of type: generic error." END IF - WRITE(*,'(A)') "#Details:" + WRITE(*,'(A)') "# Details:" WRITE(*,'(A)',ADVANCE='no') "#" WRITE(*,'(A)') TRIM(this%error_description) ELSE - CALL SetGenericError(temp_error, & - & "No Error Occurred, but PrintError Called") - CALL PrintError(temp_error) + WRITE(*,'(A)') "# No Error Occured, but PrintError was Called" END IF END SUBROUTINE PrintError !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -182,9 +198,9 @@ SUBROUTINE Cleanup(this) CALL PrintError(this) IF (this%mpi_error_set) THEN - CALL MPI_Abort(MPI_COMM_WORLD,this%mpi_error,abort_error) + CALL MPI_Abort(MPI_COMM_WORLD, this%mpi_error, abort_error) ELSE - CALL MPI_Abort(MPI_COMM_WORLD,MPI_ERR_UNKNOWN,abort_error) + CALL MPI_Abort(MPI_COMM_WORLD, MPI_ERR_UNKNOWN, abort_error) END IF END SUBROUTINE Cleanup !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/Source/Fortran/ExponentialSolversModule.F90 b/Source/Fortran/ExponentialSolversModule.F90 index 26664517..96aa6353 100644 --- a/Source/Fortran/ExponentialSolversModule.F90 +++ b/Source/Fortran/ExponentialSolversModule.F90 @@ -9,8 +9,7 @@ MODULE ExponentialSolversModule USE EigenSolversModule, ONLY : DenseMatrixFunction USE LinearSolversModule, ONLY : CGSolver USE LoadBalancerModule, ONLY : PermuteMatrix, UndoPermuteMatrix - USE LoggingModule, ONLY : EnterSubLog, ExitSubLog, WriteHeader, & - & WriteElement + USE LoggingModule, ONLY : EnterSubLog, ExitSubLog, WriteHeader, WriteElement USE PSMatrixAlgebraModule, ONLY : MatrixMultiply, MatrixNorm, ScaleMatrix, & & IncrementMatrix USE PMatrixMemoryPoolModule, ONLY : MatrixMemoryPool_p, & @@ -19,7 +18,8 @@ MODULE ExponentialSolversModule & DestructMatrix, FillMatrixIdentity, PrintMatrixInformation USE RootSolversModule, ONLY : ComputeRoot USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters USE SquareRootSolversModule, ONLY : SquareRoot IMPLICIT NONE PRIVATE @@ -42,9 +42,9 @@ SUBROUTINE ComputeExponential(InputMat, OutputMat, solver_parameters_in) !> Parameters for the solver TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: solver_parameters - TYPE(SolverParameters_t) :: sub_solver_parameters - TYPE(SolverParameters_t) :: psub_solver_parameters + TYPE(SolverParameters_t) :: params + TYPE(SolverParameters_t) :: sub_params + TYPE(SolverParameters_t) :: psub_params !! Local Matrices TYPE(Matrix_ps) :: ScaledMat TYPE(Matrix_ps) :: TempMat @@ -60,37 +60,37 @@ SUBROUTINE ComputeExponential(InputMat, OutputMat, solver_parameters_in) !! Handle The Optional Parameters !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - solver_parameters = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF - sub_solver_parameters = solver_parameters - psub_solver_parameters = solver_parameters - psub_solver_parameters%max_iterations = 10 + CALL CopySolverParameters(params, sub_params) + CALL CopySolverParameters(params, psub_params) + psub_params%max_iterations = 10 - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Exponential Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Chebyshev") - CALL PrintParameters(solver_parameters) + CALL WriteElement(key = "Method", VALUE = "Chebyshev") + CALL PrintParameters(params) END IF CALL ConstructEmptyMatrix(OutputMat, InputMat) !! Scale the matrix - CALL PowerBounds(InputMat, spectral_radius, psub_solver_parameters) + CALL PowerBounds(InputMat, spectral_radius, psub_params) sigma_val = 1.0 sigma_counter = 1 - DO WHILE (spectral_radius/sigma_val .GT. 1.0) + DO WHILE (spectral_radius / sigma_val .GT. 1.0) sigma_val = sigma_val * 2 sigma_counter = sigma_counter + 1 END DO CALL CopyMatrix(InputMat, ScaledMat) - CALL ScaleMatrix(ScaledMat, 1.0/sigma_val) - sub_solver_parameters%threshold = sub_solver_parameters%threshold/sigma_val + CALL ScaleMatrix(ScaledMat, 1.0 / sigma_val) + sub_params%threshold = sub_params%threshold / sigma_val - IF (solver_parameters%be_verbose) THEN - CALL WriteElement(key="Sigma", VALUE=sigma_val) + IF (params%be_verbose) THEN + CALL WriteElement(key = "Sigma", VALUE = sigma_val) END IF !! Expand Chebyshev Series @@ -112,40 +112,39 @@ SUBROUTINE ComputeExponential(InputMat, OutputMat, solver_parameters_in) CALL SetCoefficient(polynomial, 15, 2.127980007794583e-15_NTREAL) CALL SetCoefficient(polynomial, 16, -1.629151584468762e-16_NTREAL) - CALL Compute(ScaledMat, OutputMat, polynomial, sub_solver_parameters) + CALL Compute(ScaledMat, OutputMat, polynomial, sub_params) !! Undo the scaling by squaring at the end. - !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(OutputMat, OutputMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF - DO counter=1,sigma_counter-1 + DO counter = 1, sigma_counter - 1 CALL MatrixMultiply(OutputMat, OutputMat, TempMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL CopyMatrix(TempMat,OutputMat) END DO - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL PrintMatrixInformation(OutputMat) END IF - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF CALL DestructPolynomial(polynomial) CALL DestructMatrix(ScaledMat) CALL DestructMatrix(TempMat) - CALL DestructSolverParameters(solver_parameters) - CALL DestructSolverParameters(psub_solver_parameters) - CALL DestructSolverParameters(sub_solver_parameters) + CALL DestructSolverParameters(params) + CALL DestructSolverParameters(psub_params) + CALL DestructSolverParameters(sub_params) END SUBROUTINE ComputeExponential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the exponential of a matrix using a pade approximation. @@ -158,8 +157,8 @@ SUBROUTINE ComputeExponentialPade(InputMat, OutputMat, solver_parameters_in) !> Parameters for the solver TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: solver_parameters - TYPE(SolverParameters_t) :: sub_solver_parameters + TYPE(SolverParameters_t) :: params + TYPE(SolverParameters_t) :: sub_params !! Local Matrices TYPE(Matrix_ps) :: ScaledMat TYPE(Matrix_ps) :: IdentityMat @@ -175,18 +174,17 @@ SUBROUTINE ComputeExponentialPade(InputMat, OutputMat, solver_parameters_in) INTEGER :: II !! Handle The Optional Parameters - !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - solver_parameters = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Exponential Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Pade") - CALL PrintParameters(solver_parameters) + CALL WriteElement(key = "Method", VALUE = "Pade") + CALL PrintParameters(params) END IF !! Setup @@ -202,38 +200,38 @@ SUBROUTINE ComputeExponentialPade(InputMat, OutputMat, solver_parameters_in) sigma_counter = sigma_counter + 1 END DO CALL CopyMatrix(InputMat, ScaledMat) - CALL ScaleMatrix(ScaledMat,1.0/sigma_val) - IF (solver_parameters%be_verbose) THEN - CALL WriteElement(key="Sigma", VALUE=sigma_val) - CALL WriteElement(key="Scaling_Steps", VALUE=sigma_counter) + CALL ScaleMatrix(ScaledMat, 1.0 / sigma_val) + IF (params%be_verbose) THEN + CALL WriteElement(key = "Sigma", VALUE = sigma_val) + CALL WriteElement(key = "Scaling Steps", VALUE = sigma_counter) END IF !! Sub Solver Parameters - sub_solver_parameters = solver_parameters - sub_solver_parameters%threshold = sub_solver_parameters%threshold/sigma_val + CALL CopySolverParameters(params, sub_params) + sub_params%threshold = sub_params%threshold / sigma_val !! Power Matrices CALL MatrixMultiply(ScaledMat, ScaledMat, B1, & - & threshold_in=sub_solver_parameters%threshold, memory_pool_in=pool) + & threshold_in = sub_params%threshold, memory_pool_in = pool) CALL MatrixMultiply(B1, B1, B2, & - & threshold_in=sub_solver_parameters%threshold, memory_pool_in=pool) + & threshold_in = sub_params%threshold, memory_pool_in = pool) CALL MatrixMultiply(B2, B2, B3, & - & threshold_in=sub_solver_parameters%threshold, memory_pool_in=pool) + & threshold_in = sub_params%threshold, memory_pool_in = pool) !! Polynomials - 1 CALL CopyMatrix(IdentityMat, P1) - CALL ScaleMatrix(P1,17297280.0_NTREAL) - CALL IncrementMatrix(B1, P1, alpha_in=1995840.0_NTREAL) - CALL IncrementMatrix(B2, P1, alpha_in=25200.0_NTREAL) - CALL IncrementMatrix(B3, P1, alpha_in=56.0_NTREAL) + CALL ScaleMatrix(P1, 17297280.0_NTREAL) + CALL IncrementMatrix(B1, P1, alpha_in = 1995840.0_NTREAL) + CALL IncrementMatrix(B2, P1, alpha_in = 25200.0_NTREAL) + CALL IncrementMatrix(B3, P1, alpha_in = 56.0_NTREAL) !! Polynomials - 2 CALL CopyMatrix(IdentityMat, TempMat) - CALL ScaleMatrix(TempMat,8648640.0_NTREAL) - CALL IncrementMatrix(B1, TempMat, alpha_in=277200.0_NTREAL) - CALL IncrementMatrix(B2, TempMat, alpha_in=1512.0_NTREAL) + CALL ScaleMatrix(TempMat, 8648640.0_NTREAL) + CALL IncrementMatrix(B1, TempMat, alpha_in = 277200.0_NTREAL) + CALL IncrementMatrix(B2, TempMat, alpha_in = 1512.0_NTREAL) CALL IncrementMatrix(B3, TempMat) CALL MatrixMultiply(ScaledMat, TempMat, P2, & - & threshold_in=sub_solver_parameters%threshold, memory_pool_in=pool) + & threshold_in = sub_params%threshold, memory_pool_in = pool) !! Left and Right CALL CopyMatrix(P1, LeftMat) @@ -241,21 +239,21 @@ SUBROUTINE ComputeExponentialPade(InputMat, OutputMat, solver_parameters_in) CALL CopyMatrix(P1, RightMat) CALL IncrementMatrix(P2, RightMat, 1.0_NTREAL) - CALL CGSolver(LeftMat, OutputMat, RightMat, sub_solver_parameters) + CALL CGSolver(LeftMat, OutputMat, RightMat, sub_params) !! Undo the scaling by squaring at the end. DO II = 1, sigma_counter - 1 CALL MatrixMultiply(OutputMat, OutputMat, TempMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL CopyMatrix(TempMat,OutputMat) END DO - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL PrintMatrixInformation(OutputMat) END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF CALL DestructMatrix(ScaledMat) @@ -268,8 +266,8 @@ SUBROUTINE ComputeExponentialPade(InputMat, OutputMat, solver_parameters_in) CALL DestructMatrix(LeftMat) CALL DestructMatrix(RightMat) CALL DestructMatrixMemoryPool(pool) - CALL DestructSolverParameters(solver_parameters) - CALL DestructSolverParameters(sub_solver_parameters) + CALL DestructSolverParameters(params) + CALL DestructSolverParameters(sub_params) END SUBROUTINE ComputeExponentialPade !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the exponential of a matrix using a taylor series expansion. @@ -283,8 +281,8 @@ SUBROUTINE ComputeExponentialTaylor(InputMat, OutputMat, solver_parameters_in) !> Parameters for the solver TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: solver_parameters - TYPE(SolverParameters_t) :: psub_solver_parameters + TYPE(SolverParameters_t) :: params + TYPE(SolverParameters_t) :: psub_params !! Local Matrices TYPE(Matrix_ps) :: ScaledMat TYPE(Matrix_ps) :: Ak @@ -299,43 +297,43 @@ SUBROUTINE ComputeExponentialTaylor(InputMat, OutputMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - solver_parameters = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF - psub_solver_parameters = solver_parameters - psub_solver_parameters%max_iterations = 10 + CALL CopySolverParameters(params, psub_params) + psub_params%max_iterations = 10 - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Exponential Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Taylor") - CALL PrintParameters(solver_parameters) + CALL WriteElement(key = "Method", VALUE = "Taylor") + CALL PrintParameters(params) END IF !! Compute The Scaling Factor - CALL PowerBounds(InputMat, spectral_radius, psub_solver_parameters) + CALL PowerBounds(InputMat, spectral_radius, psub_params) !! Figure out how much to scale the matrix. sigma_val = 1.0 sigma_counter = 1 - DO WHILE (spectral_radius/sigma_val .GT. 3.0e-8) + DO WHILE (spectral_radius / sigma_val .GT. 3.0e-8) sigma_val = sigma_val * 2 sigma_counter = sigma_counter + 1 END DO CALL CopyMatrix(InputMat, ScaledMat) - CALL ScaleMatrix(ScaledMat, 1.0/sigma_val) + CALL ScaleMatrix(ScaledMat, 1.0 / sigma_val) CALL ConstructEmptyMatrix(OutputMat, InputMat) CALL FillMatrixIdentity(OutputMat) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(ScaledMat, ScaledMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(OutputMat, OutputMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Expand Taylor Series @@ -344,32 +342,32 @@ SUBROUTINE ComputeExponentialTaylor(InputMat, OutputMat, solver_parameters_in) DO II = 1, 10 taylor_denom = taylor_denom * II CALL MatrixMultiply(Ak, ScaledMat, TempMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL CopyMatrix(TempMat, Ak) CALL IncrementMatrix(Ak, OutputMat) END DO - DO II = 1, sigma_counter-1 + DO II = 1, sigma_counter - 1 CALL MatrixMultiply(OutputMat, OutputMat, TempMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) - CALL CopyMatrix(TempMat,OutputMat) + & threshold_in = params%threshold, memory_pool_in = pool) + CALL CopyMatrix(TempMat, OutputMat) END DO - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF CALL DestructMatrix(ScaledMat) CALL DestructMatrix(Ak) CALL DestructMatrix(TempMat) CALL DestructMatrixMemoryPool(pool) - CALL DestructSolverParameters(solver_parameters) - CALL DestructSolverParameters(psub_solver_parameters) + CALL DestructSolverParameters(params) + CALL DestructSolverParameters(psub_params) END SUBROUTINE ComputeExponentialTaylor !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE ComputeDenseExponential(InputMat, OutputMat, solver_parameters_in) @@ -380,29 +378,29 @@ SUBROUTINE ComputeDenseExponential(InputMat, OutputMat, solver_parameters_in) !> Parameters for the solver TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: param + TYPE(SolverParameters_t) :: params !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - param = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - param = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Exponential Solver") CALL EnterSubLog END IF !! Apply - CALL DenseMatrixFunction(InputMat, OutputMat, ExpLambda, param) + CALL DenseMatrixFunction(InputMat, OutputMat, ExpLambda, params) - IF (param%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF !! Cleanup - CALL DestructSolverParameters(param) + CALL DestructSolverParameters(params) END SUBROUTINE ComputeDenseExponential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -415,7 +413,7 @@ SUBROUTINE ComputeLogarithm(InputMat, OutputMat, solver_parameters_in) !> Parameters for the solver TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params !! Local Matrices TYPE(Matrix_ps) :: ScaledMat TYPE(Matrix_ps) :: TempMat @@ -423,30 +421,29 @@ SUBROUTINE ComputeLogarithm(InputMat, OutputMat, solver_parameters_in) !! For Chebyshev Expansion TYPE(ChebyshevPolynomial_t) :: polynomial !! Local Variables - TYPE(SolverParameters_t) :: i_sub_solver_parameters - TYPE(SolverParameters_t) :: p_sub_solver_parameters - TYPE(SolverParameters_t) :: f_sub_solver_parameters + TYPE(SolverParameters_t) :: i_sub_params + TYPE(SolverParameters_t) :: p_sub_params + TYPE(SolverParameters_t) :: f_sub_params REAL(NTREAL) :: spectral_radius INTEGER :: sigma_val INTEGER :: sigma_counter !! Handle The Optional Parameters - !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - solver_parameters = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF - i_sub_solver_parameters = solver_parameters - p_sub_solver_parameters = solver_parameters - p_sub_solver_parameters%max_iterations=16 - f_sub_solver_parameters = solver_parameters + CALL CopySolverParameters(params, i_sub_params) + CALL CopySolverParameters(params, p_sub_params) + CALL CopySolverParameters(params, f_sub_params) + p_sub_params%max_iterations = 16 - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Logarithm Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Chebyshev") - CALL PrintParameters(solver_parameters) + CALL WriteElement(key = "Method", VALUE = "Chebyshev") + CALL PrintParameters(params) END IF !! Setup @@ -459,22 +456,21 @@ SUBROUTINE ComputeLogarithm(InputMat, OutputMat, solver_parameters_in) !! Compute The Scaling Factor sigma_val = 1 sigma_counter = 1 - CALL PowerBounds(InputMat, spectral_radius, p_sub_solver_parameters) + CALL PowerBounds(InputMat, spectral_radius, p_sub_params) DO WHILE (spectral_radius .GT. SQRT(2.0)) spectral_radius = SQRT(spectral_radius) sigma_val = sigma_val * 2 sigma_counter = sigma_counter + 1 END DO - IF (solver_parameters%be_verbose) THEN - CALL WriteElement(key="Sigma", VALUE=sigma_val) + IF (params%be_verbose) THEN + CALL WriteElement(key = "Sigma", VALUE = sigma_val) END IF - f_sub_solver_parameters%threshold = & - & f_sub_solver_parameters%threshold/REAL(2**(sigma_counter-1),NTREAL) - CALL ComputeRoot(InputMat, ScaledMat, sigma_val, i_sub_solver_parameters) + f_sub_params%threshold = & + & f_sub_params%threshold / REAL(2**(sigma_counter - 1), NTREAL) + CALL ComputeRoot(InputMat, ScaledMat, sigma_val, i_sub_params) !! Shift Scaled Matrix - CALL IncrementMatrix(IdentityMat, ScaledMat, & - & alpha_in=REAL(-1.0,NTREAL)) + CALL IncrementMatrix(IdentityMat, ScaledMat, alpha_in = -1.0_NTREAL) !! Expand Chebyshev Series CALL ConstructPolynomial(polynomial, 32) @@ -511,25 +507,23 @@ SUBROUTINE ComputeLogarithm(InputMat, OutputMat, solver_parameters_in) CALL SetCoefficient(polynomial, 31, 3.91175568865e-12_NTREAL) CALL SetCoefficient(polynomial, 32, -2.21155654398e-13_NTREAL) - CALL FactorizedCompute(ScaledMat, OutputMat, polynomial, & - & f_sub_solver_parameters) + CALL FactorizedCompute(ScaledMat, OutputMat, polynomial, f_sub_params) !! Scale Back - CALL ScaleMatrix(OutputMat, & - & REAL(2**(sigma_counter-1),NTREAL)) + CALL ScaleMatrix(OutputMat, REAL(2**(sigma_counter - 1), NTREAL)) !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF CALL DestructPolynomial(polynomial) CALL DestructMatrix(ScaledMat) CALL DestructMatrix(IdentityMat) CALL DestructMatrix(TempMat) - CALL DestructSolverParameters(solver_parameters) - CALL DestructSolverParameters(i_sub_solver_parameters) - CALL DestructSolverParameters(f_sub_solver_parameters) - CALL DestructSolverParameters(p_sub_solver_parameters) + CALL DestructSolverParameters(params) + CALL DestructSolverParameters(i_sub_params) + CALL DestructSolverParameters(f_sub_params) + CALL DestructSolverParameters(p_sub_params) END SUBROUTINE ComputeLogarithm !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the logarithm of a matrix using a taylor series expansion. @@ -541,7 +535,7 @@ SUBROUTINE ComputeLogarithmTaylor(InputMat, OutputMat, solver_parameters_in) !> Parameters for the solver TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params !! Local Matrices TYPE(Matrix_ps) :: ScaledMat TYPE(Matrix_ps) :: TempMat @@ -549,7 +543,7 @@ SUBROUTINE ComputeLogarithmTaylor(InputMat, OutputMat, solver_parameters_in) TYPE(Matrix_ps) :: IdentityMat TYPE(MatrixMemoryPool_p) :: pool !! Local Variables - TYPE(SolverParameters_t) :: sub_solver_parameters + TYPE(SolverParameters_t) :: sub_params REAL(NTREAL) :: e_min, e_max, spectral_radius REAL(NTREAL) :: sigma_val REAL(NTREAL) :: taylor_denom @@ -557,19 +551,18 @@ SUBROUTINE ComputeLogarithmTaylor(InputMat, OutputMat, solver_parameters_in) INTEGER :: II !! Handle The Optional Parameters - !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - solver_parameters = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF - sub_solver_parameters = solver_parameters + CALL CopySolverParameters(params, sub_params) - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Logarithm Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Taylor") - CALL PrintParameters(solver_parameters) + CALL WriteElement(key = "Method", VALUE = "Taylor") + CALL PrintParameters(params) END IF !! Compute The Scaling Factor @@ -579,11 +572,10 @@ SUBROUTINE ComputeLogarithmTaylor(InputMat, OutputMat, solver_parameters_in) !! Figure out how much to scale the matrix. sigma_val = 1.0 sigma_counter = 1 - CALL CopyMatrix(InputMat,ScaledMat) - !do while (spectral_radius/sigma_val .gt. 1.1e-5) - DO WHILE (spectral_radius/sigma_val .GT. 1.1e-7) - CALL SquareRoot(ScaledMat,TempMat,sub_solver_parameters) - CALL CopyMatrix(TempMat,ScaledMat) + CALL CopyMatrix(InputMat, ScaledMat) + DO WHILE (spectral_radius / sigma_val .GT. 1.1e-7) + CALL SquareRoot(ScaledMat, TempMat, sub_params) + CALL CopyMatrix(TempMat, ScaledMat) CALL GershgorinBounds(ScaledMat, e_min, e_max) spectral_radius = MAX(ABS(e_min), ABS(e_max)) sigma_val = sigma_val * 2 @@ -595,43 +587,43 @@ SUBROUTINE ComputeLogarithmTaylor(InputMat, OutputMat, solver_parameters_in) !! Setup Matrices CALL IncrementMatrix(IdentityMat, ScaledMat, & - & alpha_in=REAL(-1.0,NTREAL)) + & alpha_in = -1.0_NTREAL) CALL CopyMatrix(IdentityMat, Ak) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(ScaledMat, ScaledMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(Ak, Ak, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Expand taylor series. - CALL CopyMatrix(ScaledMat,OutputMat) + CALL CopyMatrix(ScaledMat, OutputMat) DO II = 2, 10 - IF (MOD(II,2) .EQ. 0) THEN + IF (MOD(II, 2) .EQ. 0) THEN taylor_denom = -1 * II ELSE taylor_denom = II END IF CALL MatrixMultiply(Ak, ScaledMat, TempMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL CopyMatrix(TempMat, Ak) CALL IncrementMatrix(Ak, OutputMat, & - & alpha_in=1.0/taylor_denom) + & alpha_in = 1.0 / taylor_denom) END DO !! Undo scaling. - CALL ScaleMatrix(OutputMat, REAL(2**sigma_counter,NTREAL)) + CALL ScaleMatrix(OutputMat, REAL(2**sigma_counter, NTREAL)) - !! Undo load balancing. - IF (solver_parameters%do_load_balancing) THEN + !! Undo load params. + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF CALL DestructMatrix(ScaledMat) @@ -639,8 +631,8 @@ SUBROUTINE ComputeLogarithmTaylor(InputMat, OutputMat, solver_parameters_in) CALL DestructMatrix(IdentityMat) CALL DestructMatrix(Ak) CALL DestructMatrixMemoryPool(pool) - CALL DestructSolverParameters(solver_parameters) - CALL DestructSolverParameters(sub_solver_parameters) + CALL DestructSolverParameters(params) + CALL DestructSolverParameters(sub_params) END SUBROUTINE ComputeLogarithmTaylor !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE ComputeDenseLogarithm(InputMat, OutputMat, solver_parameters_in) @@ -655,9 +647,9 @@ SUBROUTINE ComputeDenseLogarithm(InputMat, OutputMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN @@ -679,16 +671,16 @@ END SUBROUTINE ComputeDenseLogarithm !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Prototypical exponential for mapping. FUNCTION ExpLambda(val) RESULT(outval) - REAL(KIND=NTREAL), INTENT(IN) :: val - REAL(KIND=NTREAL) :: outval + REAL(KIND = NTREAL), INTENT(IN) :: val + REAL(KIND = NTREAL) :: outval outval = EXP(val) END FUNCTION ExpLambda !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Prototypical exponential for mapping. FUNCTION LogLambda(val) RESULT(outval) - REAL(KIND=NTREAL), INTENT(IN) :: val - REAL(KIND=NTREAL) :: outval + REAL(KIND = NTREAL), INTENT(IN) :: val + REAL(KIND = NTREAL) :: outval outval = LOG(val) END FUNCTION LogLambda diff --git a/Source/Fortran/FermiOperatorModule.F90 b/Source/Fortran/FermiOperatorModule.F90 index 1b5952d1..b46379be 100644 --- a/Source/Fortran/FermiOperatorModule.F90 +++ b/Source/Fortran/FermiOperatorModule.F90 @@ -13,7 +13,8 @@ MODULE FermiOperatorModule USE PMatrixMemoryPoolModule, ONLY : MatrixMemoryPool_p, & & DestructMatrixMemoryPool USE SolverParametersModule, ONLY : SolverParameters_t, & - & PrintParameters, DestructSolverParameters + & PrintParameters, DestructSolverParameters, CopySolverParameters, & + & ConstructSolverParameters USE TripletListModule, ONLY : TripletList_r, DestructTripletList USE NTMPIModule IMPLICIT NONE @@ -60,9 +61,9 @@ SUBROUTINE ComputeDenseFOE(H, ISQ, trace, K, inv_temp_in, & !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (PRESENT(inv_temp_in)) THEN inv_temp = inv_temp_in @@ -75,10 +76,10 @@ SUBROUTINE ComputeDenseFOE(H, ISQ, trace, K, inv_temp_in, & CALL WriteHeader("Density Matrix Solver") CALL EnterSubLog IF (do_smearing) THEN - CALL WriteElement(key="Method", VALUE="Dense FOE") - CALL WriteElement(key="InverseTemperature", VALUE=inv_temp) + CALL WriteElement(key = "Method", VALUE = "Dense FOE") + CALL WriteElement(key = "Inverse Temperature", VALUE = inv_temp) ELSE - CALL WriteElement(key="Method", VALUE="Dense Step Function") + CALL WriteElement(key = "Method", VALUE = "Dense Step Function") END IF CALL PrintParameters(params) END IF @@ -86,13 +87,13 @@ SUBROUTINE ComputeDenseFOE(H, ISQ, trace, K, inv_temp_in, & !! Compute the working hamiltonian. CALL TransposeMatrix(ISQ, ISQT) CALL MatrixMultiply(ISQ, H, Temp, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL MatrixMultiply(Temp, ISQT, WH, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) !! Perform the eigendecomposition CALL EigenDecomposition(WH, vals, & - & eigenvectors_in=vecs, solver_parameters_in=params) + & eigenvectors_in = vecs, solver_parameters_in = params) !! Gather the eigenvalues on to every process CALL GetMatrixTripletList(vals, tlist) @@ -137,8 +138,8 @@ SUBROUTINE ComputeDenseFOE(H, ISQ, trace, K, inv_temp_in, & IF (params%be_verbose) THEN CALL WriteHeader("Chemical Potential Search") CALL EnterSubLog - CALL WriteElement(key="Potential", VALUE=chemical_potential) - CALL WriteElement(key="Iterations", VALUE=JJ) + CALL WriteElement(key = "Potential", VALUE = chemical_potential) + CALL WriteElement(key = "Iterations", VALUE = JJ) CALL ExitSubLog END IF @@ -169,20 +170,20 @@ SUBROUTINE ComputeDenseFOE(H, ISQ, trace, K, inv_temp_in, & !! Fill CALL ConstructEmptyMatrix(vals, H) - CALL FillMatrixFromTripletList(vals, tlist, preduplicated_in=.TRUE.) + CALL FillMatrixFromTripletList(vals, tlist, preduplicated_in = .TRUE.) !! Multiply Back Together - CALL MatrixMultiply(vecs, vals, temp, threshold_in=params%threshold) + CALL MatrixMultiply(vecs, vals, temp, threshold_in = params%threshold) CALL TransposeMatrix(vecs, vecsT) CALL ConjugateMatrix(vecsT) CALL MatrixMultiply(temp, vecsT, WD, & - & threshold_in=params%threshold) + & threshold_in = params%threshold) !! Compute the density matrix in the non-orthogonalized basis CALL MatrixMultiply(ISQT, WD, Temp, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL MatrixMultiply(Temp, ISQ, K, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) !! Optional out variables. IF (PRESENT(energy_value_out)) THEN diff --git a/Source/Fortran/GeometryOptimizationModule.F90 b/Source/Fortran/GeometryOptimizationModule.F90 index 3167a246..02cfdaea 100644 --- a/Source/Fortran/GeometryOptimizationModule.F90 +++ b/Source/Fortran/GeometryOptimizationModule.F90 @@ -13,7 +13,8 @@ MODULE GeometryOptimizationModule USE PSMatrixModule, ONLY : Matrix_ps, DestructMatrix, ConstructEmptyMatrix, & & PrintMatrixInformation, CopyMatrix USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters USE SquareRootSolversModule, ONLY : SquareRoot, InverseSquareRoot IMPLICIT NONE PRIVATE @@ -51,15 +52,15 @@ SUBROUTINE PurificationExtrapolate(PreviousDensity, Overlap, trace, & !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN CALL WriteHeader("Density Matrix Extrapolator") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Purification") + CALL WriteElement(key = "Method", VALUE = "Purification") CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("niklasson2010trace") @@ -79,9 +80,9 @@ SUBROUTINE PurificationExtrapolate(PreviousDensity, Overlap, trace, & !! Load Balancing Step IF (params%do_load_balancing) THEN CALL PermuteMatrix(WorkingDensity, WorkingDensity, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(WorkingOverlap, WorkingOverlap, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Iterate @@ -94,9 +95,9 @@ SUBROUTINE PurificationExtrapolate(PreviousDensity, Overlap, trace, & DO II = 1, params%max_iterations !! Xn+1 = Xn S1 Xn CALL MatrixMultiply(WorkingDensity, WorkingOverlap, TempMat, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL MatrixMultiply(TempMat, WorkingDensity, NewDensity, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) !! Figure Out Sigma Value CALL DotMatrix(WorkingDensity, WorkingOverlap, trace_value) @@ -112,9 +113,9 @@ SUBROUTINE PurificationExtrapolate(PreviousDensity, Overlap, trace, & norm_value = MatrixNorm(WorkingDensity) IF (params%be_verbose) THEN - CALL WriteListElement(key="Convergence", VALUE=norm_value) + CALL WriteListElement(key = "Convergence", VALUE = norm_value) CALL EnterSubLog - CALL WriteElement(key="Trace", VALUE=trace_value) + CALL WriteElement(key = "Trace", VALUE = trace_value) CALL ExitSubLog END IF @@ -127,14 +128,14 @@ SUBROUTINE PurificationExtrapolate(PreviousDensity, Overlap, trace, & END DO IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=II) + CALL WriteElement(key = "Total Iterations", VALUE = II) CALL PrintMatrixInformation(NewDensity) END IF !! Undo Load Balancing Step IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(NewDensity, NewDensity, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF IF (params%be_verbose) THEN @@ -175,15 +176,15 @@ SUBROUTINE LowdinExtrapolate(PreviousDensity, OldOverlap, NewOverlap, & !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN CALL WriteHeader("Density Matrix Extrapolator") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Lowdin") + CALL WriteElement(key = "Method", VALUE = "Lowdin") CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("exner2002comparison") @@ -195,9 +196,9 @@ SUBROUTINE LowdinExtrapolate(PreviousDensity, OldOverlap, NewOverlap, & CALL InverseSquareRoot(NewOverlap, ISQMat, params) CALL SimilarityTransform(PreviousDensity, SQRMat, SQRMat, TempMat, & - & pool_in=pool, threshold_in=params%threshold) + & pool_in = pool, threshold_in = params%threshold) CALL SimilarityTransform(TempMat, ISQMat, ISQMat, NewDensity, & - & pool_in=pool, threshold_in=params%threshold) + & pool_in = pool, threshold_in = params%threshold) IF (params%be_verbose) THEN CALL ExitSubLog diff --git a/Source/Fortran/HermiteSolversModule.F90 b/Source/Fortran/HermiteSolversModule.F90 index 7cbd86b2..dbd0b668 100644 --- a/Source/Fortran/HermiteSolversModule.F90 +++ b/Source/Fortran/HermiteSolversModule.F90 @@ -12,7 +12,8 @@ MODULE HermiteSolversModule USE PSMatrixModule, ONLY : Matrix_ps, ConstructEmptyMatrix, CopyMatrix, & & DestructMatrix, FillMatrixIdentity, PrintMatrixInformation USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters IMPLICIT NONE PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -102,9 +103,9 @@ SUBROUTINE Compute_horner(InputMat, OutputMat, poly, solver_parameters_in) !! Handle The Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF degree = SIZE(poly%coefficients) @@ -112,8 +113,8 @@ SUBROUTINE Compute_horner(InputMat, OutputMat, poly, solver_parameters_in) IF (params%be_verbose) THEN CALL WriteHeader("Hermite Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Standard") - CALL WriteElement(key="Degree", VALUE=degree-1) + CALL WriteElement(key = "Method", VALUE = "Standard") + CALL WriteElement(key = "Degree", VALUE = degree - 1) CALL PrintParameters(params) END IF @@ -125,9 +126,9 @@ SUBROUTINE Compute_horner(InputMat, OutputMat, poly, solver_parameters_in) !! Load Balancing Step IF (params%do_load_balancing) THEN CALL PermuteMatrix(Identity, Identity, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(BalancedInput, BalancedInput, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Recursive expansion @@ -136,26 +137,24 @@ SUBROUTINE Compute_horner(InputMat, OutputMat, poly, solver_parameters_in) CALL ScaleMatrix(OutputMat, poly%coefficients(1)) IF (degree .GT. 1) THEN CALL CopyMatrix(BalancedInput, Hk) - CALL ScaleMatrix(Hk, REAL(2.0,KIND=NTREAL)) + CALL ScaleMatrix(Hk, 2.0_NTREAL) CALL IncrementMatrix(Hk, OutputMat, & - & alpha_in=poly%coefficients(2)) + & alpha_in = poly%coefficients(2)) IF (degree .GT. 2) THEN CALL CopyMatrix(Hkminus1, Hkprime) - CALL ScaleMatrix(Hkprime, REAL(2.0,NTREAL)) + CALL ScaleMatrix(Hkprime, 2.0_NTREAL) DO II = 3, degree CALL MatrixMultiply(BalancedInput, Hk, Hkplus1, & - & alpha_in=REAL(2.0,NTREAL), & - & threshold_in=params%threshold, & - & memory_pool_in=pool) + & alpha_in = 2.0_NTREAL, threshold_in = params%threshold, & + & memory_pool_in = pool) CALL IncrementMatrix(Hkprime, Hkplus1, & - & alpha_in=REAL(-1.0,NTREAL)) + & alpha_in = -1.0_NTREAL) CALL CopyMatrix(Hk, Hkprime) - CALL ScaleMatrix(Hkprime, & - & REAL(2*(II-1),KIND=NTREAL)) + CALL ScaleMatrix(Hkprime, REAL(2 * (II - 1), KIND = NTREAL)) CALL CopyMatrix(Hk, Hkminus1) CALL CopyMatrix(Hkplus1, Hk) CALL IncrementMatrix(Hk, OutputMat, & - & alpha_in=poly%coefficients(II)) + & alpha_in = poly%coefficients(II)) END DO END IF END IF @@ -166,7 +165,7 @@ SUBROUTINE Compute_horner(InputMat, OutputMat, poly, solver_parameters_in) !! Undo Load Balancing Step IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Cleanup diff --git a/Source/Fortran/InverseSolversModule.F90 b/Source/Fortran/InverseSolversModule.F90 index 434da26c..702b47e7 100644 --- a/Source/Fortran/InverseSolversModule.F90 +++ b/Source/Fortran/InverseSolversModule.F90 @@ -13,7 +13,8 @@ MODULE InverseSolversModule USE PSMatrixModule, ONLY : Matrix_ps, ConstructEmptyMatrix, CopyMatrix, & & DestructMatrix, FillMatrixIdentity, PrintMatrixInformation USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, CopySolverParameters, & + & ConstructSolverParameters IMPLICIT NONE PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -44,9 +45,9 @@ SUBROUTINE Invert(InputMat, OutputMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN @@ -70,9 +71,9 @@ SUBROUTINE Invert(InputMat, OutputMat, solver_parameters_in) !! Load Balancing Step IF (params%do_load_balancing) THEN CALL PermuteMatrix(Identity, Identity, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(InputMat, BalancedMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) ELSE CALL CopyMatrix(InputMat, BalancedMat) END IF @@ -93,20 +94,20 @@ SUBROUTINE Invert(InputMat, OutputMat, solver_parameters_in) norm_value = params%converge_diff + 1.0_NTREAL DO II = 1, params%max_iterations IF (params%be_verbose .AND. II .GT. 1) THEN - CALL WriteListElement(key="Convergence", VALUE=norm_value) + CALL WriteListElement(key = "Convergence", VALUE = norm_value) END IF CALL MatrixMultiply(OutputMat, BalancedMat, Temp1, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) !! Check if Converged CALL CopyMatrix(Identity, Temp2) - CALL IncrementMatrix(Temp1, Temp2,-1.0_NTREAL) + CALL IncrementMatrix(Temp1, Temp2, -1.0_NTREAL) norm_value = MatrixNorm(Temp2) CALL DestructMatrix(Temp2) - CALL MatrixMultiply(Temp1, OutputMat, Temp2, alpha_in=-1.0_NTREAL, & - & threshold_in=params%threshold, memory_pool_in=pool) + CALL MatrixMultiply(Temp1, OutputMat, Temp2, alpha_in = -1.0_NTREAL, & + & threshold_in = params%threshold, memory_pool_in = pool) !! Save a copy of the last inverse matrix CALL CopyMatrix(OutputMat, Temp1) @@ -114,7 +115,7 @@ SUBROUTINE Invert(InputMat, OutputMat, solver_parameters_in) CALL ScaleMatrix(OutputMat, 2.0_NTREAL) CALL IncrementMatrix(Temp2, OutputMat, & - & threshold_in=params%threshold) + & threshold_in = params%threshold) IF (norm_value .LE. params%converge_diff) THEN EXIT @@ -122,14 +123,14 @@ SUBROUTINE Invert(InputMat, OutputMat, solver_parameters_in) END DO IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=II-1) + CALL WriteElement(key = "Total Iterations", VALUE = II-1) CALL PrintMatrixInformation(OutputMat) END IF !! Undo Load Balancing Step IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF IF (params%be_verbose) THEN @@ -157,9 +158,9 @@ SUBROUTINE DenseInvert(InputMat, OutputMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN @@ -200,9 +201,9 @@ SUBROUTINE PseudoInverse(InputMat, OutputMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN @@ -226,9 +227,9 @@ SUBROUTINE PseudoInverse(InputMat, OutputMat, solver_parameters_in) !! Load Balancing Step IF (params%do_load_balancing) THEN CALL PermuteMatrix(Identity, Identity, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(InputMat, BalancedMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) ELSE CALL CopyMatrix(InputMat, BalancedMat) END IF @@ -249,20 +250,20 @@ SUBROUTINE PseudoInverse(InputMat, OutputMat, solver_parameters_in) norm_value = params%converge_diff + 1.0_NTREAL DO II = 1,params%max_iterations IF (params%be_verbose .AND. II .GT. 1) THEN - CALL WriteListElement(key="Convergence", VALUE=norm_value) + CALL WriteListElement(key = "Convergence", VALUE = norm_value) END IF CALL MatrixMultiply(OutputMat, BalancedMat, Temp1, & - & threshold_in=params%threshold, memory_pool_in=pool) - CALL MatrixMultiply(Temp1, OutputMat, Temp2,alpha_in=-1.0_NTREAL, & - & threshold_in=params%threshold,memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) + CALL MatrixMultiply(Temp1, OutputMat, Temp2, alpha_in = -1.0_NTREAL, & + & threshold_in = params%threshold, memory_pool_in = pool) !! Save a copy of the last inverse matrix CALL CopyMatrix(OutputMat, Temp1) CALL ScaleMatrix(OutputMat, 2.0_NTREAL) CALL IncrementMatrix(Temp2, OutputMat, & - & threshold_in=params%threshold) + & threshold_in = params%threshold) !! Check if Converged CALL IncrementMatrix(OutputMat, Temp1, -1.0_NTREAL) @@ -276,14 +277,14 @@ SUBROUTINE PseudoInverse(InputMat, OutputMat, solver_parameters_in) END DO IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=II-1) + CALL WriteElement(key = "Total Iterations", VALUE = II - 1) CALL PrintMatrixInformation(OutputMat) END IF !! Undo Load Balancing Step IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF IF (params%be_verbose) THEN @@ -300,8 +301,8 @@ END SUBROUTINE PseudoInverse !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Prototypical inversion for mapping. FUNCTION InvertLambda(val) RESULT(outval) - REAL(KIND=NTREAL), INTENT(IN) :: val - REAL(KIND=NTREAL) :: outval + REAL(KIND = NTREAL), INTENT(IN) :: val + REAL(KIND = NTREAL) :: outval outval = 1.0 / val END FUNCTION InvertLambda diff --git a/Source/Fortran/LinearSolversModule.F90 b/Source/Fortran/LinearSolversModule.F90 index 7fb083b9..314fc4b1 100644 --- a/Source/Fortran/LinearSolversModule.F90 +++ b/Source/Fortran/LinearSolversModule.F90 @@ -19,7 +19,8 @@ MODULE LinearSolversModule & FillMatrixIdentity, PrintMatrixInformation, MergeMatrixLocalBlocks USE SMatrixModule, ONLY : Matrix_lsr USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters USE NTMPIMODULE IMPLICIT NONE PRIVATE @@ -54,16 +55,16 @@ SUBROUTINE CGSolver(AMat, XMat, BMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF !! Print out parameters IF (params%be_verbose) THEN CALL WriteHeader("Linear Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="CG") + CALL WriteElement(key = "Method", VALUE = "CG") CALL PrintParameters(params) END IF @@ -80,11 +81,11 @@ SUBROUTINE CGSolver(AMat, XMat, BMat, solver_parameters_in) !! Load Balancing Step IF (params%do_load_balancing) THEN CALL PermuteMatrix(Identity, Identity, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(AMat, ABalanced, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(BMat, BBalanced, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) ELSE CALL CopyMatrix(AMat,ABalanced) CALL CopyMatrix(BMat,BBalanced) @@ -94,10 +95,10 @@ SUBROUTINE CGSolver(AMat, XMat, BMat, solver_parameters_in) CALL CopyMatrix(Identity, XMat) !! Compute residual CALL MatrixMultiply(ABalanced, Xmat, TempMat, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL CopyMatrix(BBalanced,RMat) CALL IncrementMatrix(TempMat, RMat, -1.0_NTREAL) - CALL CopyMatrix(RMat,PMat) + CALL CopyMatrix(RMat, PMat) !! Iterate IF (params%be_verbose) THEN @@ -107,7 +108,7 @@ SUBROUTINE CGSolver(AMat, XMat, BMat, solver_parameters_in) norm_value = params%converge_diff + 1.0_NTREAL DO II = 1, params%max_iterations IF (params%be_verbose .AND. II .GT. 1) THEN - CALL WriteListElement(key="Convergence", VALUE=norm_value) + CALL WriteListElement(key = "Convergence", VALUE = norm_value) END IF IF (norm_value .LE. params%converge_diff) THEN EXIT @@ -115,36 +116,36 @@ SUBROUTINE CGSolver(AMat, XMat, BMat, solver_parameters_in) !! Compute the Step Size CALL MatrixMultiply(ABalanced, PMat, QMat, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL TransposeMatrix(RMat,RMatT) IF (RMatT%is_complex) THEN CALL ConjugateMatrix(RMatT) END IF CALL MatrixMultiply(RMatT, RMat, TempMat, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL MatrixTrace(TempMat, top) - CALL TransposeMatrix(PMat,PMatT) + CALL TransposeMatrix(PMat, PMatT) IF (PMatT%is_complex) THEN CALL ConjugateMatrix(PMatT) END IF CALL MatrixMultiply(PMatT, QMat, TempMat, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL MatrixTrace(TempMat, bottom) - step_size = top/bottom + step_size = top / bottom !! Update - CALL IncrementMatrix(PMat, XMat, alpha_in=step_size) - norm_value = ABS(step_size*MatrixNorm(PMat)) - CALL IncrementMatrix(QMat, RMat, alpha_in=-1.0_NTREAL*step_size) + CALL IncrementMatrix(PMat, XMat, alpha_in = step_size) + norm_value = ABS(step_size * MatrixNorm(PMat)) + CALL IncrementMatrix(QMat, RMat, alpha_in = -1.0_NTREAL * step_size) !! Update PMat - CALL TransposeMatrix(RMat,RMatT) + CALL TransposeMatrix(RMat, RMatT) IF (RMatT%is_complex) THEN CALL ConjugateMatrix(RMatT) END IF CALL MatrixMultiply(RMatT, RMat, TempMat, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL MatrixTrace(TempMat, new_top) step_size = new_top / top CALL ScaleMatrix(PMat, step_size) @@ -153,14 +154,14 @@ SUBROUTINE CGSolver(AMat, XMat, BMat, solver_parameters_in) END DO IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=II-1) + CALL WriteElement(key = "Total Iterations", VALUE = II - 1) CALL PrintMatrixInformation(XMat) END IF !! Undo Load Balancing Step IF (params%do_load_balancing) THEN - CALL UndoPermuteMatrix(XMat,XMat, & - & params%BalancePermutation, memorypool_in=pool) + CALL UndoPermuteMatrix(XMat, XMat, & + & params%BalancePermutation, memorypool_in = pool) END IF !! Cleanup @@ -208,16 +209,16 @@ SUBROUTINE CholeskyDecomposition(AMat, LMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF !! Print out parameters IF (params%be_verbose) THEN CALL WriteHeader("Linear Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Cholesky Decomposition") + CALL WriteElement(key = "Method", VALUE = "Cholesky Decomposition") CALL PrintParameters(params) END IF @@ -230,7 +231,7 @@ SUBROUTINE CholeskyDecomposition(AMat, LMat, solver_parameters_in) !! Root Lookups ALLOCATE(col_root_lookup(AMat%logical_matrix_dimension)) CALL ConstructRankLookup(AMat, LMat%process_grid, & - & col_root_lookup=col_root_lookup) + & col_root_lookup = col_root_lookup) !! Allocate space for L ALLOCATE(values_per_column_l(sparse_a%columns)) @@ -258,7 +259,7 @@ SUBROUTINE CholeskyDecomposition(AMat, LMat, solver_parameters_in) local_row = JJ - AMat%start_row + 1 Aval = dense_a%DATA(local_row, local_JJ) insert_value = SQRT(Aval - dot_values(1)) - inverse_factor = 1.0_NTREAL/insert_value + inverse_factor = 1.0_NTREAL / insert_value !! Insert CALL AppendToVector(values_per_column_l(local_JJ), & & index_l(:,local_JJ), values_l(:, local_JJ), local_row, & @@ -274,8 +275,8 @@ SUBROUTINE CholeskyDecomposition(AMat, LMat, solver_parameters_in) !! Broadcast column JJ, and Inverse Factor CALL BroadcastVector(recv_num_values, recv_index, recv_values, & & col_root, LMat%process_grid%row_comm) - CALL MPI_Allreduce(MPI_IN_PLACE, inverse_factor, 1, MPINTREAL, MPI_SUM, & - & LMat%process_grid%within_slice_comm, ierr) + CALL MPI_Allreduce(MPI_IN_PLACE, inverse_factor, 1, MPINTREAL, & + & MPI_SUM, LMat%process_grid%within_slice_comm, ierr) !! Loop over other columns CALL DotAllHelper(recv_num_values, recv_index, recv_values, & diff --git a/Source/Fortran/LoadBalancerModule.F90 b/Source/Fortran/LoadBalancerModule.F90 index 4fb4f667..c2f635b6 100644 --- a/Source/Fortran/LoadBalancerModule.F90 +++ b/Source/Fortran/LoadBalancerModule.F90 @@ -30,17 +30,17 @@ SUBROUTINE PermuteMatrix(mat, mat_out, permutation, memorypool_in) CALL ConstructEmptyMatrix(PermuteRows, mat) CALL ConstructEmptyMatrix(PermuteColumns, mat) CALL FillMatrixPermutation(PermuteRows, permutation%index_lookup, & - & permute_rows_in=.TRUE.) + & permute_rows_in = .TRUE.) CALL FillMatrixPermutation(PermuteColumns, permutation%index_lookup, & - & permute_rows_in=.FALSE.) + & permute_rows_in = .FALSE.) CALL ConstructEmptyMatrix(Temp, mat) !! Permute Matrices. IF (PRESENT(memorypool_in)) THEN CALL MatrixMultiply(PermuteRows, mat, Temp, & - & memory_pool_in=memorypool_in) + & memory_pool_in = memorypool_in) CALL MatrixMultiply(Temp, PermuteColumns, mat_out, & - & memory_pool_in=memorypool_in) + & memory_pool_in = memorypool_in) ELSE CALL MatrixMultiply(PermuteRows, mat, Temp) CALL MatrixMultiply(Temp, PermuteColumns, mat_out) @@ -69,17 +69,17 @@ SUBROUTINE UndoPermuteMatrix(mat, mat_out, permutation, memorypool_in) CALL ConstructEmptyMatrix(PermuteRows, mat) CALL ConstructEmptyMatrix(PermuteColumns, mat) CALL FillMatrixPermutation(PermuteRows, permutation%index_lookup, & - & permute_rows_in=.TRUE.) + & permute_rows_in = .TRUE.) CALL FillMatrixPermutation(PermuteColumns, permutation%index_lookup, & - & permute_rows_in=.FALSE.) + & permute_rows_in = .FALSE.) CALL ConstructEmptyMatrix(Temp, mat) !! Permute Matrices. IF (PRESENT(memorypool_in)) THEN CALL MatrixMultiply(PermuteColumns, mat, Temp, & - & memory_pool_in=memorypool_in) + & memory_pool_in = memorypool_in) CALL MatrixMultiply(Temp, PermuteRows, mat_out, & - & memory_pool_in=memorypool_in) + & memory_pool_in = memorypool_in) ELSE CALL MatrixMultiply(PermuteColumns, mat, Temp) CALL MatrixMultiply(Temp, PermuteRows, mat_out) diff --git a/Source/Fortran/LoggingModule.F90 b/Source/Fortran/LoggingModule.F90 index 2cb24664..16ca9ec9 100644 --- a/Source/Fortran/LoggingModule.F90 +++ b/Source/Fortran/LoggingModule.F90 @@ -5,14 +5,15 @@ MODULE LoggingModule IMPLICIT NONE PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - INTEGER :: CurrentLevel = 0 - LOGICAL :: IsActive = .FALSE. - INTEGER :: UNIT = 6 - LOGICAL :: file_open = .FALSE. - INTEGER :: initial_offset = 0 + INTEGER, SAVE :: CurrentLevel = 0 + LOGICAL, SAVE :: IsActive = .FALSE. + INTEGER, SAVE :: UNIT = 6 + LOGICAL, SAVE :: file_open = .FALSE. + INTEGER, SAVE :: initial_offset = 0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PUBLIC :: ActivateLogger PUBLIC :: DeactivateLogger + PUBLIC :: IsLoggerActive !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PUBLIC :: EnterSubLog PUBLIC :: ExitSubLog @@ -21,6 +22,8 @@ MODULE LoggingModule PUBLIC :: WriteListElement !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PUBLIC :: SetInitialOffset + PUBLIC :: SetLoggerLevel + PUBLIC :: GetLoggerLevel !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! INTERFACE WriteListElement MODULE PROCEDURE WriteListElement_bool @@ -75,6 +78,13 @@ SUBROUTINE DeactivateLogger UNIT = 6 CurrentLevel = 0 END SUBROUTINE DeactivateLogger +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Check if the logger is currently active + FUNCTION IsLoggerActive() RESULT(active) + LOGICAL :: active + + active = IsActive + END FUNCTION IsLoggerActive !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Call this subroutine when you enter into a section with verbose output SUBROUTINE EnterSubLog @@ -101,8 +111,8 @@ SUBROUTINE WriteHeader(header_value) IF (IsActive) THEN CALL WriteIndent - WRITE(UNIT,'(A)',ADVANCE='no') header_value - WRITE(UNIT,'(A1)') ":" + WRITE(UNIT, '(A)', ADVANCE='no') header_value + WRITE(UNIT, '(A1)') ":" END IF END SUBROUTINE WriteHeader !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -116,11 +126,11 @@ SUBROUTINE WriteElement_bool(key, VALUE) IF (IsActive) THEN CALL WriteIndent - WRITE(UNIT,'(A)',ADVANCE='no') key + WRITE(UNIT, '(A)', ADVANCE='no') key IF (VALUE) THEN - WRITE(UNIT,'(A)',ADVANCE='no') ": True" + WRITE(UNIT, '(A)', ADVANCE='no') ": True" ELSE - WRITE(UNIT,'(A)',ADVANCE='no') ": False" + WRITE(UNIT, '(A)', ADVANCE='no') ": False" END IF WRITE(UNIT,*) @@ -137,11 +147,11 @@ SUBROUTINE WriteElement_float(key, VALUE) IF (IsActive) THEN CALL WriteIndent - WRITE(UNIT,'(A)',ADVANCE='no') key - WRITE(UNIT,'(A)',ADVANCE='no') ": " - WRITE(UNIT,'(ES22.14)',ADVANCE='no') VALUE + WRITE(UNIT, '(A)', ADVANCE='no') key + WRITE(UNIT, '(A)', ADVANCE='no') ": " + WRITE(UNIT, '(ES22.14)', ADVANCE='no') VALUE - WRITE(UNIT,*) + WRITE(UNIT, *) END IF END SUBROUTINE WriteElement_float !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -155,11 +165,11 @@ SUBROUTINE WriteElement_int(key, VALUE) IF (IsActive) THEN CALL WriteIndent - WRITE(UNIT,'(A)',ADVANCE='no') key - WRITE(UNIT,'(A)',ADVANCE='no') ": " - WRITE(UNIT,'(I20)',ADVANCE='no') VALUE + WRITE(UNIT, '(A)', ADVANCE = 'no') key + WRITE(UNIT, '(A)', ADVANCE = 'no') ": " + WRITE(UNIT, '(I20)', ADVANCE = 'no') VALUE - WRITE(UNIT,*) + WRITE(UNIT, *) END IF END SUBROUTINE WriteElement_int !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -173,9 +183,9 @@ SUBROUTINE WriteElement_string(key, VALUE) IF (IsActive) THEN CALL WriteIndent - WRITE(UNIT,'(A)',ADVANCE='no') key - WRITE(UNIT,'(A)',ADVANCE='no') ": " - WRITE(UNIT,'(A)',ADVANCE='no') VALUE + WRITE(UNIT, '(A)', ADVANCE = 'no') key + WRITE(UNIT, '(A)', ADVANCE = 'no') ": " + WRITE(UNIT, '(A)', ADVANCE = 'no') VALUE WRITE(UNIT,*) END IF @@ -191,15 +201,15 @@ SUBROUTINE WriteListElement_bool(key, VALUE) IF (IsActive) THEN CALL WriteIndent - WRITE(UNIT,'(A)',ADVANCE='no') "- " - WRITE(UNIT,'(A)',ADVANCE='no') key + WRITE(UNIT, '(A)', ADVANCE = 'no') "- " + WRITE(UNIT, '(A)', ADVANCE = 'no') key IF (VALUE) THEN - WRITE(UNIT,'(A)',ADVANCE='no') ": True" + WRITE(UNIT, '(A)', ADVANCE = 'no') ": True" ELSE - WRITE(UNIT,'(A)',ADVANCE='no') ": False" + WRITE(UNIT, '(A)', ADVANCE = 'no') ": False" END IF - WRITE(UNIT,*) + WRITE(UNIT, *) END IF END SUBROUTINE WriteListElement_bool !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -213,10 +223,10 @@ SUBROUTINE WriteListElement_float(key, VALUE) IF (IsActive) THEN CALL WriteIndent - WRITE(UNIT,'(A)',ADVANCE='no') "- " - WRITE(UNIT,'(A)',ADVANCE='no') key - WRITE(UNIT,'(A)',ADVANCE='no') ": " - WRITE(UNIT,'(ES22.14)',ADVANCE='no') VALUE + WRITE(UNIT, '(A)', ADVANCE = 'no') "- " + WRITE(UNIT, '(A)', ADVANCE = 'no') key + WRITE(UNIT, '(A)', ADVANCE = 'no') ": " + WRITE(UNIT, '(ES22.14)', ADVANCE = 'no') VALUE WRITE(UNIT,*) END IF @@ -232,10 +242,10 @@ SUBROUTINE WriteListElement_int(key, VALUE) IF (IsActive) THEN CALL WriteIndent - WRITE(UNIT,'(A)',ADVANCE='no') "- " - WRITE(UNIT,'(A)',ADVANCE='no') key - WRITE(UNIT,'(A)',ADVANCE='no') ": " - WRITE(UNIT,'(I10)',ADVANCE='no') VALUE + WRITE(UNIT, '(A)', ADVANCE = 'no') "- " + WRITE(UNIT, '(A)', ADVANCE = 'no') key + WRITE(UNIT, '(A)', ADVANCE = 'no') ": " + WRITE(UNIT, '(I10)', ADVANCE = 'no') VALUE WRITE(UNIT,*) END IF @@ -251,11 +261,11 @@ SUBROUTINE WriteListElement_string(key, VALUE) IF (IsActive) THEN CALL WriteIndent - WRITE(UNIT,'(A)',ADVANCE='no') "- " - WRITE(UNIT,'(A)',ADVANCE='no') key + WRITE(UNIT, '(A)', ADVANCE = 'no') "- " + WRITE(UNIT, '(A)', ADVANCE = 'no') key IF (PRESENT(VALUE)) THEN - WRITE(UNIT,'(A)',ADVANCE='no') ": " - WRITE(UNIT,'(A)',ADVANCE='no') VALUE + WRITE(UNIT, '(A)', ADVANCE = 'no') ": " + WRITE(UNIT, '(A)', ADVANCE = 'no') VALUE END IF WRITE(UNIT,*) @@ -266,12 +276,26 @@ END SUBROUTINE WriteListElement_string SUBROUTINE WriteIndent INTEGER :: II - DO II=1,initial_offset - WRITE(UNIT,'(A1)',ADVANCE='NO') " " + DO II = 1, initial_offset + WRITE(UNIT, '(A1)', ADVANCE = 'NO') " " END DO - DO II=1,CurrentLevel*2 - WRITE(UNIT,'(A1)',ADVANCE='NO') " " + DO II = 1, CurrentLevel * 2 + WRITE(UNIT, '(A1)', ADVANCE = 'NO') " " END DO END SUBROUTINE WriteIndent +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Set the logging level manually + SUBROUTINE SetLoggerLevel(level) + INTEGER, INTENT(IN) :: level + + CurrentLevel = level + END SUBROUTINE SetLoggerLevel +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Get the current logging level + FUNCTION GetLoggerLevel() RESULT(level) + INTEGER :: level + + level = CurrentLevel + END FUNCTION GetLoggerLevel !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE LoggingModule \ No newline at end of file diff --git a/Source/Fortran/MatrixConversionModule.F90 b/Source/Fortran/MatrixConversionModule.F90 index 9f585be6..0ea14652 100644 --- a/Source/Fortran/MatrixConversionModule.F90 +++ b/Source/Fortran/MatrixConversionModule.F90 @@ -46,7 +46,7 @@ SUBROUTINE SnapMatrixToSparsityPattern(mat, pattern) !! Here we add in the zero values that were missing from the original !! matrix. The secret here is that if you use a negative threshold, we !! never filter a value. - CALL IncrementMatrix(pattern_0s, mat, threshold_in=-1.0_NTREAL) + CALL IncrementMatrix(pattern_0s, mat, threshold_in = -1.0_NTREAL) !! Next, we zero out values outside of the sparsity pattern. CALL CopyMatrix(mat, filtered) diff --git a/Source/Fortran/MatrixMapsModule.F90 b/Source/Fortran/MatrixMapsModule.F90 index 48c4dc7f..e9aa2ffc 100644 --- a/Source/Fortran/MatrixMapsModule.F90 +++ b/Source/Fortran/MatrixMapsModule.F90 @@ -50,7 +50,7 @@ FUNCTION proc(row, column, val) RESULT(valid) !> The column value of an element. INTEGER, INTENT(INOUT), OPTIONAL :: column !> The actual value of an element. - REAL(KIND=NTREAL), INTENT(INOUT), OPTIONAL :: val + REAL(KIND = NTREAL), INTENT(INOUT), OPTIONAL :: val !> Set this to false to filter an element. LOGICAL :: valid END FUNCTION proc @@ -76,7 +76,7 @@ FUNCTION proc(row, column, val) RESULT(valid) !> The column value of an element. INTEGER, INTENT(INOUT), OPTIONAL :: column !> The actual value of an element. - COMPLEX(KIND=NTCOMPLEX), INTENT(INOUT), OPTIONAL :: val + COMPLEX(KIND = NTCOMPLEX), INTENT(INOUT), OPTIONAL :: val !> Set this to false to filter an element. LOGICAL :: valid END FUNCTION proc @@ -103,7 +103,7 @@ FUNCTION proc(row, column, val) RESULT(valid) !> The column value of an element. INTEGER, INTENT(INOUT), OPTIONAL :: column !> The actual value of an element. - REAL(KIND=NTREAL), INTENT(INOUT), OPTIONAL :: val + REAL(KIND = NTREAL), INTENT(INOUT), OPTIONAL :: val !> Set this to false to filter an element. LOGICAL :: valid END FUNCTION proc @@ -134,7 +134,7 @@ FUNCTION proc(row, column, val) RESULT(valid) !> The column value of an element. INTEGER, INTENT(INOUT), OPTIONAL :: column !> The actual value of an element. - COMPLEX(KIND=NTCOMPLEX), INTENT(INOUT), OPTIONAL :: val + COMPLEX(KIND = NTCOMPLEX), INTENT(INOUT), OPTIONAL :: val !> Set this to false to filter an element. LOGICAL :: valid END FUNCTION proc @@ -165,15 +165,15 @@ FUNCTION proc(row, column, val, supp_in) RESULT(valid) !> The column value of an element. INTEGER, INTENT(INOUT), OPTIONAL :: column !> The actual value of an element. - REAL(KIND=NTREAL), INTENT(INOUT), OPTIONAL :: val + REAL(KIND = NTREAL), INTENT(INOUT), OPTIONAL :: val !> Any supplementary data you need to pass the map can packed here. - REAL(KIND=NTREAL), DIMENSION(:), INTENT(IN), OPTIONAL :: supp_in + REAL(KIND = NTREAL), DIMENSION(:), INTENT(IN), OPTIONAL :: supp_in !> Set this to false to filter an element. LOGICAL :: valid END FUNCTION proc END INTERFACE !> Any supplementary data you need to pass the map can packed here. - REAL(KIND=NTREAL), DIMENSION(:), INTENT(IN) :: supp_in + REAL(KIND = NTREAL), DIMENSION(:), INTENT(IN) :: supp_in !! Local Variables TYPE(TripletList_r) :: inlist, outlist @@ -198,15 +198,16 @@ FUNCTION proc(row, column, val, supp_in) RESULT(valid) !> The column value of an element. INTEGER, INTENT(INOUT), OPTIONAL :: column !> The actual value of an element. - COMPLEX(KIND=NTCOMPLEX), INTENT(INOUT), OPTIONAL :: val + COMPLEX(KIND = NTCOMPLEX), INTENT(INOUT), OPTIONAL :: val !> Any supplementary data you need to pass the map can packed here. - COMPLEX(KIND=NTCOMPLEX), DIMENSION(:), INTENT(IN), OPTIONAL :: supp_in + COMPLEX(KIND = NTCOMPLEX), DIMENSION(:), & + & INTENT(IN), OPTIONAL :: supp_in !> Set this to false to filter an element. LOGICAL :: valid END FUNCTION proc END INTERFACE !> Any supplementary data you need to pass the map can packed here. - COMPLEX(KIND=NTCOMPLEX), DIMENSION(:), INTENT(IN) :: supp_in + COMPLEX(KIND = NTCOMPLEX), DIMENSION(:), INTENT(IN) :: supp_in !! Local Variables TYPE(TripletList_c) :: inlist, outlist @@ -231,7 +232,7 @@ FUNCTION proc(row, column, val, supp_in) RESULT(valid) !> The column value of an element. INTEGER, INTENT(INOUT), OPTIONAL :: column !> The actual value of an element. - REAL(KIND=NTREAL), INTENT(INOUT), OPTIONAL :: val + REAL(KIND = NTREAL), INTENT(INOUT), OPTIONAL :: val !> Any supplementary data you need to pass the map can packed here. INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: supp_in !> Set this to false to filter an element. @@ -264,7 +265,7 @@ FUNCTION proc(row, column, val, supp_in) RESULT(valid) !> The column value of an element. INTEGER, INTENT(INOUT), OPTIONAL :: column !> The actual value of an element. - COMPLEX(KIND=NTCOMPLEX), INTENT(INOUT), OPTIONAL :: val + COMPLEX(KIND = NTCOMPLEX), INTENT(INOUT), OPTIONAL :: val !> Any supplementary data you need to pass the map can packed here. INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: supp_in !> Set this to false to filter an element. @@ -298,15 +299,15 @@ FUNCTION proc(row, column, val, supp_in) RESULT(valid) !> The column value of an element. INTEGER, INTENT(INOUT), OPTIONAL :: column !> The actual value of an element. - REAL(KIND=NTREAL), INTENT(INOUT), OPTIONAL :: val + REAL(KIND = NTREAL), INTENT(INOUT), OPTIONAL :: val !> Any supplementary data you need to pass the map can packed here. - REAL(KIND=NTREAL), DIMENSION(:), INTENT(IN), OPTIONAL :: supp_in + REAL(KIND = NTREAL), DIMENSION(:), INTENT(IN), OPTIONAL :: supp_in !> Set this to false to filter an element. LOGICAL :: valid END FUNCTION proc END INTERFACE !> Any supplementary data you need to pass the map can packed here. - REAL(KIND=NTREAL), DIMENSION(:), INTENT(IN) :: supp_in + REAL(KIND = NTREAL), DIMENSION(:), INTENT(IN) :: supp_in !> How many process slices to do this mapping on (default is 1) INTEGER, INTENT(IN), OPTIONAL :: num_slices_in !> What process slice this process should compute (default is 0). @@ -336,15 +337,16 @@ FUNCTION proc(row, column, val, supp_in) RESULT(valid) !> The column value of an element. INTEGER, INTENT(INOUT), OPTIONAL :: column !> The actual value of an element. - COMPLEX(KIND=NTCOMPLEX), INTENT(INOUT), OPTIONAL :: val + COMPLEX(KIND = NTCOMPLEX), INTENT(INOUT), OPTIONAL :: val !> Any supplementary data you need to pass the map can packed here. - COMPLEX(KIND=NTCOMPLEX), DIMENSION(:), INTENT(IN), OPTIONAL :: supp_in + COMPLEX(KIND = NTCOMPLEX), DIMENSION(:), & + & INTENT(IN), OPTIONAL :: supp_in !> Set this to false to filter an element. LOGICAL :: valid END FUNCTION proc END INTERFACE !> Any supplementary data you need to pass the map can packed here. - COMPLEX(KIND=NTCOMPLEX), DIMENSION(:), INTENT(IN) :: supp_in + COMPLEX(KIND = NTCOMPLEX), DIMENSION(:), INTENT(IN) :: supp_in !> How many process slices to do this mapping on (default is 1) INTEGER, INTENT(IN), OPTIONAL :: num_slices_in !> What process slice this process should compute (default is 0). @@ -374,7 +376,7 @@ FUNCTION proc(row, column, val, supp_in) RESULT(valid) !> The column value of an element. INTEGER, INTENT(INOUT), OPTIONAL :: column !> The actual value of an element. - REAL(KIND=NTREAL), INTENT(INOUT), OPTIONAL :: val + REAL(KIND = NTREAL), INTENT(INOUT), OPTIONAL :: val !> Any supplementary data you need to pass the map can packed here. INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: supp_in !> Set this to false to filter an element. @@ -412,7 +414,7 @@ FUNCTION proc(row, column, val, supp_in) RESULT(valid) !> The column value of an element. INTEGER, INTENT(INOUT), OPTIONAL :: column !> The actual value of an element. - COMPLEX(KIND=NTCOMPLEX), INTENT(INOUT), OPTIONAL :: val + COMPLEX(KIND = NTCOMPLEX), INTENT(INOUT), OPTIONAL :: val !> Any supplementary data you need to pass the map can packed here. INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: supp_in !> Set this to false to filter an element. diff --git a/Source/Fortran/MatrixMarketModule.F90 b/Source/Fortran/MatrixMarketModule.F90 index 97aff343..9c4ca578 100644 --- a/Source/Fortran/MatrixMarketModule.F90 +++ b/Source/Fortran/MatrixMarketModule.F90 @@ -6,25 +6,25 @@ MODULE MatrixMarketModule !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ENUM, BIND(c) !> Sparse coordinate file. - ENUMERATOR :: MM_COORDINATE=1 + ENUMERATOR :: MM_COORDINATE = 1 !> Dense array file. - ENUMERATOR :: MM_ARRAY=2 + ENUMERATOR :: MM_ARRAY = 2 !> Real data being read in. - ENUMERATOR :: MM_REAL=1 + ENUMERATOR :: MM_REAL = 1 !> Integer data being read in. - ENUMERATOR :: MM_INTEGER=2 + ENUMERATOR :: MM_INTEGER = 2 !>Complex numbers being read in. - ENUMERATOR :: MM_COMPLEX=3 + ENUMERATOR :: MM_COMPLEX = 3 !> Just a pattern of non zeros. - ENUMERATOR :: MM_PATTERN=4 + ENUMERATOR :: MM_PATTERN = 4 !> File lacks symmetry. - ENUMERATOR :: MM_GENERAL=1 + ENUMERATOR :: MM_GENERAL = 1 !> File is symmetric - ENUMERATOR :: MM_SYMMETRIC=2 + ENUMERATOR :: MM_SYMMETRIC = 2 !> File is skew symmetric. - ENUMERATOR :: MM_SKEW_SYMMETRIC=3 - !> File is hermitian. - ENUMERATOR :: MM_HERMITIAN=4 + ENUMERATOR :: MM_SKEW_SYMMETRIC = 3 + !> File is hermitian. + ENUMERATOR :: MM_HERMITIAN = 4 END ENUM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> The longest line size possible according to the spec. @@ -46,7 +46,7 @@ MODULE MatrixMarketModule FUNCTION ParseMMHeader(line,sparsity_type,data_type,pattern_type) & & RESULT(no_error) !> String to parse. - CHARACTER(len=*), INTENT(IN) :: line + CHARACTER(LEN = *), INTENT(IN) :: line !> If coordinate or array type. INTEGER, INTENT(OUT) :: sparsity_type !> If real, integer, complex, pattern. @@ -65,13 +65,13 @@ FUNCTION ParseMMHeader(line,sparsity_type,data_type,pattern_type) & pos2 = INDEX(line(pos1:), ' ') !! This part is just "matrix". - pos1 = pos2+pos1 + pos1 = pos2 + pos1 pos2 = INDEX(line(pos1:), ' ') !! This part is coordinate or array. - pos1 = pos2+pos1 + pos1 = pos2 + pos1 pos2 = INDEX(line(pos1:), ' ') - SELECT CASE(TRIM(line(pos1:pos1+pos2-1))) + SELECT CASE(TRIM(line(pos1:pos1 + pos2 - 1))) CASE('coordinate') sparsity_type = MM_COORDINATE CASE('array') @@ -81,9 +81,9 @@ FUNCTION ParseMMHeader(line,sparsity_type,data_type,pattern_type) & END SELECT !! This part is real, integer, complex, pattern. - pos1 = pos2+pos1 + pos1 = pos2 + pos1 pos2 = INDEX(line(pos1:), ' ') - SELECT CASE(TRIM(line(pos1:pos1+pos2-1))) + SELECT CASE(TRIM(line(pos1: pos1 + pos2 - 1))) CASE('real') data_type = MM_REAL CASE('array') @@ -116,15 +116,15 @@ END FUNCTION ParseMMHeader !> Write the line describing the size of the matrix PURE SUBROUTINE WriteMMSize(outstring, rows, columns, values_in) !> The final string is written to this variable. - CHARACTER(LEN=MAX_LINE_LENGTH), INTENT(INOUT) :: outstring + CHARACTER(LEN = MAX_LINE_LENGTH), INTENT(INOUT) :: outstring !> The number of rows of the matrix INTEGER, INTENT(IN) :: rows !> The number of columns of the matrix INTEGER, INTENT(IN) :: columns !> The total number of non zero values in the matrix (for sparse format). - INTEGER(KIND=NTLONG), INTENT(IN), OPTIONAL :: values_in + INTEGER(KIND = NTLONG), INTENT(IN), OPTIONAL :: values_in !! Local variables - CHARACTER(LEN=MAX_LINE_LENGTH) :: temp1, temp2, temp3 + CHARACTER(LEN = MAX_LINE_LENGTH) :: temp1, temp2, temp3 !! Write everything to strings. WRITE(temp1, *) rows @@ -144,15 +144,15 @@ END SUBROUTINE WriteMMSize !> Write a single line that would correspond to a matrix market entry. PURE SUBROUTINE WriteMMLine_ii(outstring, row, column, add_newline_in) !> The final string is written to this variable. - CHARACTER(LEN=MAX_LINE_LENGTH), INTENT(INOUT) :: outstring + CHARACTER(LEN = MAX_LINE_LENGTH), INTENT(INOUT) :: outstring !> The first coordinate value INTEGER, INTENT(IN) :: row !> The second coordinate value INTEGER, INTENT(IN) :: column - !> Whether to append a new line to the output (default=F) + !> Whether to append a new line to the output (default = .false.) LOGICAL, INTENT(IN), OPTIONAL :: add_newline_in !! Local variables - CHARACTER(LEN=MAX_LINE_LENGTH) :: temp1, temp2 + CHARACTER(LEN = MAX_LINE_LENGTH) :: temp1, temp2 LOGICAL :: add_newline !! Process Optional Arguments @@ -178,17 +178,17 @@ END SUBROUTINE WriteMMLine_ii !> Write a single line that would correspond to a matrix market entry. PURE SUBROUTINE WriteMMLine_iif(outstring, row, column, val, add_newline_in) !> The final string is written to this variable. - CHARACTER(LEN=MAX_LINE_LENGTH), INTENT(INOUT) :: outstring + CHARACTER(LEN = MAX_LINE_LENGTH), INTENT(INOUT) :: outstring !> The first coordinate value INTEGER, INTENT(IN) :: row !> The second coordinate value INTEGER, INTENT(IN) :: column !> The value at that coordinate REAL(NTREAL), INTENT(IN) :: val - !> Whether to append a new line to the output (default=F) + !> Whether to append a new line to the output (default = .false.) LOGICAL, INTENT(IN), OPTIONAL :: add_newline_in !! Local variables - CHARACTER(LEN=MAX_LINE_LENGTH) :: temp1, temp2, temp3 + CHARACTER(LEN = MAX_LINE_LENGTH) :: temp1, temp2, temp3 LOGICAL :: add_newline !! Process Optional Arguments @@ -217,7 +217,7 @@ END SUBROUTINE WriteMMLine_iif PURE SUBROUTINE WriteMMLine_iiff(outstring, row, column, val1, val2, & & add_newline_in) !> The final string is written to this variable. - CHARACTER(LEN=MAX_LINE_LENGTH), INTENT(INOUT) :: outstring + CHARACTER(LEN = MAX_LINE_LENGTH), INTENT(INOUT) :: outstring !> The first coordinate value INTEGER, INTENT(IN) :: row !> The second coordinate value @@ -226,10 +226,10 @@ PURE SUBROUTINE WriteMMLine_iiff(outstring, row, column, val1, val2, & REAL(NTREAL), INTENT(IN) :: val1 !> The second value at the coordinate REAL(NTREAL), INTENT(IN) :: val2 - !> Whether to append a new line to the output (default=F) + !> Whether to append a new line to the output (default = .false.) LOGICAL, INTENT(IN), OPTIONAL :: add_newline_in !! Local variables - CHARACTER(LEN=MAX_LINE_LENGTH) :: temp1, temp2, temp3, temp4 + CHARACTER(LEN = MAX_LINE_LENGTH) :: temp1, temp2, temp3, temp4 LOGICAL :: add_newline !! Process Optional Arguments @@ -259,13 +259,13 @@ END SUBROUTINE WriteMMLine_iiff !> Write a single line that would correspond to a matrix market entry. PURE SUBROUTINE WriteMMLine_f(outstring, val, add_newline_in) !> The final string is written to this variable. - CHARACTER(LEN=MAX_LINE_LENGTH), INTENT(INOUT) :: outstring + CHARACTER(LEN = MAX_LINE_LENGTH), INTENT(INOUT) :: outstring !> The value at that coordinate REAL(NTREAL), INTENT(IN) :: val - !> Whether to append a new line to the output (default=F) + !> Whether to append a new line to the output (default = .false.) LOGICAL, INTENT(IN), OPTIONAL :: add_newline_in !! Local Variables - CHARACTER(LEN=MAX_LINE_LENGTH) :: temp1 + CHARACTER(LEN = MAX_LINE_LENGTH) :: temp1 LOGICAL :: add_newline !! Process Optional Arguments @@ -289,15 +289,15 @@ END SUBROUTINE WriteMMLine_f !> Write a single line that would correspond to a matrix market entry. PURE SUBROUTINE WriteMMLine_ff(outstring, val1, val2, add_newline_in) !> The final string is written to this variable. - CHARACTER(LEN=MAX_LINE_LENGTH), INTENT(INOUT) :: outstring + CHARACTER(LEN = MAX_LINE_LENGTH), INTENT(INOUT) :: outstring !> The value at that coordinate REAL(NTREAL), INTENT(IN) :: val1 !> The second value at that coordinate REAL(NTREAL), INTENT(IN) :: val2 - !> Whether to append a new line to the output (default=F) + !> Whether to append a new line to the output (default = .false.) LOGICAL, INTENT(IN), OPTIONAL :: add_newline_in !! Local variables - CHARACTER(LEN=MAX_LINE_LENGTH) :: temp1, temp2 + CHARACTER(LEN = MAX_LINE_LENGTH) :: temp1, temp2 LOGICAL :: add_newline !! Process Optional Arguments diff --git a/Source/Fortran/MatrixReduceModule.F90 b/Source/Fortran/MatrixReduceModule.F90 index a4c819a2..78b8ce64 100644 --- a/Source/Fortran/MatrixReduceModule.F90 +++ b/Source/Fortran/MatrixReduceModule.F90 @@ -86,14 +86,14 @@ MODULE MatrixReduceModule END INTERFACE ReduceAndSumMatrix CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> The first routine to call, gathers the sizes of the data to be sent. - SUBROUTINE ReduceAndComposeMatrixSizes_lsr(matrix, communicator, & - & gathered_matrix, helper) + SUBROUTINE ReduceAndComposeMatrixSizes_lsr(matrix, comm, gathered_matrix, & + & helper) !> The matrix to send. TYPE(Matrix_lsr), INTENT(IN) :: matrix + !> The communicator to send along. + INTEGER, INTENT(INOUT) :: comm !> The matrix we are gathering. TYPE(Matrix_lsr), INTENT(INOUT) :: gathered_matrix - !> The communicator to send along. - INTEGER, INTENT(INOUT) :: communicator !> The helper associated with this gather. TYPE(ReduceHelper_t), INTENT(INOUT) :: helper #ifdef NOIALLGATHER @@ -104,14 +104,14 @@ SUBROUTINE ReduceAndComposeMatrixSizes_lsr(matrix, communicator, & END SUBROUTINE ReduceAndComposeMatrixSizes_lsr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> The first routine to call, gathers the sizes of the data to be sent. - SUBROUTINE ReduceAndComposeMatrixSizes_lsc(matrix, communicator, & - & gathered_matrix, helper) + SUBROUTINE ReduceAndComposeMatrixSizes_lsc(matrix, comm, gathered_matrix, & + & helper) !! The matrix to send. TYPE(Matrix_lsc), INTENT(IN) :: matrix + !! The communicator to send along. + INTEGER, INTENT(INOUT) :: comm !> The matrix we are gathering. TYPE(Matrix_lsc), INTENT(INOUT) :: gathered_matrix - !! The communicator to send along. - INTEGER, INTENT(INOUT) :: communicator !! The helper associated with this gather. TYPE(ReduceHelper_t), INTENT(INOUT) :: helper #ifdef NOIALLGATHER @@ -121,74 +121,66 @@ SUBROUTINE ReduceAndComposeMatrixSizes_lsc(matrix, communicator, & #endif END SUBROUTINE ReduceAndComposeMatrixSizes_lsc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !> Second function to call, will gather the data and align it one matrix - SUBROUTINE ReduceAndComposeMatrixData_lsr(matrix, communicator, & - & gathered_matrix, helper) + !> Second function to call, will gather the data and align one matrix + !> next to another. + SUBROUTINE ReduceAndComposeMatrixData_lsr(matrix, comm, gathered_matrix, & + & helper) !> The matrix to send. TYPE(Matrix_lsr), INTENT(IN) :: matrix + !> The communicator to send along. + INTEGER, INTENT(INOUT) :: comm !> The matrix we are gathering. TYPE(Matrix_lsr), INTENT(INOUT) :: gathered_matrix !> The helper associated with this gather. TYPE(ReduceHelper_t), INTENT(INOUT) :: helper - !> The communicator to send along. - INTEGER, INTENT(INOUT) :: communicator #ifdef NOIALLGATHER #include "comm_includes/ReduceAndComposeMatrixData_sendrecv.f90" DO II = 1, helper%comm_size CALL MPI_ISend(matrix%values, SIZE(matrix%values), MPINTREAL, & - & II-1, 4, communicator, helper%data_send_request_list(II), & - & grid_error) - istart = helper%displacement(II)+1 + & II - 1, 4, comm, helper%data_send_request_list(II), ierr) + istart = helper%displacement(II) + 1 isize = helper%values_per_process(II) iend = istart + isize - 1 CALL MPI_Irecv(gathered_matrix%values(istart:iend), isize, MPINTREAL, & - & II-1, 4, communicator, & - & helper%data_recv_request_list(II), grid_error) + & II - 1, 4, comm, helper%data_recv_request_list(II), ierr) END DO #else #include "comm_includes/ReduceAndComposeMatrixData.f90" CALL MPI_IAllGatherv(matrix%values, SIZE(matrix%values), MPINTREAL,& & gathered_matrix%values, helper%values_per_process, & - & helper%displacement, MPINTREAL, communicator, helper%data_request, & - & grid_error) + & helper%displacement, MPINTREAL, comm, helper%data_request, ierr) #endif END SUBROUTINE ReduceAndComposeMatrixData_lsr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !> Second function to call, will gather the data and align it one matrix + !> Second function to call, will gather the data and align one matrix !> next to another. - !> @param[in] matrix to send. - !> @param[inout] communicator to send along. - !> @param[inout] gathered_matrix the matrix we are gathering. - !> @param[inout] helper a helper associated with this gather. - SUBROUTINE ReduceAndComposeMatrixData_lsc(matrix, communicator, & - & gathered_matrix, helper) + SUBROUTINE ReduceAndComposeMatrixData_lsc(matrix, comm, gathered_matrix, & + & helper) !> The matrix to send. TYPE(Matrix_lsc), INTENT(IN) :: matrix + !> The communicator to send along. + INTEGER, INTENT(INOUT) :: comm !> The matrix we are gathering. TYPE(Matrix_lsc), INTENT(INOUT) :: gathered_matrix !> The helper associated with this gather. TYPE(ReduceHelper_t), INTENT(INOUT) :: helper - !> The communicator to send along. - INTEGER, INTENT(INOUT) :: communicator #ifdef NOIALLGATHER #include "comm_includes/ReduceAndComposeMatrixData_sendrecv.f90" DO II = 1, helper%comm_size CALL MPI_ISend(matrix%values, SIZE(matrix%values), MPINTCOMPLEX, & - & II-1, 4, communicator, helper%data_send_request_list(II), & - & grid_error) - istart = helper%displacement(II)+1 + & II - 1, 4, comm, helper%data_send_request_list(II), ierr) + istart = helper%displacement(II) + 1 isize = helper%values_per_process(II) iend = istart + isize - 1 CALL MPI_Irecv(gathered_matrix%values(istart:iend), isize, & - & MPINTCOMPLEX, II-1, 4, communicator, & - & helper%data_recv_request_list(II), grid_error) + & MPINTCOMPLEX, II - 1, 4, comm, & + & helper%data_recv_request_list(II), ierr) END DO #else #include "comm_includes/ReduceAndComposeMatrixData.f90" CALL MPI_IAllGatherv(matrix%values, SIZE(matrix%values), MPINTCOMPLEX,& & gathered_matrix%values, helper%values_per_process, & - & helper%displacement, MPINTCOMPLEX, communicator, & - & helper%data_request, grid_error) + & helper%displacement, MPINTCOMPLEX, comm, helper%data_request, ierr) #endif END SUBROUTINE ReduceAndComposeMatrixData_lsc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -262,13 +254,13 @@ END SUBROUTINE ReduceAndComposeMatrixCleanup_lsc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Reduce and sum the matrices in one step. If you use this method, you !> lose the opportunity for overlapping communication. - SUBROUTINE ReduceAndComposeMatrix_lsr(matrix, gathered_matrix, comm) + SUBROUTINE ReduceAndComposeMatrix_lsr(matrix, comm, gathered_matrix) !> The matrix to send. TYPE(Matrix_lsr), INTENT(IN) :: matrix + !> The communicator to send along. + INTEGER, INTENT(INOUT) :: comm !> The matrix we are gathering. TYPE(Matrix_lsr), INTENT(INOUT) :: gathered_matrix - !> The communicator to send along. - INTEGER, INTENT(INOUT) :: comm !! Local Variables TYPE(ReduceHelper_t) :: helper @@ -278,13 +270,13 @@ END SUBROUTINE ReduceAndComposeMatrix_lsr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Reduce and sum the matrices in one step. If you use this method, you !> lose the opportunity for overlapping communication. - SUBROUTINE ReduceAndComposeMatrix_lsc(matrix, gathered_matrix, comm) + SUBROUTINE ReduceAndComposeMatrix_lsc(matrix, comm, gathered_matrix) !> The matrix to send. TYPE(Matrix_lsc), INTENT(IN) :: matrix + !> The communicator to send along. + INTEGER, INTENT(INOUT) :: comm !> The matrix we are gathering. TYPE(Matrix_lsc), INTENT(INOUT) :: gathered_matrix - !> The communicator to send along. - INTEGER, INTENT(INOUT) :: comm !! Local Variables TYPE(ReduceHelper_t) :: helper @@ -293,14 +285,13 @@ SUBROUTINE ReduceAndComposeMatrix_lsc(matrix, gathered_matrix, comm) END SUBROUTINE ReduceAndComposeMatrix_lsc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> The first routine to call, gathers the sizes of the data to be sent. - SUBROUTINE ReduceAndSumMatrixSizes_lsr(matrix, communicator, & - & gathered_matrix, helper) + SUBROUTINE ReduceAndSumMatrixSizes_lsr(matrix, comm, gathered_matrix, helper) !> The matrix to send. TYPE(Matrix_lsr), INTENT(IN) :: matrix + !> The communicator to send along. + INTEGER, INTENT(INOUT) :: comm !> The matrix we are gathering. TYPE(Matrix_lsr), INTENT(INOUT) :: gathered_matrix - !> The communicator to send along. - INTEGER, INTENT(INOUT) :: communicator !> The helper associated with this gather. TYPE(ReduceHelper_t), INTENT(INOUT) :: helper #ifdef NOIALLGATHER @@ -311,14 +302,13 @@ SUBROUTINE ReduceAndSumMatrixSizes_lsr(matrix, communicator, & END SUBROUTINE ReduceAndSumMatrixSizes_lsr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> The first routine to call, gathers the sizes of the data to be sent. - SUBROUTINE ReduceAndSumMatrixSizes_lsc(matrix, communicator, & - & gathered_matrix, helper) + SUBROUTINE ReduceAndSumMatrixSizes_lsc(matrix, comm, gathered_matrix, helper) !> The matrix to send. TYPE(Matrix_lsc), INTENT(IN) :: matrix + !> The communicator to send along. + INTEGER, INTENT(INOUT) :: comm !> The matrix we are gathering. TYPE(Matrix_lsc), INTENT(INOUT) :: gathered_matrix - !> The communicator to send along. - INTEGER, INTENT(INOUT) :: communicator !> The helper associated with this gather. TYPE(ReduceHelper_t), INTENT(INOUT) :: helper #ifdef NOIALLGATHER @@ -329,68 +319,61 @@ SUBROUTINE ReduceAndSumMatrixSizes_lsc(matrix, communicator, & END SUBROUTINE ReduceAndSumMatrixSizes_lsc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Second routine to call for gathering and summing up the data. - SUBROUTINE ReduceAndSumMatrixData_lsr(matrix, gathered_matrix, communicator, & - & helper) + SUBROUTINE ReduceAndSumMatrixData_lsr(matrix, comm, gathered_matrix, helper) !> The matrix to send. TYPE(Matrix_lsr), INTENT(IN) :: matrix + !> The communicator to send along. + INTEGER, INTENT(INOUT) :: comm !> The matrix we are gathering. TYPE(Matrix_lsr), INTENT(INOUT) :: gathered_matrix - !> The communicator to send along. - INTEGER, INTENT(INOUT) :: communicator !> The helper associated with this gather. TYPE(ReduceHelper_t), INTENT(INOUT) :: helper #ifdef NOIALLGATHER #include "comm_includes/ReduceAndSumMatrixData_sendrecv.f90" DO II = 1, helper%comm_size CALL MPI_ISend(matrix%values, SIZE(matrix%values), MPINTREAL, & - & II-1, 4, communicator, helper%data_send_request_list(II), & - & grid_error) - istart = helper%displacement(II)+1 + & II - 1, 4, comm, helper%data_send_request_list(II), ierr) + istart = helper%displacement(II) + 1 isize = helper%values_per_process(II) iend = istart + isize - 1 CALL MPI_Irecv(gathered_matrix%values(istart:iend), isize, MPINTREAL, & - & II-1, 4, communicator, & - & helper%data_recv_request_list(II), grid_error) + & II - 1, 4, comm, helper%data_recv_request_list(II), ierr) END DO #else #include "comm_includes/ReduceAndSumMatrixData.f90" CALL MPI_IAllGatherv(matrix%values, SIZE(matrix%values), MPINTREAL,& & gathered_matrix%values, helper%values_per_process, & - & helper%displacement, MPINTREAL, communicator, helper%data_request, & - & grid_error) + & helper%displacement, MPINTREAL, comm, helper%data_request, ierr) #endif END SUBROUTINE ReduceAndSumMatrixData_lsr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Second routine to call for gathering and summing up the data. - SUBROUTINE ReduceAndSumMatrixData_lsc(matrix, gathered_matrix, communicator, & - & helper) + SUBROUTINE ReduceAndSumMatrixData_lsc(matrix, comm, gathered_matrix, helper) !> The matrix to send. TYPE(Matrix_lsc), INTENT(IN) :: matrix + !> The communicator to send along. + INTEGER, INTENT(INOUT) :: comm !> The matrix we are gathering. TYPE(Matrix_lsc), INTENT(INOUT) :: gathered_matrix - !> The communicator to send along. - INTEGER, INTENT(INOUT) :: communicator !> The helper associated with this gather. TYPE(ReduceHelper_t), INTENT(INOUT) :: helper #ifdef NOIALLGATHER #include "comm_includes/ReduceAndSumMatrixData_sendrecv.f90" DO II = 1, helper%comm_size CALL MPI_ISend(matrix%values, SIZE(matrix%values), MPINTCOMPLEX, & - & II-1, 4, communicator, helper%data_send_request_list(II), & - & grid_error) - istart = helper%displacement(II)+1 + & II - 1, 4, comm, helper%data_send_request_list(II), ierr) + istart = helper%displacement(II) + 1 isize = helper%values_per_process(II) iend = istart + isize - 1 CALL MPI_Irecv(gathered_matrix%values(istart:iend), isize, & - & MPINTCOMPLEX, II-1, 4, communicator, & - & helper%data_recv_request_list(II), grid_error) + & MPINTCOMPLEX, II - 1, 4, comm, & + & helper%data_recv_request_list(II), ierr) END DO #else #include "comm_includes/ReduceAndSumMatrixData.f90" CALL MPI_IAllGatherv(matrix%values, SIZE(matrix%values), MPINTCOMPLEX,& & gathered_matrix%values, helper%values_per_process, & - & helper%displacement, MPINTCOMPLEX, communicator, & - & helper%data_request, grid_error) + & helper%displacement, MPINTCOMPLEX, comm, helper%data_request, ierr) #endif END SUBROUTINE ReduceAndSumMatrixData_lsc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -406,7 +389,7 @@ PURE SUBROUTINE ReduceAndSumMatrixCleanup_lsr(matrix, gathered_matrix, & !> The helper associated with this gather. TYPE(ReduceHelper_t), INTENT(INOUT) :: helper !! Local Data - TYPE(Matrix_lsr) :: temporary_matrix, sum_matrix + TYPE(Matrix_lsr) :: acc_matrix, sum_matrix #include "comm_includes/ReduceAndSumMatrixCleanup.f90" #ifdef NOIALLGATHER @@ -443,7 +426,7 @@ PURE SUBROUTINE ReduceAndSumMatrixCleanup_lsc(matrix, gathered_matrix, & !> The helper associated with this gather. TYPE(ReduceHelper_t), INTENT(INOUT) :: helper !! Local Data - TYPE(Matrix_lsc) :: temporary_matrix, sum_matrix + TYPE(Matrix_lsc) :: acc_matrix, sum_matrix #include "comm_includes/ReduceAndSumMatrixCleanup.f90" #ifdef NOIALLGATHER @@ -470,15 +453,15 @@ END SUBROUTINE ReduceAndSumMatrixCleanup_lsc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Reduce and sum the matrices in one step. If you use this method, you !> lose the opportunity for overlapping communication. - SUBROUTINE ReduceAndSumMatrix_lsr(matrix, gathered_matrix, threshold, comm) + SUBROUTINE ReduceAndSumMatrix_lsr(matrix, comm, gathered_matrix, threshold) !> The matrix to send. TYPE(Matrix_lsr), INTENT(IN) :: matrix + !> The communicator to send along. + INTEGER, INTENT(INOUT) :: comm !> The gathered_matrix the matrix being gathered. TYPE(Matrix_lsr), INTENT(INOUT) :: gathered_matrix !> The threshold the threshold for flushing values. REAL(NTREAL), INTENT(IN) :: threshold - !> The communicator to send along. - INTEGER, INTENT(INOUT) :: comm !! Local Data TYPE(ReduceHelper_t) :: helper @@ -487,15 +470,15 @@ END SUBROUTINE ReduceAndSumMatrix_lsr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Reduce and sum the matrices in one step. If you use this method, you !> lose the opportunity for overlapping communication. - SUBROUTINE ReduceAndSumMatrix_lsc(matrix, gathered_matrix, threshold, comm) + SUBROUTINE ReduceAndSumMatrix_lsc(matrix, comm, gathered_matrix, threshold) !> The matrix to send. TYPE(Matrix_lsc), INTENT(IN) :: matrix + !> The communicator to send along. + INTEGER, INTENT(INOUT) :: comm !> The threshold the threshold for flushing values. TYPE(Matrix_lsc), INTENT(INOUT) :: gathered_matrix !> The threshold the threshold for flushing values. REAL(NTREAL), INTENT(IN) :: threshold - !> The communicator to send along. - INTEGER, INTENT(INOUT) :: comm !! Local Data TYPE(ReduceHelper_t) :: helper diff --git a/Source/Fortran/PMatrixMemoryPoolModule.F90 b/Source/Fortran/PMatrixMemoryPoolModule.F90 index 7601395b..d2a5c2a0 100644 --- a/Source/Fortran/PMatrixMemoryPoolModule.F90 +++ b/Source/Fortran/PMatrixMemoryPoolModule.F90 @@ -53,7 +53,7 @@ PURE SUBROUTINE DestructMatrixMemoryPool_p(this) !> Distributed Matrix Memory Pool object to destroy. TYPE(MatrixMemoryPool_p), INTENT(INOUT) :: this !! Local Data - INTEGER :: row_counter, column_counter + INTEGER :: II, JJ #define grid grid_r #include "distributed_pool_includes/DestructMatrixMemoryPool.f90" diff --git a/Source/Fortran/PSMatrixAlgebraModule.F90 b/Source/Fortran/PSMatrixAlgebraModule.F90 index dcca6159..c4e18e60 100644 --- a/Source/Fortran/PSMatrixAlgebraModule.F90 +++ b/Source/Fortran/PSMatrixAlgebraModule.F90 @@ -5,7 +5,7 @@ MODULE PSMatrixAlgebraModule USE GemmTasksModule USE MatrixReduceModule, ONLY : ReduceHelper_t, ReduceAndComposeMatrixSizes, & & ReduceAndComposeMatrixData, ReduceAndComposeMatrixCleanup, & - & ReduceANdSumMatrixSizes, ReduceAndSumMatrixData, & + & ReduceAndSumMatrixSizes, ReduceAndSumMatrixData, & & ReduceAndSumMatrixCleanup, TestReduceSizeRequest, & & TestReduceInnerRequest, TestReduceDataRequest USE PMatrixMemoryPoolModule, ONLY : MatrixMemoryPool_p, & @@ -19,7 +19,6 @@ MODULE PSMatrixAlgebraModule & MatrixColumnNorm USE SMatrixModule, ONLY : Matrix_lsr, Matrix_lsc, DestructMatrix, CopyMatrix,& & TransposeMatrix, ComposeMatrixColumns, MatrixToTripletList - USE TimerModule, ONLY : StartTimer, StopTimer USE TripletListModule, ONLY : TripletList_r, TripletList_c USE NTMPIModule IMPLICIT NONE @@ -77,7 +76,7 @@ SUBROUTINE MatrixSigma_ps(this, sigma_value) !! Local Data REAL(NTREAL), DIMENSION(:), ALLOCATABLE :: column_sigma_contribution !! Counters/Temporary - INTEGER :: inner_counter, outer_counter + INTEGER :: II, JJ TYPE(Matrix_lsr) :: merged_local_data_r TYPE(Matrix_lsc) :: merged_local_data_c INTEGER :: ierr @@ -157,32 +156,39 @@ SUBROUTINE MatrixMultiply_ps(matA, matB ,matC, alpha_in, beta_in, & END IF END IF - !! Perform Upcasting IF (matB%is_complex .AND. .NOT. matA%is_complex) THEN CALL ConvertMatrixToComplex(matA, matAConverted) IF (PRESENT(memory_pool_in)) THEN - CALL MatrixMultiply_ps_imp(matAConverted, matB, matC, alpha, beta, & + CALL MatrixMultiply_psc(matAConverted, matB, matC, alpha, beta, & & threshold, memory_pool_in) ELSE - CALL MatrixMultiply_ps_imp(matAConverted, matB, matC, alpha, beta, & + CALL MatrixMultiply_psc(matAConverted, matB, matC, alpha, beta, & & threshold, memory_pool) END IF ELSE IF (matA%is_complex .AND. .NOT. matB%is_complex) THEN CALL ConvertMatrixToComplex(matB, matBConverted) IF (PRESENT(memory_pool_in)) THEN - CALL MatrixMultiply_ps_imp(matA, matBConverted, matC, alpha, beta, & + CALL MatrixMultiply_psc(matA, matBConverted, matC, alpha, beta, & + & threshold, memory_pool_in) + ELSE + CALL MatrixMultiply_psc(matA, matBConverted, matC, alpha, beta, & + & threshold, memory_pool) + END IF + ELSE IF (matA%is_complex .AND. matB%is_complex) THEN + IF (PRESENT(memory_pool_in)) THEN + CALL MatrixMultiply_psc(matA, matB, matC, alpha, beta, & & threshold, memory_pool_in) ELSE - CALL MatrixMultiply_ps_imp(matA, matBConverted, matC, alpha, beta, & + CALL MatrixMultiply_psc(matA, matB, matC, alpha, beta, & & threshold, memory_pool) END IF ELSE IF (PRESENT(memory_pool_in)) THEN - CALL MatrixMultiply_ps_imp(matA, matB, matC, alpha, beta, & + CALL MatrixMultiply_psr(matA, matB, matC, alpha, beta, & & threshold, memory_pool_in) ELSE - CALL MatrixMultiply_ps_imp(matA, matB, matC, alpha, beta, & + CALL MatrixMultiply_psr(matA, matB, matC, alpha, beta, & & threshold, memory_pool) END IF END IF @@ -195,7 +201,7 @@ END SUBROUTINE MatrixMultiply_ps !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> The actual implementation of matrix multiply is here. Takes the !> same parameters as the standard multiply, but nothing is optional. - SUBROUTINE MatrixMultiply_ps_imp(matA, matB ,matC, alpha, beta, & + SUBROUTINE MatrixMultiply_psr(matA, matB, matC, alpha, beta, & & threshold, memory_pool) !! Parameters TYPE(Matrix_ps), INTENT(IN) :: matA @@ -205,90 +211,51 @@ SUBROUTINE MatrixMultiply_ps_imp(matA, matB ,matC, alpha, beta, & REAL(NTREAL), INTENT(IN) :: beta REAL(NTREAL), INTENT(IN) :: threshold TYPE(MatrixMemoryPool_p), INTENT(INOUT) :: memory_pool - TYPE(Matrix_ps) :: matAB !! Temporary Matrices - TYPE(Matrix_lsr), DIMENSION(:,:), ALLOCATABLE :: AdjacentABlocks_r - TYPE(Matrix_lsr), DIMENSION(:), ALLOCATABLE :: LocalRowContribution_r - TYPE(Matrix_lsr), DIMENSION(:), ALLOCATABLE :: GatheredRowContribution_r - TYPE(Matrix_lsr), DIMENSION(:), ALLOCATABLE :: GatheredRowContributionT_r - TYPE(Matrix_lsr), DIMENSION(:,:), ALLOCATABLE :: TransposedBBlocks_r - TYPE(Matrix_lsr), DIMENSION(:), ALLOCATABLE :: LocalColumnContribution_r - TYPE(Matrix_lsr), DIMENSION(:), ALLOCATABLE :: GatheredColumnContribution_r - TYPE(Matrix_lsr), DIMENSION(:,:), ALLOCATABLE :: SliceContribution_r - TYPE(Matrix_lsc), DIMENSION(:,:), ALLOCATABLE :: AdjacentABlocks_c - TYPE(Matrix_lsc), DIMENSION(:), ALLOCATABLE :: LocalRowContribution_c - TYPE(Matrix_lsc), DIMENSION(:), ALLOCATABLE :: GatheredRowContribution_c - TYPE(Matrix_lsc), DIMENSION(:), ALLOCATABLE :: GatheredRowContributionT_c - TYPE(Matrix_lsc), DIMENSION(:,:), ALLOCATABLE :: TransposedBBlocks_c - TYPE(Matrix_lsc), DIMENSION(:), ALLOCATABLE :: LocalColumnContribution_c - TYPE(Matrix_lsc), DIMENSION(:), ALLOCATABLE :: GatheredColumnContribution_c - TYPE(Matrix_lsc), DIMENSION(:,:), ALLOCATABLE :: SliceContribution_c - !! Communication Helpers - TYPE(ReduceHelper_t), DIMENSION(:), ALLOCATABLE :: row_helper - TYPE(ReduceHelper_t), DIMENSION(:), ALLOCATABLE :: column_helper - TYPE(ReduceHelper_t), DIMENSION(:,:), ALLOCATABLE :: slice_helper - !! For Iterating Over Local Blocks - INTEGER :: II, II2 - INTEGER :: JJ, JJ2 - INTEGER :: duplicate_start_column, duplicate_offset_column - INTEGER :: duplicate_start_row, duplicate_offset_row - REAL(NTREAL) :: working_threshold - !! Scheduling the A work - INTEGER, DIMENSION(:), ALLOCATABLE :: ATasks - INTEGER :: ATasks_completed - !! Scheduling the B work - INTEGER, DIMENSION(:), ALLOCATABLE :: BTasks - INTEGER :: BTasks_completed - !! Scheduling the AB work - INTEGER, DIMENSION(:,:), ALLOCATABLE :: ABTasks - INTEGER :: ABTasks_completed + TYPE(Matrix_lsr), DIMENSION(:,:), ALLOCATABLE :: AdjacentABlocks + TYPE(Matrix_lsr), DIMENSION(:), ALLOCATABLE :: LocalRowContribution + TYPE(Matrix_lsr), DIMENSION(:), ALLOCATABLE :: GatheredRowContribution + TYPE(Matrix_lsr), DIMENSION(:), ALLOCATABLE :: GatheredRowContributionT + TYPE(Matrix_lsr), DIMENSION(:,:), ALLOCATABLE :: TransposedBBlocks + TYPE(Matrix_lsr), DIMENSION(:), ALLOCATABLE :: LocalColumnContribution + TYPE(Matrix_lsr), DIMENSION(:), ALLOCATABLE :: GatheredColumnContribution + TYPE(Matrix_lsr), DIMENSION(:,:), ALLOCATABLE :: SliceContribution - IF (matA%is_complex) THEN -#define AdjacentABlocks AdjacentABlocks_c -#define LocalRowContribution LocalRowContribution_c -#define GatheredRowContribution GatheredRowContribution_c -#define GatheredRowContributionT GatheredRowContributionT_c -#define TransposedBBlocks TransposedBBlocks_c -#define LocalColumnContribution LocalColumnContribution_c -#define GatheredColumnContribution GatheredColumnContribution_c -#define SliceContribution SliceContribution_c -#define LMAT local_data_c -#define MPGRID memory_pool%grid_c +#define LMAT local_data_r +#define MPGRID memory_pool%grid_r #include "distributed_algebra_includes/MatrixMultiply.f90" -#undef AdjacentABlocks -#undef LocalRowContribution -#undef GatheredRowContribution -#undef GatheredRowContributionT -#undef TransposedBBlocks -#undef LocalColumnContribution -#undef GatheredColumnContribution -#undef SliceContribution #undef LMAT #undef MPGRID - ELSE -#define AdjacentABlocks AdjacentABlocks_r -#define LocalRowContribution LocalRowContribution_r -#define GatheredRowContribution GatheredRowContribution_r -#define GatheredRowContributionT GatheredRowContributionT_r -#define TransposedBBlocks TransposedBBlocks_r -#define LocalColumnContribution LocalColumnContribution_r -#define GatheredColumnContribution GatheredColumnContribution_r -#define SliceContribution SliceContribution_r -#define LMAT local_data_r -#define MPGRID memory_pool%grid_r + END SUBROUTINE MatrixMultiply_psr +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> The actual implementation of matrix multiply is here. Takes the + !> same parameters as the standard multiply, but nothing is optional. + SUBROUTINE MatrixMultiply_psc(matA, matB, matC, alpha, beta, & + & threshold, memory_pool) + !! Parameters + TYPE(Matrix_ps), INTENT(IN) :: matA + TYPE(Matrix_ps), INTENT(IN) :: matB + TYPE(Matrix_ps), INTENT(INOUT) :: matC + REAL(NTREAL), INTENT(IN) :: alpha + REAL(NTREAL), INTENT(IN) :: beta + REAL(NTREAL), INTENT(IN) :: threshold + TYPE(MatrixMemoryPool_p), INTENT(INOUT) :: memory_pool + !! Temporary Matrices + TYPE(Matrix_lsc), DIMENSION(:,:), ALLOCATABLE :: AdjacentABlocks + TYPE(Matrix_lsc), DIMENSION(:), ALLOCATABLE :: LocalRowContribution + TYPE(Matrix_lsc), DIMENSION(:), ALLOCATABLE :: GatheredRowContribution + TYPE(Matrix_lsc), DIMENSION(:), ALLOCATABLE :: GatheredRowContributionT + TYPE(Matrix_lsc), DIMENSION(:,:), ALLOCATABLE :: TransposedBBlocks + TYPE(Matrix_lsc), DIMENSION(:), ALLOCATABLE :: LocalColumnContribution + TYPE(Matrix_lsc), DIMENSION(:), ALLOCATABLE :: GatheredColumnContribution + TYPE(Matrix_lsc), DIMENSION(:,:), ALLOCATABLE :: SliceContribution + +#define LMAT local_data_c +#define MPGRID memory_pool%grid_c #include "distributed_algebra_includes/MatrixMultiply.f90" -#undef AdjacentABlocks -#undef LocalRowContribution -#undef GatheredRowContribution -#undef GatheredRowContributionT -#undef TransposedBBlocks -#undef LocalColumnContribution -#undef GatheredColumnContribution -#undef SliceContribution #undef LMAT #undef MPGRID - END IF - END SUBROUTINE MatrixMultiply_ps_imp + END SUBROUTINE MatrixMultiply_psc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Sum up the elements in a matrix into a single value. SUBROUTINE MatrixGrandSum_psr(this, sum) @@ -438,9 +405,9 @@ RECURSIVE SUBROUTINE IncrementMatrix_ps(matA, matB, alpha_in, threshold_in) TYPE(Matrix_ps), INTENT(IN) :: matA !> Matrix B. TYPE(Matrix_ps), INTENT(INOUT) :: matB - !> Multiplier (default= 1.0). + !> Multiplier (default = 1.0). REAL(NTREAL), OPTIONAL, INTENT(IN) :: alpha_in - !> For flushing values to zero (default=0). + !> For flushing values to zero (default = 0). REAL(NTREAL), OPTIONAL, INTENT(IN) :: threshold_in !! Local Data TYPE(Matrix_ps) :: converted_matrix @@ -535,7 +502,7 @@ SUBROUTINE MatrixTrace_psr(this, trace_value) TYPE(TripletList_r) :: triplet_list_r TYPE(TripletList_c) :: triplet_list_c !! Counters/Temporary - INTEGER :: counter + INTEGER :: II TYPE(Matrix_lsr) :: merged_local_data_r TYPE(Matrix_lsc) :: merged_local_data_c INTEGER :: ierr @@ -597,14 +564,14 @@ SUBROUTINE SimilarityTransform(A, P, PInv, ResMat, pool_in, threshold_in) !! Compute IF (PRESENT(pool_in)) THEN CALL MatrixMultiply(P, A, TempMat, & - & threshold_in=threshold, memory_pool_in=pool_in) + & threshold_in = threshold, memory_pool_in = pool_in) CALL MatrixMultiply(TempMat, PInv, ResMat, & - & threshold_in=threshold, memory_pool_in=pool_in) + & threshold_in = threshold, memory_pool_in = pool_in) ELSE CALL MatrixMultiply(P, A, TempMat, & - & threshold_in=threshold, memory_pool_in=pool) + & threshold_in = threshold, memory_pool_in = pool) CALL MatrixMultiply(TempMat, PInv, ResMat, & - & threshold_in=threshold, memory_pool_in=pool) + & threshold_in = threshold, memory_pool_in = pool) END IF END IF diff --git a/Source/Fortran/PSMatrixModule.F90 b/Source/Fortran/PSMatrixModule.F90 index ea3f37ce..ca35d566 100644 --- a/Source/Fortran/PSMatrixModule.F90 +++ b/Source/Fortran/PSMatrixModule.F90 @@ -18,11 +18,10 @@ MODULE PSMatrixModule & PrintMatrix, TransposeMatrix, ConjugateMatrix, SplitMatrix, & & ComposeMatrix, ConvertMatrixType, MatrixToTripletList, & & ConstructMatrixFromTripletList, ConstructEmptyMatrix - USE TimerModule, ONLY : StartTimer, StopTimer USE TripletModule, ONLY : Triplet_r, Triplet_c, GetMPITripletType_r, & & GetMPITripletType_c USE TripletListModule, ONLY : TripletList_r, TripletList_c, & - & ConstructTripletList, & + & ConstructTripletList, CopyTripletList, & & DestructTripletList, SortTripletList, AppendToTripletList, & & SymmetrizeTripletList, GetTripletAt, RedistributeTripletLists, & & ShiftTripletList @@ -123,7 +122,7 @@ MODULE PSMatrixModule MODULE PROCEDURE FillMatrixPermutation_ps END INTERFACE FillMatrixPermutation INTERFACE FillMatrixDense - MODULE PROCEDURE FillMatrixDense_psc + MODULE PROCEDURE FillMatrixDense_ps END INTERFACE FillMatrixDense INTERFACE GetMatrixActualDimension MODULE PROCEDURE GetMatrixActualDimension_ps @@ -183,12 +182,12 @@ MODULE PSMatrixModule END INTERFACE GatherMatrixToProcess CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Construct an empty sparse, distributed, matrix. - SUBROUTINE ConstructEmptyMatrix_ps(this, matrix_dim_, process_grid_in, & + SUBROUTINE ConstructEmptyMatrix_ps(this, matrix_dim, process_grid_in, & & is_complex_in) !> The matrix to be constructed. TYPE(Matrix_ps), INTENT(INOUT) :: this !> The dimension of the full matrix. - INTEGER, INTENT(IN) :: matrix_dim_ + INTEGER, INTENT(IN) :: matrix_dim !> True if you want to use complex numbers. LOGICAL, INTENT(IN), OPTIONAL :: is_complex_in !> A process grid to host the matrix. @@ -214,8 +213,8 @@ SUBROUTINE ConstructEmptyMatrix_ps(this, matrix_dim_, process_grid_in, & END IF !! Matrix Dimensions - this%actual_matrix_dimension = matrix_dim_ - this%logical_matrix_dimension = CalculateScaledDimension(this, matrix_dim_) + this%actual_matrix_dimension = matrix_dim + this%logical_matrix_dimension = CalculateScaledDimension(this, matrix_dim) !! Full Local Data Size Description this%local_rows = & @@ -269,18 +268,18 @@ PURE SUBROUTINE DestructMatrix_ps(this) INTEGER :: II, JJ IF (ALLOCATED(this%local_data_r)) THEN - DO II = 1, SIZE(this%local_data_r,DIM=1) - DO JJ = 1, SIZE(this%local_data_r,DIM=2) - CALL DestructMatrix(this%local_data_r(II,JJ)) + DO II = 1, SIZE(this%local_data_r, DIM = 1) + DO JJ = 1, SIZE(this%local_data_r, DIM = 2) + CALL DestructMatrix(this%local_data_r(II, JJ)) END DO END DO DEALLOCATE(this%local_data_r) END IF IF (ALLOCATED(this%local_data_c)) THEN - DO II = 1, SIZE(this%local_data_c,DIM=1) - DO JJ = 1, SIZE(this%local_data_c,DIM=2) - CALL DestructMatrix(this%local_data_c(II,JJ)) + DO II = 1, SIZE(this%local_data_c, DIM = 1) + DO JJ = 1, SIZE(this%local_data_c, DIM = 2) + CALL DestructMatrix(this%local_data_c(II, JJ)) END DO END DO DEALLOCATE(this%local_data_c) @@ -308,19 +307,19 @@ SUBROUTINE SetMatrixProcessGrid(this, grid) !> The grid to set it to. TYPE(ProcessGrid_t), INTENT(IN) :: grid !! Local variables - TYPE(TripletList_r) :: triplet_list_r - TYPE(TripletList_c) :: triplet_list_c + TYPE(TripletList_r) :: tlist_r + TYPE(TripletList_c) :: tlist_c TYPE(Matrix_ps) :: new_mat !! Get the data in a triplet list - CALL ConstructTripletList(triplet_list_c) - CALL ConstructTripletList(triplet_list_r) + CALL ConstructTripletList(tlist_c) + CALL ConstructTripletList(tlist_r) IF (this%process_grid%my_slice .EQ. 0) THEN IF (this%is_complex) THEN - CALL GetMatrixTripletList(this, triplet_list_c) + CALL GetMatrixTripletList(this, tlist_c) ELSE - CALL GetMatrixTripletList(this, triplet_list_r) + CALL GetMatrixTripletList(this, tlist_r) END IF END IF @@ -328,9 +327,9 @@ SUBROUTINE SetMatrixProcessGrid(this, grid) CALL ConstructEmptyMatrix(new_mat, this%actual_matrix_dimension, grid, & & this%is_complex) IF (this%is_complex) THEN - CALL FillMatrixFromTripletList(new_mat, triplet_list_c) + CALL FillMatrixFromTripletList(new_mat, tlist_c) ELSE - CALL FillMatrixFromTripletList(new_mat, triplet_list_r) + CALL FillMatrixFromTripletList(new_mat, tlist_r) END IF !! Copy back to finish @@ -338,8 +337,8 @@ SUBROUTINE SetMatrixProcessGrid(this, grid) !! Cleanup CALL DestructMatrix(new_mat) - CALL DestructTripletList(triplet_list_c) - CALL DestructTripletList(triplet_list_r) + CALL DestructTripletList(tlist_c) + CALL DestructTripletList(tlist_r) END SUBROUTINE SetMatrixProcessGrid !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Construct distributed sparse matrix from a matrix market file in parallel. @@ -351,7 +350,7 @@ RECURSIVE SUBROUTINE ConstructMatrixFromMatrixMarket_ps(this, file_name, & !> Grid to distribute the matrix on. TYPE(ProcessGrid_t), INTENT(IN), OPTIONAL :: process_grid_in !> The name of the file to read. - CHARACTER(len=*), INTENT(IN) :: file_name + CHARACTER(LEN = *), INTENT(IN) :: file_name INTEGER, PARAMETER :: MAX_LINE_LENGTH = 100 !! File Handles INTEGER :: local_file_handler @@ -359,23 +358,23 @@ RECURSIVE SUBROUTINE ConstructMatrixFromMatrixMarket_ps(this, file_name, & !! About the matrix market file. INTEGER :: sparsity_type, data_type, pattern_type !! Reading The File - TYPE(TripletList_r) :: triplet_list_r + TYPE(TripletList_r) :: tlist_r TYPE(Triplet_r) :: temp_triplet_r - TYPE(TripletList_c) :: triplet_list_c + TYPE(TripletList_c) :: tlist_c TYPE(Triplet_c) :: temp_triplet_c INTEGER :: matrix_rows, matrix_columns INTEGER(NTLONG) :: total_values !! Length Variables INTEGER :: header_length - INTEGER(KIND=MPI_OFFSET_KIND) :: total_file_size - INTEGER(KIND=MPI_OFFSET_KIND) :: local_offset - INTEGER(KIND=MPI_OFFSET_KIND) :: local_data_size - INTEGER(KIND=MPI_OFFSET_KIND) :: local_data_size_plus_buffer + INTEGER(KIND = MPI_OFFSET_KIND) :: total_file_size + INTEGER(KIND = MPI_OFFSET_KIND) :: local_offset + INTEGER(KIND = MPI_OFFSET_KIND) :: local_data_size + INTEGER(KIND = MPI_OFFSET_KIND) :: local_data_size_plus_buffer INTEGER :: current_line_length !! Input Buffers - CHARACTER(len=MAX_LINE_LENGTH) :: input_buffer - CHARACTER(len=:), ALLOCATABLE :: mpi_input_buffer - CHARACTER(len=MAX_LINE_LENGTH) :: temp_substring + CHARACTER(LEN = MAX_LINE_LENGTH) :: input_buffer + CHARACTER(LEN = :), ALLOCATABLE :: mpi_input_buffer + CHARACTER(LEN = MAX_LINE_LENGTH) :: temp_substring !! Temporary Variables REAL(NTREAL) :: realval, cval INTEGER :: bytes_per_character @@ -392,14 +391,14 @@ RECURSIVE SUBROUTINE ConstructMatrixFromMatrixMarket_ps(this, file_name, & ELSE CALL ConstructError(err) !! Setup Involves Just The Root Opening And Reading Parameter Data - CALL StartTimer("MPI Read Text") CALL MPI_Type_size(MPI_CHARACTER, bytes_per_character, ierr) IF (IsRoot(process_grid_in)) THEN header_length = 0 local_file_handler = 16 - OPEN(local_file_handler, file=file_name, iostat=ierr, status="old") + OPEN(local_file_handler, file = file_name, iostat = ierr, & + & status = "old") IF (ierr .NE. 0) THEN - CALL SetGenericError(err, TRIM(file_name)//" doesn't exist", & + CALL SetGenericError(err, TRIM(file_name) // " doesn't exist", & & .TRUE.) END IF !! Parse the header. @@ -447,11 +446,12 @@ RECURSIVE SUBROUTINE ConstructMatrixFromMatrixMarket_ps(this, file_name, & !! Global read CALL MPI_File_open(this%process_grid%global_comm, file_name, & - & MPI_MODE_RDONLY, MPI_INFO_NULL, mpi_file_handler,ierr) - CALL MPI_File_get_size(mpi_file_handler, total_file_size,ierr) + & MPI_MODE_RDONLY, MPI_INFO_NULL, mpi_file_handler, ierr) + CALL MPI_File_get_size(mpi_file_handler, total_file_size, ierr) !! Compute Offsets And Data Size - local_data_size = (total_file_size - bytes_per_character*header_length)/& + local_data_size = & + & (total_file_size - bytes_per_character*header_length) / & & this%process_grid%total_processors IF (local_data_size .LT. 2*MAX_LINE_LENGTH) THEN local_data_size = 2*MAX_LINE_LENGTH @@ -479,7 +479,8 @@ RECURSIVE SUBROUTINE ConstructMatrixFromMatrixMarket_ps(this, file_name, & END IF !! A buffer to read the data into. - ALLOCATE(CHARACTER(LEN=local_data_size_plus_buffer) :: mpi_input_buffer) + ALLOCATE(CHARACTER(LEN = local_data_size_plus_buffer) :: & + & mpi_input_buffer) !! Do Actual Reading CALL MPI_File_read_at_all(mpi_file_handler, local_offset, & @@ -489,7 +490,7 @@ RECURSIVE SUBROUTINE ConstructMatrixFromMatrixMarket_ps(this, file_name, & !! Trim Off The Half Read Line At The Start IF (.NOT. this%process_grid%global_rank .EQ. & & this%process_grid%RootID) THEN - full_buffer_counter = INDEX(mpi_input_buffer,new_LINE('A')) + 1 + full_buffer_counter = INDEX(mpi_input_buffer, new_LINE('A')) + 1 ELSE full_buffer_counter = 1 END IF @@ -501,9 +502,9 @@ RECURSIVE SUBROUTINE ConstructMatrixFromMatrixMarket_ps(this, file_name, & END IF IF (this%is_complex) THEN - CALL ConstructTripletList(triplet_list_c) + CALL ConstructTripletList(tlist_c) ELSE - CALL ConstructTripletList(triplet_list_r) + CALL ConstructTripletList(tlist_r) END IF DO WHILE(.NOT. end_of_buffer) current_line_length = INDEX(mpi_input_buffer(full_buffer_counter:),& @@ -513,29 +514,29 @@ RECURSIVE SUBROUTINE ConstructMatrixFromMatrixMarket_ps(this, file_name, & end_of_buffer = .TRUE. ELSE temp_substring = mpi_input_buffer(full_buffer_counter: & - & full_buffer_counter+current_line_length-1) + & full_buffer_counter + current_line_length - 1) IF (current_line_length .GT. 1) THEN IF (data_type .EQ. MM_COMPLEX) THEN - READ(temp_substring(:current_line_length-1),*) & + READ(temp_substring(:current_line_length - 1),*) & & temp_triplet_c%index_row, & & temp_triplet_c%index_column, & & realval, cval temp_triplet_c%point_value = & - & CMPLX(realval, cval, KIND=NTCOMPLEX) - CALL AppendToTripletList(triplet_list_c, temp_triplet_c) + & CMPLX(realval, cval, KIND = NTCOMPLEX) + CALL AppendToTripletList(tlist_c, temp_triplet_c) ELSE - READ(temp_substring(:current_line_length-1),*) & + READ(temp_substring(:current_line_length - 1),*) & & temp_triplet_r%index_row, & & temp_triplet_r%index_column, & & temp_triplet_r%point_value - CALL AppendToTripletList(triplet_list_r, temp_triplet_r) + CALL AppendToTripletList(tlist_r, temp_triplet_r) END IF END IF IF (full_buffer_counter + current_line_length .GE. & - & local_data_size+2) THEN + & local_data_size + 2) THEN IF (.NOT. this%process_grid%global_rank .EQ. & - & this%process_grid%total_processors-1) THEN + & this%process_grid%total_processors - 1) THEN end_of_buffer = .TRUE. END IF END IF @@ -544,19 +545,18 @@ RECURSIVE SUBROUTINE ConstructMatrixFromMatrixMarket_ps(this, file_name, & END DO !! Cleanup - CALL MPI_File_close(mpi_file_handler,ierr) - CALL StopTimer("MPI Read Text") - CALL MPI_Barrier(this%process_grid%global_comm,ierr) + CALL MPI_File_close(mpi_file_handler, ierr) + CALL MPI_Barrier(this%process_grid%global_comm, ierr) !! Redistribute The Matrix IF (this%is_complex) THEN - CALL SymmetrizeTripletList(triplet_list_c, pattern_type) - CALL FillMatrixFromTripletList(this,triplet_list_c) - CALL DestructTripletList(triplet_list_c) + CALL SymmetrizeTripletList(tlist_c, pattern_type) + CALL FillMatrixFromTripletList(this, tlist_c) + CALL DestructTripletList(tlist_c) ELSE - CALL SymmetrizeTripletList(triplet_list_r, pattern_type) - CALL FillMatrixFromTripletList(this,triplet_list_r) - CALL DestructTripletList(triplet_list_r) + CALL SymmetrizeTripletList(tlist_r, pattern_type) + CALL FillMatrixFromTripletList(this, tlist_r) + CALL DestructTripletList(tlist_r) END IF DEALLOCATE(mpi_input_buffer) @@ -576,8 +576,8 @@ RECURSIVE SUBROUTINE ConstructMatrixFromBinary_ps(this, file_name, & CHARACTER(len=*), INTENT(IN) :: file_name !! Local Data INTEGER :: triplet_mpi_type - TYPE(TripletList_r) :: triplet_list_r - TYPE(TripletList_c) :: triplet_list_c + TYPE(TripletList_r) :: tlist_r + TYPE(TripletList_c) :: tlist_c !! File Handles INTEGER :: mpi_file_handler !! Reading The File @@ -585,8 +585,8 @@ RECURSIVE SUBROUTINE ConstructMatrixFromBinary_ps(this, file_name, & INTEGER(NTLONG) :: total_values INTEGER, DIMENSION(3) :: matrix_information INTEGER :: local_triplets - INTEGER(KIND=MPI_OFFSET_KIND) :: local_offset - INTEGER(KIND=MPI_OFFSET_KIND) :: header_size + INTEGER(KIND = MPI_OFFSET_KIND) :: local_offset + INTEGER(KIND = MPI_OFFSET_KIND) :: header_size INTEGER :: bytes_per_int, bytes_per_data, bytes_per_long !! Temporary variables INTEGER :: message_status(MPI_STATUS_SIZE) @@ -598,7 +598,6 @@ RECURSIVE SUBROUTINE ConstructMatrixFromBinary_ps(this, file_name, & CALL ConstructMatrixFromBinary(this, file_name, global_grid) ELSE CALL ConstructError(err) - CALL StartTimer("MPI Read Binary") CALL MPI_File_open(process_grid_in%global_comm, file_name, & & MPI_MODE_RDONLY, MPI_INFO_NULL, mpi_file_handler, ierr) error_occured = CheckMPIError(err, TRIM(file_name)//" doesn't exist", & @@ -635,10 +634,10 @@ RECURSIVE SUBROUTINE ConstructMatrixFromBinary_ps(this, file_name, & !! Build Local Storage IF (complex_flag .EQ. 1) THEN CALL ConstructEmptyMatrix(this, matrix_rows, process_grid_in, & - & is_complex_in=.TRUE.) + & is_complex_in = .TRUE.) ELSE CALL ConstructEmptyMatrix(this, matrix_rows, process_grid_in, & - & is_complex_in=.FALSE.) + & is_complex_in = .FALSE.) END IF !! Sizes specific to the type @@ -651,8 +650,8 @@ RECURSIVE SUBROUTINE ConstructMatrixFromBinary_ps(this, file_name, & END IF !! Compute Offset - local_triplets = total_values/this%process_grid%total_processors - local_offset = local_triplets * (this%process_grid%global_rank) + local_triplets = total_values / this%process_grid%total_processors + local_offset = local_triplets * this%process_grid%global_rank header_size = 3 * bytes_per_int + bytes_per_long IF (this%process_grid%global_rank .EQ. & & this%process_grid%total_processors - 1) THEN @@ -666,23 +665,22 @@ RECURSIVE SUBROUTINE ConstructMatrixFromBinary_ps(this, file_name, & & triplet_mpi_type, triplet_mpi_type, "native", MPI_INFO_NULL, & & ierr) IF (this%is_complex) THEN - CALL ConstructTripletList(triplet_list_c, local_triplets) - CALL MPI_File_read_all(mpi_file_handler, triplet_list_c%DATA, & + CALL ConstructTripletList(tlist_c, local_triplets) + CALL MPI_File_read_all(mpi_file_handler, tlist_c%DATA, & & local_triplets, triplet_mpi_type, message_status, ierr) ELSE - CALL ConstructTripletList(triplet_list_r, local_triplets) - CALL MPI_File_read_all(mpi_file_handler, triplet_list_r%DATA, & + CALL ConstructTripletList(tlist_r, local_triplets) + CALL MPI_File_read_all(mpi_file_handler, tlist_r%DATA, & & local_triplets, triplet_mpi_type, message_status, ierr) END IF CALL MPI_File_close(mpi_file_handler,ierr) - CALL StopTimer("MPI Read Binary") IF (this%is_complex) THEN - CALL FillMatrixFromTripletList(this,triplet_list_c) - CALL DestructTripletList(triplet_list_c) + CALL FillMatrixFromTripletList(this, tlist_c) + CALL DestructTripletList(tlist_c) ELSE - CALL FillMatrixFromTripletList(this,triplet_list_r) - CALL DestructTripletList(triplet_list_r) + CALL FillMatrixFromTripletList(this, tlist_r) + CALL DestructTripletList(tlist_r) END IF END IF @@ -690,7 +688,7 @@ END SUBROUTINE ConstructMatrixFromBinary_ps !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Save a distributed sparse matrix to a binary file. !> Faster than text, so this is good for check pointing. - SUBROUTINE WriteMatrixToBinary_ps(this,file_name) + SUBROUTINE WriteMatrixToBinary_ps(this, file_name) !> The Matrix to write. TYPE(Matrix_ps), INTENT(IN) :: this !> The name of the file to write to. @@ -716,7 +714,7 @@ SUBROUTINE WriteMatrixToBinary_psr(this, file_name, triplet_mpi_type) !> The triplet type, which distinguishes real and complex triplets. INTEGER, INTENT(IN) :: triplet_mpi_type !! Local Data - TYPE(TripletList_r) :: triplet_list + TYPE(TripletList_r) :: tlist TYPE(Matrix_lsr) :: merged_local_data #include "distributed_includes/WriteMatrixToBinary.f90" @@ -732,7 +730,7 @@ SUBROUTINE WriteMatrixToBinary_psc(this, file_name, triplet_mpi_type) !> The triplet type, which distinguishes real and complex triplets. INTEGER, INTENT(IN) :: triplet_mpi_type !! Local Data - TYPE(TripletList_c) :: triplet_list + TYPE(TripletList_c) :: tlist TYPE(Matrix_lsc) :: merged_local_data #include "distributed_includes/WriteMatrixToBinary.f90" @@ -741,7 +739,7 @@ END SUBROUTINE WriteMatrixToBinary_psc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Write a distributed sparse matrix to a matrix market file. !> Read \cite boisvert1996matrix for the details. - SUBROUTINE WriteMatrixToMatrixMarket_ps(this,file_name) + SUBROUTINE WriteMatrixToMatrixMarket_ps(this, file_name) !> The Matrix to write. TYPE(Matrix_ps), INTENT(IN) :: this !> The name of the file to write to. @@ -755,13 +753,13 @@ SUBROUTINE WriteMatrixToMatrixMarket_ps(this,file_name) END SUBROUTINE WriteMatrixToMatrixMarket_ps !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Write to matrix market implementation for real data. - SUBROUTINE WriteMatrixToMatrixMarket_psr(this,file_name) + SUBROUTINE WriteMatrixToMatrixMarket_psr(this, file_name) !> The Matrix to write. TYPE(Matrix_ps), INTENT(IN) :: this !> The name of the file to write to. CHARACTER(len=*), INTENT(IN) :: file_name !! Local Data - TYPE(TripletList_r) :: triplet_list + TYPE(TripletList_r) :: tlist TYPE(Matrix_lsr) :: merged_local_data #include "distributed_includes/WriteToMatrixMarket.f90" @@ -769,13 +767,13 @@ SUBROUTINE WriteMatrixToMatrixMarket_psr(this,file_name) END SUBROUTINE WriteMatrixToMatrixMarket_psr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Write to matrix market implementation for complex data. - SUBROUTINE WriteMatrixToMatrixMarket_psc(this,file_name) + SUBROUTINE WriteMatrixToMatrixMarket_psc(this, file_name) !> The Matrix to write. TYPE(Matrix_ps), INTENT(IN) :: this !> The name of the file to write to. CHARACTER(len=*), INTENT(IN) :: file_name !! Local Data - TYPE(TripletList_c) :: triplet_list + TYPE(TripletList_c) :: tlist TYPE(Matrix_lsc) :: merged_local_data #define ISCOMPLEX @@ -792,9 +790,9 @@ END SUBROUTINE WriteMatrixToMatrixMarket_psc SUBROUTINE FillMatrixFromTripletList_psr(this, triplet_list, & & preduplicated_in, prepartitioned_in) !> The matrix to fill. - TYPE(Matrix_ps) :: this + TYPE(Matrix_ps), INTENT(INOUT) :: this !> The triplet list of values. - TYPE(TripletList_r) :: triplet_list + TYPE(TripletList_r), INTENT(IN) :: triplet_list !> If lists are preduplicated across slices set this to true. LOGICAL, INTENT(IN), OPTIONAL :: preduplicated_in !> If all lists only contain local matrix elements set this to true. @@ -802,7 +800,7 @@ SUBROUTINE FillMatrixFromTripletList_psr(this, triplet_list, & !! Local Data TYPE(Matrix_ps) :: temp_matrix TYPE(TripletList_r) :: shifted - TYPE(TripletList_r) :: sorted_triplet_list + TYPE(TripletList_r) :: sorted_tlist TYPE(Matrix_lsr) :: local_matrix TYPE(Matrix_lsr) :: gathered_matrix !! Local Data @@ -828,16 +826,16 @@ END SUBROUTINE FillMatrixFromTripletList_psr SUBROUTINE FillMatrixFromTripletList_psc(this, triplet_list, & & preduplicated_in, prepartitioned_in) !> The matrix to fill. - TYPE(Matrix_ps) :: this + TYPE(Matrix_ps), INTENT(INOUT) :: this !> The triplet list of values. - TYPE(TripletList_c) :: triplet_list + TYPE(TripletList_c), INTENT(IN) :: triplet_list !> If lists are preduplicated across slices set this to true. LOGICAL, INTENT(IN), OPTIONAL :: preduplicated_in !> If all lists only contain local matrix elements set this to true. LOGICAL, INTENT(IN), OPTIONAL :: prepartitioned_in !! Local Data TYPE(TripletList_c) :: shifted - TYPE(TripletList_c) :: sorted_triplet_list + TYPE(TripletList_c) :: sorted_tlist TYPE(Matrix_lsc) :: local_matrix TYPE(Matrix_lsc) :: gathered_matrix !! Local Data @@ -874,7 +872,7 @@ SUBROUTINE FillMatrixIdentity_psr(this) !> The matrix being filled. TYPE(Matrix_ps), INTENT(INOUT) :: this !! Local Data - TYPE(TripletList_r) :: triplet_list + TYPE(TripletList_r) :: tlist #include "distributed_includes/FillMatrixIdentity.f90" @@ -885,7 +883,7 @@ SUBROUTINE FillMatrixIdentity_psc(this) !> The matrix being filled. TYPE(Matrix_ps), INTENT(INOUT) :: this !! Local Data - TYPE(TripletList_c) :: triplet_list + TYPE(TripletList_c) :: tlist #include "distributed_includes/FillMatrixIdentity.f90" @@ -927,7 +925,7 @@ SUBROUTINE FillMatrixPermutation_psr(this, permutation_vector, rows) !> If true permute rows, false permute columns. LOGICAL, INTENT(IN) :: rows !! Local Data - TYPE(TripletList_r) :: triplet_list + TYPE(TripletList_r) :: tlist #include "distributed_includes/FillMatrixPermutation.f90" @@ -942,7 +940,7 @@ SUBROUTINE FillMatrixPermutation_psc(this, permutation_vector, rows) !> If true permute rows, false permute columns. LOGICAL, INTENT(IN) :: rows !! Local Data - TYPE(TripletList_c) :: triplet_list + TYPE(TripletList_c) :: tlist #include "distributed_includes/FillMatrixPermutation.f90" @@ -968,7 +966,7 @@ SUBROUTINE FillMatrixDense_psr(this) !> The matrix being filled. TYPE(Matrix_ps), INTENT(INOUT) :: this !! Local Data - TYPE(TripletList_r) :: triplet_list + TYPE(TripletList_r) :: tlist #include "distributed_includes/FillMatrixDense.f90" @@ -979,7 +977,7 @@ SUBROUTINE FillMatrixDense_psc(this) !> The matrix being filled. TYPE(Matrix_ps), INTENT(INOUT) :: this !! Local Data - TYPE(TripletList_c) :: triplet_list + TYPE(TripletList_c) :: tlist #include "distributed_includes/FillMatrixDense.f90" @@ -1036,13 +1034,13 @@ SUBROUTINE GetMatrixBlock_psr(this, triplet_list, start_row, end_row, & !> The list to fill. TYPE(TripletList_r), INTENT(INOUT) :: triplet_list !> The starting row for data to store on this process. - INTEGER :: start_row + INTEGER, INTENT(IN) :: start_row !> The ending row for data to store on this process. - INTEGER :: end_row + INTEGER, INTENT(IN) :: end_row !> The starting col for data to store on this process - INTEGER :: start_column + INTEGER, INTENT(IN) :: start_column !> The ending col for data to store on this process - INTEGER :: end_column + INTEGER, INTENT(IN) :: end_column !! Local Data TYPE(Matrix_ps) :: working_matrix TYPE(Matrix_lsr) :: merged_local_data @@ -1095,13 +1093,13 @@ SUBROUTINE GetMatrixBlock_psc(this, triplet_list, start_row, end_row, & !> The list to fill. TYPE(TripletList_c), INTENT(INOUT) :: triplet_list !> The starting row for data to store on this process. - INTEGER :: start_row + INTEGER, INTENT(IN) :: start_row !> The ending row for data to store on this process. - INTEGER :: end_row + INTEGER, INTENT(IN) :: end_row !> The starting col for data to store on this process - INTEGER :: start_column + INTEGER, INTENT(IN) :: start_column !> The ending col for data to store on this process - INTEGER :: end_column + INTEGER, INTENT(IN) :: end_column !! Local Data TYPE(Matrix_ps) :: working_matrix TYPE(Matrix_lsc) :: merged_local_data @@ -1153,13 +1151,13 @@ SUBROUTINE GetMatrixSlice(this, submatrix, start_row, end_row, & !> The slice to fill. TYPE(Matrix_ps), INTENT(INOUT) :: submatrix !> The starting row to include in this matrix. - INTEGER :: start_row + INTEGER, INTENT(IN) :: start_row !> The ending row to include in this matrix. - INTEGER :: end_row + INTEGER, INTENT(IN) :: end_row !> The starting column to include in this matrix. - INTEGER :: start_column + INTEGER, INTENT(IN) :: start_column !> The last column to include in this matrix. - INTEGER :: end_column + INTEGER, INTENT(IN) :: end_column !! Get a triplet list with the values IF (this%is_complex) THEN @@ -1180,13 +1178,13 @@ SUBROUTINE GetMatrixSlice_psr(this, submatrix, start_row, end_row, & !> The slice to fill. TYPE(Matrix_ps), INTENT(INOUT) :: submatrix !> The starting row to include in this matrix. - INTEGER :: start_row + INTEGER, INTENT(IN) :: start_row !> The ending row to include in this matrix. - INTEGER :: end_row + INTEGER, INTENT(IN) :: end_row !> The starting column to include in this matrix. - INTEGER :: start_column + INTEGER, INTENT(IN) :: start_column !> The last column to include in this matrix. - INTEGER :: end_column + INTEGER, INTENT(IN) :: end_column #define TLISTTYPE TripletList_r #define TTYPE Triplet_r @@ -1204,13 +1202,13 @@ SUBROUTINE GetMatrixSlice_psc(this, submatrix, start_row, end_row, & !> The slice to fill. TYPE(Matrix_ps), INTENT(INOUT) :: submatrix !> The starting row to include in this matrix. - INTEGER :: start_row + INTEGER, INTENT(IN) :: start_row !> The ending row to include in this matrix. - INTEGER :: end_row + INTEGER, INTENT(IN) :: end_row !> The starting column to include in this matrix. - INTEGER :: start_column + INTEGER, INTENT(IN) :: start_column !> The last column to include in this matrix. - INTEGER :: end_column + INTEGER, INTENT(IN) :: end_column #define TLISTTYPE TripletList_c #define TTYPE Triplet_c @@ -1248,17 +1246,17 @@ SUBROUTINE PrintMatrixInformation_ps(this) INTEGER :: min_size, max_size REAL(NTREAL) :: sparsity - CALL GetMatrixLoadBalance(this,min_size,max_size) - sparsity = REAL(GetMatrixSize(this),KIND=NTREAL) / & - & (REAL(this%actual_matrix_dimension,KIND=NTREAL)**2) + CALL GetMatrixLoadBalance(this, min_size, max_size) + sparsity = REAL(GetMatrixSize(this), KIND = NTREAL) / & + & (REAL(this%actual_matrix_dimension, KIND = NTREAL)**2) CALL WriteHeader("Load_Balance") CALL EnterSubLog - CALL WriteListElement(key="min_size", VALUE=min_size) - CALL WriteListElement(key="max_size", VALUE=max_size) + CALL WriteListElement(key = "min_size", VALUE = min_size) + CALL WriteListElement(key = "max_size", VALUE = max_size) CALL ExitSubLog - CALL WriteElement(key="Dimension",VALUE=this%actual_matrix_dimension) - CALL WriteElement(key="Sparsity", VALUE=sparsity) + CALL WriteElement(key = "Dimension",VALUE = this%actual_matrix_dimension) + CALL WriteElement(key = "Sparsity", VALUE = sparsity) END SUBROUTINE PrintMatrixInformation_ps !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Print out a distributed sparse matrix. @@ -1288,7 +1286,7 @@ END SUBROUTINE PrintMatrix_ps !> Print matrix implementation (real). SUBROUTINE PrintMatrix_psr(this, file_name_in) !> The matrix to print. - TYPE(Matrix_ps) :: this + TYPE(Matrix_ps), INTENT(IN) :: this !> Optionally, you can pass a file to print to instead of the console. CHARACTER(len=*), OPTIONAL, INTENT(IN) :: file_name_in !! Temporary Variables @@ -1300,7 +1298,7 @@ END SUBROUTINE PrintMatrix_psr !> Print matrix implementation (complex). SUBROUTINE PrintMatrix_psc(this, file_name_in) !> The matrix to print. - TYPE(Matrix_ps) :: this + TYPE(Matrix_ps), INTENT(IN) :: this !> Optionally, you can pass a file to print to instead of the console. CHARACTER(len=*), OPTIONAL, INTENT(IN) :: file_name_in !! Temporary Variables @@ -1331,9 +1329,9 @@ SUBROUTINE FilterMatrix_psr(this, threshold) !> Threshold (absolute) values below this are filtered REAL(NTREAL), INTENT(IN) :: threshold !! Local Variables - TYPE(TripletList_r) :: triplet_list + TYPE(TripletList_r) :: tlist TYPE(TripletList_r) :: new_list - TYPE(Triplet_r) :: temporary + TYPE(Triplet_r) :: trip #include "distributed_includes/FilterMatrix.f90" END SUBROUTINE FilterMatrix_psr @@ -1345,9 +1343,9 @@ SUBROUTINE FilterMatrix_psc(this, threshold) !> Threshold (absolute) values below this are filtered REAL(NTREAL), INTENT(IN) :: threshold !! Local Variables - TYPE(TripletList_c) :: triplet_list + TYPE(TripletList_c) :: tlist TYPE(TripletList_c) :: new_list - TYPE(Triplet_c) :: temporary + TYPE(Triplet_c) :: trip #include "distributed_includes/FilterMatrix.f90" END SUBROUTINE FilterMatrix_psc @@ -1377,10 +1375,10 @@ FUNCTION GetMatrixSize_ps(this) RESULT(total_size) END IF !! Global Sum - CALL MPI_Allreduce(local_size,temp_size,1,MPINTREAL,MPI_SUM,& + CALL MPI_Allreduce(local_size, temp_size, 1, MPINTREAL, MPI_SUM, & & this%process_grid%within_slice_comm, ierr) - total_size = INT(temp_size, kind=NTLONG) + total_size = INT(temp_size, KIND = NTLONG) END FUNCTION GetMatrixSize_ps !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -1412,9 +1410,9 @@ SUBROUTINE GetMatrixLoadBalance_ps(this, min_size, max_size) END IF !! Global Reduce - CALL MPI_Allreduce(local_size,max_size,1,MPINTINTEGER,MPI_MAX,& + CALL MPI_Allreduce(local_size, max_size, 1, MPINTINTEGER, MPI_MAX,& & this%process_grid%within_slice_comm, ierr) - CALL MPI_Allreduce(local_size,min_size,1,MPINTINTEGER,MPI_MIN,& + CALL MPI_Allreduce(local_size, min_size, 1, MPINTINTEGER, MPI_MIN,& & this%process_grid%within_slice_comm, ierr) END SUBROUTINE GetMatrixLoadBalance_ps @@ -1425,7 +1423,7 @@ SUBROUTINE TransposeMatrix_ps(AMat, TransMat) !> The matrix to transpose. TYPE(Matrix_ps), INTENT(IN) :: AMat !> TransMat = A^T . - TYPE(Matrix_ps), INTENT(OUT) :: TransMat + TYPE(Matrix_ps), INTENT(INOUT) :: TransMat IF (AMat%is_complex) THEN CALL TransposeMatrix_psc(AMat, TransMat) @@ -1440,11 +1438,11 @@ SUBROUTINE TransposeMatrix_psr(AMat, TransMat) !> The matrix to transpose. TYPE(Matrix_ps), INTENT(IN) :: AMat !> TransMat = A^T . - TYPE(Matrix_ps), INTENT(OUT) :: TransMat + TYPE(Matrix_ps), INTENT(INOUT) :: TransMat !! Local Variables - TYPE(TripletList_r) :: triplet_list + TYPE(TripletList_r) :: tlist TYPE(TripletList_r) :: new_list - TYPE(Triplet_r) :: temporary, temporary_t + TYPE(Triplet_r) :: trip, trip_t #include "distributed_includes/TransposeMatrix.f90" @@ -1455,11 +1453,11 @@ SUBROUTINE TransposeMatrix_psc(AMat, TransMat) !> The matrix to transpose. TYPE(Matrix_ps), INTENT(IN) :: AMat !> TransMat = A^T . - TYPE(Matrix_ps), INTENT(OUT) :: TransMat + TYPE(Matrix_ps), INTENT(INOUT) :: TransMat !! Local Variables - TYPE(TripletList_c) :: triplet_list + TYPE(TripletList_c) :: tlist TYPE(TripletList_c) :: new_list - TYPE(Triplet_c) :: temporary, temporary_t + TYPE(Triplet_c) :: trip, trip_t #include "distributed_includes/TransposeMatrix.f90" @@ -1540,8 +1538,8 @@ END SUBROUTINE CommSplitMatrix_psc !> This will redistribute the data so that the local data are entries in !> the rows and columns list. The order of the row list and column list matter !> because local data is filled in the same order. - SUBROUTINE RedistributeData_psr(this,index_lookup,reverse_index_lookup,& - & initial_triplet_list,sorted_triplet_list) + SUBROUTINE RedistributeData_psr(this, index_lookup, reverse_index_lookup,& + & initial_triplet_list, sorted_triplet_list) !> The matrix to redistribute TYPE(Matrix_ps), INTENT(INOUT) :: this !> Lookup describing how data is distributed. @@ -1566,8 +1564,8 @@ END SUBROUTINE RedistributeData_psr !> This will redistribute the data so that the local data are entries in !> the rows and columns list. The order of the row list and column list matter !> because local data is filled in the same order. - SUBROUTINE RedistributeData_psc(this,index_lookup,reverse_index_lookup,& - & initial_triplet_list,sorted_triplet_list) + SUBROUTINE RedistributeData_psc(this, index_lookup, reverse_index_lookup,& + & initial_triplet_list, sorted_triplet_list) !> The matrix to redistribute TYPE(Matrix_ps), INTENT(INOUT) :: this !> Lookup describing how data is distributed. @@ -1605,11 +1603,11 @@ PURE FUNCTION CalculateScaledDimension(this, matrix_dim) RESULT(scaled_dim) & this%process_grid%num_process_columns* & & this%process_grid%num_process_rows - size_ratio = matrix_dim/lcm + size_ratio = matrix_dim / lcm IF (size_ratio * lcm .EQ. matrix_dim) THEN scaled_dim = matrix_dim ELSE - scaled_dim = (size_ratio + 1)*(lcm) + scaled_dim = (size_ratio + 1) * lcm END IF END FUNCTION CalculateScaledDimension !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/Source/Fortran/PermutationModule.F90 b/Source/Fortran/PermutationModule.F90 index 820e300e..4fe2f3ff 100644 --- a/Source/Fortran/PermutationModule.F90 +++ b/Source/Fortran/PermutationModule.F90 @@ -21,6 +21,7 @@ MODULE PermutationModule PUBLIC :: ConstructReversePermutation PUBLIC :: ConstructRandomPermutation PUBLIC :: ConstructLimitedRandomPermutation + PUBLIC :: CopyPermutation PUBLIC :: DestructPermutation CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Constructs a permutation that preserves the original order. @@ -30,7 +31,7 @@ SUBROUTINE ConstructDefaultPermutation(this, matrix_dimension) !> The dimension of the matrix. INTEGER, INTENT(IN) :: matrix_dimension !! Local Data - INTEGER :: counter + INTEGER :: II CALL DestructPermutation(this) @@ -38,9 +39,9 @@ SUBROUTINE ConstructDefaultPermutation(this, matrix_dimension) ALLOCATE(this%reverse_index_lookup(matrix_dimension)) !! Fill by counting. - fill: DO counter = 1, matrix_dimension - this%index_lookup(counter) = counter - this%reverse_index_lookup(counter) = counter + fill: DO II = 1, matrix_dimension + this%index_lookup(II) = II + this%reverse_index_lookup(II) = II END DO fill END SUBROUTINE ConstructDefaultPermutation @@ -52,7 +53,7 @@ SUBROUTINE ConstructReversePermutation(this, matrix_dimension) !> The size of the matrix. INTEGER, INTENT(IN) :: matrix_dimension !! Local Data - INTEGER :: counter + INTEGER :: II CALL DestructPermutation(this) @@ -60,9 +61,9 @@ SUBROUTINE ConstructReversePermutation(this, matrix_dimension) ALLOCATE(this%reverse_index_lookup(matrix_dimension)) !! Fill by counting. - fill: DO counter = 1, matrix_dimension - this%index_lookup(counter) = matrix_dimension - counter + 1 - this%reverse_index_lookup(counter) = counter + fill: DO II = 1, matrix_dimension + this%index_lookup(II) = matrix_dimension - II + 1 + this%reverse_index_lookup(II) = II END DO fill END SUBROUTINE ConstructReversePermutation @@ -79,17 +80,17 @@ SUBROUTINE ConstructRandomPermutation(this, matrix_dimension, & !> This is to synchronize random number across processes. TYPE(ProcessGrid_t), INTENT(INOUT), OPTIONAL :: process_grid_in !! Local Data - INTEGER :: counter + INTEGER :: II INTEGER :: random_integer - REAL(KIND=NTREAL) :: rand_temp + REAL(KIND = NTREAL) :: rand_temp INTEGER :: swap_space INTEGER :: ierr !! First fill by counting. - CALL ConstructDefaultPermutation(this,matrix_dimension) + CALL ConstructDefaultPermutation(this, matrix_dimension) !! Do the shuffle - shuffle: DO counter=matrix_dimension,1,-1 + shuffle: DO II = matrix_dimension, 1, -1 CALL RANDOM_NUMBER(rand_temp) random_integer = FLOOR(matrix_dimension*rand_temp)+1 swap_space = this%index_lookup(matrix_dimension) @@ -107,8 +108,8 @@ SUBROUTINE ConstructRandomPermutation(this, matrix_dimension, & END IF !! Compute the reverse lookup - reverse: DO counter=1,matrix_dimension - this%reverse_index_lookup(this%index_lookup(counter)) = counter + reverse: DO II = 1, matrix_dimension + this%reverse_index_lookup(this%index_lookup(II)) = II END DO reverse END SUBROUTINE ConstructRandomPermutation !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -126,19 +127,19 @@ SUBROUTINE ConstructLimitedRandomPermutation(this, actual_matrix_dimension, & !> This is to synchronize random number across processes. TYPE(ProcessGrid_t), INTENT(INOUT), OPTIONAL :: process_grid_in !! Local Data - INTEGER :: counter + INTEGER :: II INTEGER :: random_integer - REAL(KIND=NTREAL) :: rand_temp + REAL(KIND = NTREAL) :: rand_temp INTEGER :: swap_space INTEGER :: ierr !! First fill by counting. - CALL ConstructDefaultPermutation(this,logical_matrix_dimension) + CALL ConstructDefaultPermutation(this, logical_matrix_dimension) !! Do the shuffle - shuffle: DO counter=actual_matrix_dimension,1,-1 + shuffle: DO II = actual_matrix_dimension, 1, -1 CALL RANDOM_NUMBER(rand_temp) - random_integer = FLOOR(actual_matrix_dimension*rand_temp)+1 + random_integer = FLOOR(actual_matrix_dimension * rand_temp) + 1 swap_space = this%index_lookup(actual_matrix_dimension) this%index_lookup(actual_matrix_dimension) = & & this%index_lookup(random_integer) @@ -155,10 +156,21 @@ SUBROUTINE ConstructLimitedRandomPermutation(this, actual_matrix_dimension, & END IF !! Compute the reverse lookup - reverse: DO counter=1,logical_matrix_dimension - this%reverse_index_lookup(this%index_lookup(counter)) = counter + reverse: DO II = 1, logical_matrix_dimension + this%reverse_index_lookup(this%index_lookup(II)) = II END DO reverse END SUBROUTINE ConstructLimitedRandomPermutation +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Copy one permutation to another in a safe way. + SUBROUTINE CopyPermutation(permA, permB) + !> Permutation to copy + TYPE(Permutation_t), INTENT(IN) :: permA + !> permB = permA + TYPE(Permutation_t), INTENT(INOUT) :: permB + + CALL DestructPermutation(permB) + permB = permA + END SUBROUTINE CopyPermutation !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Destruct a permutation object. PURE SUBROUTINE DestructPermutation(this) diff --git a/Source/Fortran/PolynomialSolversModule.F90 b/Source/Fortran/PolynomialSolversModule.F90 index 2ba22f10..21ebea0a 100644 --- a/Source/Fortran/PolynomialSolversModule.F90 +++ b/Source/Fortran/PolynomialSolversModule.F90 @@ -12,7 +12,8 @@ MODULE PolynomialSolversModule USE PSMatrixModule, ONLY : Matrix_ps, DestructMatrix, FillMatrixIdentity, & & ConstructEmptyMatrix, CopyMatrix USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters IMPLICIT NONE PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -100,9 +101,9 @@ SUBROUTINE Compute_stand(InputMat, OutputMat, poly, solver_parameters_in) !! Handle The Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF degree = SIZE(poly%coefficients) @@ -110,9 +111,9 @@ SUBROUTINE Compute_stand(InputMat, OutputMat, poly, solver_parameters_in) IF (params%be_verbose) THEN CALL WriteHeader("Polynomial Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Horner") + CALL WriteElement(key = "Method", VALUE = "Horner") CALL PrintParameters(params) - CALL WriteElement(key="Degree", VALUE=degree-1) + CALL WriteElement(key = "Degree", VALUE = degree-1) END IF !! Initial values for matrices @@ -124,31 +125,31 @@ SUBROUTINE Compute_stand(InputMat, OutputMat, poly, solver_parameters_in) !! Load Balancing Step IF (params%do_load_balancing) THEN CALL PermuteMatrix(Identity, Identity, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(BalancedInput, BalancedInput, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF CALL CopyMatrix(Identity, OutputMat) IF (SIZE(poly%coefficients) .EQ. 1) THEN CALL ScaleMatrix(OutputMat, poly%coefficients(degree)) ELSE - CALL ScaleMatrix(OutputMat,poly%coefficients(degree-1)) - CALL IncrementMatrix(BalancedInput,OutputMat, & + CALL ScaleMatrix(OutputMat,poly%coefficients(degree - 1)) + CALL IncrementMatrix(BalancedInput, OutputMat, & & poly%coefficients(degree)) - DO II = degree-2, 1, -1 - CALL MatrixMultiply(BalancedInput,OutputMat,Temporary, & - & threshold_in=params%threshold, memory_pool_in=pool) - CALL CopyMatrix(Temporary,OutputMat) - CALL IncrementMatrix(Identity, & - & OutputMat, alpha_in=poly%coefficients(II)) + DO II = degree - 2, 1, -1 + CALL MatrixMultiply(BalancedInput, OutputMat, Temporary, & + & threshold_in = params%threshold, memory_pool_in = pool) + CALL CopyMatrix(Temporary, OutputMat) + CALL IncrementMatrix(Identity, OutputMat, & + & alpha_in = poly%coefficients(II)) END DO END IF !! Undo Load Balancing Step IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Cleanup @@ -191,9 +192,9 @@ SUBROUTINE FactorizedCompute_stand(InputMat, OutputMat, poly, & !! Handle The Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF !! Parameters for splitting up polynomial. @@ -205,16 +206,16 @@ SUBROUTINE FactorizedCompute_stand(InputMat, OutputMat, poly, & IF (params%be_verbose) THEN CALL WriteHeader("Polynomial Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Paterson Stockmeyer") + CALL WriteElement(key = "Method", VALUE = "Paterson Stockmeyer") CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("paterson1973number") CALL ExitSubLog CALL PrintParameters(params) - CALL WriteElement(key="Degree", VALUE=degree-1) + CALL WriteElement(key = "Degree", VALUE = degree - 1) END IF - ALLOCATE(x_powers(s_value+1)) + ALLOCATE(x_powers(s_value + 1)) !! Initial values for matrices CALL ConstructEmptyMatrix(Identity, InputMat) @@ -223,45 +224,45 @@ SUBROUTINE FactorizedCompute_stand(InputMat, OutputMat, poly, & !! Create the X Powers CALL ConstructEmptyMatrix(x_powers(1), InputMat) CALL FillMatrixIdentity(x_powers(1)) - DO II = 1, s_value+1-1 - CALL MatrixMultiply(InputMat,x_powers(II-1+1),x_powers(II+1),& - & memory_pool_in=pool) + DO II = 1, s_value + CALL MatrixMultiply(InputMat,x_powers(II), x_powers(II + 1), & + & memory_pool_in = pool) END DO - CALL CopyMatrix(x_powers(s_value+1),Xs) + CALL CopyMatrix(x_powers(s_value + 1), Xs) !! S_k = bmX CALL CopyMatrix(Identity,Bk) - CALL ScaleMatrix(Bk, poly%coefficients(s_value*r_value+1)) - DO II = 1, m_value-s_value*r_value+1-1 - c_index = s_value*r_value + II - CALL IncrementMatrix(x_powers(II+1),Bk, & - & alpha_in=poly%coefficients(c_index+1)) + CALL ScaleMatrix(Bk, poly%coefficients(s_value * r_value + 1)) + DO II = 1, m_value - s_value * r_value + c_index = s_value * r_value + II + CALL IncrementMatrix(x_powers(II + 1), Bk, & + & alpha_in = poly%coefficients(c_index + 1)) END DO - CALL MatrixMultiply(Bk, Xs, OutputMat, memory_pool_in=pool) + CALL MatrixMultiply(Bk, Xs, OutputMat, memory_pool_in = pool) !! S_k += bmx + bm-1I k_value = r_value - 1 CALL CopyMatrix(Identity, Bk) - CALL ScaleMatrix(Bk, poly%coefficients(s_value*k_value+1)) - DO II = 1, s_value-1+1-1 + CALL ScaleMatrix(Bk, poly%coefficients(s_value * k_value + 1)) + DO II = 1, s_value - 1 c_index = s_value*k_value + II - CALL IncrementMatrix(x_powers(II+1),Bk, & - & alpha_in=poly%coefficients(c_index+1)) + CALL IncrementMatrix(x_powers(II + 1), Bk, & + & alpha_in = poly%coefficients(c_index + 1)) END DO CALL IncrementMatrix(Bk,OutputMat) !! Loop over the rest. - DO k_value=r_value-2,-1+1,-1 + DO k_value = r_value - 2, 0, -1 CALL CopyMatrix(Identity,Bk) - CALL ScaleMatrix(Bk, poly%coefficients(s_value*k_value+1)) - DO II=1,s_value-1+1-1 - c_index = s_value*k_value + II - CALL IncrementMatrix(x_powers(II+1),Bk, & - & alpha_in=poly%coefficients(c_index+1)) + CALL ScaleMatrix(Bk, poly%coefficients(s_value * k_value + 1)) + DO II = 1, s_value - 1 + c_index = s_value * k_value + II + CALL IncrementMatrix(x_powers(II + 1), Bk, & + & alpha_in = poly%coefficients(c_index + 1)) END DO - CALL MatrixMultiply(Xs,OutputMat,Temp) - CALL CopyMatrix(Temp,OutputMat) - CALL IncrementMatrix(Bk,OutputMat) + CALL MatrixMultiply(Xs, OutputMat, Temp) + CALL CopyMatrix(Temp, OutputMat) + CALL IncrementMatrix(Bk, OutputMat) END DO !! Cleanup diff --git a/Source/Fortran/ProcessGridModule.F90 b/Source/Fortran/ProcessGridModule.F90 index 1300f552..5678a50f 100644 --- a/Source/Fortran/ProcessGridModule.F90 +++ b/Source/Fortran/ProcessGridModule.F90 @@ -81,16 +81,16 @@ MODULE ProcessGridModule END INTERFACE ConstructNewProcessGrid CONTAINS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Setup the default process grid. - SUBROUTINE ConstructProcessGrid_full(world_comm_, process_rows_, & - & process_columns_, process_slices_, be_verbose_in) + SUBROUTINE ConstructProcessGrid_full(world_comm, process_rows, & + & process_columns, process_slices, be_verbose_in) !> A communicator that every process in the grid is a part of. - INTEGER, INTENT(IN) :: world_comm_ + INTEGER, INTENT(IN) :: world_comm !> The number of grid rows. - INTEGER, INTENT(IN) :: process_rows_ + INTEGER, INTENT(IN) :: process_rows !> The number of grid columns. - INTEGER, INTENT(IN) :: process_columns_ + INTEGER, INTENT(IN) :: process_columns !> The number of grid slices. - INTEGER, INTENT(IN) :: process_slices_ + INTEGER, INTENT(IN) :: process_slices !> Set true to print process grid info. LOGICAL, INTENT(IN), OPTIONAL :: be_verbose_in !! Local Data @@ -103,15 +103,15 @@ SUBROUTINE ConstructProcessGrid_full(world_comm_, process_rows_, & be_verbose = .FALSE. END IF - CALL ConstructNewProcessGrid(global_grid, world_comm_, process_rows_, & - & process_columns_, process_slices_) + CALL ConstructNewProcessGrid(global_grid, world_comm, process_rows, & + & process_columns, process_slices) END SUBROUTINE ConstructProcessGrid_full !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Setup a process grid specifying only the slices - SUBROUTINE ConstructProcessGrid_onlyslice(world_comm_, process_slices_in, & + SUBROUTINE ConstructProcessGrid_onlyslice(world_comm, process_slices_in, & & be_verbose_in) !> A communicator that every process in the grid is a part of. - INTEGER, INTENT(IN) :: world_comm_ + INTEGER, INTENT(IN) :: world_comm !> The number of grid slices. INTEGER, INTENT(IN), OPTIONAL :: process_slices_in !> Set true to print process grid info. @@ -123,7 +123,7 @@ SUBROUTINE ConstructProcessGrid_onlyslice(world_comm_, process_slices_in, & INTEGER :: ierr !! Total processors - CALL MPI_COMM_SIZE(world_comm_, total_processors, ierr) + CALL MPI_COMM_SIZE(world_comm, total_processors, ierr) !! Process Optional Parameters IF (PRESENT(be_verbose_in)) THEN @@ -131,6 +131,7 @@ SUBROUTINE ConstructProcessGrid_onlyslice(world_comm_, process_slices_in, & ELSE be_verbose = .FALSE. END IF + IF (PRESENT(process_slices_in)) THEN process_slices = process_slices_in ELSE @@ -142,23 +143,23 @@ SUBROUTINE ConstructProcessGrid_onlyslice(world_comm_, process_slices_in, & & process_columns) !! Now call the full setup - CALL ConstructProcessGrid(world_comm_, process_rows, process_columns, & + CALL ConstructProcessGrid(world_comm, process_rows, process_columns, & & process_slices, be_verbose) END SUBROUTINE ConstructProcessGrid_onlyslice !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Construct a process grid. - SUBROUTINE ConstructNewProcessGrid_full(grid, world_comm_, process_rows_, & - & process_columns_, process_slices_) + SUBROUTINE ConstructNewProcessGrid_full(grid, world_comm, process_rows, & + & process_columns, process_slices) !> The grid to construct TYPE(ProcessGrid_t), INTENT(INOUT) :: grid !> A communicator that every process in the grid is a part of. - INTEGER, INTENT(IN) :: world_comm_ + INTEGER, INTENT(IN) :: world_comm !> The number of grid rows. - INTEGER, INTENT(IN) :: process_rows_ + INTEGER, INTENT(IN) :: process_rows !> The number of grid columns. - INTEGER, INTENT(IN) :: process_columns_ + INTEGER, INTENT(IN) :: process_columns !> The number of grid slices. - INTEGER, INTENT(IN) :: process_slices_ + INTEGER, INTENT(IN) :: process_slices !! Local Data INTEGER :: column_block_multiplier INTEGER :: row_block_multiplier @@ -170,17 +171,17 @@ SUBROUTINE ConstructNewProcessGrid_full(grid, world_comm_, process_rows_, & TYPE(Error_t) :: err CALL ConstructError(err) - CALL MPI_COMM_DUP(world_comm_, grid%global_comm, ierr) + CALL MPI_COMM_DUP(world_comm, grid%global_comm, ierr) !! Grid Dimensions - grid%num_process_rows = process_rows_ - grid%num_process_columns = process_columns_ - grid%num_process_slices = process_slices_ + grid%num_process_rows = process_rows + grid%num_process_columns = process_columns + grid%num_process_slices = process_slices CALL MPI_COMM_SIZE(grid%global_comm, grid%total_processors, ierr) - grid%slice_size = grid%total_processors/grid%num_process_slices + grid%slice_size = grid%total_processors / grid%num_process_slices !! Do a sanity check - IF (grid%num_process_rows*grid%num_process_columns*grid%num_process_slices & - & .NE. grid%total_processors) THEN + IF (grid%num_process_rows * grid%num_process_columns & + & * grid%num_process_slices .NE. grid%total_processors) THEN CALL SetGenericError(err, & & "you did not specify a consistent process grid size", .TRUE.) END IF @@ -189,16 +190,16 @@ SUBROUTINE ConstructNewProcessGrid_full(grid, world_comm_, process_rows_, & & MIN(grid%num_process_rows, grid%num_process_columns)) & & .NE. 0) THEN CALL SetGenericError(err, & - & "if slices >1, either rows or columns must be a multiple"//& + & "if slices >1, either rows or columns must be a multiple" // & & "of the other.", & & .TRUE.) END IF END IF !! Grid ID - CALL MPI_COMM_RANK(grid%global_comm,grid%global_rank,ierr) - grid%my_slice = grid%global_rank/grid%slice_size - grid%my_row = MOD(grid%global_rank, grid%slice_size)/ & + CALL MPI_COMM_RANK(grid%global_comm,grid%global_rank, ierr) + grid%my_slice = grid%global_rank / grid%slice_size + grid%my_row = MOD(grid%global_rank, grid%slice_size) / & & grid%num_process_columns grid%my_column = MOD(grid%global_rank, grid%num_process_columns) @@ -209,20 +210,22 @@ SUBROUTINE ConstructNewProcessGrid_full(grid, world_comm_, process_rows_, & CALL MPI_COMM_SPLIT(grid%global_comm, grid%within_slice_rank, & & grid%global_rank, grid%between_slice_comm, ierr) CALL MPI_COMM_RANK(grid%between_slice_comm, grid%between_slice_rank, ierr) - CALL MPI_COMM_SPLIT(grid%within_slice_comm, grid%my_row, grid%global_rank, & - & grid%row_comm, ierr) + CALL MPI_COMM_SPLIT(grid%within_slice_comm, grid%my_row, & + & grid%global_rank, grid%row_comm, ierr) CALL MPI_COMM_RANK(grid%row_comm, grid%row_rank, ierr) CALL MPI_COMM_SPLIT(grid%within_slice_comm, grid%my_column, & & grid%global_rank, grid%column_comm, ierr) CALL MPI_COMM_RANK(grid%column_comm, grid%column_rank, ierr) !! Blocking Information - column_block_multiplier = (grid%num_process_rows/grid%num_process_columns)*& + column_block_multiplier = & + & (grid%num_process_rows / grid%num_process_columns) * & & grid%num_process_slices IF (column_block_multiplier .EQ. 0) THEN - column_block_multiplier = 1*grid%num_process_slices + column_block_multiplier = grid%num_process_slices END IF - row_block_multiplier = (grid%num_process_columns/grid%num_process_rows)* & + row_block_multiplier = & + & (grid%num_process_columns / grid%num_process_rows) * & & grid%num_process_slices IF (row_block_multiplier .EQ. 0) THEN row_block_multiplier = 1*grid%num_process_slices @@ -238,8 +241,8 @@ SUBROUTINE ConstructNewProcessGrid_full(grid, world_comm_, process_rows_, & num_threads = omp_get_num_threads() grid%omp_max_threads = omp_get_max_threads() !$omp end PARALLEL - grid%block_multiplier = num_threads/& - & (column_block_multiplier+row_block_multiplier) + grid%block_multiplier = num_threads / & + & (column_block_multiplier + row_block_multiplier) IF (grid%block_multiplier .EQ. 0) THEN grid%block_multiplier = 1 END IF @@ -248,9 +251,9 @@ SUBROUTINE ConstructNewProcessGrid_full(grid, world_comm_, process_rows_, & #endif grid%number_of_blocks_columns = & - & column_block_multiplier*grid%block_multiplier + & column_block_multiplier * grid%block_multiplier grid%number_of_blocks_rows = & - & row_block_multiplier*grid%block_multiplier + & row_block_multiplier * grid%block_multiplier !! Create Blocked Communicators ALLOCATE(grid%blocked_row_comm(grid%number_of_blocks_rows)) @@ -260,21 +263,21 @@ SUBROUTINE ConstructNewProcessGrid_full(grid, world_comm_, process_rows_, & ALLOCATE(grid%blocked_between_slice_comm(grid%number_of_blocks_rows, & & grid%number_of_blocks_columns)) - DO JJ=1,grid%number_of_blocks_columns - DO II=1,grid%number_of_blocks_rows + DO JJ = 1, grid%number_of_blocks_columns + DO II = 1, grid%number_of_blocks_rows CALL MPI_COMM_SPLIT(grid%global_comm, grid%my_slice, & - & grid%global_rank, grid%blocked_within_slice_comm(II,JJ), & + & grid%global_rank, grid%blocked_within_slice_comm(II, JJ), & & ierr) CALL MPI_COMM_SPLIT(grid%global_comm, grid%within_slice_rank, & - & grid%global_rank, grid%blocked_between_slice_comm(II,JJ), & + & grid%global_rank, grid%blocked_between_slice_comm(II, JJ), & & ierr) END DO END DO - DO JJ=1,grid%number_of_blocks_columns + DO JJ = 1, grid%number_of_blocks_columns CALL MPI_COMM_SPLIT(grid%within_slice_comm, grid%my_column, & & grid%global_rank, grid%blocked_column_comm(JJ), ierr) END DO - DO II=1,grid%number_of_blocks_rows + DO II = 1, grid%number_of_blocks_rows CALL MPI_COMM_SPLIT(grid%within_slice_comm, grid%my_row, & & grid%global_rank, grid%blocked_row_comm(II), ierr) END DO @@ -282,12 +285,12 @@ SUBROUTINE ConstructNewProcessGrid_full(grid, world_comm_, process_rows_, & END SUBROUTINE ConstructNewProcessGrid_full !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Setup a process grid specifying only the slices - SUBROUTINE ConstructNewProcessGrid_onlyslice(grid, world_comm_, & + SUBROUTINE ConstructNewProcessGrid_onlyslice(grid, world_comm, & & process_slices_in) !> The grid to construct TYPE(ProcessGrid_t), INTENT(INOUT) :: grid !> A communicator that every process in the grid is a part of. - INTEGER, INTENT(IN) :: world_comm_ + INTEGER, INTENT(IN) :: world_comm !> The number of grid slices. INTEGER, INTENT(IN), OPTIONAL :: process_slices_in !! Local Data @@ -296,7 +299,7 @@ SUBROUTINE ConstructNewProcessGrid_onlyslice(grid, world_comm_, & INTEGER :: ierr !! Total processors - CALL MPI_COMM_SIZE(world_comm_, total_processors, ierr) + CALL MPI_COMM_SIZE(world_comm, total_processors, ierr) !! Process Optional Parameters IF (PRESENT(process_slices_in)) THEN @@ -310,7 +313,7 @@ SUBROUTINE ConstructNewProcessGrid_onlyslice(grid, world_comm_, & & process_columns) !! Now call the full setup - CALL ConstructNewProcessGrid(grid, world_comm_, process_rows, & + CALL ConstructNewProcessGrid(grid, world_comm, process_rows, & & process_columns, process_slices) END SUBROUTINE ConstructNewProcessGrid_onlyslice !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -364,16 +367,16 @@ SUBROUTINE CopyProcessGrid(old_grid, new_grid) CALL MPI_COMM_DUP(old_grid%blocked_column_comm(JJ), & & new_grid%blocked_column_comm(JJ), ierr) END DO - DO JJ=1,new_grid%number_of_blocks_columns - DO II=1,new_grid%number_of_blocks_rows - CALL MPI_COMM_DUP(old_grid%blocked_within_slice_comm(II,JJ), & - & new_grid%blocked_within_slice_comm(II,JJ), ierr) + DO JJ = 1, new_grid%number_of_blocks_columns + DO II = 1,new_grid%number_of_blocks_rows + CALL MPI_COMM_DUP(old_grid%blocked_within_slice_comm(II, JJ), & + & new_grid%blocked_within_slice_comm(II, JJ), ierr) END DO END DO - DO JJ=1,new_grid%number_of_blocks_columns - DO II=1,new_grid%number_of_blocks_rows - CALL MPI_COMM_DUP(old_grid%blocked_between_slice_comm(II,JJ), & - & new_grid%blocked_between_slice_comm(II,JJ), ierr) + DO JJ = 1, new_grid%number_of_blocks_columns + DO II = 1, new_grid%number_of_blocks_rows + CALL MPI_COMM_DUP(old_grid%blocked_between_slice_comm(II, JJ), & + & new_grid%blocked_between_slice_comm(II, JJ), ierr) END DO END DO @@ -422,9 +425,9 @@ RECURSIVE SUBROUTINE DestructProcessGrid(grid_in) END IF IF (ALLOCATED(grid_in%blocked_within_slice_comm)) THEN - DO JJ=1,grid_in%number_of_blocks_columns - DO II=1,grid_in%number_of_blocks_rows - CALL MPI_COMM_FREE(grid_in%blocked_within_slice_comm(II,JJ), & + DO JJ = 1, grid_in%number_of_blocks_columns + DO II = 1, grid_in%number_of_blocks_rows + CALL MPI_COMM_FREE(grid_in%blocked_within_slice_comm(II, JJ), & & ierr) END DO END DO @@ -432,9 +435,9 @@ RECURSIVE SUBROUTINE DestructProcessGrid(grid_in) END IF IF (ALLOCATED(grid_in%blocked_between_slice_comm)) THEN - DO JJ=1,grid_in%number_of_blocks_columns - DO II=1,grid_in%number_of_blocks_rows - CALL MPI_COMM_FREE(grid_in%blocked_between_slice_comm(II,JJ), & + DO JJ = 1, grid_in%number_of_blocks_columns + DO II = 1, grid_in%number_of_blocks_rows + CALL MPI_COMM_FREE(grid_in%blocked_between_slice_comm(II, JJ), & & ierr) END DO END DO @@ -477,7 +480,7 @@ SUBROUTINE SplitProcessGrid(old_grid, new_grid, my_color, split_slice, & between_rank = 0 !! First preferentially try to split along slices ELSE IF (old_grid%num_process_slices .GT. 1) THEN - midpoint = old_grid%num_process_slices/2 + midpoint = old_grid%num_process_slices / 2 cols = old_grid%num_process_columns rows = old_grid%num_process_rows IF (old_grid%my_slice .LT. midpoint) THEN @@ -489,10 +492,10 @@ SUBROUTINE SplitProcessGrid(old_grid, new_grid, my_color, split_slice, & END IF between_rank = old_grid%my_slice split_slice = .TRUE. - left_grid_size = midpoint*cols*rows + left_grid_size = midpoint * cols * rows !! Next try to split the bigger direction ELSE IF (old_grid%num_process_rows .GT. old_grid%num_process_columns) THEN - midpoint = old_grid%num_process_rows/2 + midpoint = old_grid%num_process_rows / 2 cols = old_grid%num_process_columns slices = 1 IF (old_grid%my_row .LT. midpoint) THEN @@ -503,10 +506,10 @@ SUBROUTINE SplitProcessGrid(old_grid, new_grid, my_color, split_slice, & rows = old_grid%num_process_rows - midpoint END IF between_rank = old_grid%my_row - left_grid_size = midpoint*cols*slices + left_grid_size = midpoint * cols * slices !! Default Case ELSE - midpoint = old_grid%num_process_columns/2 + midpoint = old_grid%num_process_columns / 2 slices = 1 rows = old_grid%num_process_rows IF (old_grid%my_column .LT. midpoint) THEN @@ -517,7 +520,7 @@ SUBROUTINE SplitProcessGrid(old_grid, new_grid, my_color, split_slice, & cols = old_grid%num_process_columns - midpoint END IF between_rank = old_grid%my_column - left_grid_size = midpoint*slices*rows + left_grid_size = midpoint * slices * rows END IF !! Construct @@ -606,12 +609,12 @@ SUBROUTINE ComputeGridSize(total_processors, set_slices, rows, columns) rows = 1 columns = 1 - slice_size = total_processors/set_slices + slice_size = total_processors / set_slices size_search = FLOOR(SQRT(REAL(slice_size))) - DO II=size_search,1,-1 - IF (MOD(slice_size,II) .EQ. 0) THEN + DO II = size_search, 1, -1 + IF (MOD(slice_size, II) .EQ. 0) THEN rows = II - columns = slice_size/II + columns = slice_size / II EXIT END IF END DO @@ -646,7 +649,7 @@ SUBROUTINE ComputeNumSlices(total_processors, slices) !! If not, we try a grid where the rows are twice the number of columns. slice_dim = FLOOR(SQRT(REAL(slice_size/2))) - IF (slice_dim*slice_dim*2 .EQ. slice_size) THEN + IF (slice_dim*slice_dim * 2 .EQ. slice_size) THEN FOUND = .TRUE. EXIT END IF @@ -663,16 +666,16 @@ RECURSIVE SUBROUTINE WriteProcessGridInfo(this) IF (PRESENT(this)) THEN CALL WriteHeader("Process Grid") CALL EnterSubLog - CALL WriteListElement("Process Rows", & - & VALUE=this%num_process_rows) + CALL WriteListElement(key = "Process Rows", & + & VALUE = this%num_process_rows) CALL WriteListElement(key = "Process Columns", & - & VALUE=this%num_process_columns) + & VALUE = this%num_process_columns) CALL WriteListElement(key = "Process Slices", & - & VALUE=this%num_process_slices) + & VALUE = this%num_process_slices) CALL WriteListElement(key = "Column Blocks", & - & VALUE=this%number_of_blocks_columns) + & VALUE = this%number_of_blocks_columns) CALL WriteListElement(key = "Row Blocks", & - & VALUE=this%number_of_blocks_rows) + & VALUE = this%number_of_blocks_rows) CALL ExitSubLog ELSE CALL WriteProcessGridInfo(global_grid) diff --git a/Source/Fortran/RootSolversModule.F90 b/Source/Fortran/RootSolversModule.F90 index bb04c846..aba0c360 100644 --- a/Source/Fortran/RootSolversModule.F90 +++ b/Source/Fortran/RootSolversModule.F90 @@ -16,7 +16,8 @@ MODULE RootSolversModule USE PSMatrixModule, ONLY : Matrix_ps, ConstructEmptyMatrix, CopyMatrix, & & DestructMatrix, FillMatrixIdentity, PrintMatrixInformation USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters USE SquareRootSolversModule, ONLY : SquareRoot, InverseSquareRoot IMPLICIT NONE PRIVATE @@ -43,15 +44,15 @@ RECURSIVE SUBROUTINE ComputeRoot(InputMat, OutputMat, root, & !! Handle The Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN CALL WriteHeader("Root Solver") CALL EnterSubLog - CALL WriteElement(key="Root", VALUE=root) + CALL WriteElement(key = "Root", VALUE = root) CALL PrintParameters(params) END IF @@ -62,16 +63,14 @@ RECURSIVE SUBROUTINE ComputeRoot(InputMat, OutputMat, root, & CALL SquareRoot(InputMat, OutputMat, params) ELSE IF (root .EQ. 3) THEN CALL MatrixMultiply(InputMat, InputMat, TempMat, & - & threshold_in=params%threshold) - CALL ComputeRootImplementation(TempMat, OutputMat, 6, & - & params) + & threshold_in = params%threshold) + CALL ComputeRootImplementation(TempMat, OutputMat, 6, params) ELSE IF (root .EQ. 4) THEN CALL SquareRoot(InputMat, TempMat, params) CALL SquareRoot(TempMat, OutputMat, params) CALL DestructMatrix(TempMat) ELSE - CALL ComputeRootImplementation(InputMat, OutputMat, root, & - & params) + CALL ComputeRootImplementation(InputMat, OutputMat, root, params) END IF IF (params%be_verbose) THEN @@ -102,9 +101,9 @@ SUBROUTINE ComputeRootImplementation(InputMat, OutputMat, root, params) !! So first, we raise to the root-1 power CALL ConstructPolynomial(power_poly, root) DO II = 1, root-1 - CALL SetCoefficient(power_poly, II, REAL(0.0,NTREAL)) + CALL SetCoefficient(power_poly, II, 0.0_NTREAL) END DO - CALL SetCoefficient(power_poly, root, REAL(1.0,NTREAL)) + CALL SetCoefficient(power_poly, root, 1.0_NTREAL) CALL FactorizedCompute(InputMat, RaisedMat, power_poly, params) CALL DestructPolynomial(power_poly) @@ -113,7 +112,7 @@ SUBROUTINE ComputeRootImplementation(InputMat, OutputMat, root, params) !! Multiply by the original matrix CALL MatrixMultiply(InputMat, TempMat, OutputMat, & - & threshold_in=params%threshold) + & threshold_in = params%threshold) !! Cleanup CALL DestructMatrix(RaisedMat) @@ -137,17 +136,16 @@ RECURSIVE SUBROUTINE ComputeInverseRoot(InputMat, OutputMat, root, & TYPE(Matrix_ps) :: TempMat !! Handle The Optional Parameters - !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN CALL WriteHeader("Inverse Root Solver") CALL EnterSubLog - CALL WriteElement(key="Root", VALUE=root) + CALL WriteElement(key = "Root", VALUE = root) CALL PrintParameters(params) END IF @@ -157,7 +155,7 @@ RECURSIVE SUBROUTINE ComputeInverseRoot(InputMat, OutputMat, root, & ELSE IF (root .EQ. 2) THEN CALL InverseSquareRoot(InputMat, OutputMat, params) ELSE IF (root .EQ. 3) THEN - CALL ComputeRoot(InputMat,TempMat,3, params) + CALL ComputeRoot(InputMat, TempMat, 3, params) CALL Invert(TempMat, OutputMat, params) ELSE IF (root .EQ. 4) THEN CALL SquareRoot(InputMat, TempMat, params) @@ -216,17 +214,17 @@ SUBROUTINE ComputeInverseRootImplemention(InputMat, OutputMat, root, params) !! Compute The Scaling Factor CALL GershgorinBounds(InputMat, e_min, e_max) - scaling_factor = e_max/SQRT(2.0)**(1.0/root) + scaling_factor = e_max / SQRT(2.0)**(1.0 / root) !! Compute the target root (adjust for the fact that we just took the !! fourth root. target_root = 0 - IF (MOD(root,4) .EQ. 0) THEN - target_root = root/4 - ELSE IF (MOD(root,4) .EQ. 1 .OR. MOD(root,4) .EQ. 3) THEN + IF (MOD(root, 4) .EQ. 0) THEN + target_root = root / 4 + ELSE IF (MOD(root, 4) .EQ. 1 .OR. MOD(root, 4) .EQ. 3) THEN target_root = root ELSE - target_root = (root-2)/2 + 1 + target_root = (root - 2) / 2 + 1 END IF !! Initialize @@ -242,16 +240,16 @@ SUBROUTINE ComputeInverseRootImplemention(InputMat, OutputMat, root, params) !! Load Balancing Step IF (params%do_load_balancing) THEN CALL PermuteMatrix(FthrtMat, FthrtMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(IdentityMat, IdentityMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF CALL CopyMatrix(IdentityMat, OutputMat) - CALL ScaleMatrix(OutputMat, 1.0/scaling_factor) + CALL ScaleMatrix(OutputMat, 1.0 / scaling_factor) CALL CopyMatrix(FthrtMat, Mk) - CALL ScaleMatrix(Mk, 1.0/(scaling_factor**target_root)) + CALL ScaleMatrix(Mk, 1.0 / (scaling_factor**target_root)) CALL DestructMatrix(FthrtMat) CALL ConstructEmptyMatrix(IntermediateMat, InputMat) @@ -266,34 +264,33 @@ SUBROUTINE ComputeInverseRootImplemention(InputMat, OutputMat, root, params) norm_value = params%converge_diff + 1.0_NTREAL DO II = 1, params%max_iterations IF (params%be_verbose .AND. II .GT. 1) THEN - CALL WriteListElement(key="Convergence", VALUE=norm_value) + CALL WriteListElement(key = "Convergence", VALUE = norm_value) END IF CALL CopyMatrix(IdentityMat, IntermediateMat) CALL ScaleMatrix(IntermediateMat, & - & REAL(target_root+1,NTREAL)) + & REAL(target_root + 1, NTREAL)) CALL IncrementMatrix(Mk, IntermediateMat, & - & alpha_in=NEGATIVE_ONE) - CALL ScaleMatrix(IntermediateMat, & - & REAL(1.0,NTREAL)/target_root) + & alpha_in=-1.0_NTREAL) + CALL ScaleMatrix(IntermediateMat, 1.0_NTREAL/target_root) CALL MatrixMultiply(OutputMat, IntermediateMat, Temp, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL CopyMatrix(Temp, OutputMat) CALL CopyMatrix(IntermediateMat, IntermediateMatP) - DO JJ = 1, target_root-1 + DO JJ = 1, target_root - 1 CALL MatrixMultiply(IntermediateMat, IntermediateMatP, Temp, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL CopyMatrix(Temp, IntermediateMatP) END DO CALL MatrixMultiply(IntermediateMatP, Mk, Temp, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL CopyMatrix(Temp, Mk) CALL IncrementMatrix(IdentityMat, Temp, & - & alpha_in=NEGATIVE_ONE) + & alpha_in=-1.0_NTREAL) norm_value = MatrixNorm(Temp) IF (norm_value .LE. params%converge_diff) THEN @@ -302,25 +299,25 @@ SUBROUTINE ComputeInverseRootImplemention(InputMat, OutputMat, root, params) END DO IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=II-1) + CALL WriteElement(key = "Total Iterations", VALUE = II - 1) CALL PrintMatrixInformation(OutputMat) END IF - IF (MOD(root,4) .EQ. 1 .OR. MOD(root,4) .EQ. 3) THEN + IF (MOD(root, 4) .EQ. 1 .OR. MOD(root, 4) .EQ. 3) THEN CALL MatrixMultiply(OutputMat, OutputMat, Temp, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL MatrixMultiply(Temp, Temp, OutputMat, & - & threshold_in=params%threshold, memory_pool_in=pool) - ELSE IF (MOD(root,4) .NE. 0) THEN + & threshold_in = params%threshold, memory_pool_in = pool) + ELSE IF (MOD(root, 4) .NE. 0) THEN CALL MatrixMultiply(OutputMat, OutputMat, Temp, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL CopyMatrix(Temp, OutputMat) END IF !! Undo Load Balancing Step IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Cleanup diff --git a/Source/Fortran/SMatrixAlgebraModule.F90 b/Source/Fortran/SMatrixAlgebraModule.F90 index 9648babd..cd790e76 100644 --- a/Source/Fortran/SMatrixAlgebraModule.F90 +++ b/Source/Fortran/SMatrixAlgebraModule.F90 @@ -113,9 +113,9 @@ PURE SUBROUTINE IncrementMatrix_lsr(matA, matB, alpha_in, threshold_in) TYPE(Matrix_lsr), INTENT(IN) :: matA !> Matrix B. TYPE(Matrix_lsr), INTENT(INOUT) :: matB - !> Multiplier (default=1.0). + !> Multiplier (default = 1.0). REAL(NTREAL), OPTIONAL, INTENT(IN) :: alpha_in - !> For flushing values to zero (default=0). + !> For flushing values to zero (default = 0). REAL(NTREAL), OPTIONAL, INTENT(IN) :: threshold_in !! Local Variables TYPE(Matrix_lsr) :: matC @@ -130,9 +130,9 @@ PURE SUBROUTINE IncrementMatrix_lsc(matA, matB, alpha_in, threshold_in) TYPE(Matrix_lsc), INTENT(IN) :: matA !> Matrix B. TYPE(Matrix_lsc), INTENT(INOUT) :: matB - !> Multiplier (default=1.0). + !> Multiplier (default = 1.0). REAL(NTREAL), OPTIONAL, INTENT(IN) :: alpha_in - !> For flushing values to zero (default=0). + !> For flushing values to zero (default = 0). REAL(NTREAL), OPTIONAL, INTENT(IN) :: threshold_in !! Local Variables TYPE(Matrix_lsc) :: matC @@ -181,7 +181,7 @@ PURE SUBROUTINE DotMatrix_lsr(matA, matB, product) !! Local Variables TYPE(Matrix_lsr) :: matC - CALL PairwiseMultiplyMatrix(matA,matB,matC) + CALL PairwiseMultiplyMatrix(matA, matB, matC) CALL MatrixGrandSum(matC, product) CALL DestructMatrix(matC) @@ -462,7 +462,7 @@ PURE SUBROUTINE MultiplyBlock_lsr(matAT,matBT,memorypool) !> Memory pool to multiply into. TYPE(MatrixMemoryPool_lr), INTENT(INOUT) :: memorypool !! Temp Variables - REAL(NTREAL) :: temp_value_a, temp_value_b, temp_value_c + REAL(NTREAL) :: val_a, val_b, val_c #include "sparse_includes/MultiplyBlock.f90" END SUBROUTINE MultiplyBlock_lsr @@ -476,7 +476,7 @@ PURE SUBROUTINE MultiplyBlock_lsc(matAT,matBT,memorypool) !> Memory pool to multiply into. TYPE(MatrixMemoryPool_lc), INTENT(INOUT) :: memorypool !! Temp Variables - COMPLEX(NTCOMPLEX) :: temp_value_a, temp_value_b, temp_value_c + COMPLEX(NTCOMPLEX) :: val_a, val_b, val_c #include "sparse_includes/MultiplyBlock.f90" END SUBROUTINE MultiplyBlock_lsc diff --git a/Source/Fortran/SMatrixModule.F90 b/Source/Fortran/SMatrixModule.F90 index f02a84c3..2d4465d5 100644 --- a/Source/Fortran/SMatrixModule.F90 +++ b/Source/Fortran/SMatrixModule.F90 @@ -136,7 +136,6 @@ PURE SUBROUTINE ConstructEmptyMatrixSub_lsr(this, rows, columns, zero_in) LOGICAL, INTENT(IN), OPTIONAL :: zero_in #include "sparse_includes/ConstructEmptyMatrix.f90" - END SUBROUTINE ConstructEmptyMatrixSub_lsr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> A subroutine type wrapper for the constructor. @@ -151,7 +150,6 @@ PURE SUBROUTINE ConstructEmptyMatrixSub_lsc(this, rows, columns, zero_in) LOGICAL, INTENT(IN), OPTIONAL :: zero_in #include "sparse_includes/ConstructEmptyMatrix.f90" - END SUBROUTINE ConstructEmptyMatrixSub_lsc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Subroutine wrapper for the construct from file function. @@ -163,9 +161,9 @@ SUBROUTINE ConstructMatrixFromFileSub_lsr(this, file_name) !! About the matrix market file. INTEGER :: sparsity_type, data_type, pattern_type !! Local Data - TYPE(TripletList_r) :: triplet_list - TYPE(TripletList_r) :: sorted_triplet_list - TYPE(Triplet_r) :: temporary + TYPE(TripletList_r) :: tlist + TYPE(TripletList_r) :: sorted_tlist + TYPE(Triplet_r) :: temp #include "sparse_includes/ConstructMatrixFromFile.f90" END SUBROUTINE ConstructMatrixFromFileSub_lsr @@ -178,15 +176,14 @@ SUBROUTINE ConstructMatrixFromFileSub_lsc(this, file_name) !! About the matrix market file. INTEGER :: sparsity_type, data_type, pattern_type !! Local Data - TYPE(TripletList_c) :: triplet_list - TYPE(TripletList_c) :: sorted_triplet_list - TYPE(Triplet_c) :: temporary + TYPE(TripletList_c) :: tlist + TYPE(TripletList_c) :: sorted_tlist + TYPE(Triplet_c) :: temp REAL(NTREAL) :: real_val, comp_val #define ISCOMPLEX #include "sparse_includes/ConstructMatrixFromFile.f90" #undef ISCOMPLEX - END SUBROUTINE ConstructMatrixFromFileSub_lsc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> A subroutine wrapper for the triplet list based constructor. @@ -204,7 +201,6 @@ PURE SUBROUTINE ConstructMatrixFromTripletListSub_lsr(this, triplet_list, & #define ISCOMPLEX #include "sparse_includes/ConstructMatrixFromTripletList.f90" #undef ISCOMPLEX - END SUBROUTINE ConstructMatrixFromTripletListSub_lsr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> A subroutine wrapper for the triplet list based constructor. @@ -220,7 +216,6 @@ PURE SUBROUTINE ConstructMatrixFromTripletListSub_lsc(this, triplet_list, & INTEGER, INTENT(IN) :: columns #include "sparse_includes/ConstructMatrixFromTripletList.f90" - END SUBROUTINE ConstructMatrixFromTripletListSub_lsc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Explicitly destruct a sparse matrix. @@ -386,14 +381,13 @@ PURE SUBROUTINE ComposeMatrix_lsr(mat_array, block_rows, block_columns, & !> The number of columns of the array of blocks. INTEGER, INTENT(IN) :: block_columns !> 2d array of matrices to compose. - TYPE(Matrix_lsr), DIMENSION(block_rows,block_columns), INTENT(IN) :: & - & mat_array + TYPE(Matrix_lsr), DIMENSION(:, :), INTENT(IN) :: mat_array !> The composed matrix. TYPE(Matrix_lsr), INTENT(INOUT) :: out_matrix !! Local Data TYPE(Matrix_lsr), DIMENSION(block_columns) :: merged_columns TYPE(Matrix_lsr) :: Temp - TYPE(Matrix_lsr), DIMENSION(block_rows,block_columns) :: mat_t + TYPE(Matrix_lsr), DIMENSION(block_rows, block_columns) :: mat_t #include "sparse_includes/ComposeMatrix.f90" END SUBROUTINE ComposeMatrix_lsr @@ -407,14 +401,13 @@ PURE SUBROUTINE ComposeMatrix_lsc(mat_array, block_rows, block_columns, & !> The number of columns of the array of blocks. INTEGER, INTENT(IN) :: block_columns !> 2d array of matrices to compose. - TYPE(Matrix_lsc), DIMENSION(block_rows,block_columns), INTENT(IN) :: & - & mat_array + TYPE(Matrix_lsc), DIMENSION(:, :), INTENT(IN) :: mat_array !> The composed matrix. TYPE(Matrix_lsc), INTENT(INOUT) :: out_matrix !! Local Data TYPE(Matrix_lsc), DIMENSION(block_columns) :: merged_columns TYPE(Matrix_lsc) :: Temp - TYPE(Matrix_lsc), DIMENSION(block_rows,block_columns) :: mat_t + TYPE(Matrix_lsc), DIMENSION(block_rows, block_columns) :: mat_t #include "sparse_includes/ComposeMatrix.f90" END SUBROUTINE ComposeMatrix_lsc @@ -523,8 +516,6 @@ PURE SUBROUTINE MatrixToTripletList_lsr(this, triplet_list) TYPE(Matrix_lsr), INTENT(IN) :: this !> The triplet list we created. TYPE(TripletList_r), INTENT(INOUT) :: triplet_list - !! Local Variables - TYPE(Triplet_r) :: temporary #include "sparse_includes/MatrixToTripletList.f90" END SUBROUTINE MatrixToTripletList_lsr @@ -535,8 +526,6 @@ PURE SUBROUTINE MatrixToTripletList_lsc(this, triplet_list) TYPE(Matrix_lsc), INTENT(IN) :: this !> The triplet list we created. TYPE(TripletList_c), INTENT(INOUT) :: triplet_list - !! Local Variables - TYPE(Triplet_c) :: temporary #include "sparse_includes/MatrixToTripletList.f90" END SUBROUTINE MatrixToTripletList_lsc diff --git a/Source/Fortran/SignSolversModule.F90 b/Source/Fortran/SignSolversModule.F90 index 8a6cb24a..5eaf44f1 100644 --- a/Source/Fortran/SignSolversModule.F90 +++ b/Source/Fortran/SignSolversModule.F90 @@ -15,7 +15,8 @@ MODULE SignSolversModule & FillMatrixIdentity, PrintMatrixInformation, TransposeMatrix, & & ConjugateMatrix, ConstructEmptyMatrix USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters IMPLICIT NONE PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -36,9 +37,9 @@ SUBROUTINE SignFunction(InMat, OutMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN @@ -74,9 +75,9 @@ SUBROUTINE DenseSignFunction(InMat, OutputMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN @@ -108,9 +109,9 @@ SUBROUTINE PolarDecomposition(InMat, Umat, Hmat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN @@ -131,7 +132,7 @@ SUBROUTINE PolarDecomposition(InMat, Umat, Hmat, solver_parameters_in) CALL ConjugateMatrix(UmatT) END IF CALL MatrixMultiply(UmatT, InMat, Hmat, & - & threshold_in=params%threshold) + & threshold_in = params%threshold) CALL DestructMatrix(UmatT) END IF @@ -178,17 +179,17 @@ SUBROUTINE CoreComputation(InMat, OutMat, params, needs_transpose) IF (params%do_load_balancing) THEN !! Permute Matrices CALL PermuteMatrix(Identity, Identity, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(InMat, OutMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) ELSE CALL CopyMatrix(InMat, OutMat) END IF !! Initialize CALL GershgorinBounds(InMat, e_min, e_max) - xk = ABS(e_min/e_max) - CALL ScaleMatrix(OutMat, 1.0_NTREAL/ABS(e_max)) + xk = ABS(e_min / e_max) + CALL ScaleMatrix(OutMat, 1.0_NTREAL / ABS(e_max)) !! Iterate. IF (params%be_verbose) THEN @@ -199,12 +200,12 @@ SUBROUTINE CoreComputation(InMat, OutMat, params, needs_transpose) norm_value = params%converge_diff + 1.0_NTREAL iterate: DO II = 1, params%max_iterations IF (params%be_verbose .AND. II .GT. 1) THEN - CALL WriteListElement(key="Convergence", VALUE=norm_value) + CALL WriteListElement(key = "Convergence", VALUE = norm_value) END IF !! Update Scaling Factors - alpha_k = MIN(SQRT(3.0_NTREAL/(1.0_NTREAL+xk+xk**2)), alpha) - xk = 0.5_NTREAL*alpha_k*xk*(3.0_NTREAL-(alpha_k**2)*xk**2) + alpha_k = MIN(SQRT(3.0_NTREAL / (1.0_NTREAL + xk + xk**2)), alpha) + xk = 0.5_NTREAL * alpha_k * xk * (3.0_NTREAL - (alpha_k**2) * xk**2) IF (needs_transpose) THEN CALL TransposeMatrix(OutMat, OutMatT) @@ -212,19 +213,20 @@ SUBROUTINE CoreComputation(InMat, OutMat, params, needs_transpose) CALL ConjugateMatrix(OutMatT) END IF CALL MatrixMultiply(OutMatT, OutMat, Temp1, & - & alpha_in=-1.0_NTREAL*alpha_k**2, & - & threshold_in=params%threshold, memory_pool_in=pool) + & alpha_in = -1.0_NTREAL * alpha_k**2, & + & threshold_in = params%threshold, memory_pool_in = pool) ELSE CALL MatrixMultiply(OutMat, OutMat, Temp1, & - & alpha_in=-1.0_NTREAL*alpha_k**2, & - & threshold_in=params%threshold, memory_pool_in=pool) + & alpha_in = -1.0_NTREAL * alpha_k**2, & + & threshold_in = params%threshold, memory_pool_in = pool) END IF - CALL IncrementMatrix(Identity, Temp1, alpha_in=3.0_NTREAL) + CALL IncrementMatrix(Identity, Temp1, alpha_in = 3.0_NTREAL) - CALL MatrixMultiply(OutMat, Temp1, Temp2, alpha_in=0.5_NTREAL*alpha_k, & - & threshold_in=params%threshold, memory_pool_in=pool) + CALL MatrixMultiply(OutMat, Temp1, Temp2, & + & alpha_in = 0.5_NTREAL * alpha_k, & + & threshold_in = params%threshold, memory_pool_in = pool) - CALL IncrementMatrix(Temp2, OutMat, alpha_in=-1.0_NTREAL) + CALL IncrementMatrix(Temp2, OutMat, alpha_in = -1.0_NTREAL) norm_value = MatrixNorm(OutMat) CALL CopyMatrix(Temp2, OutMat) @@ -234,14 +236,14 @@ SUBROUTINE CoreComputation(InMat, OutMat, params, needs_transpose) END DO iterate IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=II-1) + CALL WriteElement(key = "Total Iterations", VALUE = II - 1) CALL PrintMatrixInformation(OutMat) END IF !! Undo Load Balancing Step IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutMat,OutMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF CALL DestructMatrix(Temp1) @@ -253,10 +255,10 @@ END SUBROUTINE CoreComputation !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Prototypical sign function for mapping. FUNCTION SignLambda(val) RESULT(outval) - REAL(KIND=NTREAL), INTENT(IN) :: val - REAL(KIND=NTREAL) :: outval + REAL(KIND = NTREAL), INTENT(IN) :: val + REAL(KIND = NTREAL) :: outval - IF (val < 0.0_NTREAL) THEN + IF (val .LT. 0.0_NTREAL) THEN outval = -1.0_NTREAL ELSE outval = 1.0_NTREAL diff --git a/Source/Fortran/SingularValueSolversModule.F90 b/Source/Fortran/SingularValueSolversModule.F90 index 23f9e013..8ddaa439 100644 --- a/Source/Fortran/SingularValueSolversModule.F90 +++ b/Source/Fortran/SingularValueSolversModule.F90 @@ -7,7 +7,8 @@ MODULE SingularValueSolversModule USE PSMatrixModule, ONLY : Matrix_ps, DestructMatrix USE SignSolversModule, ONLY : PolarDecomposition USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters IMPLICIT NONE PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -33,15 +34,15 @@ SUBROUTINE SingularValueDecomposition(this, left_vectors, & !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN CALL WriteHeader("Singular Value Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Polar") + CALL WriteElement(key = "Method", VALUE="Polar") CALL PrintParameters(params) END IF @@ -50,11 +51,11 @@ SUBROUTINE SingularValueDecomposition(this, left_vectors, & !! Compute the eigen decomposition of the hermitian matrix CALL EigenDecomposition(HMat, singularvalues, & - & eigenvectors_in=right_vectors, solver_parameters_in=params) + & eigenvectors_in = right_vectors, solver_parameters_in = params) !! Compute the left singular vectors CALL MatrixMultiply(UMat, right_vectors, left_vectors, & - & threshold_in=params%threshold) + & threshold_in = params%threshold) !! Cleanup IF (params%be_verbose) THEN diff --git a/Source/Fortran/SolverParametersModule.F90 b/Source/Fortran/SolverParametersModule.F90 index a125fd56..b87ae69e 100644 --- a/Source/Fortran/SolverParametersModule.F90 +++ b/Source/Fortran/SolverParametersModule.F90 @@ -4,7 +4,8 @@ MODULE SolverParametersModule USE DataTypesModule, ONLY : NTREAL USE LoggingModule, ONLY : EnterSubLog, ExitSubLog, WriteElement, & & WriteHeader - USE PermutationModule, ONLY : Permutation_t, DestructPermutation + USE PermutationModule, ONLY : Permutation_t, CopyPermutation, & + & DestructPermutation IMPLICIT NONE PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -23,11 +24,9 @@ MODULE SolverParametersModule !> The permutation used for load balancing. TYPE(Permutation_t) :: BalancePermutation END TYPE SolverParameters_t -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - INTERFACE SolverParameters_t - MODULE PROCEDURE SolverParameters_init - END INTERFACE SolverParameters_t !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + PUBLIC :: ConstructSolverParameters + PUBLIC :: CopySolverParameters PUBLIC :: SetParametersConvergeDiff PUBLIC :: SetParametersMaxIterations PUBLIC :: SetParametersThreshold @@ -42,8 +41,10 @@ MODULE SolverParametersModule INTEGER, PARAMETER, PUBLIC :: MAX_ITERATIONS_CONST = 1000 CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Construct a data type which stores iterative solver parameters. - PURE FUNCTION SolverParameters_init(converge_diff_in, threshold_in, & - & max_iterations_in, be_verbose_in, BalancePermutation_in) RESULT(this) + SUBROUTINE ConstructSolverParameters(this, converge_diff_in, threshold_in, & + & max_iterations_in, be_verbose_in, BalancePermutation_in) + !> The parameters to construct. + TYPE(SolverParameters_t), INTENT(INOUT) :: this !> Converge_diff_in the difference between iterations to consider !> a calculation converged. REAL(NTREAL), INTENT(IN), OPTIONAL :: converge_diff_in @@ -55,7 +56,8 @@ PURE FUNCTION SolverParameters_init(converge_diff_in, threshold_in, & LOGICAL, INTENT(IN), OPTIONAL :: be_verbose_in !> For load balancing TYPE(Permutation_t), INTENT(IN), OPTIONAL :: BalancePermutation_in - TYPE(SolverParameters_t) :: this + + CALL DestructSolverParameters(this) !! Optional Parameters IF (.NOT. PRESENT(converge_diff_in)) THEN @@ -82,9 +84,19 @@ PURE FUNCTION SolverParameters_init(converge_diff_in, threshold_in, & this%do_load_balancing = .FALSE. ELSE this%do_load_balancing = .TRUE. - this%BalancePermutation = BalancePermutation_in + CALL CopyPermutation(BalancePermutation_in, this%BalancePermutation) END IF - END FUNCTION SolverParameters_init + END SUBROUTINE ConstructSolverParameters +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE CopySolverParameters(paramA, paramB) + !> Parameters to copy + TYPE(SolverParameters_t), INTENT(IN) :: paramA + !> paramB = paramA + TYPE(SolverParameters_t), INTENT(INOUT) :: paramB + + CALL DestructSolverParameters(paramB) + paramB = paramA + END SUBROUTINE CopySolverParameters !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Set the value of the convergence difference. PURE SUBROUTINE SetParametersConvergeDiff(this,new_value) @@ -144,11 +156,16 @@ SUBROUTINE PrintParameters(this) CALL WriteHeader("Solver Parameters") CALL EnterSubLog - CALL WriteElement(key="be_verbose", VALUE=this%be_verbose) - CALL WriteElement(key="do_load_balancing", VALUE=this%do_load_balancing) - CALL WriteElement(key="converge_diff", VALUE=this%converge_diff) - CALL WriteElement(key="threshold", VALUE=this%threshold) - CALL WriteElement(key="max_iterations", VALUE=this%max_iterations) + CALL WriteElement(key = "Verbosity", & + & VALUE = this%be_verbose) + CALL WriteElement(key = "Load Balancing", & + & VALUE = this%do_load_balancing) + CALL WriteElement(key = "Convergence Difference", & + & VALUE = this%converge_diff) + CALL WriteElement(key = "Threshold", & + & VALUE = this%threshold) + CALL WriteElement(key = "Maximum Iterations", & + & VALUE = this%max_iterations) CALL ExitSubLog END SUBROUTINE PrintParameters !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/Source/Fortran/SquareRootSolversModule.F90 b/Source/Fortran/SquareRootSolversModule.F90 index 109b7a72..b4c68c45 100644 --- a/Source/Fortran/SquareRootSolversModule.F90 +++ b/Source/Fortran/SquareRootSolversModule.F90 @@ -14,7 +14,8 @@ MODULE SquareRootSolversModule USE PSMatrixModule, ONLY : Matrix_ps, ConstructEmptyMatrix, CopyMatrix, & & DestructMatrix, FillMatrixIdentity, PrintMatrixInformation USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters IMPLICIT NONE PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -37,12 +38,14 @@ SUBROUTINE SquareRoot(InputMat, OutputMat, solver_parameters_in, order_in) !! Local Variables TYPE(SolverParameters_t) :: params + !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF + !! Call routine with the desired order. IF (PRESENT(order_in)) THEN CALL SquareRootSelector(InputMat, OutputMat, params, .FALSE.,& & order_in) @@ -67,9 +70,9 @@ SUBROUTINE DenseSquareRoot(Mat, OutputMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN @@ -103,12 +106,14 @@ SUBROUTINE InverseSquareRoot(InputMat, OutputMat, solver_parameters_in, & !! Local Variables TYPE(SolverParameters_t) :: params + !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF + !! Call routine with the desired order. IF (PRESENT(order_in)) THEN CALL SquareRootSelector(InputMat, OutputMat, params, .TRUE., order_in) ELSE @@ -133,9 +138,9 @@ SUBROUTINE DenseInverseSquareRoot(Mat, OutputMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN @@ -165,7 +170,7 @@ SUBROUTINE SquareRootSelector(InputMat, OutputMat, params, & TYPE(SolverParameters_t),INTENT(IN) :: params !> True if we are computing the inverse square root. LOGICAL, INTENT(IN) :: compute_inverse - !> The polynomial degree to use (optional, default=5) + !> The polynomial degree to use (optional, default = 5) INTEGER, INTENT(IN), OPTIONAL :: order_in !! Local Variables INTEGER :: order @@ -232,7 +237,7 @@ SUBROUTINE NewtonSchultzISROrder2(InMat, OutMat, params, compute_inverse) !! Compute the lambda scaling value. CALL GershgorinBounds(InMat, e_min, e_max) max_between = MAX(ABS(e_min), ABS(e_max)) - lambda = 1.0/max_between + lambda = 1.0 / max_between !! Initialize CALL FillMatrixIdentity(InverseSquareRootMat) @@ -241,11 +246,11 @@ SUBROUTINE NewtonSchultzISROrder2(InMat, OutMat, params, compute_inverse) !! Load Balancing Step IF (params%do_load_balancing) THEN CALL PermuteMatrix(SquareRootMat, SquareRootMat, & - & params%BalancePermutation, memorypool_in=mpool) + & params%BalancePermutation, memorypool_in = mpool) CALL PermuteMatrix(Identity, Identity, & - & params%BalancePermutation, memorypool_in=mpool) + & params%BalancePermutation, memorypool_in = mpool) CALL PermuteMatrix(InverseSquareRootMat, InverseSquareRootMat, & - & params%BalancePermutation, memorypool_in=mpool) + & params%BalancePermutation, memorypool_in = mpool) END IF !! Iterate. @@ -255,41 +260,43 @@ SUBROUTINE NewtonSchultzISROrder2(InMat, OutMat, params, compute_inverse) END IF II = 1 norm_value = params%converge_diff + 1.0_NTREAL - DO II = 1,params%max_iterations + DO II = 1, params%max_iterations !! Compute X_k CALL MatrixMultiply(SquareRootMat, InverseSquareRootMat, X_k, & - & threshold_in=params%threshold, memory_pool_in=mpool) + & threshold_in = params%threshold, memory_pool_in = mpool) CALL GershgorinBounds(X_k, e_min, e_max) max_between = MAX(ABS(e_min), ABS(e_max)) - lambda = 1.0/max_between + lambda = 1.0 / max_between CALL ScaleMatrix(X_k, lambda) !! Check if Converged CALL CopyMatrix(Identity, Temp) - CALL IncrementMatrix(X_k, Temp, REAL(-1.0,NTREAL)) + CALL IncrementMatrix(X_k, Temp, & + & alpha_in = -1.0_NTREAL) norm_value = MatrixNorm(Temp) !! Compute T_k CALL CopyMatrix(Identity, T_k) - CALL ScaleMatrix(T_k, REAL(3.0,NTREAL)) - CALL IncrementMatrix(X_k, T_k, REAL(-1.0,NTREAL)) - CALL ScaleMatrix(T_k, REAL(0.5,NTREAL)) + CALL ScaleMatrix(T_k, 3.0_NTREAL) + CALL IncrementMatrix(X_k, T_k, & + & alpha_in = -1.0_NTREAL) + CALL ScaleMatrix(T_k, 0.5_NTREAL) !! Compute Z_k+1 CALL CopyMatrix(InverseSquareRootMat, Temp) CALL MatrixMultiply(Temp, T_k, InverseSquareRootMat, & - & threshold_in=params%threshold, memory_pool_in=mpool) + & threshold_in = params%threshold, memory_pool_in = mpool) CALL ScaleMatrix(InverseSquareRootMat, SQRT(lambda)) !! Compute Y_k+1 CALL CopyMatrix(SquareRootMat, Temp) CALL MatrixMultiply(T_k, Temp, SquareRootMat, & - & threshold_in=params%threshold, memory_pool_in=mpool) + & threshold_in = params%threshold, memory_pool_in = mpool) CALL ScaleMatrix(SquareRootMat, SQRT(lambda)) IF (params%be_verbose) THEN - CALL WriteElement(key="Convergence", VALUE=norm_value) + CALL WriteElement(key = "Convergence", VALUE = norm_value) END IF IF (norm_value .LE. params%converge_diff) THEN @@ -298,7 +305,7 @@ SUBROUTINE NewtonSchultzISROrder2(InMat, OutMat, params, compute_inverse) END DO IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=II) + CALL WriteElement(key = "Total Iterations", VALUE = II) CALL PrintMatrixInformation(InverseSquareRootMat) END IF @@ -311,7 +318,7 @@ SUBROUTINE NewtonSchultzISROrder2(InMat, OutMat, params, compute_inverse) !! Undo Load Balancing Step IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutMat, OutMat, & - & params%BalancePermutation, memorypool_in=mpool) + & params%BalancePermutation, memorypool_in = mpool) END IF !! Cleanup @@ -379,7 +386,7 @@ SUBROUTINE NewtonSchultzISRTaylor(InMat, OutMat, params, & !! Compute the lambda scaling value. CALL GershgorinBounds(InMat, e_min, e_max) max_between = MAX(ABS(e_min), ABS(e_max)) - lambda = 1.0_NTREAL/max_between + lambda = 1.0_NTREAL / max_between !! Initialize CALL FillMatrixIdentity(InverseSquareRootMat) @@ -389,11 +396,11 @@ SUBROUTINE NewtonSchultzISRTaylor(InMat, OutMat, params, & !! Load Balancing Step IF (params%do_load_balancing) THEN CALL PermuteMatrix(SquareRootMat, SquareRootMat, & - & params%BalancePermutation, memorypool_in=mpool) + & params%BalancePermutation, memorypool_in = mpool) CALL PermuteMatrix(Identity, Identity, & - & params%BalancePermutation, memorypool_in=mpool) + & params%BalancePermutation, memorypool_in = mpool) CALL PermuteMatrix(InverseSquareRootMat, InverseSquareRootMat, & - & params%BalancePermutation, memorypool_in=mpool) + & params%BalancePermutation, memorypool_in = mpool) END IF !! Iterate. @@ -406,15 +413,15 @@ SUBROUTINE NewtonSchultzISRTaylor(InMat, OutMat, params, & DO II = 1, params%max_iterations !! Compute X_k = Z_k * Y_k - I CALL MatrixMultiply(InverseSquareRootMat, SquareRootMat, X_k, & - & threshold_in=params%threshold, memory_pool_in=mpool) - CALL IncrementMatrix(Identity,X_k,-1.0_NTREAL) + & threshold_in = params%threshold, memory_pool_in = mpool) + CALL IncrementMatrix(Identity, X_k, -1.0_NTREAL) norm_value = MatrixNorm(X_k) SELECT CASE(taylor_order) CASE(3) !! Compute X_k^2 CALL MatrixMultiply(X_k, X_k, Temp, & - & threshold_in=params%threshold, memory_pool_in=mpool) + & threshold_in = params%threshold, memory_pool_in = mpool) !! X_k = I - 1/2 X_k + 3/8 X_k^2 + ... CALL ScaleMatrix(X_k, -0.5_NTREAL) @@ -423,10 +430,10 @@ SUBROUTINE NewtonSchultzISRTaylor(InMat, OutMat, params, & CASE(5) !! Compute p(x) = x^4 + A*x^3 + B*x^2 + C*x + D !! Scale to make coefficient of x^4 equal to 1 - aa = -40.0_NTREAL/35.0_NTREAL - bb = 48.0_NTREAL/35.0_NTREAL - cc = -64.0_NTREAL/35.0_NTREAL - dd = 128.0_NTREAL/35.0_NTREAL + aa = -40.0_NTREAL / 35.0_NTREAL + bb = 48.0_NTREAL / 35.0_NTREAL + cc = -64.0_NTREAL / 35.0_NTREAL + dd = 128.0_NTREAL / 35.0_NTREAL !! The method of Knuth !! p = (z+x+b) * (z+c) + d @@ -435,15 +442,16 @@ SUBROUTINE NewtonSchultzISRTaylor(InMat, OutMat, params, & !! b = B*(a+1) - C - a*(a+1)*(a+1) !! c = B - b - a*(a+1) !! d = D - b*c - a = (aa-1.0_NTREAL)/2.0_NTREAL - b = bb*(a+1.0_NTREAL)-cc-a*(a+1.0_NTREAL)**2 - c = bb-b-a*(a+1.0_NTREAL) - d = dd-b*c + a = (aa - 1.0_NTREAL) / 2.0_NTREAL + b = bb*(a + 1.0_NTREAL) - cc - a * (a + 1.0_NTREAL)**2 + c = bb - b - a * (a + 1.0_NTREAL) + d = dd - b * c !! Compute Temp = z = x * (x+a) CALL MatrixMultiply(X_k, X_k, Temp, & - & threshold_in=params%threshold, memory_pool_in=mpool) - CALL IncrementMatrix(X_k, Temp, a) + & threshold_in = params%threshold, memory_pool_in = mpool) + CALL IncrementMatrix(X_k, Temp, & + & alpha_in = a) !! Compute Temp2 = z + x + b CALL CopyMatrix(Identity, Temp2) @@ -456,25 +464,25 @@ SUBROUTINE NewtonSchultzISRTaylor(InMat, OutMat, params, & !! Compute X_k = (z+x+b) * (z+c) + d = Temp2 * Temp + d CALL MatrixMultiply(Temp2, Temp, X_k, & - & threshold_in=params%threshold, memory_pool_in=mpool) - CALL IncrementMatrix(Identity,X_k,d) + & threshold_in = params%threshold, memory_pool_in = mpool) + CALL IncrementMatrix(Identity, X_k, d) !! Scale back to the target coefficients - CALL ScaleMatrix(X_k, 35.0_NTREAL/128.0_NTREAL) + CALL ScaleMatrix(X_k, 35.0_NTREAL / 128.0_NTREAL) END SELECT !! Compute Z_k+1 = Z_k * X_k CALL CopyMatrix(InverseSquareRootMat, Temp) CALL MatrixMultiply(X_k, Temp, InverseSquareRootMat, & - & threshold_in=params%threshold,memory_pool_in=mpool) + & threshold_in = params%threshold, memory_pool_in = mpool) !! Compute Y_k+1 = X_k * Y_k CALL CopyMatrix(SquareRootMat, Temp) CALL MatrixMultiply(Temp, X_k, SquareRootMat, & - & threshold_in=params%threshold,memory_pool_in=mpool) + & threshold_in = params%threshold, memory_pool_in = mpool) IF (params%be_verbose) THEN - CALL WriteListElement(key="Convergence", VALUE=norm_value) + CALL WriteListElement(key = "Convergence", VALUE = norm_value) END IF IF (norm_value .LE. params%converge_diff) THEN @@ -483,7 +491,7 @@ SUBROUTINE NewtonSchultzISRTaylor(InMat, OutMat, params, & END DO IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=II) + CALL WriteElement(key = "Total Iterations", VALUE = II) CALL PrintMatrixInformation(InverseSquareRootMat) END IF @@ -491,14 +499,14 @@ SUBROUTINE NewtonSchultzISRTaylor(InMat, OutMat, params, & CALL ScaleMatrix(InverseSquareRootMat, SQRT(lambda)) CALL CopyMatrix(InverseSquareRootMat, OutMat) ELSE - CALL ScaleMatrix(SquareRootMat, 1.0_NTREAL/SQRT(lambda)) + CALL ScaleMatrix(SquareRootMat, 1.0_NTREAL / SQRT(lambda)) CALL CopyMatrix(SquareRootMat, OutMat) END IF !! Undo Load Balancing Step IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutMat, OutMat, & - & params%BalancePermutation,memorypool_in=mpool) + & params%BalancePermutation, memorypool_in = mpool) END IF !! Cleanup @@ -519,18 +527,18 @@ END SUBROUTINE NewtonSchultzISRTaylor !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Prototypical square root function. FUNCTION SquareRootLambda(val) RESULT(outval) - REAL(KIND=NTREAL), INTENT(IN) :: val - REAL(KIND=NTREAL) :: outval + REAL(KIND = NTREAL), INTENT(IN) :: val + REAL(KIND = NTREAL) :: outval outval = SQRT(val) END FUNCTION SquareRootLambda !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Prototypical inverse square root function. FUNCTION InverseSquareRootLambda(val) RESULT(outval) - REAL(KIND=NTREAL), INTENT(IN) :: val - REAL(KIND=NTREAL) :: outval + REAL(KIND = NTREAL), INTENT(IN) :: val + REAL(KIND = NTREAL) :: outval - outval = 1.0/SQRT(val) + outval = 1.0 / SQRT(val) END FUNCTION InverseSquareRootLambda !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE SquareRootSolversModule diff --git a/Source/Fortran/TimerModule.F90 b/Source/Fortran/TimerModule.F90 index fd66703f..e77e44ce 100644 --- a/Source/Fortran/TimerModule.F90 +++ b/Source/Fortran/TimerModule.F90 @@ -1,16 +1,17 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> A module to do timings. MODULE TimerModule + USE DataTypesModule, ONLY : NTREAL USE LoggingModule, ONLY : EnterSubLog, ExitSubLog, WriteElement, & & WriteHeader USE ProcessGridModule, ONLY : global_grid USE NTMPIModule IMPLICIT NONE PRIVATE - LOGICAL :: is_initialized = .FALSE. - CHARACTER(len=20), DIMENSION(:), ALLOCATABLE :: timer_list - DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: start_times - DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: elapsed_times + INTEGER, PARAMETER :: name_len = 50 + CHARACTER(LEN = name_len), DIMENSION(:), ALLOCATABLE, SAVE :: timer_list + REAL(NTREAL), DIMENSION(:), ALLOCATABLE, SAVE :: start_times + REAL(NTREAL), DIMENSION(:), ALLOCATABLE, SAVE:: elapsed_times !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PUBLIC :: RegisterTimer PUBLIC :: StartTimer @@ -22,13 +23,13 @@ MODULE TimerModule !> Register a timer with the timer module. Call this before using that timer. SUBROUTINE RegisterTimer(timer_name) !> Name of the timer. - CHARACTER(len=*), INTENT(IN) :: timer_name + CHARACTER(LEN = *), INTENT(IN) :: timer_name !! Local Data - CHARACTER(len=20), DIMENSION(:), ALLOCATABLE :: temp_timer_list - DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: temp_start_times - DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: temp_elapsed_times + CHARACTER(LEN = name_len), DIMENSION(:), ALLOCATABLE :: temp_timer_list + REAL(NTREAL), DIMENSION(:), ALLOCATABLE :: temp_start_times + REAL(NTREAL), DIMENSION(:), ALLOCATABLE :: temp_elapsed_times - IF (is_initialized) THEN + IF (ALLOCATED(timer_list)) THEN ALLOCATE(temp_timer_list(SIZE(timer_list)+1)) ALLOCATE(temp_start_times(SIZE(start_times)+1)) ALLOCATE(temp_elapsed_times(SIZE(elapsed_times)+1)) @@ -46,39 +47,38 @@ SUBROUTINE RegisterTimer(timer_name) ALLOCATE(elapsed_times(1)) timer_list(1) = timer_name elapsed_times(1) = 0 - is_initialized = .TRUE. END IF END SUBROUTINE RegisterTimer !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Start the clock running for a given timer. SUBROUTINE StartTimer(timer_name) !> Name of the timer. Must be registered. - CHARACTER(len=*), INTENT(IN) :: timer_name + CHARACTER(LEN = *), INTENT(IN) :: timer_name !! Local Data - INTEGER :: timer_position - DOUBLE PRECISION :: temp_time + INTEGER :: II + REAL(NTREAL) :: temp_time temp_time = MPI_WTIME() - timer_position = GetTimerPosition(timer_name) - IF (timer_position > 0) THEN - start_times(timer_position) = temp_time + II = GetTimerPosition(timer_name) + IF (II .GT. 0) THEN + start_times(II) = temp_time END IF END SUBROUTINE StartTimer !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Stop the clock for a given timer. SUBROUTINE StopTimer(timer_name) !> Name of the timer. Must be registered. - CHARACTER(len=*), INTENT(IN) :: timer_name + CHARACTER(LEN = *), INTENT(IN) :: timer_name !! Local Data - INTEGER :: timer_position - DOUBLE PRECISION :: temp_elapsed_time - DOUBLE PRECISION :: temp_start_time + INTEGER :: II + REAL(NTREAL):: temp_elapsed_time + REAL(NTREAL) :: temp_start_time - timer_position = GetTimerPosition(timer_name) - IF (timer_position > 0) THEN + II = GetTimerPosition(timer_name) + IF (II .GT. 0) THEN temp_elapsed_time = MPI_WTIME() - temp_start_time = start_times(timer_position) - elapsed_times(timer_position) = elapsed_times(timer_position) + & + temp_start_time = start_times(II) + elapsed_times(II) = elapsed_times(II) + & & temp_elapsed_time - temp_start_time END IF END SUBROUTINE StopTimer @@ -86,16 +86,15 @@ END SUBROUTINE StopTimer !> Print out the elapsed time for a given timer. SUBROUTINE PrintTimer(timer_name) !> Name of the timer. Must be registered. - CHARACTER(len=*), INTENT(IN) :: timer_name + CHARACTER(LEN = *), INTENT(IN) :: timer_name !! Local Data - INTEGER :: timer_position + INTEGER :: II - timer_position = GetTimerPosition(timer_name) + II = GetTimerPosition(timer_name) CALL WriteHeader("Timers") CALL EnterSubLog - IF (timer_position > 0) THEN - CALL WriteElement(key=timer_name, & - & VALUE=elapsed_times(timer_position)) + IF (II > 0) THEN + CALL WriteElement(key = timer_name, VALUE = elapsed_times(II)) END IF CALL ExitSubLog END SUBROUTINE PrintTimer @@ -103,13 +102,12 @@ END SUBROUTINE PrintTimer !> Print out the elapsed time for each timer on this process. SUBROUTINE PrintAllTimers() !! Local Data - INTEGER :: timer_position + INTEGER :: II CALL WriteHeader("Timers") CALL EnterSubLog - DO timer_position = LBOUND(timer_list,dim=1), UBOUND(timer_list,dim=1) - CALL WriteElement(key=timer_list(timer_position), & - & VALUE=elapsed_times(timer_position)) + DO II = LBOUND(timer_list, dim = 1), UBOUND(timer_list, dim = 1) + CALL WriteElement(key = timer_list(II), VALUE = elapsed_times(II)) END DO CALL ExitSubLog END SUBROUTINE PrintAllTimers @@ -118,20 +116,19 @@ END SUBROUTINE PrintAllTimers !> processes. SUBROUTINE PrintAllTimersDistributed() !! Local Data - INTEGER :: timer_position - DOUBLE PRECISION :: elapsed - DOUBLE PRECISION :: max_time - INTEGER :: ierr + INTEGER :: II + REAL(NTREAL) :: elapsed + REAL(NTREAL) :: max_time + INTEGER :: ierr CALL WriteHeader("Timers") CALL EnterSubLog - DO timer_position = LBOUND(timer_list,dim=1), UBOUND(timer_list,dim=1) - elapsed = elapsed_times(timer_position) + DO II = LBOUND(timer_list, dim = 1), UBOUND(timer_list, dim = 1) + elapsed = elapsed_times(II) CALL MPI_Allreduce(elapsed, max_time, 1, MPI_DOUBLE_PRECISION ,MPI_MAX, & & global_grid%global_comm, ierr) - CALL WriteElement(key=timer_list(timer_position), & - & VALUE=max_time) + CALL WriteElement(key = timer_list(II), VALUE = max_time) END DO CALL ExitSubLog @@ -142,18 +139,18 @@ END SUBROUTINE PrintAllTimersDistributed FUNCTION GetTimerPosition(timer_name) RESULT(timer_position) !! Parameters !> Name of the timer. - CHARACTER(len=*), INTENT(IN) :: timer_name + CHARACTER(LEN = *), INTENT(IN) :: timer_name !> The position of the timer. 0 means the timer has not been registered. INTEGER :: timer_position !! Local Data - INTEGER :: counter + INTEGER :: II LOGICAL :: not_found not_found = .TRUE. - IF (is_initialized) THEN - DO counter=1, SIZE(timer_list) - IF (timer_name .EQ. timer_list(counter)) THEN + IF (ALLOCATED(timer_list)) THEN + DO II = 1, SIZE(timer_list) + IF (timer_name .EQ. timer_list(II)) THEN not_found = .FALSE. EXIT END IF @@ -163,7 +160,7 @@ FUNCTION GetTimerPosition(timer_name) RESULT(timer_position) IF (not_found) THEN timer_position = 0 ELSE - timer_position = counter + timer_position = II END IF END FUNCTION GetTimerPosition !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/Source/Fortran/TrigonometrySolversModule.F90 b/Source/Fortran/TrigonometrySolversModule.F90 index a6c569cd..d08c6ac4 100644 --- a/Source/Fortran/TrigonometrySolversModule.F90 +++ b/Source/Fortran/TrigonometrySolversModule.F90 @@ -14,7 +14,8 @@ MODULE TrigonometrySolversModule USE PSMatrixModule, ONLY : Matrix_ps, ConstructEmptyMatrix, CopyMatrix, & & DestructMatrix, FillMatrixIdentity USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & - & DestructSolverParameters + & DestructSolverParameters, ConstructSolverParameters, & + & CopySolverParameters IMPLICIT NONE PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -38,13 +39,13 @@ SUBROUTINE Sine(InputMat, OutputMat, solver_parameters_in) !! A temporary matrix to hold the transformation from sine to cosine. TYPE(Matrix_ps) :: ShiftedMat TYPE(Matrix_ps) :: IdentityMat - REAL(NTREAL), PARAMETER :: PI = 4*ATAN(1.00_NTREAL) + REAL(NTREAL), PARAMETER :: PI = 4 * ATAN(1.00_NTREAL) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF !! Shift @@ -52,7 +53,7 @@ SUBROUTINE Sine(InputMat, OutputMat, solver_parameters_in) CALL ConstructEmptyMatrix(IdentityMat, InputMat) CALL FillMatrixIdentity(IdentityMat) CALL IncrementMatrix(IdentityMat, ShiftedMat, & - & alpha_in=REAL(-1.0_NTREAL*PI/2.0_NTREAL,NTREAL)) + & alpha_in = -1.0_NTREAL * PI / 2.0_NTREAL) CALL DestructMatrix(IdentityMat) CALL ScaleSquareTrigonometry(ShiftedMat, OutputMat, solver_parameters_in) @@ -75,9 +76,9 @@ SUBROUTINE DenseSine(Mat, OutputMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN @@ -108,9 +109,9 @@ SUBROUTINE Cosine(InputMat, OutputMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF CALL ScaleSquareTrigonometry(InputMat, OutputMat, params) @@ -132,9 +133,9 @@ SUBROUTINE DenseCosine(Mat, OutputMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - params = solver_parameters_in + CALL CopySolverParameters(solver_parameters_in, params) ELSE - params = SolverParameters_t() + CALL ConstructSolverParameters(params) END IF IF (params%be_verbose) THEN @@ -176,7 +177,7 @@ SUBROUTINE ScaleSquareTrigonometryTaylor(InputMat, OutputMat, params) IF (params%be_verbose) THEN CALL WriteHeader("Trigonometry Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Taylor") + CALL WriteElement(key = "Method", VALUE = "Taylor") CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("higham2003computing") @@ -197,7 +198,7 @@ SUBROUTINE ScaleSquareTrigonometryTaylor(InputMat, OutputMat, params) END DO CALL CopyMatrix(InputMat, ScaledMat) - CALL ScaleMatrix(ScaledMat, 1.0_NTREAL/sigma_val) + CALL ScaleMatrix(ScaledMat, 1.0_NTREAL / sigma_val) CALL ConstructEmptyMatrix(OutputMat, InputMat) CALL FillMatrixIdentity(OutputMat) CALL ConstructEmptyMatrix(IdentityMat, InputMat) @@ -206,44 +207,44 @@ SUBROUTINE ScaleSquareTrigonometryTaylor(InputMat, OutputMat, params) !! Load Balancing Step IF (params%do_load_balancing) THEN CALL PermuteMatrix(ScaledMat, ScaledMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(OutputMat, OutputMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(IdentityMat, IdentityMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Square the scaled matrix. taylor_denom = -2.0_NTREAL CALL CopyMatrix(OutputMat, Ak) CALL MatrixMultiply(ScaledMat, ScaledMat, TempMat, & - & threshold_in=params%threshold, memory_pool_in=pool) - CALL CopyMatrix(TempMat,ScaledMat) + & threshold_in = params%threshold, memory_pool_in = pool) + CALL CopyMatrix(TempMat, ScaledMat) !! Expand Taylor Series DO II = 2, 40, 2 CALL MatrixMultiply(Ak, ScaledMat, TempMat, & - & threshold_in=params%threshold, memory_pool_in=pool) - CALL CopyMatrix(TempMat,Ak) - CALL IncrementMatrix(Ak,OutputMat, & - & alpha_in=REAL(1.0_NTREAL/taylor_denom,NTREAL)) - taylor_denom = taylor_denom * (II+1) - taylor_denom = -1.0_NTREAL*taylor_denom*(II+1) + & threshold_in = params%threshold, memory_pool_in = pool) + CALL CopyMatrix(TempMat, Ak) + CALL IncrementMatrix(Ak, OutputMat, & + & alpha_in = 1.0_NTREAL / taylor_denom) + taylor_denom = taylor_denom * (II + 1) + taylor_denom = -1.0_NTREAL * taylor_denom * (II + 1) END DO !! Undo scaling - DO II = 1, sigma_counter-1 + DO II = 1, sigma_counter - 1 CALL MatrixMultiply(OutputMat, OutputMat, TempMat, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL CopyMatrix(TempMat, OutputMat) - CALL ScaleMatrix(OutputMat, REAL(2.0_NTREAL,NTREAL)) + CALL ScaleMatrix(OutputMat, 2.0_NTREAL) CALL IncrementMatrix(IdentityMat, OutputMat, & - & REAL(-1.0_NTREAL,NTREAL)) + & alpha_in=-1.0_NTREAL) END DO IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Cleanup @@ -286,7 +287,7 @@ SUBROUTINE ScaleSquareTrigonometry(InputMat, OutputMat, params) IF (params%be_verbose) THEN CALL WriteHeader("Trigonometry Solver") CALL EnterSubLog - CALL WriteElement(key="Method", VALUE="Chebyshev") + CALL WriteElement(key = "Method", VALUE = "Chebyshev") CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("serbin1980algorithm") @@ -303,13 +304,13 @@ SUBROUTINE ScaleSquareTrigonometry(InputMat, OutputMat, params) !! Figure out how much to scale the matrix. sigma_val = 1.0_NTREAL sigma_counter = 1 - DO WHILE (spectral_radius/sigma_val .GT. 1.0_NTREAL) + DO WHILE (spectral_radius / sigma_val .GT. 1.0_NTREAL) sigma_val = sigma_val * 2 sigma_counter = sigma_counter + 1 END DO CALL CopyMatrix(InputMat, ScaledMat) - CALL ScaleMatrix(ScaledMat, 1.0_NTREAL/sigma_val) + CALL ScaleMatrix(ScaledMat, 1.0_NTREAL / sigma_val) CALL ConstructEmptyMatrix(OutputMat, InputMat) CALL ConstructEmptyMatrix(IdentityMat, InputMat) CALL FillMatrixIdentity(IdentityMat) @@ -317,9 +318,9 @@ SUBROUTINE ScaleSquareTrigonometry(InputMat, OutputMat, params) !! Load Balancing Step IF (params%do_load_balancing) THEN CALL PermuteMatrix(ScaledMat, ScaledMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) CALL PermuteMatrix(IdentityMat, IdentityMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Expand the Chebyshev Polynomial. @@ -342,46 +343,49 @@ SUBROUTINE ScaleSquareTrigonometry(InputMat, OutputMat, params) coefficients(17) = 9.181480886537484e-17_NTREAL !! Basic T Values. - CALL MatrixMultiply(ScaledMat, ScaledMat,T2, alpha_in=2.0_NTREAL,& - & threshold_in=params%threshold, memory_pool_in=pool) - CALL IncrementMatrix(IdentityMat, T2, alpha_in=-1.0_NTREAL) - CALL MatrixMultiply(T2, T2, T4, alpha_in=2.0_NTREAL,& - & threshold_in=params%threshold, memory_pool_in=pool) - CALL IncrementMatrix(IdentityMat, T4, alpha_in=-1.0_NTREAL) - CALL MatrixMultiply(T4, T2, T6, alpha_in=2.0_NTREAL,& - & threshold_in=params%threshold, memory_pool_in=pool) - CALL IncrementMatrix(T2, T6, alpha_in=-1.0_NTREAL) - CALL MatrixMultiply(T6, T2, T8,alpha_in=2.0_NTREAL,& - & threshold_in=params%threshold, memory_pool_in=pool) - CALL IncrementMatrix(T4, T8, alpha_in=-1.0_NTREAL) + CALL MatrixMultiply(ScaledMat, ScaledMat,T2, alpha_in = 2.0_NTREAL, & + & threshold_in = params%threshold, memory_pool_in = pool) + CALL IncrementMatrix(IdentityMat, T2, alpha_in = -1.0_NTREAL) + CALL MatrixMultiply(T2, T2, T4, alpha_in = 2.0_NTREAL, & + & threshold_in = params%threshold, memory_pool_in = pool) + CALL IncrementMatrix(IdentityMat, T4, alpha_in = -1.0_NTREAL) + CALL MatrixMultiply(T4, T2, T6, alpha_in = 2.0_NTREAL, & + & threshold_in = params%threshold, memory_pool_in = pool) + CALL IncrementMatrix(T2, T6, alpha_in = -1.0_NTREAL) + CALL MatrixMultiply(T6, T2, T8,alpha_in = 2.0_NTREAL, & + & threshold_in = params%threshold, memory_pool_in = pool) + CALL IncrementMatrix(T4, T8, alpha_in = -1.0_NTREAL) !! Contribution from the second half. CALL CopyMatrix(T8, OutputMat) - CALL ScaleMatrix(OutputMat, 0.5_NTREAL*coefficients(17)) - CALL IncrementMatrix(T6, OutputMat, alpha_in=0.5_NTREAL*coefficients(15)) - CALL IncrementMatrix(T4, OutputMat, alpha_in=0.5_NTREAL*coefficients(13)) - CALL IncrementMatrix(T2, OutputMat, alpha_in=0.5_NTREAL*coefficients(11)) + CALL ScaleMatrix(OutputMat, 0.5_NTREAL * coefficients(17)) + CALL IncrementMatrix(T6, OutputMat, & + & alpha_in = 0.5_NTREAL*coefficients(15)) + CALL IncrementMatrix(T4, OutputMat, & + & alpha_in = 0.5_NTREAL*coefficients(13)) + CALL IncrementMatrix(T2, OutputMat, & + & alpha_in = 0.5_NTREAL*coefficients(11)) CALL MatrixMultiply(T8, OutputMat, TempMat,& - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) !! Contribution from the first half. CALL CopyMatrix(T8, OutputMat) CALL ScaleMatrix(OutputMat, coefficients(9)) CALL IncrementMatrix(T6, OutputMat, & - & alpha_in=coefficients(7)+0.5_NTREAL*coefficients(11)) + & alpha_in = coefficients(7) + 0.5_NTREAL * coefficients(11)) CALL IncrementMatrix(T4, OutputMat, & - & alpha_in=coefficients(5)+0.5_NTREAL*coefficients(13)) + & alpha_in = coefficients(5) + 0.5_NTREAL * coefficients(13)) CALL IncrementMatrix(T2, OutputMat, & - & alpha_in=coefficients(3)+0.5_NTREAL*coefficients(15)) + & alpha_in = coefficients(3) + 0.5_NTREAL * coefficients(15)) CALL IncrementMatrix(IdentityMat, OutputMat, & - & alpha_in=coefficients(1)+0.5_NTREAL*coefficients(17)) + & alpha_in = coefficients(1) + 0.5_NTREAL * coefficients(17)) CALL IncrementMatrix(TempMat, OutputMat) !! Undo scaling - DO II = 1, sigma_counter-1 + DO II = 1, sigma_counter - 1 CALL MatrixMultiply(OutputMat, OutputMat, TempMat, & - & threshold_in=params%threshold, memory_pool_in=pool) + & threshold_in = params%threshold, memory_pool_in = pool) CALL CopyMatrix(TempMat, OutputMat) CALL ScaleMatrix(OutputMat, 2.0_NTREAL) CALL IncrementMatrix(IdentityMat, OutputMat, -1.0_NTREAL) @@ -389,7 +393,7 @@ SUBROUTINE ScaleSquareTrigonometry(InputMat, OutputMat, params) IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & params%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in = pool) END IF !! Cleanup @@ -408,16 +412,16 @@ END SUBROUTINE ScaleSquareTrigonometry !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Prototypical sine function for mapping. FUNCTION SineLambda(val) RESULT(outval) - REAL(KIND=NTREAL), INTENT(IN) :: val - REAL(KIND=NTREAL) :: outval + REAL(KIND = NTREAL), INTENT(IN) :: val + REAL(KIND = NTREAL) :: outval outval = SIN(val) END FUNCTION SineLambda !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Prototypical cosine function. FUNCTION CosineLambda(val) RESULT(outval) - REAL(KIND=NTREAL), INTENT(IN) :: val - REAL(KIND=NTREAL) :: outval + REAL(KIND = NTREAL), INTENT(IN) :: val + REAL(KIND = NTREAL) :: outval outval = COS(val) END FUNCTION CosineLambda diff --git a/Source/Fortran/TripletListModule.F90 b/Source/Fortran/TripletListModule.F90 index 0c6c2f5c..04ca627e 100644 --- a/Source/Fortran/TripletListModule.F90 +++ b/Source/Fortran/TripletListModule.F90 @@ -29,6 +29,7 @@ MODULE TripletListModule PUBLIC :: TripletList_r PUBLIC :: TripletList_c PUBLIC :: ConstructTripletList + PUBLIC :: CopyTripletList PUBLIC :: DestructTripletList PUBLIC :: ResizeTripletList PUBLIC :: AppendToTripletList @@ -45,6 +46,10 @@ MODULE TripletListModule MODULE PROCEDURE ConstructTripletListSup_r MODULE PROCEDURE ConstructTripletListSup_c END INTERFACE ConstructTripletList + INTERFACE CopyTripletList + MODULE PROCEDURE CopyTripletList_r + MODULE PROCEDURE CopyTripletList_c + END INTERFACE CopyTripletList INTERFACE DestructTripletList MODULE PROCEDURE DestructTripletList_r MODULE PROCEDURE DestructTripletList_c @@ -98,7 +103,7 @@ MODULE TripletListModule PURE SUBROUTINE ConstructTripletListSup_r(this, size_in) !> The triplet list to construct. TYPE(TripletList_r), INTENT(INOUT) :: this - !> The length of the triplet list (default=0). + !> The length of the triplet list (default = 0). INTEGER, INTENT(IN), OPTIONAL :: size_in #include "triplet_includes/ConstructTripletList.f90" @@ -109,7 +114,7 @@ END SUBROUTINE ConstructTripletListSup_r PURE SUBROUTINE ConstructTripletListSup_c(this, size_in) !> The triplet list to construct. TYPE(TripletList_c), INTENT(INOUT) :: this - !> The length of the triplet list (default=0). + !> The length of the triplet list (default = 0). INTEGER, INTENT(IN), OPTIONAL :: size_in #include "triplet_includes/ConstructTripletList.f90" @@ -133,6 +138,24 @@ PURE SUBROUTINE DestructTripletList_c(this) #include "triplet_includes/DestructTripletList.f90" END SUBROUTINE DestructTripletList_c +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE CopyTripletList_r(tripA, tripB) + !> The triplet list to copy. + TYPE(TripletList_r), INTENT(IN) :: tripA + !> tripB = tripA + TYPE(TripletList_r), INTENT(INOUT) :: tripB + +#include "triplet_includes/CopyTripletList.f90" + END SUBROUTINE CopyTripletList_r +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE CopyTripletList_c(tripA, tripB) + !> The triplet list to copy. + TYPE(TripletList_c), INTENT(IN) :: tripA + !> tripB = tripA + TYPE(TripletList_c), INTENT(INOUT) :: tripB + +#include "triplet_includes/CopyTripletList.f90" + END SUBROUTINE CopyTripletList_c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Increase the size of a triplet list. PURE SUBROUTINE ResizeTripletList_r(this, size) @@ -246,7 +269,7 @@ PURE SUBROUTINE SortTripletList_r(input_list, matrix_columns, matrix_rows, & !> False if you do not need the final bubble sort. LOGICAL, OPTIONAL, INTENT(IN) :: bubble_in !! Local Data - TYPE(Triplet_r) :: temporary + TYPE(Triplet_r) :: trip #include "triplet_includes/SortTripletList.f90" @@ -268,7 +291,7 @@ PURE SUBROUTINE SortTripletList_c(input_list, matrix_columns, matrix_rows, & !> False if you do not need the final bubble sort. LOGICAL, OPTIONAL, INTENT(IN) :: bubble_in !! Local Data - TYPE(Triplet_c) :: temporary + TYPE(Triplet_c) :: trip #include "triplet_includes/SortTripletList.f90" @@ -350,7 +373,7 @@ PURE SUBROUTINE ShiftTripletList_r(triplet_list, row_shift, column_shift) !> The column offset to shift by. INTEGER, INTENT(IN) :: column_shift !! Local Variables - INTEGER :: counter + INTEGER :: II #include "triplet_includes/ShiftTripletList.f90" @@ -368,7 +391,7 @@ PURE SUBROUTINE ShiftTripletList_c(triplet_list, row_shift, column_shift) !> The column offset to shift by. INTEGER, INTENT(IN) :: column_shift !! Local Variables - INTEGER :: counter + INTEGER :: II #include "triplet_includes/ShiftTripletList.f90" @@ -420,30 +443,30 @@ SUBROUTINE SymmetrizeTripletList_r(triplet_list, pattern_type) !> Type of symmetry. INTEGER, INTENT(IN) :: pattern_type !! Local variables - TYPE(Triplet_r) :: temporary, temporary_transpose - INTEGER :: counter + TYPE(Triplet_r) :: trip, trip_t + INTEGER :: II INTEGER :: initial_size initial_size = triplet_list%CurrentSize SELECT CASE(pattern_type) CASE(MM_SYMMETRIC) - DO counter = 1, initial_size - CALL GetTripletAt(triplet_list,counter,temporary) - IF (temporary%index_column .NE. temporary%index_row) THEN - temporary_transpose%index_row = temporary%index_column - temporary_transpose%index_column = temporary%index_row - temporary_transpose%point_value = temporary%point_value - CALL AppendToTripletList(triplet_list,temporary_transpose) + DO II = 1, initial_size + CALL GetTripletAt(triplet_list, II, trip) + IF (trip%index_column .NE. trip%index_row) THEN + trip_t%index_row = trip%index_column + trip_t%index_column = trip%index_row + trip_t%point_value = trip%point_value + CALL AppendToTripletList(triplet_list, trip_t) END IF END DO CASE(MM_SKEW_SYMMETRIC) - DO counter = 1, initial_size - CALL GetTripletAt(triplet_list,counter,temporary) - IF (temporary%index_column .NE. temporary%index_row) THEN - temporary_transpose%index_row = temporary%index_column - temporary_transpose%index_column = temporary%index_row - temporary_transpose%point_value = -1.0*temporary%point_value - CALL AppendToTripletList(triplet_list,temporary_transpose) + DO II = 1, initial_size + CALL GetTripletAt(triplet_list, II, trip) + IF (trip%index_column .NE. trip%index_row) THEN + trip_t%index_row = trip%index_column + trip_t%index_column = trip%index_row + trip_t%point_value = -1.0 * trip%point_value + CALL AppendToTripletList(triplet_list, trip_t) END IF END DO END SELECT @@ -457,40 +480,40 @@ SUBROUTINE SymmetrizeTripletList_c(triplet_list, pattern_type) !> Type of symmetry. INTEGER, INTENT(IN) :: pattern_type !! Local variables - TYPE(Triplet_c) :: temporary, temporary_transpose - INTEGER :: counter + TYPE(Triplet_c) :: trip, trip_t + INTEGER :: II INTEGER :: initial_size initial_size = triplet_list%CurrentSize SELECT CASE(pattern_type) CASE(MM_SYMMETRIC) - DO counter = 1, initial_size - CALL GetTripletAt(triplet_list,counter,temporary) - IF (temporary%index_column .NE. temporary%index_row) THEN - temporary_transpose%index_row = temporary%index_column - temporary_transpose%index_column = temporary%index_row - temporary_transpose%point_value = temporary%point_value - CALL AppendToTripletList(triplet_list,temporary_transpose) + DO II = 1, initial_size + CALL GetTripletAt(triplet_list, II, trip) + IF (trip%index_column .NE. trip%index_row) THEN + trip_t%index_row = trip%index_column + trip_t%index_column = trip%index_row + trip_t%point_value = trip%point_value + CALL AppendToTripletList(triplet_list, trip_t) END IF END DO CASE(MM_HERMITIAN) - DO counter = 1, initial_size - CALL GetTripletAt(triplet_list,counter,temporary) - IF (temporary%index_column .NE. temporary%index_row) THEN - temporary_transpose%index_row = temporary%index_column - temporary_transpose%index_column = temporary%index_row - temporary_transpose%point_value = CONJG(temporary%point_value) - CALL AppendToTripletList(triplet_list,temporary_transpose) + DO II = 1, initial_size + CALL GetTripletAt(triplet_list, II, trip) + IF (trip%index_column .NE. trip%index_row) THEN + trip_t%index_row = trip%index_column + trip_t%index_column = trip%index_row + trip_t%point_value = CONJG(trip%point_value) + CALL AppendToTripletList(triplet_list, trip_t) END IF END DO CASE(MM_SKEW_SYMMETRIC) - DO counter = 1, initial_size - CALL GetTripletAt(triplet_list,counter,temporary) - IF (temporary%index_column .NE. temporary%index_row) THEN - temporary_transpose%index_row = temporary%index_column - temporary_transpose%index_column = temporary%index_row - temporary_transpose%point_value = -1.0*temporary%point_value - CALL AppendToTripletList(triplet_list,temporary_transpose) + DO II = 1, initial_size + CALL GetTripletAt(triplet_list, II, trip) + IF (trip%index_column .NE. trip%index_row) THEN + trip_t%index_row = trip%index_column + trip_t%index_column = trip%index_row + trip_t%point_value = -1.0*trip%point_value + CALL AppendToTripletList(triplet_list, trip_t) END IF END DO END SELECT diff --git a/Source/Fortran/TripletModule.F90 b/Source/Fortran/TripletModule.F90 index d95b9b8e..25848faa 100644 --- a/Source/Fortran/TripletModule.F90 +++ b/Source/Fortran/TripletModule.F90 @@ -1,28 +1,27 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!> A Module For Storing Triplets of Integer, Integer, Value. +!> A module for the triplet data type. +!> Each one stores two indices and a value. This is related to sparse matrices, +!> the referencing indices are usually rows and columns. MODULE TripletModule USE DataTypesModule, ONLY: NTREAL, MPINTREAL, NTCOMPLEX, MPINTCOMPLEX, & & MPINTINTEGER + USE ErrorModule, ONLY : Error_t, CheckMPIError USE NTMPIModule IMPLICIT NONE PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> A data type for a triplet of integer, integer, double. - !> As this is related to matrix multiplication, the referencing indices are - !> rows and columns. TYPE, PUBLIC :: Triplet_r INTEGER :: index_column !< column value. INTEGER :: index_row !< row value. - REAL(NTREAL) :: point_value !< actual value at those indices. + REAL(NTREAL) :: point_value !< actual value at those indices. END TYPE Triplet_r !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> A data type for a triplet of integer, integer, complex. - !> As this is related to matrix multiplication, the referencing indices are - !> rows and columns. TYPE, PUBLIC :: Triplet_c INTEGER :: index_column !< column value. INTEGER :: index_row !< row value. - COMPLEX(NTCOMPLEX) :: point_value !< actual value at those indices. + COMPLEX(NTCOMPLEX) :: point_value !< actual value at those indices. END TYPE Triplet_c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PUBLIC :: SetTriplet @@ -49,29 +48,29 @@ MODULE TripletModule MODULE PROCEDURE ConvertTripletToComplex END INTERFACE ConvertTripletType CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !> Set the values of a triplet. - PURE SUBROUTINE SetTriplet_r(this,index_column,index_row,point_value) + !> Set the values of a triplet (real). + PURE SUBROUTINE SetTriplet_r(this, index_column, index_row, point_value) !> The triplet to set the values of. TYPE(Triplet_r), INTENT(INOUT) :: this !> The column value. - INTEGER, INTENT(IN) :: index_column + INTEGER, INTENT(IN) :: index_column !> The row value. - INTEGER, INTENT(IN) :: index_row + INTEGER, INTENT(IN) :: index_row !> The value at that point. - REAL(NTREAL), INTENT(IN) :: point_value + REAL(NTREAL), INTENT(IN) :: point_value #include "triplet_includes/SetTriplet.f90" END SUBROUTINE SetTriplet_r !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !> Set the values of a triplet. - PURE SUBROUTINE SetTriplet_c(this,index_column,index_row,point_value) + !> Set the values of a triplet (complex). + PURE SUBROUTINE SetTriplet_c(this, index_column, index_row, point_value) !> The triplet to set the values of. TYPE(Triplet_c), INTENT(INOUT) :: this !> The column value. - INTEGER, INTENT(IN) :: index_column + INTEGER, INTENT(IN) :: index_column !> The row value. - INTEGER, INTENT(IN) :: index_row + INTEGER, INTENT(IN) :: index_row !> The value at that point. COMPLEX(NTCOMPLEX), INTENT(IN) :: point_value @@ -80,28 +79,30 @@ PURE SUBROUTINE SetTriplet_c(this,index_column,index_row,point_value) END SUBROUTINE SetTriplet_c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Get the values of a triplet. - PURE SUBROUTINE GetTripletValues_r(this,index_column,index_row,point_value) + PURE SUBROUTINE GetTripletValues_r(this, index_column, index_row, & + & point_value) !> The triplet to extract the values of. TYPE(Triplet_r), INTENT(IN) :: this !> Column value. - INTEGER, INTENT(OUT) :: index_column + INTEGER, INTENT(OUT) :: index_column !> Row value. - INTEGER, INTENT(OUT) :: index_row + INTEGER, INTENT(OUT) :: index_row !> Actual stored value. - REAL(NTREAL), INTENT(OUT) :: point_value + REAL(NTREAL), INTENT(OUT) :: point_value #include "triplet_includes/GetTriplet.f90" END SUBROUTINE GetTripletValues_r !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Get the values of a triplet. - PURE SUBROUTINE GetTripletValues_c(this,index_column,index_row,point_value) + PURE SUBROUTINE GetTripletValues_c(this, index_column, index_row, & + & point_value) !> The triplet to extract the values of. - TYPE(Triplet_c), INTENT(IN) :: this + TYPE(Triplet_c), INTENT(IN) :: this !> Column value. - INTEGER, INTENT(OUT) :: index_column + INTEGER, INTENT(OUT) :: index_column !> Row value. - INTEGER, INTENT(OUT) :: index_row + INTEGER, INTENT(OUT) :: index_row !> Actual stored value. COMPLEX(NTCOMPLEX), INTENT(OUT) :: point_value @@ -123,8 +124,8 @@ PURE FUNCTION CompareTriplets_r(tripA, tripB) RESULT(islessthan) END FUNCTION CompareTriplets_r !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !> Compare two triplets based on their index values, first by column and - !> second by row. Returns A < B. + !> Compare two triplets based on their index values (complex), first by + !> column and second by row. Returns A < B. PURE FUNCTION CompareTriplets_c(tripA, tripB) RESULT(islessthan) !> First triplet. TYPE(Triplet_c), INTENT(IN) :: tripA @@ -137,7 +138,7 @@ PURE FUNCTION CompareTriplets_c(tripA, tripB) RESULT(islessthan) END FUNCTION CompareTriplets_c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !> Returns an MPI Derived Data Type For A Triplet. + !> Returns an MPI derived data type for a triplet (Real). !> We statically store this derived type so that we do not have to recreate !> it every time this function is called. Thus this functional call should !> add very little overhead. @@ -146,31 +147,24 @@ FUNCTION GetMPITripletType_r() RESULT(mpi_triplet_type) INTEGER :: mpi_triplet_type !! Local Data INTEGER, DIMENSION(3) :: triplet_sub_types - INTEGER, DIMENSION(3) :: triplet_displacement + INTEGER(KIND = MPI_ADDRESS_KIND), DIMENSION(3) :: triplet_displacement INTEGER, DIMENSION(3) :: triplet_block_length - INTEGER :: bytes_per_int - INTEGER :: bytes_per_double + INTEGER :: bytes_per_int, bytes_per_double INTEGER :: ierr - CALL MPI_Type_extent(MPINTINTEGER,bytes_per_int,ierr) - CALL MPI_Type_extent(MPINTREAL,bytes_per_double,ierr) - triplet_block_length(1) = 1 - triplet_block_length(2) = 1 - triplet_block_length(3) = 1 - triplet_displacement(1) = 0 - triplet_displacement(2) = bytes_per_int + triplet_displacement(1) - triplet_displacement(3) = bytes_per_int + triplet_displacement(2) - triplet_sub_types(1) = MPINTINTEGER - triplet_sub_types(2) = MPINTINTEGER - triplet_sub_types(3) = MPINTREAL - - CALL MPI_Type_struct(3,triplet_block_length,triplet_displacement,& - & triplet_sub_types,mpi_triplet_type,ierr) - CALL MPI_Type_commit(mpi_triplet_type,ierr) + CALL MPI_Type_extent(MPINTINTEGER, bytes_per_int, ierr) + CALL MPI_Type_extent(MPINTREAL, bytes_per_double, ierr) + triplet_block_length = [1, 1, 1] + triplet_displacement = [0, bytes_per_int, 2 * bytes_per_int] + triplet_sub_types = [MPINTINTEGER, MPINTINTEGER, MPINTREAL] + + CALL MPI_Type_create_struct(3, triplet_block_length, & + & triplet_displacement, triplet_sub_types, mpi_triplet_type, ierr) + CALL MPI_Type_commit(mpi_triplet_type, ierr) END FUNCTION GetMPITripletType_r !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !> Returns an MPI Derived Data Type For A Triplet. + !> Returns an MPI derived data type for a triplet (complex). !> We statically store this derived type so that we do not have to recreate !> it every time this function is called. Thus this functional call should !> add very little overhead. @@ -179,52 +173,51 @@ FUNCTION GetMPITripletType_c() RESULT(mpi_triplet_type) INTEGER :: mpi_triplet_type !! Local Data INTEGER, DIMENSION(3) :: triplet_sub_types - INTEGER, DIMENSION(3) :: triplet_displacement + INTEGER(KIND = MPI_ADDRESS_KIND), DIMENSION(3) :: triplet_displacement INTEGER, DIMENSION(3) :: triplet_block_length - INTEGER :: bytes_per_int - INTEGER :: bytes_per_double + INTEGER :: bytes_per_int, bytes_per_double + TYPE(Error_t) :: error_check + LOGICAL :: error_occured INTEGER :: ierr - CALL MPI_Type_extent(MPINTINTEGER,bytes_per_int,ierr) - CALL MPI_Type_extent(MPINTCOMPLEX,bytes_per_double,ierr) - triplet_block_length(1) = 1 - triplet_block_length(2) = 1 - triplet_block_length(3) = 1 - triplet_displacement(1) = 0 - triplet_displacement(2) = bytes_per_int + triplet_displacement(1) - triplet_displacement(3) = bytes_per_int + triplet_displacement(2) - triplet_sub_types(1) = MPINTINTEGER - triplet_sub_types(2) = MPINTINTEGER - triplet_sub_types(3) = MPINTCOMPLEX - - CALL MPI_Type_struct(3,triplet_block_length,triplet_displacement,& - & triplet_sub_types,mpi_triplet_type,ierr) - CALL MPI_Type_commit(mpi_triplet_type,ierr) + CALL MPI_Type_extent(MPINTINTEGER, bytes_per_int, ierr) + CALL MPI_Type_extent(MPINTCOMPLEX, bytes_per_double, ierr) + triplet_block_length = [1, 1, 1] + triplet_displacement = [0, bytes_per_int, 2 * bytes_per_int] + triplet_sub_types = [MPINTINTEGER, MPINTINTEGER, MPINTCOMPLEX] + + CALL MPI_Type_create_struct(3, triplet_block_length, & + & triplet_displacement, triplet_sub_types, mpi_triplet_type, ierr) + CALL MPI_Type_commit(mpi_triplet_type, ierr) + + error_occured = CheckMPIError(error_check, "Creation of MPINTCOMPLEX", & + & ierr, .TRUE.) END FUNCTION GetMPITripletType_c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Convert a complex triplet to a real triplet. SUBROUTINE ConvertTripletToReal(cin_triplet, rout_triplet) !> The starting triplet - TYPE(Triplet_c), INTENT(IN) :: cin_triplet + TYPE(Triplet_c), INTENT(IN) :: cin_triplet !> Real valued triplet. TYPE(Triplet_r), INTENT(INOUT) :: rout_triplet rout_triplet%index_row = cin_triplet%index_row rout_triplet%index_column = cin_triplet%index_column - rout_triplet%point_value = REAL(cin_triplet%point_value) + rout_triplet%point_value = REAL(cin_triplet%point_value, KIND = NTREAL) END SUBROUTINE ConvertTripletToReal !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Convert a real triplet to a complex triplet. SUBROUTINE ConvertTripletToComplex(rin_triplet, cout_triplet) !> The starting triplet. - TYPE(Triplet_r), INTENT(IN) :: rin_triplet + TYPE(Triplet_r), INTENT(IN) :: rin_triplet !> Complex valued triplet. TYPE(Triplet_c), INTENT(INOUT) :: cout_triplet cout_triplet%index_row = rin_triplet%index_row cout_triplet%index_column = rin_triplet%index_column - cout_triplet%point_value = CMPLX(rin_triplet%point_value, 0, KIND=NTCOMPLEX) + cout_triplet%point_value = CMPLX(rin_triplet%point_value, 0.0_NTREAL, & + & KIND = NTCOMPLEX) END SUBROUTINE ConvertTripletToComplex !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE TripletModule diff --git a/Source/Fortran/comm_includes/ReduceAndComposeMatrixCleanup.f90 b/Source/Fortran/comm_includes/ReduceAndComposeMatrixCleanup.f90 index 56c65f71..33119539 100644 --- a/Source/Fortran/comm_includes/ReduceAndComposeMatrixCleanup.f90 +++ b/Source/Fortran/comm_includes/ReduceAndComposeMatrixCleanup.f90 @@ -1,14 +1,14 @@ !! Local Data INTEGER :: II, JJ - INTEGER :: temp_offset + INTEGER :: offset !! Sum Up The Outer Indices DO II = 1, helper%comm_size - 1 - temp_offset = II*matrix%columns+1 + offset = II * matrix%columns + 1 DO JJ = 1, matrix%columns - gathered_matrix%outer_index(temp_offset+JJ) = & - & gathered_matrix%outer_index(temp_offset) + & - & gathered_matrix%outer_index(temp_offset+JJ) + gathered_matrix%outer_index(offset + JJ) = & + & gathered_matrix%outer_index(offset) + & + & gathered_matrix%outer_index(offset + JJ) END DO END DO DEALLOCATE(helper%values_per_process) diff --git a/Source/Fortran/comm_includes/ReduceAndComposeMatrixData.f90 b/Source/Fortran/comm_includes/ReduceAndComposeMatrixData.f90 index 9089aebc..3e1003d9 100644 --- a/Source/Fortran/comm_includes/ReduceAndComposeMatrixData.f90 +++ b/Source/Fortran/comm_includes/ReduceAndComposeMatrixData.f90 @@ -1,13 +1,11 @@ !! Local Data - INTEGER :: grid_error - INTEGER :: II - INTEGER :: total_values - INTEGER :: idx + INTEGER :: II, idx, total_values + INTEGER :: ierr !! Compute values per process ALLOCATE(helper%values_per_process(helper%comm_size)) DO II = 1, helper%comm_size - idx = matrix%columns*II + 1 + idx = matrix%columns * II + 1 helper%values_per_process(II) = gathered_matrix%outer_index(idx) END DO @@ -15,8 +13,8 @@ ALLOCATE(helper%displacement(helper%comm_size)) helper%displacement(1) = 0 DO II = 2, SIZE(helper%displacement) - helper%displacement(II) = helper%displacement(II-1) + & - & helper%values_per_process(II-1) + helper%displacement(II) = helper%displacement(II - 1) + & + & helper%values_per_process(II - 1) END DO !! Build Storage @@ -25,7 +23,6 @@ ALLOCATE(gathered_matrix%inner_index(total_values)) !! MPI Calls - CALL MPI_IAllGatherv(matrix%inner_index,SIZE(matrix%values),MPINTINTEGER, & + CALL MPI_IAllGatherv(matrix%inner_index, SIZE(matrix%values), MPINTINTEGER, & & gathered_matrix%inner_index, helper%values_per_process, & - & helper%displacement, MPINTINTEGER, communicator, & - & helper%inner_request, grid_error) + & helper%displacement, MPINTINTEGER, comm, helper%inner_request, ierr) diff --git a/Source/Fortran/comm_includes/ReduceAndComposeMatrixData_sendrecv.f90 b/Source/Fortran/comm_includes/ReduceAndComposeMatrixData_sendrecv.f90 index 85495bc4..40017aed 100644 --- a/Source/Fortran/comm_includes/ReduceAndComposeMatrixData_sendrecv.f90 +++ b/Source/Fortran/comm_includes/ReduceAndComposeMatrixData_sendrecv.f90 @@ -1,9 +1,7 @@ !! Local Data - INTEGER :: grid_error - INTEGER :: II - INTEGER :: total_values + INTEGER :: II, idx, total_values INTEGER :: istart, iend, isize - INTEGER :: idx + INTEGER :: ierr !! Send Receive Buffers ALLOCATE(helper%inner_send_request_list(helper%comm_size)) @@ -14,7 +12,7 @@ !! Compute values per process ALLOCATE(helper%values_per_process(helper%comm_size)) DO II = 1, helper%comm_size - idx = matrix%columns*II + 1 + idx = matrix%columns * II + 1 helper%values_per_process(II) = gathered_matrix%outer_index(idx) END DO @@ -22,8 +20,8 @@ ALLOCATE(helper%displacement(helper%comm_size)) helper%displacement(1) = 0 DO II = 2, SIZE(helper%displacement) - helper%displacement(II) = helper%displacement(II-1) + & - & helper%values_per_process(II-1) + helper%displacement(II) = helper%displacement(II - 1) + & + & helper%values_per_process(II - 1) END DO !! Build Storage @@ -35,12 +33,12 @@ DO II = 1, helper%comm_size !! Send/Recv inner index CALL MPI_ISend(matrix%inner_index, SIZE(matrix%inner_index), & - & MPINTINTEGER, II-1, 2, communicator, & - & helper%inner_send_request_list(II), grid_error) - istart = helper%displacement(II)+1 + & MPINTINTEGER, II - 1, 2, comm, & + & helper%inner_send_request_list(II), ierr) + istart = helper%displacement(II) + 1 isize = helper%values_per_process(II) iend = istart + isize - 1 CALL MPI_Irecv(gathered_matrix%inner_index(istart:iend), isize, & - & MPINTINTEGER, II-1, 2, communicator, & - & helper%inner_recv_request_list(II), grid_error) + & MPINTINTEGER, II - 1, 2, comm, & + & helper%inner_recv_request_list(II), ierr) END DO diff --git a/Source/Fortran/comm_includes/ReduceAndComposeMatrixSizes.f90 b/Source/Fortran/comm_includes/ReduceAndComposeMatrixSizes.f90 index dec64ab2..6ca8dcf5 100644 --- a/Source/Fortran/comm_includes/ReduceAndComposeMatrixSizes.f90 +++ b/Source/Fortran/comm_includes/ReduceAndComposeMatrixSizes.f90 @@ -1,15 +1,14 @@ !! Local Data - INTEGER :: grid_error + INTEGER :: ierr - CALL MPI_Comm_size(communicator,helper%comm_size,grid_error) + CALL MPI_Comm_size(comm, helper%comm_size, ierr) !! Build Storage CALL ConstructEmptyMatrix(gathered_matrix, & - & matrix%rows,matrix%columns*helper%comm_size) + & matrix%rows, matrix%columns * helper%comm_size) gathered_matrix%outer_index(1) = 0 !! Gather Information About Other Processes CALL MPI_IAllGather(matrix%outer_index(2:), matrix%columns,& & MPINTINTEGER, gathered_matrix%outer_index(2:), & - & matrix%columns, MPINTINTEGER, communicator, helper%outer_request, & - & grid_error) + & matrix%columns, MPINTINTEGER, comm, helper%outer_request, ierr) diff --git a/Source/Fortran/comm_includes/ReduceAndComposeMatrixSizes_sendrecv.f90 b/Source/Fortran/comm_includes/ReduceAndComposeMatrixSizes_sendrecv.f90 index 9f4cc895..5fc79647 100644 --- a/Source/Fortran/comm_includes/ReduceAndComposeMatrixSizes_sendrecv.f90 +++ b/Source/Fortran/comm_includes/ReduceAndComposeMatrixSizes_sendrecv.f90 @@ -1,13 +1,13 @@ !! Local Data - INTEGER :: grid_error INTEGER :: II INTEGER :: istart, isize, iend + INTEGER :: ierr - CALL MPI_Comm_size(communicator,helper%comm_size,grid_error) + CALL MPI_Comm_size(comm, helper%comm_size, ierr) !! Build Storage CALL ConstructEmptyMatrix(gathered_matrix, & - & matrix%rows,matrix%columns*helper%comm_size) + & matrix%rows, matrix%columns * helper%comm_size) gathered_matrix%outer_index(1) = 0 ALLOCATE(helper%outer_send_request_list(helper%comm_size)) @@ -17,12 +17,11 @@ DO II = 1, helper%comm_size !! Send/Recv Outer Index CALL MPI_ISend(matrix%outer_index(2:), matrix%columns, MPINTINTEGER, & - & II-1, 3, communicator, helper%outer_send_request_list(II), & - & grid_error) - istart = (matrix%columns)*(II-1)+2 + & II-1, 3, comm, helper%outer_send_request_list(II), ierr) + istart = (matrix%columns)*(II - 1) + 2 isize = matrix%columns iend = istart + isize - 1 CALL MPI_Irecv(gathered_matrix%outer_index(istart:iend), isize, & - & MPINTINTEGER, II-1, 3, communicator, & - & helper%outer_recv_request_list(II), grid_error) + & MPINTINTEGER, II - 1, 3, comm, & + & helper%outer_recv_request_list(II), ierr) END DO diff --git a/Source/Fortran/comm_includes/ReduceAndSumMatrix.f90 b/Source/Fortran/comm_includes/ReduceAndSumMatrix.f90 index ac822437..7d01e04e 100644 --- a/Source/Fortran/comm_includes/ReduceAndSumMatrix.f90 +++ b/Source/Fortran/comm_includes/ReduceAndSumMatrix.f90 @@ -2,7 +2,7 @@ DO WHILE(.NOT. TestReduceSizeRequest(helper)) END DO - CALL ReduceAndSumMatrixData(matrix, gathered_matrix, comm, helper) + CALL ReduceAndSumMatrixData(matrix, comm, gathered_matrix, helper) DO WHILE(.NOT. TestReduceInnerRequest(helper)) END DO DO WHILE(.NOT. TestReduceDataRequest(helper)) diff --git a/Source/Fortran/comm_includes/ReduceAndSumMatrixCleanup.f90 b/Source/Fortran/comm_includes/ReduceAndSumMatrixCleanup.f90 index 3e01cf69..795fb8e6 100644 --- a/Source/Fortran/comm_includes/ReduceAndSumMatrixCleanup.f90 +++ b/Source/Fortran/comm_includes/ReduceAndSumMatrixCleanup.f90 @@ -1,37 +1,38 @@ !! Local Data INTEGER :: II - INTEGER :: temporary_total_values + INTEGER :: total_values !! Build Matrix Objects - CALL ConstructEmptyMatrix(temporary_matrix,matrix%rows,matrix%columns) - CALL ConstructEmptyMatrix(sum_matrix,matrix%rows,matrix%columns,& - & zero_in=.TRUE.) + CALL ConstructEmptyMatrix(acc_matrix, matrix%rows, matrix%columns) + CALL ConstructEmptyMatrix(sum_matrix, matrix%rows, matrix%columns, & + & zero_in = .TRUE.) !! Sum DO II = 1, helper%comm_size - temporary_total_values = helper%values_per_process(II) - ALLOCATE(temporary_matrix%values(temporary_total_values)) - ALLOCATE(temporary_matrix%inner_index(temporary_total_values)) - temporary_matrix%values = gathered_matrix%values( & - & helper%displacement(II)+1: & + total_values = helper%values_per_process(II) + ALLOCATE(acc_matrix%values(total_values)) + ALLOCATE(acc_matrix%inner_index(total_values)) + acc_matrix%values = gathered_matrix%values( & + & helper%displacement(II) + 1: & & helper%displacement(II) + helper%values_per_process(II)) - temporary_matrix%inner_index = gathered_matrix%inner_index( & - & helper%displacement(II)+1: & + acc_matrix%inner_index = gathered_matrix%inner_index( & + & helper%displacement(II) + 1: & & helper%displacement(II) + helper%values_per_process(II)) - temporary_matrix%outer_index = gathered_matrix%outer_index(& - & (matrix%columns+1)*(II-1)+1:(matrix%columns+1)*(II)) + acc_matrix%outer_index = gathered_matrix%outer_index(& + & (matrix%columns + 1) * (II - 1) + 1:(matrix%columns + 1) * II) IF (II .EQ. helper%comm_size) THEN - CALL IncrementMatrix(temporary_matrix,sum_matrix,threshold_in=threshold) + CALL IncrementMatrix(acc_matrix, sum_matrix, & + & threshold_in = threshold) ELSE - CALL IncrementMatrix(temporary_matrix,sum_matrix,& - & threshold_in=REAL(0.0,NTREAL)) + CALL IncrementMatrix(acc_matrix, sum_matrix,& + & threshold_in = 0.0_NTREAL) END IF - DEALLOCATE(temporary_matrix%values) - DEALLOCATE(temporary_matrix%inner_index) + DEALLOCATE(acc_matrix%values) + DEALLOCATE(acc_matrix%inner_index) END DO CALL CopyMatrix(sum_matrix, gathered_matrix) CALL DestructMatrix(sum_matrix) - CALL DestructMatrix(temporary_matrix) + CALL DestructMatrix(acc_matrix) DEALLOCATE(helper%values_per_process) DEALLOCATE(helper%displacement) diff --git a/Source/Fortran/comm_includes/ReduceAndSumMatrixData.f90 b/Source/Fortran/comm_includes/ReduceAndSumMatrixData.f90 index 44969938..bbc2f213 100644 --- a/Source/Fortran/comm_includes/ReduceAndSumMatrixData.f90 +++ b/Source/Fortran/comm_includes/ReduceAndSumMatrixData.f90 @@ -1,13 +1,12 @@ !! Local Data - INTEGER :: grid_error - INTEGER :: II + INTEGER :: II, idx INTEGER :: sum_total_values - INTEGER :: idx + INTEGER :: ierr !! Compute values per process ALLOCATE(helper%values_per_process(helper%comm_size)) DO II = 1, helper%comm_size - idx = (matrix%columns+1)*II + idx = (matrix%columns + 1) * II helper%values_per_process(II) = gathered_matrix%outer_index(idx) END DO @@ -15,8 +14,8 @@ ALLOCATE(helper%displacement(helper%comm_size)) helper%displacement(1) = 0 DO II = 2, SIZE(helper%displacement) - helper%displacement(II) = helper%displacement(II-1) + & - & helper%values_per_process(II-1) + helper%displacement(II) = helper%displacement(II - 1) + & + & helper%values_per_process(II - 1) END DO !! Build Storage @@ -27,5 +26,4 @@ !! MPI Calls CALL MPI_IAllGatherv(matrix%inner_index, SIZE(matrix%values), MPINTINTEGER, & & gathered_matrix%inner_index, helper%values_per_process, & - & helper%displacement, MPINTINTEGER, communicator, & - & helper%inner_request, grid_error) + & helper%displacement, MPINTINTEGER, comm, helper%inner_request, ierr) diff --git a/Source/Fortran/comm_includes/ReduceAndSumMatrixData_sendrecv.f90 b/Source/Fortran/comm_includes/ReduceAndSumMatrixData_sendrecv.f90 index e50c2ec1..32900c32 100644 --- a/Source/Fortran/comm_includes/ReduceAndSumMatrixData_sendrecv.f90 +++ b/Source/Fortran/comm_includes/ReduceAndSumMatrixData_sendrecv.f90 @@ -1,9 +1,8 @@ !! Local Data - INTEGER :: grid_error - INTEGER :: II + INTEGER :: II, idx INTEGER :: sum_total_values INTEGER :: istart, isize, iend - INTEGER :: idx + INTEGER :: ierr !! Send Receive Buffers ALLOCATE(helper%inner_send_request_list(helper%comm_size)) @@ -14,7 +13,7 @@ !! Compute values per process ALLOCATE(helper%values_per_process(helper%comm_size)) DO II = 1, helper%comm_size - idx = (matrix%columns+1)*II + idx = (matrix%columns + 1) * II helper%values_per_process(II) = gathered_matrix%outer_index(idx) END DO @@ -22,8 +21,8 @@ ALLOCATE(helper%displacement(helper%comm_size)) helper%displacement(1) = 0 DO II = 2, SIZE(helper%displacement) - helper%displacement(II) = helper%displacement(II-1) + & - & helper%values_per_process(II-1) + helper%displacement(II) = helper%displacement(II - 1) + & + & helper%values_per_process(II - 1) END DO !! Build Storage @@ -35,12 +34,12 @@ DO II = 1, helper%comm_size !! Send/Recv inner index CALL MPI_ISend(matrix%inner_index, SIZE(matrix%inner_index), & - & MPINTINTEGER, II-1, 2, communicator, & - & helper%inner_send_request_list(II), grid_error) - istart = helper%displacement(II)+1 + & MPINTINTEGER, II - 1, 2, comm, & + & helper%inner_send_request_list(II), ierr) + istart = helper%displacement(II) + 1 isize = helper%values_per_process(II) iend = istart + isize - 1 CALL MPI_Irecv(gathered_matrix%inner_index(istart:iend), isize, & - & MPINTINTEGER, II-1, 2, communicator, & - & helper%inner_recv_request_list(II), grid_error) + & MPINTINTEGER, II - 1, 2, comm, & + & helper%inner_recv_request_list(II), ierr) END DO diff --git a/Source/Fortran/comm_includes/ReduceAndSumMatrixSizes.f90 b/Source/Fortran/comm_includes/ReduceAndSumMatrixSizes.f90 index db9cbbf1..2eaecafc 100644 --- a/Source/Fortran/comm_includes/ReduceAndSumMatrixSizes.f90 +++ b/Source/Fortran/comm_includes/ReduceAndSumMatrixSizes.f90 @@ -1,15 +1,15 @@ !! Local Data - INTEGER :: grid_error INTEGER :: sum_outer_indices + INTEGER :: ierr - CALL MPI_Comm_size(communicator,helper%comm_size,grid_error) + CALL MPI_Comm_size(comm, helper%comm_size, ierr) !! Build Storage CALL DestructMatrix(gathered_matrix) - sum_outer_indices = (matrix%columns+1)*helper%comm_size - ALLOCATE(gathered_matrix%outer_index(sum_outer_indices+1)) + sum_outer_indices = (matrix%columns + 1) * helper%comm_size + ALLOCATE(gathered_matrix%outer_index(sum_outer_indices + 1)) !! Gather Outer Indices - CALL MPI_IAllGather(matrix%outer_index, matrix%columns+1,& - & MPINTINTEGER, gathered_matrix%outer_index, matrix%columns+1, & - & MPINTINTEGER, communicator, helper%outer_request, grid_error) + CALL MPI_IAllGather(matrix%outer_index, matrix%columns+1, & + & MPINTINTEGER, gathered_matrix%outer_index, matrix%columns + 1, & + & MPINTINTEGER, comm, helper%outer_request, ierr) diff --git a/Source/Fortran/comm_includes/ReduceAndSumMatrixSizes_sendrecv.f90 b/Source/Fortran/comm_includes/ReduceAndSumMatrixSizes_sendrecv.f90 index b23bab6a..d1f51ee0 100644 --- a/Source/Fortran/comm_includes/ReduceAndSumMatrixSizes_sendrecv.f90 +++ b/Source/Fortran/comm_includes/ReduceAndSumMatrixSizes_sendrecv.f90 @@ -1,15 +1,15 @@ !! Local Data - INTEGER :: grid_error INTEGER :: sum_outer_indices INTEGER :: II INTEGER :: istart, isize, iend + INTEGER :: ierr - CALL MPI_Comm_size(communicator,helper%comm_size,grid_error) + CALL MPI_Comm_size(comm, helper%comm_size, ierr) !! Build Storage CALL DestructMatrix(gathered_matrix) - sum_outer_indices = (matrix%columns+1)*helper%comm_size - ALLOCATE(gathered_matrix%outer_index(sum_outer_indices+1)) + sum_outer_indices = (matrix%columns + 1) * helper%comm_size + ALLOCATE(gathered_matrix%outer_index(sum_outer_indices + 1)) ALLOCATE(helper%outer_send_request_list(helper%comm_size)) ALLOCATE(helper%outer_recv_request_list(helper%comm_size)) @@ -17,12 +17,12 @@ !! Send/Recv Outer Index DO II = 1, helper%comm_size CALL MPI_ISend(matrix%outer_index, SIZE(matrix%outer_index), & - & MPINTINTEGER, II-1, 3, communicator, & - & helper%outer_send_request_list(II), grid_error) - istart = (matrix%columns+1)*(II-1)+1 + & MPINTINTEGER, II - 1, 3, comm, & + & helper%outer_send_request_list(II), ierr) + istart = (matrix%columns + 1) * (II - 1) + 1 isize = matrix%columns + 1 iend = istart + isize - 1 CALL MPI_Irecv(gathered_matrix%outer_index(istart:iend), isize, & - & MPINTINTEGER, II-1, 3, communicator, & - & helper%outer_recv_request_list(II), grid_error) + & MPINTINTEGER, II - 1, 3, comm, & + & helper%outer_recv_request_list(II), ierr) END DO diff --git a/Source/Fortran/dense_includes/CheckMemoryPoolValidity.f90 b/Source/Fortran/dense_includes/CheckMemoryPoolValidity.f90 index 9fc6d70d..ef0b2d0f 100644 --- a/Source/Fortran/dense_includes/CheckMemoryPoolValidity.f90 +++ b/Source/Fortran/dense_includes/CheckMemoryPoolValidity.f90 @@ -5,10 +5,10 @@ IF (isvalid) THEN !! Check allocation size - IF (.NOT. SIZE(this%value_array,dim=2) .EQ. rows) THEN + IF (.NOT. SIZE(this%value_array, dim = 2) .EQ. rows) THEN isvalid = .FALSE. END IF - IF (.NOT. SIZE(this%value_array,dim=1) .EQ. columns) THEN + IF (.NOT. SIZE(this%value_array, dim = 1) .EQ. columns) THEN isvalid = .FALSE. END IF END IF diff --git a/Source/Fortran/dense_includes/ComposeMatrix.f90 b/Source/Fortran/dense_includes/ComposeMatrix.f90 index 14dbe388..28de6079 100644 --- a/Source/Fortran/dense_includes/ComposeMatrix.f90 +++ b/Source/Fortran/dense_includes/ComposeMatrix.f90 @@ -1,6 +1,6 @@ !! Local Data - INTEGER, DIMENSION(block_rows+1) :: row_offsets - INTEGER, DIMENSION(block_columns+1) :: column_offsets + INTEGER, DIMENSION(block_rows + 1) :: row_offsets + INTEGER, DIMENSION(block_columns + 1) :: column_offsets INTEGER :: out_rows, out_columns INTEGER :: II, JJ @@ -9,14 +9,14 @@ column_offsets(1) = 1 out_columns = 0 DO JJ = 1, block_columns - column_offsets(JJ+1) = column_offsets(JJ) + mat_array(1,JJ)%columns - out_columns = out_columns + mat_array(1,JJ)%columns + column_offsets(JJ + 1) = column_offsets(JJ) + mat_array(1, JJ)%columns + out_columns = out_columns + mat_array(1, JJ)%columns END DO row_offsets(1) = 1 out_rows = 0 DO II = 1, block_rows - row_offsets(II+1) = row_offsets(II) + mat_array(II,1)%rows - out_rows = out_rows + mat_array(II,1)%rows + row_offsets(II + 1) = row_offsets(II) + mat_array(II, 1)%rows + out_rows = out_rows + mat_array(II, 1)%rows END DO !! Allocate Memory @@ -25,8 +25,8 @@ !! Copy DO JJ = 1, block_columns DO II = 1, block_rows - out_matrix%DATA(row_offsets(II):row_offsets(II+1)-1, & - & column_offsets(JJ):column_offsets(JJ+1)-1) = & - & mat_array(II,JJ)%DATA + out_matrix%DATA(row_offsets(II):row_offsets(II + 1) - 1, & + & column_offsets(JJ):column_offsets(JJ + 1) - 1) = & + & mat_array(II, JJ)%DATA END DO END DO diff --git a/Source/Fortran/dense_includes/ConstructEmptyMatrix.f90 b/Source/Fortran/dense_includes/ConstructEmptyMatrix.f90 index 48ec05d1..8c8bbe9d 100644 --- a/Source/Fortran/dense_includes/ConstructEmptyMatrix.f90 +++ b/Source/Fortran/dense_includes/ConstructEmptyMatrix.f90 @@ -3,4 +3,4 @@ this%rows = rows this%columns = columns - ALLOCATE(this%DATA(rows,columns)) + ALLOCATE(this%DATA(rows, columns)) diff --git a/Source/Fortran/dense_includes/ConstructMatrixDFromS.f90 b/Source/Fortran/dense_includes/ConstructMatrixDFromS.f90 index 860a5895..9f6f9111 100644 --- a/Source/Fortran/dense_includes/ConstructMatrixDFromS.f90 +++ b/Source/Fortran/dense_includes/ConstructMatrixDFromS.f90 @@ -1,23 +1,22 @@ !! Helper Variables - INTEGER :: inner_counter, outer_counter + INTEGER :: II, JJ + INTEGER :: KK ! Total element counter INTEGER :: elements_per_inner - INTEGER :: total_counter CALL ConstructEmptyMatrix(dense_matrix, sparse_matrix%rows, & & sparse_matrix%columns) + dense_matrix%DATA = 0 !! Loop over elements. - dense_matrix%DATA = 0 - total_counter = 1 - DO outer_counter = 1, sparse_matrix%columns - elements_per_inner = sparse_matrix%outer_index(outer_counter+1) - & - & sparse_matrix%outer_index(outer_counter) - temporary%index_column = outer_counter - DO inner_counter = 1, elements_per_inner - temporary%index_row = sparse_matrix%inner_index(total_counter) - temporary%point_value = sparse_matrix%values(total_counter) - dense_matrix%DATA(temporary%index_row, temporary%index_column) = & - & temporary%point_value - total_counter = total_counter + 1 + KK = 1 + DO JJ = 1, sparse_matrix%columns + elements_per_inner = sparse_matrix%outer_index(JJ + 1) - & + & sparse_matrix%outer_index(JJ) + temp%index_column = JJ + DO II = 1, elements_per_inner + temp%index_row = sparse_matrix%inner_index(KK) + temp%point_value = sparse_matrix%values(KK) + dense_matrix%DATA(temp%index_row, temp%index_column) = temp%point_value + KK = KK + 1 END DO END DO diff --git a/Source/Fortran/dense_includes/ConstructMatrixMemoryPool.f90 b/Source/Fortran/dense_includes/ConstructMatrixMemoryPool.f90 index f83a5e80..93e4d7b3 100644 --- a/Source/Fortran/dense_includes/ConstructMatrixMemoryPool.f90 +++ b/Source/Fortran/dense_includes/ConstructMatrixMemoryPool.f90 @@ -10,19 +10,19 @@ IF (.NOT. PRESENT(sparsity_in)) THEN this%hash_size = 1 ELSE - this%hash_size = INT(1.0/sparsity_in) + this%hash_size = INT(1.0 / sparsity_in) IF (this%hash_size > columns) this%hash_size = columns END IF num_buckets = columns/this%hash_size + 1 !! Allocate - ALLOCATE(this%pruned_list(columns*rows), stat=alloc_stat) - ALLOCATE(this%value_array(columns,rows), stat=alloc_stat) - ALLOCATE(this%dirty_array(columns,rows), stat=alloc_stat) + ALLOCATE(this%pruned_list(columns * rows), stat = alloc_stat) + ALLOCATE(this%value_array(columns, rows), stat = alloc_stat) + ALLOCATE(this%dirty_array(columns, rows), stat = alloc_stat) - ALLOCATE(this%hash_index(columns,rows)) - ALLOCATE(this%inserted_per_bucket(columns,rows)) + ALLOCATE(this%hash_index(columns, rows)) + ALLOCATE(this%inserted_per_bucket(columns, rows)) this%value_array = 0 this%hash_index = 0 diff --git a/Source/Fortran/dense_includes/ConstructMatrixSFromD.f90 b/Source/Fortran/dense_includes/ConstructMatrixSFromD.f90 index 6bb618a8..c9fc2546 100644 --- a/Source/Fortran/dense_includes/ConstructMatrixSFromD.f90 +++ b/Source/Fortran/dense_includes/ConstructMatrixSFromD.f90 @@ -1,37 +1,39 @@ !! Local Variables - INTEGER :: inner_counter, outer_counter - INTEGER :: columns, rows - - columns = dense_matrix%columns - rows = dense_matrix%rows + INTEGER :: II, JJ, KK, NNZ + REAL(NTREAL) :: threshold IF (PRESENT(threshold_in)) THEN - CALL ConstructTripletList(temporary_list) - DO outer_counter = 1, columns - temporary%index_column = outer_counter - DO inner_counter = 1, rows - temporary%point_value = & - & dense_matrix%DATA(inner_counter,outer_counter) - IF (ABS(temporary%point_value) .GT. threshold_in) THEN - temporary%index_row = inner_counter - CALL AppendToTripletList(temporary_list,temporary) - END IF - END DO - END DO + threshold = threshold_in ELSE - CALL ConstructTripletList(temporary_list, rows*columns) - DO outer_counter = 1, columns - temporary%index_column = outer_counter - DO inner_counter = 1, rows - temporary%point_value = & - & dense_matrix%DATA(inner_counter,outer_counter) - temporary%index_row = inner_counter - temporary_list%DATA(inner_counter+rows*(outer_counter-1)) = & - & temporary - END DO - END DO + threshold = 0.0_NTREAL END IF - CALL ConstructMatrixFromTripletList(sparse_matrix, temporary_list, & - & rows, columns) - CALL DestructTripletList(temporary_list) + CALL ConstructEmptyMatrix(sparse_matrix, dense_matrix%rows, & + & dense_matrix%columns) + + !! Fill in the outer index information. + NNZ = 0 + DO II = 1, dense_matrix%columns + DO JJ = 1, dense_matrix%rows + IF (ABS(dense_matrix%DATA(JJ, II)) .GT. threshold) THEN + NNZ = NNZ + 1 + END IF + END DO + sparse_matrix%outer_index(II + 1) = NNZ + END DO + + !! Allocate Storage + ALLOCATE(sparse_matrix%inner_index(NNZ)) + ALLOCATE(sparse_matrix%values(NNZ)) + + !! Fill in the Values + KK = 1 + DO II = 1, dense_matrix%columns + DO JJ = 1, dense_matrix%rows + IF (ABS(dense_matrix%DATA(JJ, II)) .GT. threshold) THEN + sparse_matrix%inner_index(KK) = JJ + sparse_matrix%values(KK) = dense_matrix%DATA(JJ, II) + KK = KK + 1 + END IF + END DO + END DO diff --git a/Source/Fortran/dense_includes/SetPoolSparsity.f90 b/Source/Fortran/dense_includes/SetPoolSparsity.f90 index 45699b10..105450ba 100644 --- a/Source/Fortran/dense_includes/SetPoolSparsity.f90 +++ b/Source/Fortran/dense_includes/SetPoolSparsity.f90 @@ -1,6 +1,6 @@ !! Local Variables INTEGER :: num_buckets - this%hash_size = INT(1.0/sparsity) - IF (this%hash_size > this%columns) this%hash_size = this%columns - num_buckets = this%columns/this%hash_size + 1 + this%hash_size = INT(1.0 / sparsity) + IF (this%hash_size .GT. this%columns) this%hash_size = this%columns + num_buckets = this%columns / this%hash_size + 1 diff --git a/Source/Fortran/dense_includes/SplitMatrix.f90 b/Source/Fortran/dense_includes/SplitMatrix.f90 index 8b7ee86e..24b0021b 100644 --- a/Source/Fortran/dense_includes/SplitMatrix.f90 +++ b/Source/Fortran/dense_includes/SplitMatrix.f90 @@ -1,8 +1,8 @@ !! Local Data INTEGER, DIMENSION(block_rows) :: block_size_row INTEGER, DIMENSION(block_columns) :: block_size_column - INTEGER, DIMENSION(block_rows+1) :: row_offsets - INTEGER, DIMENSION(block_columns+1) :: column_offsets + INTEGER, DIMENSION(block_rows + 1) :: row_offsets + INTEGER, DIMENSION(block_columns + 1) :: column_offsets !! Temporary Variables INTEGER :: divisor_row, divisor_column INTEGER :: II, JJ @@ -11,36 +11,36 @@ IF (PRESENT(block_size_row_in)) THEN block_size_row = block_size_row_in ELSE - divisor_row = this%rows/block_rows + divisor_row = this%rows / block_rows block_size_row = divisor_row - block_size_row(block_rows) = this%rows - divisor_row*(block_rows-1) + block_size_row(block_rows) = this%rows - divisor_row * (block_rows - 1) END IF IF (PRESENT(block_size_column_in)) THEN block_size_column = block_size_column_in ELSE - divisor_column = this%columns/block_columns + divisor_column = this%columns / block_columns block_size_column = divisor_column block_size_column(block_columns) = this%columns - & - & divisor_column*(block_columns-1) + & divisor_column * (block_columns - 1) END IF !! Copy the block offsets row_offsets(1) = 1 DO II = 1, block_rows - row_offsets(II+1) = row_offsets(II) + block_size_row(II) + row_offsets(II + 1) = row_offsets(II) + block_size_row(II) END DO column_offsets(1) = 1 DO JJ = 1, block_columns - column_offsets(JJ+1) = column_offsets(JJ) + block_size_column(JJ) + column_offsets(JJ + 1) = column_offsets(JJ) + block_size_column(JJ) END DO !! Copy DO JJ = 1, block_columns DO II = 1, block_rows - CALL ConstructEmptyMatrix(split_array(II,JJ), block_size_column(JJ), & + CALL ConstructEmptyMatrix(split_array(II, JJ), block_size_column(JJ), & & block_size_row(II)) - split_array(II,JJ)%DATA = & - & this%DATA(row_offsets(II):row_offsets(II+1)-1, & - & column_offsets(JJ):column_offsets(JJ+1)-1) + split_array(II, JJ)%DATA = & + & this%DATA(row_offsets(II):row_offsets(II + 1) - 1, & + & column_offsets(JJ):column_offsets(JJ + 1) - 1) END DO END DO diff --git a/Source/Fortran/distributed_algebra_includes/DotMatrix.f90 b/Source/Fortran/distributed_algebra_includes/DotMatrix.f90 index 039e62bc..2ab62553 100644 --- a/Source/Fortran/distributed_algebra_includes/DotMatrix.f90 +++ b/Source/Fortran/distributed_algebra_includes/DotMatrix.f90 @@ -8,7 +8,7 @@ CALL PairwiseMultiplyMatrix(matAH, matB, matC) CALL DestructMatrix(matAH) ELSE - CALL PairwiseMultiplyMatrix(matA,matB,matC) + CALL PairwiseMultiplyMatrix(matA, matB, matC) END IF CALL MatrixGrandSum(matC, product) diff --git a/Source/Fortran/distributed_algebra_includes/IncrementMatrix.f90 b/Source/Fortran/distributed_algebra_includes/IncrementMatrix.f90 index 34362820..64cf5f13 100644 --- a/Source/Fortran/distributed_algebra_includes/IncrementMatrix.f90 +++ b/Source/Fortran/distributed_algebra_includes/IncrementMatrix.f90 @@ -2,7 +2,7 @@ !$omp do collapse(2) DO JJ = 1, matA%process_grid%number_of_blocks_columns DO II = 1, matA%process_grid%number_of_blocks_rows - CALL IncrementMatrix(matA%LMAT(II,JJ), matB%LMAT(II,JJ), alpha, & + CALL IncrementMatrix(matA%LMAT(II, JJ), matB%LMAT(II, JJ), alpha, & & threshold) END DO END DO diff --git a/Source/Fortran/distributed_algebra_includes/MatrixGrandSum.f90 b/Source/Fortran/distributed_algebra_includes/MatrixGrandSum.f90 index ea7ce6e1..e6615c76 100644 --- a/Source/Fortran/distributed_algebra_includes/MatrixGrandSum.f90 +++ b/Source/Fortran/distributed_algebra_includes/MatrixGrandSum.f90 @@ -1,8 +1,8 @@ sum = 0 DO JJ = 1, this%process_grid%number_of_blocks_columns DO II = 1, this%process_grid%number_of_blocks_rows - CALL MatrixGrandSum(this%LMAT(II,JJ), TEMP) - sum = sum + REAL(TEMP, KIND=NTREAL) + CALL MatrixGrandSum(this%LMAT(II, JJ), TEMP) + sum = sum + REAL(TEMP, KIND = NTREAL) END DO END DO diff --git a/Source/Fortran/distributed_algebra_includes/MatrixMultiply.f90 b/Source/Fortran/distributed_algebra_includes/MatrixMultiply.f90 index 3969dbac..8165ae0f 100644 --- a/Source/Fortran/distributed_algebra_includes/MatrixMultiply.f90 +++ b/Source/Fortran/distributed_algebra_includes/MatrixMultiply.f90 @@ -1,9 +1,29 @@ - CALL StartTimer("GEMM") + !! Communication Helpers + TYPE(ReduceHelper_t), DIMENSION(:), ALLOCATABLE :: row_helper + TYPE(ReduceHelper_t), DIMENSION(:), ALLOCATABLE :: column_helper + TYPE(ReduceHelper_t), DIMENSION(:, :), ALLOCATABLE :: slice_helper + !! For Iterating Over Local Blocks + INTEGER :: II, II2 + INTEGER :: JJ, JJ2 + INTEGER :: duplicate_start_column, duplicate_offset_column + INTEGER :: duplicate_start_row, duplicate_offset_row + REAL(NTREAL) :: working_threshold + !! Scheduling the A work + INTEGER, DIMENSION(:), ALLOCATABLE :: ATasks + INTEGER :: ATasks_completed + !! Scheduling the B work + INTEGER, DIMENSION(:), ALLOCATABLE :: BTasks + INTEGER :: BTasks_completed + !! Scheduling the AB work + INTEGER, DIMENSION(:,:), ALLOCATABLE :: ABTasks + INTEGER :: ABTasks_completed + !! Temporary AB matrix for scaling. + TYPE(Matrix_ps) :: matAB !! The threshold needs to be smaller if we are doing a sliced version !! because you might flush a value that would be kept in the summed version. IF (matA%process_grid%num_process_slices .GT. 1) THEN - working_threshold = threshold/(matA%process_grid%num_process_slices*1000) + working_threshold = threshold / (matA%process_grid%num_process_slices*1000) ELSE working_threshold = threshold END IF @@ -12,13 +32,13 @@ CALL ConstructEmptyMatrix(matAB, matA) ALLOCATE(AdjacentABlocks(matAB%process_grid%number_of_blocks_rows, & - & matAB%process_grid%number_of_blocks_columns/& + & matAB%process_grid%number_of_blocks_columns / & & matAB%process_grid%num_process_slices)) ALLOCATE(LocalRowContribution(matAB%process_grid%number_of_blocks_rows)) ALLOCATE(GatheredRowContribution(matAB%process_grid%number_of_blocks_rows)) ALLOCATE(GatheredRowContributionT(matAB%process_grid%number_of_blocks_rows)) - ALLOCATE(TransposedBBlocks(matAB%process_grid%number_of_blocks_rows/& + ALLOCATE(TransposedBBlocks(matAB%process_grid%number_of_blocks_rows / & & matAB%process_grid%num_process_slices, & & matAB%process_grid%number_of_blocks_columns)) ALLOCATE(LocalColumnContribution(& @@ -36,53 +56,55 @@ !! Construct the task queues ALLOCATE(ATasks(matAB%process_grid%number_of_blocks_rows)) - DO II=1,matAB%process_grid%number_of_blocks_rows + DO II = 1, matAB%process_grid%number_of_blocks_rows ATasks(II) = LocalGatherA END DO ALLOCATE(BTasks(matAB%process_grid%number_of_blocks_columns)) - DO JJ=1,matAB%process_grid%number_of_blocks_columns + DO JJ = 1, matAB%process_grid%number_of_blocks_columns BTasks(JJ) = LocalGatherB END DO ALLOCATE(ABTasks(matAB%process_grid%number_of_blocks_rows, & & matAB%process_grid%number_of_blocks_columns)) - DO JJ=1,matAB%process_grid%number_of_blocks_columns - DO II=1,matAB%process_grid%number_of_blocks_rows + DO JJ = 1, matAB%process_grid%number_of_blocks_columns + DO II = 1, matAB%process_grid%number_of_blocks_rows ABTasks(II,JJ) = AwaitingAB END DO END DO !! Setup A Tasks - duplicate_start_column = matAB%process_grid%my_slice+1 + duplicate_start_column = matAB%process_grid%my_slice + 1 duplicate_offset_column = matAB%process_grid%num_process_slices !! Setup B Tasks - duplicate_start_row = matAB%process_grid%my_slice+1 + duplicate_start_row = matAB%process_grid%my_slice + 1 duplicate_offset_row = matAB%process_grid%num_process_slices !! Run A Tasks ATasks_completed = 0 BTasks_completed = 0 ABTasks_completed = 0 + !$OMP PARALLEL !$OMP MASTER DO WHILE (ATasks_completed .LT. SIZE(ATasks) .OR. & & BTasks_completed .LT. SIZE(BTasks) .OR. & & ABTasks_completed .LT. SIZE(ABTasks)) - DO II=1, matAB%process_grid%number_of_blocks_rows + DO II = 1, matAB%process_grid%number_of_blocks_rows SELECT CASE (ATasks(II)) CASE(LocalGatherA) ATasks(II) = TaskRunningA !$OMP TASK DEFAULT(SHARED), PRIVATE(JJ2), FIRSTPRIVATE(II) !! First Align The Data We Are Working With - DO JJ2=1, & - & matAB%process_grid%number_of_blocks_columns/ & + DO JJ2 = 1, & + & matAB%process_grid%number_of_blocks_columns / & & matAB%process_grid%num_process_slices CALL CopyMatrix(matA%LMAT(II, & - & duplicate_start_column+duplicate_offset_column*(JJ2-1)),& - & AdjacentABlocks(II,JJ2)) + & duplicate_start_column + & + & duplicate_offset_column * (JJ2 - 1)),& + & AdjacentABlocks(II, JJ2)) END DO !! Then Do A Local Gather - CALL ComposeMatrixColumns(AdjacentABlocks(II,:), & + CALL ComposeMatrixColumns(AdjacentABlocks(II, :), & & LocalRowContribution(II)) ATasks(II) = SendSizeA !$OMP END TASK @@ -122,20 +144,20 @@ END SELECT END DO !! B Tasks - DO JJ=1,matAB%process_grid%number_of_blocks_columns + DO JJ = 1 , matAB%process_grid%number_of_blocks_columns SELECT CASE (BTasks(JJ)) CASE(LocalGatherB) BTasks(JJ) = TaskRunningB !$OMP TASK DEFAULT(SHARED), PRIVATE(II2), FIRSTPRIVATE(JJ) !! First Transpose The Data We Are Working With - DO II2=1, matAB%process_grid%number_of_blocks_rows/& + DO II2 = 1, matAB%process_grid%number_of_blocks_rows / & & matAB%process_grid%num_process_slices - CALL TransposeMatrix(matB%LMAT(duplicate_start_row+& - & duplicate_offset_row*(II2-1),JJ), & - & TransposedBBlocks(II2,JJ)) + CALL TransposeMatrix(matB%LMAT(duplicate_start_row + & + & duplicate_offset_row * (II2 - 1), JJ), & + & TransposedBBlocks(II2, JJ)) END DO !! Then Do A Local Gather - CALL ComposeMatrixColumns(TransposedBBlocks(:,JJ), & + CALL ComposeMatrixColumns(TransposedBBlocks(:, JJ), & & LocalColumnContribution(JJ)) BTasks(JJ) = SendSizeB !$OMP END TASK @@ -173,61 +195,60 @@ END SELECT END DO !! AB Tasks - DO II=1,matAB%process_grid%number_of_blocks_rows - DO JJ=1,matAB%process_grid%number_of_blocks_columns - SELECT CASE(ABTasks(II,JJ)) + DO II = 1 , matAB%process_grid%number_of_blocks_rows + DO JJ = 1, matAB%process_grid%number_of_blocks_columns + SELECT CASE(ABTasks(II, JJ)) CASE (AwaitingAB) IF (ATasks(II) .EQ. FinishedA .AND. & & BTasks(JJ) .EQ. FinishedB) THEN - ABTasks(II,JJ) = GemmAB + ABTasks(II, JJ) = GemmAB END IF CASE (GemmAB) - ABTasks(II,JJ) = TaskRunningAB - !$OMP TASK DEFAULT(shared), FIRSTPRIVATE(II,JJ) + ABTasks(II, JJ) = TaskRunningAB + !$OMP TASK DEFAULT(shared), FIRSTPRIVATE(II, JJ) CALL MatrixMultiply(GatheredRowContributionT(II), & & GatheredColumnContribution(JJ), & - & SliceContribution(II,JJ), & - & IsATransposed_in=.TRUE., IsBTransposed_in=.TRUE., & - & alpha_in=alpha, threshold_in=working_threshold, & - & blocked_memory_pool_in=MPGRID(II,JJ)) + & SliceContribution(II, JJ), & + & IsATransposed_in = .TRUE., IsBTransposed_in = .TRUE., & + & alpha_in = alpha, threshold_in = working_threshold, & + & blocked_memory_pool_in = MPGRID(II, JJ)) !! We can exit early if there is only one process slice IF (matAB%process_grid%num_process_slices .EQ. 1) THEN ABTasks(II,JJ) = CleanupAB - CALL CopyMatrix(SliceContribution(II,JJ), matAB%LMAT(II,JJ)) + CALL CopyMatrix(SliceContribution(II, JJ), matAB%LMAT(II, JJ)) ELSE - ABTasks(II,JJ) = SendSizeAB + ABTasks(II, JJ) = SendSizeAB END IF !$OMP END TASK CASE(SendSizeAB) - CALL ReduceAndSumMatrixSizes(SliceContribution(II,JJ),& - & matAB%process_grid%blocked_between_slice_comm(II,JJ), & - & matAB%LMAT(II,JJ), slice_helper(II,JJ)) - ABTasks(II,JJ) = GatherAndSumAB + CALL ReduceAndSumMatrixSizes(SliceContribution(II, JJ),& + & matAB%process_grid%blocked_between_slice_comm(II, JJ), & + & matAB%LMAT(II, JJ), slice_helper(II, JJ)) + ABTasks(II, JJ) = GatherAndSumAB CASE (GatherAndSumAB) - IF (TestReduceSizeRequest(slice_helper(II,JJ))) THEN - CALL ReduceAndSumMatrixData(SliceContribution(II,JJ), & - & matAB%LMAT(II,JJ), & - & matAB%process_grid%blocked_between_slice_comm(II,JJ),& - & slice_helper(II,JJ)) - ABTasks(II,JJ) = WaitInnerAB + IF (TestReduceSizeRequest(slice_helper(II, JJ))) THEN + CALL ReduceAndSumMatrixData(SliceContribution(II, JJ), & + & matAB%process_grid%blocked_between_slice_comm(II, JJ), & + & matAB%LMAT(II, JJ), slice_helper(II, JJ)) + ABTasks(II, JJ) = WaitInnerAB END IF CASE (WaitInnerAB) - IF (TestReduceInnerRequest(slice_helper(II,JJ))) THEN - ABTasks(II,JJ) = WaitDataAB + IF (TestReduceInnerRequest(slice_helper(II, JJ))) THEN + ABTasks(II, JJ) = WaitDataAB END IF CASE (WaitDataAB) - IF (TestReduceDataRequest(slice_helper(II,JJ))) THEN - ABTasks(II,JJ) = LocalSumAB + IF (TestReduceDataRequest(slice_helper(II, JJ))) THEN + ABTasks(II, JJ) = LocalSumAB END IF CASE(LocalSumAB) - ABTasks(II,JJ) = TaskRunningAB - !$OMP TASK DEFAULT(SHARED), FIRSTPRIVATE(II,JJ) - CALL ReduceAndSumMatrixCleanup(SliceContribution(II,JJ), & - & matAB%LMAT(II,JJ), threshold, slice_helper(II,JJ)) - ABTasks(II,JJ) = CleanupAB + ABTasks(II, JJ) = TaskRunningAB + !$OMP TASK DEFAULT(SHARED), FIRSTPRIVATE(II, JJ) + CALL ReduceAndSumMatrixCleanup(SliceContribution(II, JJ), & + & matAB%LMAT(II, JJ), threshold, slice_helper(II, JJ)) + ABTasks(II, JJ) = CleanupAB !$OMP END TASK CASE(CleanupAB) - ABTasks(II,JJ) = FinishedAB + ABTasks(II, JJ) = FinishedAB ABTasks_completed = ABTasks_completed + 1 END SELECT END DO @@ -242,10 +263,10 @@ !! Copy to output matrix. IF (beta .EQ. 0.0) THEN - CALL CopyMatrix(matAB,matC) + CALL CopyMatrix(matAB, matC) ELSE - CALL ScaleMatrix(MatC,beta) - CALL IncrementMatrix(MatAB,MatC) + CALL ScaleMatrix(MatC, beta) + CALL IncrementMatrix(MatAB, MatC) END IF !! Cleanup @@ -258,10 +279,10 @@ DEALLOCATE(ABTasks) !! Deallocate Buffers From A - DO II=1,matAB%process_grid%number_of_blocks_rows - DO JJ2=1,matAB%process_grid%number_of_blocks_columns/& + DO II = 1, matAB%process_grid%number_of_blocks_rows + DO JJ2 = 1, matAB%process_grid%number_of_blocks_columns / & & matAB%process_grid%num_process_slices - CALL DestructMatrix(AdjacentABlocks(II,JJ2)) + CALL DestructMatrix(AdjacentABlocks(II, JJ2)) END DO CALL DestructMatrix(LocalRowContribution(II)) CALL DestructMatrix(GatheredRowContribution(II)) @@ -270,30 +291,28 @@ DEALLOCATE(LocalRowContribution) DEALLOCATE(GatheredRowContribution) !! Deallocate Buffers From B - DO JJ=1,matAB%process_grid%number_of_blocks_columns - DO II2=1,matAB%process_grid%number_of_blocks_rows/& + DO JJ = 1, matAB%process_grid%number_of_blocks_columns + DO II2 = 1, matAB%process_grid%number_of_blocks_rows / & & matAB%process_grid%num_process_slices - CALL DestructMatrix(TransposedBBlocks(II2,JJ)) + CALL DestructMatrix(TransposedBBlocks(II2, JJ)) END DO CALL DestructMatrix(LocalColumnContribution(JJ)) END DO DEALLOCATE(TransposedBBlocks) DEALLOCATE(LocalColumnContribution) !! Deallocate Buffers From Multiplying The Block - DO II=1,matAB%process_grid%number_of_blocks_rows + DO II = 1, matAB%process_grid%number_of_blocks_rows CALL DestructMatrix(GatheredRowContributionT(II)) END DO - DO JJ=1,matAB%process_grid%number_of_blocks_columns + DO JJ = 1, matAB%process_grid%number_of_blocks_columns CALL DestructMatrix(GatheredColumnContribution(JJ)) END DO DEALLOCATE(GatheredRowContributionT) DEALLOCATE(GatheredColumnContribution) !! Deallocate Buffers From Sum - DO JJ=1,matAB%process_grid%number_of_blocks_columns - DO II=1,matAB%process_grid%number_of_blocks_rows - CALL DestructMatrix(SliceContribution(II,JJ)) + DO JJ = 1, matAB%process_grid%number_of_blocks_columns + DO II = 1, matAB%process_grid%number_of_blocks_rows + CALL DestructMatrix(SliceContribution(II, JJ)) END DO END DO DEALLOCATE(SliceContribution) - - CALL StopTimer("GEMM") diff --git a/Source/Fortran/distributed_algebra_includes/MatrixNorm.f90 b/Source/Fortran/distributed_algebra_includes/MatrixNorm.f90 index da0cbbea..04f9028b 100644 --- a/Source/Fortran/distributed_algebra_includes/MatrixNorm.f90 +++ b/Source/Fortran/distributed_algebra_includes/MatrixNorm.f90 @@ -3,13 +3,13 @@ ALLOCATE(local_norm(LMAT%columns)) !! Sum Along Columns - CALL MatrixColumnNorm(LMAT,local_norm) - CALL MPI_Allreduce(MPI_IN_PLACE,local_norm,SIZE(local_norm), & + CALL MatrixColumnNorm(LMAT, local_norm) + CALL MPI_Allreduce(MPI_IN_PLACE, local_norm, SIZE(local_norm), & & MPINTREAL, MPI_SUM, this%process_grid%column_comm, ierr) !! Find Max Value Amonst Columns norm_value = MAXVAL(local_norm) - CALL MPI_Allreduce(MPI_IN_PLACE,norm_value,1,MPINTREAL,MPI_MAX, & + CALL MPI_Allreduce(MPI_IN_PLACE, norm_value,1, MPINTREAL, MPI_MAX, & & this%process_grid%row_comm, ierr) CALL DestructMatrix(LMAT) diff --git a/Source/Fortran/distributed_algebra_includes/MatrixSigma.f90 b/Source/Fortran/distributed_algebra_includes/MatrixSigma.f90 index b0739287..c34d67ae 100644 --- a/Source/Fortran/distributed_algebra_includes/MatrixSigma.f90 +++ b/Source/Fortran/distributed_algebra_includes/MatrixSigma.f90 @@ -3,20 +3,18 @@ ALLOCATE(column_sigma_contribution(LMAT%columns)) column_sigma_contribution = 0 - DO outer_counter = 1, LMAT%columns - DO inner_counter = LMAT%outer_index(outer_counter), & - & LMAT%outer_index(outer_counter+1)-1 - column_sigma_contribution(outer_counter) = & - & column_sigma_contribution(outer_counter) + & - & ABS(LMAT%values(inner_counter+1)) + DO II = 1, LMAT%columns + DO JJ = LMAT%outer_index(II), LMAT%outer_index(II + 1) - 1 + column_sigma_contribution(II) = column_sigma_contribution(II) + & + & ABS(LMAT%values(JJ + 1)) END DO END DO - CALL MPI_Allreduce(MPI_IN_PLACE,column_sigma_contribution,& - & LMAT%columns,MPINTREAL,MPI_SUM, & + CALL MPI_Allreduce(MPI_IN_PLACE, column_sigma_contribution, & + & LMAT%columns, MPINTREAL, MPI_SUM, & & this%process_grid%column_comm, ierr) - CALL MPI_Allreduce(MAXVAL(column_sigma_contribution),sigma_value,1, & - & MPINTREAL,MPI_MAX, this%process_grid%row_comm, ierr) - sigma_value = 1.0_NTREAL/(sigma_value**2) + CALL MPI_Allreduce(MAXVAL(column_sigma_contribution), sigma_value, 1, & + & MPINTREAL, MPI_MAX, this%process_grid%row_comm, ierr) + sigma_value = 1.0_NTREAL / (sigma_value**2) DEALLOCATE(column_sigma_contribution) CALL DestructMatrix(LMAT) diff --git a/Source/Fortran/distributed_algebra_includes/MatrixTrace.f90 b/Source/Fortran/distributed_algebra_includes/MatrixTrace.f90 index ad657556..83de165c 100644 --- a/Source/Fortran/distributed_algebra_includes/MatrixTrace.f90 +++ b/Source/Fortran/distributed_algebra_includes/MatrixTrace.f90 @@ -4,11 +4,11 @@ !! Compute The Local Contribution trace_value = 0 CALL MatrixToTripletList(LMAT, TLIST) - DO counter = 1, TLIST%CurrentSize - IF (this%start_row + TLIST%DATA(counter)%index_row .EQ. & - & this%start_column + TLIST%DATA(counter)%index_column) THEN + DO II = 1, TLIST%CurrentSize + IF (this%start_row + TLIST%DATA(II)%index_row .EQ. & + & this%start_column + TLIST%DATA(II)%index_column) THEN trace_value = trace_value + & - & REAL(TLIST%DATA(counter)%point_value, NTREAL) + & REAL(TLIST%DATA(II)%point_value, NTREAL) END IF END DO diff --git a/Source/Fortran/distributed_algebra_includes/PairwiseMultiply.f90 b/Source/Fortran/distributed_algebra_includes/PairwiseMultiply.f90 index 224361bb..88c11f1e 100644 --- a/Source/Fortran/distributed_algebra_includes/PairwiseMultiply.f90 +++ b/Source/Fortran/distributed_algebra_includes/PairwiseMultiply.f90 @@ -5,8 +5,8 @@ !$omp do collapse(2) DO JJ = 1, matA%process_grid%number_of_blocks_columns DO II = 1, matA%process_grid%number_of_blocks_rows - CALL PairwiseMultiplyMatrix(matA%LMAT(II,JJ), matB%LMAT(II,JJ), & - & matC%LMAT(II,JJ)) + CALL PairwiseMultiplyMatrix(matA%LMAT(II, JJ), matB%LMAT(II, JJ), & + & matC%LMAT(II, JJ)) END DO END DO !$omp end do diff --git a/Source/Fortran/distributed_algebra_includes/ScaleMatrix.f90 b/Source/Fortran/distributed_algebra_includes/ScaleMatrix.f90 index 70954492..0459ccfc 100644 --- a/Source/Fortran/distributed_algebra_includes/ScaleMatrix.f90 +++ b/Source/Fortran/distributed_algebra_includes/ScaleMatrix.f90 @@ -2,7 +2,7 @@ !$omp do collapse(2) DO JJ = 1, this%process_grid%number_of_blocks_columns DO II = 1, this%process_grid%number_of_blocks_rows - CALL ScaleMatrix(this%LOCALDATA(II,JJ),constant) + CALL ScaleMatrix(this%LOCALDATA(II, JJ), constant) END DO END DO !$omp end do diff --git a/Source/Fortran/distributed_includes/CommSplitMatrix.f90 b/Source/Fortran/distributed_includes/CommSplitMatrix.f90 index 8f98dbae..e0af23fc 100644 --- a/Source/Fortran/distributed_includes/CommSplitMatrix.f90 +++ b/Source/Fortran/distributed_includes/CommSplitMatrix.f90 @@ -5,7 +5,7 @@ INTEGER :: between_grid_rank !! For Data Redistribution INTEGER :: fsize - INTEGER :: counter + INTEGER :: II INTEGER :: ierr IF (this%process_grid%total_processors .EQ. 1) THEN @@ -19,7 +19,7 @@ !! Copy The Data Across New Process Grids. Unnecessary if we just split !! by slices. - CALL GetMatrixTripletList(this,full_list) + CALL GetMatrixTripletList(this, full_list) IF (.NOT. split_slice) THEN CALL MPI_COMM_SIZE(between_grid_comm, between_grid_size, ierr) CALL MPI_COMM_RANK(between_grid_comm, between_grid_rank, ierr) @@ -32,26 +32,26 @@ CALL ConstructTripletList(send_list(1)) CALL ConstructTripletList(send_list(2), full_list%CurrentSize) send_list(2)%DATA(:fsize) = full_list%DATA(:fsize) - DO counter = 3, between_grid_size - CALL ConstructTripletList(send_list(counter)) + DO II = 3, between_grid_size + CALL ConstructTripletList(send_list(II)) END DO ELSE !! The larger process grid only needs to send to process 1 CALL ConstructTripletList(send_list(1), full_list%CurrentSize) send_list(1)%DATA(:fsize) = full_list%DATA(:fsize) - DO counter = 2, between_grid_size - CALL ConstructTripletList(send_list(counter)) + DO II = 2, between_grid_size + CALL ConstructTripletList(send_list(II)) END DO END IF - CALL ConstructTripletList(send_list(between_grid_rank+1), & + CALL ConstructTripletList(send_list(between_grid_rank + 1), & & full_list%CurrentSize) - send_list(between_grid_rank+1)%DATA(:fsize) = full_list%DATA(:fsize) + send_list(between_grid_rank + 1)%DATA(:fsize) = full_list%DATA(:fsize) CALL RedistributeTripletLists(send_list, between_grid_comm, new_list) END IF !! Create The New Matrix CALL ConstructEmptyMatrix(split_mat, this%actual_matrix_dimension, & - & process_grid_in=new_grid, is_complex_in=this%is_complex) + & process_grid_in = new_grid, is_complex_in = this%is_complex) IF (.NOT. split_slice) THEN CALL FillMatrixFromTripletList(split_mat, new_list, .TRUE.) ELSE @@ -62,8 +62,8 @@ CALL DestructTripletList(full_list) CALL DestructTripletList(new_list) IF (ALLOCATED(send_list)) THEN - DO counter = 1, between_grid_size - CALL DestructTripletList(send_list(counter)) + DO II = 1, between_grid_size + CALL DestructTripletList(send_list(II)) END DO END IF END IF diff --git a/Source/Fortran/distributed_includes/ConvertMatrixType.f90 b/Source/Fortran/distributed_includes/ConvertMatrixType.f90 index bd02b838..15ce3fba 100644 --- a/Source/Fortran/distributed_includes/ConvertMatrixType.f90 +++ b/Source/Fortran/distributed_includes/ConvertMatrixType.f90 @@ -2,7 +2,8 @@ CALL MergeMatrixLocalBlocks(in, local_matrix) CALL ConstructEmptyMatrix(out, in%actual_matrix_dimension, & - & process_grid_in=in%process_grid, is_complex_in=convert_to_complex) + & process_grid_in = in%process_grid, & + & is_complex_in = convert_to_complex) CALL ConvertMatrixType(local_matrix, converted_matrix) CALL SplitMatrixToLocalBlocks(out, converted_matrix) diff --git a/Source/Fortran/distributed_includes/FillMatrixDense.f90 b/Source/Fortran/distributed_includes/FillMatrixDense.f90 index 9efb074f..26ba1edc 100644 --- a/Source/Fortran/distributed_includes/FillMatrixDense.f90 +++ b/Source/Fortran/distributed_includes/FillMatrixDense.f90 @@ -1,26 +1,25 @@ !! Local Data - INTEGER :: II, JJ - INTEGER :: total + INTEGER :: II, JJ, KK - CALL ConstructTripletList(triplet_list, this%local_rows * this%local_columns) + CALL ConstructTripletList(tlist, this%local_rows * this%local_columns) - total = 0 + KK = 0 !! Find local identity values DO JJ = this%start_row, this%end_row - 1 DO II = this%start_column, this%end_column - 1 IF (II .LE. this%actual_matrix_dimension .AND. & & JJ .LE. this%actual_matrix_dimension) THEN - total = total + 1 - triplet_list%DATA(total)%index_column = II - triplet_list%DATA(total)%index_row = JJ - triplet_list%DATA(total)%point_value = 1.0 + KK = KK + 1 + tlist%DATA(KK)%index_column = II + tlist%DATA(KK)%index_row = JJ + tlist%DATA(KK)%point_value = 1.0 END IF END DO END DO - triplet_list%CurrentSize = total + tlist%CurrentSize = KK !! Finish constructing - CALL FillMatrixFromTripletList(this, triplet_list, prepartitioned_in=.TRUE.) + CALL FillMatrixFromTripletList(this, tlist, prepartitioned_in = .TRUE.) !! Cleanup - CALL DestructTripletList(triplet_list) + CALL DestructTripletList(tlist) diff --git a/Source/Fortran/distributed_includes/FillMatrixFromTripletList.f90 b/Source/Fortran/distributed_includes/FillMatrixFromTripletList.f90 index f2213b8f..6151d02b 100644 --- a/Source/Fortran/distributed_includes/FillMatrixFromTripletList.f90 +++ b/Source/Fortran/distributed_includes/FillMatrixFromTripletList.f90 @@ -11,16 +11,14 @@ prepartitioned = prepartitioned_in END IF - CALL StartTimer("FillFromTriplet") - IF (prepartitioned) THEN !! Shift and sort the local entries. - shifted = triplet_list + CALL CopyTripletList(triplet_list, shifted) CALL ShiftTripletList(shifted, 1 - this%start_row, 1 - this%start_column) CALL SortTripletList(shifted, this%local_columns, & - & this%local_rows, sorted_triplet_list) + & this%local_rows, sorted_tlist) !! Build - CALL ConstructMatrixFromTripletList(local_matrix, sorted_triplet_list, & + CALL ConstructMatrixFromTripletList(local_matrix, sorted_tlist, & & this%local_rows, this%local_columns) CALL SplitMatrixToLocalBlocks(this, local_matrix) ELSE @@ -29,18 +27,18 @@ CALL ConstructDefaultPermutation(basic_permutation, & & this%logical_matrix_dimension) CALL RedistributeData(this,basic_permutation%index_lookup, & - & basic_permutation%reverse_index_lookup, triplet_list, & - & sorted_triplet_list) + & basic_permutation%reverse_index_lookup, triplet_list, sorted_tlist) !! Now we can just construct a local matrix. - CALL ConstructMatrixFromTripletList(local_matrix, sorted_triplet_list, & + CALL ConstructMatrixFromTripletList(local_matrix, sorted_tlist, & & this%local_rows, this%local_columns) !! And reduce over the Z dimension. IF (.NOT. preduplicated .AND. & & .NOT. this%process_grid%num_process_slices .EQ. 1) THEN - CALL ReduceAndSumMatrix(local_matrix, gathered_matrix, threshold, & - & this%process_grid%between_slice_comm) + CALL ReduceAndSumMatrix(local_matrix, & + & this%process_grid%between_slice_comm, & + & gathered_matrix, threshold) CALL SplitMatrixToLocalBlocks(this, gathered_matrix) ELSE CALL SplitMatrixToLocalBlocks(this, local_matrix) @@ -48,6 +46,4 @@ END IF CALL DestructMatrix(local_matrix) - CALL DestructTripletList(sorted_triplet_list) - - CALL StopTimer("FillFromTriplet") + CALL DestructTripletList(sorted_tlist) diff --git a/Source/Fortran/distributed_includes/FillMatrixIdentity.f90 b/Source/Fortran/distributed_includes/FillMatrixIdentity.f90 index b1b1be3a..bc41503c 100644 --- a/Source/Fortran/distributed_includes/FillMatrixIdentity.f90 +++ b/Source/Fortran/distributed_includes/FillMatrixIdentity.f90 @@ -1,26 +1,25 @@ !! Local Data - INTEGER :: II, JJ - INTEGER :: total + INTEGER :: II, JJ, KK !! There can't be more than one entry per row - CALL ConstructTripletList(triplet_list, this%local_rows) + CALL ConstructTripletList(tlist, this%local_rows) - total = 0 + KK = 0 !! Find local identity values DO JJ = this%start_row, this%end_row - 1 DO II = this%start_column, this%end_column - 1 IF (JJ .EQ. II .AND. JJ .LE. this%actual_matrix_dimension) THEN - total = total + 1 - triplet_list%DATA(total)%index_column = II - triplet_list%DATA(total)%index_row = JJ - triplet_list%DATA(total)%point_value = 1.0 + KK = KK + 1 + tlist%DATA(KK)%index_column = II + tlist%DATA(KK)%index_row = JJ + tlist%DATA(KK)%point_value = 1.0 END IF END DO END DO - triplet_list%CurrentSize = total + tlist%CurrentSize = KK !! Finish constructing - CALL FillMatrixFromTripletList(this, triplet_list, prepartitioned_in=.TRUE.) + CALL FillMatrixFromTripletList(this, tlist, prepartitioned_in = .TRUE.) !! Cleanup - CALL DestructTripletList(triplet_list) + CALL DestructTripletList(tlist) diff --git a/Source/Fortran/distributed_includes/FillMatrixPermutation.f90 b/Source/Fortran/distributed_includes/FillMatrixPermutation.f90 index 6329d361..710639cf 100644 --- a/Source/Fortran/distributed_includes/FillMatrixPermutation.f90 +++ b/Source/Fortran/distributed_includes/FillMatrixPermutation.f90 @@ -1,36 +1,35 @@ !! Local Data - INTEGER :: total - INTEGER :: II + INTEGER :: II, KK !! Build Local Triplet List !! There can't be more than one entry per row - CALL ConstructTripletList(triplet_list, this%local_rows) - total = 0 + CALL ConstructTripletList(tlist, this%local_rows) + KK = 0 IF (rows) THEN - DO II=this%start_row,this%end_row-1 + DO II = this%start_row, this%end_row - 1 IF (permutation_vector(II) .GE. this%start_column .AND. & & permutation_vector(II) .LT. this%end_column) THEN - total = total + 1 - triplet_list%DATA(total)%index_column = permutation_vector(II) - triplet_list%DATA(total)%index_row = II - triplet_list%DATA(total)%point_value = 1.0 + KK = KK + 1 + tlist%DATA(KK)%index_column = permutation_vector(II) + tlist%DATA(KK)%index_row = II + tlist%DATA(KK)%point_value = 1.0 END IF END DO ELSE - DO II=this%start_column,this%end_column-1 + DO II = this%start_column, this%end_column -1 IF (permutation_vector(II) .GE. this%start_row .AND. & & permutation_vector(II) .LT. this%end_row) THEN - total = total + 1 - triplet_list%DATA(total)%index_column = II - triplet_list%DATA(total)%index_row = permutation_vector(II) - triplet_list%DATA(total)%point_value = 1.0 + KK = KK + 1 + tlist%DATA(KK)%index_column = II + tlist%DATA(KK)%index_row = permutation_vector(II) + tlist%DATA(KK)%point_value = 1.0 END IF END DO END IF - triplet_list%CurrentSize = total + tlist%CurrentSize = KK !! Finish constructing - CALL FillMatrixFromTripletList(this, triplet_list, prepartitioned_in=.TRUE.) + CALL FillMatrixFromTripletList(this, tlist, prepartitioned_in = .TRUE.) !! Cleanup - CALL DestructTripletList(triplet_list) + CALL DestructTripletList(tlist) diff --git a/Source/Fortran/distributed_includes/FilterMatrix.f90 b/Source/Fortran/distributed_includes/FilterMatrix.f90 index 723d9a68..0373f513 100644 --- a/Source/Fortran/distributed_includes/FilterMatrix.f90 +++ b/Source/Fortran/distributed_includes/FilterMatrix.f90 @@ -1,16 +1,15 @@ !! Local Data - INTEGER :: counter - INTEGER :: size_temp TYPE(ProcessGrid_t) :: grid_temp LOGICAL :: is_complex_temp + INTEGER :: II, size_temp - CALL GetMatrixTripletList(this, triplet_list) + CALL GetMatrixTripletList(this, tlist) CALL ConstructTripletList(new_list) - DO counter=1,triplet_list%CurrentSize - CALL GetTripletAt(triplet_list, counter, temporary) - IF (ABS(temporary%point_value) .GT. threshold) THEN - CALL AppendToTripletList(new_list, temporary) + DO II = 1, tlist%CurrentSize + CALL GetTripletAt(tlist, II, trip) + IF (ABS(trip%point_value) .GT. threshold) THEN + CALL AppendToTripletList(new_list, trip) END IF END DO diff --git a/Source/Fortran/distributed_includes/GatherMatrixToAll.f90 b/Source/Fortran/distributed_includes/GatherMatrixToAll.f90 index 89519d65..567f7caa 100644 --- a/Source/Fortran/distributed_includes/GatherMatrixToAll.f90 +++ b/Source/Fortran/distributed_includes/GatherMatrixToAll.f90 @@ -1,20 +1,20 @@ - CALL MergeMatrixLocalBlocks(this, local) !! Merge Columns CALL TransposeMatrix(local, localT) - CALL ReduceAndComposeMatrix(localT, merged_columns, & - & this%process_grid%column_comm) + CALL ReduceAndComposeMatrix(localT, this%process_grid%column_comm, & + & merged_columns) !! Merge Rows CALL TransposeMatrix(merged_columns, merged_columnsT) - CALL ReduceAndComposeMatrix(merged_columnsT, gathered, & - & this%process_grid%row_comm) + CALL ReduceAndComposeMatrix(merged_columnsT, this%process_grid%row_comm, & + & gathered) !! Remove the excess rows and columns that come from the logical size. CALL ConstructEmptyMatrix(local_mat, this%actual_matrix_dimension, & & this%actual_matrix_dimension) - local_mat%outer_index = gathered%outer_index(:this%actual_matrix_dimension+1) + local_mat%outer_index = & + & gathered%outer_index(:this%actual_matrix_dimension + 1) ALLOCATE(local_mat%inner_index(SIZE(gathered%inner_index))) local_mat%inner_index = gathered%inner_index ALLOCATE(local_mat%values(SIZE(gathered%values))) diff --git a/Source/Fortran/distributed_includes/GatherMatrixToProcess.f90 b/Source/Fortran/distributed_includes/GatherMatrixToProcess.f90 index 0802eb09..8e21b665 100644 --- a/Source/Fortran/distributed_includes/GatherMatrixToProcess.f90 +++ b/Source/Fortran/distributed_includes/GatherMatrixToProcess.f90 @@ -15,7 +15,7 @@ DO II = 1, this%process_grid%slice_size CALL ConstructTripletList(slist(II)) END DO - CALL ConstructTripletList(slist(within_slice_id+1), list_size) + CALL ConstructTripletList(slist(within_slice_id + 1), list_size) slist(within_slice_id+1)%DATA(:list_size) = tlist%DATA(:list_size) CALL DestructTripletList(tlist) CALL RedistributeTripletLists(slist, this%process_grid%within_slice_comm, & diff --git a/Source/Fortran/distributed_includes/GetMatrixBlock.f90 b/Source/Fortran/distributed_includes/GetMatrixBlock.f90 index 1507f71e..1d426520 100644 --- a/Source/Fortran/distributed_includes/GetMatrixBlock.f90 +++ b/Source/Fortran/distributed_includes/GetMatrixBlock.f90 @@ -104,7 +104,7 @@ !! Convert receive buffer to triplet list CALL ConstructTripletList(triplet_list, SUM(recv_per_proc)) - DO II=1, SUM(recv_per_proc) + DO II = 1, SUM(recv_per_proc) triplet_list%DATA(II)%index_row = recv_buffer_row(II) triplet_list%DATA(II)%index_column = recv_buffer_col(II) triplet_list%DATA(II)%point_value = recv_buffer_val(II) diff --git a/Source/Fortran/distributed_includes/RedistributeData.f90 b/Source/Fortran/distributed_includes/RedistributeData.f90 index a19aadb9..28615b65 100644 --- a/Source/Fortran/distributed_includes/RedistributeData.f90 +++ b/Source/Fortran/distributed_includes/RedistributeData.f90 @@ -4,40 +4,37 @@ INTEGER, DIMENSION(:), ALLOCATABLE :: location_list_within_slice !! Temporary Values INTEGER :: row_size, column_size - INTEGER :: temp_row, temp_column + INTEGER :: row, col INTEGER :: process_id - INTEGER :: counter - - CALL StartTimer("Redistribute") + INTEGER :: II !! First we need to figure out where our local elements go ALLOCATE(row_lookup(SIZE(index_lookup))) ALLOCATE(column_lookup(SIZE(index_lookup))) - row_size = SIZE(index_lookup)/this%process_grid%num_process_rows - DO counter = LBOUND(index_lookup,1), UBOUND(index_lookup,1) - row_lookup(index_lookup(counter)) = (counter-1)/(row_size) + row_size = SIZE(index_lookup) / this%process_grid%num_process_rows + DO II = LBOUND(index_lookup, 1), UBOUND(index_lookup, 1) + row_lookup(index_lookup(II)) = (II - 1) / row_size END DO - column_size = SIZE(index_lookup)/this%process_grid%num_process_columns - DO counter = LBOUND(index_lookup,1), UBOUND(index_lookup,1) - column_lookup(index_lookup(counter)) = (counter-1)/(column_size) + column_size = SIZE(index_lookup) / this%process_grid%num_process_columns + DO II = LBOUND(index_lookup, 1), UBOUND(index_lookup, 1) + column_lookup(index_lookup(II)) = (II - 1) / column_size END DO ALLOCATE(location_list_within_slice(initial_triplet_list%CurrentSize)) - DO counter = 1, initial_triplet_list%CurrentSize - temp_row = row_lookup(initial_triplet_list%DATA(counter)%index_row) - temp_column = & - & column_lookup(initial_triplet_list%DATA(counter)%index_column) - location_list_within_slice(counter) = & - & temp_column+temp_row*this%process_grid%num_process_columns + DO II = 1, initial_triplet_list%CurrentSize + row = row_lookup(initial_triplet_list%DATA(II)%index_row) + col = column_lookup(initial_triplet_list%DATA(II)%index_column) + location_list_within_slice(II) = & + & col + row * this%process_grid%num_process_columns END DO !! Build A Send Buffer - DO counter = 1, this%process_grid%slice_size - CALL ConstructTripletList(send_triplet_lists(counter)) + DO II = 1, this%process_grid%slice_size + CALL ConstructTripletList(send_triplet_lists(II)) END DO - DO counter = 1, initial_triplet_list%CurrentSize - process_id = location_list_within_slice(counter) - CALL GetTripletAt(initial_triplet_list, counter, temp_triplet) - CALL AppendToTripletList(send_triplet_lists(process_id+1), temp_triplet) + DO II = 1, initial_triplet_list%CurrentSize + process_id = location_list_within_slice(II) + CALL GetTripletAt(initial_triplet_list, II, temp_triplet) + CALL AppendToTripletList(send_triplet_lists(process_id + 1), temp_triplet) END DO !! Actual Send @@ -45,26 +42,23 @@ & this%process_grid%within_slice_comm, gathered_list) !! Adjust Indices to Local - DO counter = 1, gathered_list%CurrentSize - gathered_list%DATA(counter)%index_row = & - & reverse_index_lookup(gathered_list%DATA(counter)%index_row) - & + DO II = 1, gathered_list%CurrentSize + gathered_list%DATA(II)%index_row = & + & reverse_index_lookup(gathered_list%DATA(II)%index_row) - & & this%start_row + 1 - gathered_list%DATA(counter)%index_column = & - & reverse_index_lookup(gathered_list%DATA(counter)%index_column) - & + gathered_list%DATA(II)%index_column = & + & reverse_index_lookup(gathered_list%DATA(II)%index_column) - & & this%start_column + 1 END DO - CALL StartTimer("SortTripletList") CALL SortTripletList(gathered_list, this%local_columns, this%local_rows, & & sorted_triplet_list) - CALL StopTimer("SortTripletList") !! Cleanup - DO counter = 1, this%process_grid%slice_size - CALL DestructTripletList(send_triplet_lists(counter)) + DO II = 1, this%process_grid%slice_size + CALL DestructTripletList(send_triplet_lists(II)) END DO DEALLOCATE(row_lookup) DEALLOCATE(column_lookup) DEALLOCATE(location_list_within_slice) CALL DestructTripletList(gathered_list) - CALL StopTimer("Redistribute") diff --git a/Source/Fortran/distributed_includes/ResizeMatrix.f90 b/Source/Fortran/distributed_includes/ResizeMatrix.f90 index 7ddb214e..658a9801 100644 --- a/Source/Fortran/distributed_includes/ResizeMatrix.f90 +++ b/Source/Fortran/distributed_includes/ResizeMatrix.f90 @@ -15,7 +15,7 @@ !! Rebuild. CALL ConstructEmptyMatrix(this, new_size) - CALL FillMatrixFromTripletList(this, pruned, preduplicated_in=.TRUE.) + CALL FillMatrixFromTripletList(this, pruned, preduplicated_in = .TRUE.) !! Cleanup CALL DestructTripletList(tlist) diff --git a/Source/Fortran/distributed_includes/SliceMatrix.f90 b/Source/Fortran/distributed_includes/SliceMatrix.f90 index 4f1794b3..a17550c5 100644 --- a/Source/Fortran/distributed_includes/SliceMatrix.f90 +++ b/Source/Fortran/distributed_includes/SliceMatrix.f90 @@ -24,8 +24,8 @@ new_dim = MAX(end_row - start_row + 1, end_column - start_column + 1) CALL ConstructEmptyMatrix(submatrix, new_dim, & - & process_grid_in=this%process_grid, is_complex_in=this%is_complex) - CALL FillMatrixFromTripletList(submatrix, slist, preduplicated_in=.TRUE.) + & process_grid_in = this%process_grid, is_complex_in = this%is_complex) + CALL FillMatrixFromTripletList(submatrix, slist, preduplicated_in = .TRUE.) !! Cleanup CALL DestructTripletList(tlist) diff --git a/Source/Fortran/distributed_includes/TransposeMatrix.f90 b/Source/Fortran/distributed_includes/TransposeMatrix.f90 index 1cddb500..93bbf8be 100644 --- a/Source/Fortran/distributed_includes/TransposeMatrix.f90 +++ b/Source/Fortran/distributed_includes/TransposeMatrix.f90 @@ -1,23 +1,22 @@ !! Local Data - INTEGER :: counter + INTEGER :: II CALL ConstructTripletList(new_list) - CALL GetMatrixTripletList(AMat,triplet_list) - DO counter=1,triplet_list%CurrentSize - IF (MOD(counter, AMat%process_grid%num_process_slices) .EQ. & + CALL GetMatrixTripletList(AMat, tlist) + DO II = 1, tlist%CurrentSize + IF (MOD(II, AMat%process_grid%num_process_slices) .EQ. & & AMat%process_grid%my_slice) THEN - CALL GetTripletAt(triplet_list,counter,temporary) - temporary_t%index_row = temporary%index_column - temporary_t%index_column = temporary%index_row - temporary_t%point_value = temporary%point_value - CALL AppendToTripletList(new_list,temporary_t) + CALL GetTripletAt(tlist, II, trip) + trip_t%index_row = trip%index_column + trip_t%index_column = trip%index_row + trip_t%point_value = trip%point_value + CALL AppendToTripletList(new_list, trip_t) END IF END DO CALL DestructMatrix(TransMat) - CALL ConstructEmptyMatrix(TransMat, AMat%actual_matrix_dimension, & - & AMat%process_grid, AMat%is_complex) - CALL FillMatrixFromTripletList(TransMat,new_list) + CALL ConstructEmptyMatrix(TransMat, AMat) + CALL FillMatrixFromTripletList(TransMat, new_list) CALL DestructTripletList(new_list) - CALL DestructTripletList(triplet_list) + CALL DestructTripletList(tlist) diff --git a/Source/Fortran/distributed_includes/WriteMatrixToBinary.f90 b/Source/Fortran/distributed_includes/WriteMatrixToBinary.f90 index 0a16e6d3..c9eb96f9 100644 --- a/Source/Fortran/distributed_includes/WriteMatrixToBinary.f90 +++ b/Source/Fortran/distributed_includes/WriteMatrixToBinary.f90 @@ -1,15 +1,15 @@ !! Local Data INTEGER, DIMENSION(:), ALLOCATABLE :: local_values_buffer INTEGER :: mpi_file_handler - INTEGER(KIND=MPI_OFFSET_KIND) :: header_size - INTEGER(KIND=MPI_OFFSET_KIND) :: write_offset + INTEGER(KIND = MPI_OFFSET_KIND) :: header_size + INTEGER(KIND = MPI_OFFSET_KIND) :: write_offset !! Temporary Variables INTEGER :: bytes_per_int, bytes_per_long, bytes_per_entry INTEGER, DIMENSION(3) :: header_buffer - INTEGER(KIND=NTLONG) :: total_values + INTEGER(KIND = NTLONG) :: total_values INTEGER :: message_status(MPI_STATUS_SIZE) - INTEGER(KIND=MPI_OFFSET_KIND) :: zero_offset = 0 - INTEGER :: counter + INTEGER(KIND = MPI_OFFSET_KIND) :: zero_offset = 0 + INTEGER :: II INTEGER :: ierr !! Merge all the local data @@ -19,27 +19,26 @@ CALL MPI_Type_size(MPINTINTEGER, bytes_per_int, ierr) CALL MPI_Type_size(MPINTLONG, bytes_per_long, ierr) CALL MPI_Type_extent(triplet_mpi_type, bytes_per_entry, ierr) - header_size = bytes_per_int*3 + bytes_per_long + header_size = bytes_per_int * 3 + bytes_per_long ALLOCATE(local_values_buffer(this%process_grid%slice_size)) - CALL MPI_Allgather(SIZE(merged_local_data%values), 1, MPINTINTEGER,& - & local_values_buffer, 1, MPINTINTEGER,& - & this%process_grid%within_slice_comm,ierr) + CALL MPI_Allgather(SIZE(merged_local_data%values), 1, MPINTINTEGER, & + & local_values_buffer, 1, MPINTINTEGER, & + & this%process_grid%within_slice_comm, ierr) write_offset = 0 write_offset = write_offset + header_size - DO counter = 1,this%process_grid%within_slice_rank + DO II = 1, this%process_grid%within_slice_rank write_offset = write_offset + & - & local_values_buffer(counter)*(bytes_per_entry) + & local_values_buffer(II) * bytes_per_entry END DO !! Write The File IF (this%process_grid%between_slice_rank .EQ. 0) THEN !! Create Special MPI Type - CALL MatrixToTripletList(merged_local_data, triplet_list) + CALL MatrixToTripletList(merged_local_data, tlist) !! Absolute Positions - CALL ShiftTripletList(triplet_list, this%start_row - 1, & - & this%start_column - 1) + CALL ShiftTripletList(tlist, this%start_row - 1, this%start_column - 1) CALL MPI_File_open(this%process_grid%within_slice_comm, file_name,& & IOR(MPI_MODE_CREATE, MPI_MODE_WRONLY), MPI_INFO_NULL, & & mpi_file_handler, ierr) @@ -56,20 +55,19 @@ & 3, MPINTINTEGER, message_status, ierr) total_values = SUM(local_values_buffer) CALL MPI_File_write_at(mpi_file_handler, & - & zero_offset + bytes_per_int*3, total_values, & + & zero_offset + bytes_per_int * 3, total_values, & & 1, MPINTLONG, message_status, ierr) END IF !! Write The Rest CALL MPI_File_set_view(mpi_file_handler, write_offset, triplet_mpi_type,& & triplet_mpi_type, "native", MPI_INFO_NULL, ierr) - CALL MPI_File_write(mpi_file_handler, triplet_list%DATA, & - & triplet_list%CurrentSize, triplet_mpi_type, MPI_STATUS_IGNORE, & - & ierr) + CALL MPI_File_write(mpi_file_handler, tlist%DATA, tlist%CurrentSize, & + & triplet_mpi_type, MPI_STATUS_IGNORE, ierr) !! Cleanup - CALL MPI_File_close(mpi_file_handler,ierr) - CALL DestructTripletList(triplet_list) + CALL MPI_File_close(mpi_file_handler, ierr) + CALL DestructTripletList(tlist) END IF DEALLOCATE(local_values_buffer) - CALL MPI_Barrier(this%process_grid%global_comm,ierr) + CALL MPI_Barrier(this%process_grid%global_comm, ierr) CALL DestructMatrix(merged_local_data) diff --git a/Source/Fortran/distributed_includes/WriteToMatrixMarket.f90 b/Source/Fortran/distributed_includes/WriteToMatrixMarket.f90 index f9430ab8..e0eef93c 100644 --- a/Source/Fortran/distributed_includes/WriteToMatrixMarket.f90 +++ b/Source/Fortran/distributed_includes/WriteToMatrixMarket.f90 @@ -4,21 +4,20 @@ INTEGER, DIMENSION(:), ALLOCATABLE :: local_values_buffer !! Local Data INTEGER :: triplet_list_string_length - INTEGER(KIND=MPI_OFFSET_KIND) :: header_size - INTEGER(KIND=MPI_OFFSET_KIND) :: write_offset - INTEGER(KIND=MPI_OFFSET_KIND) :: header_offset - INTEGER(KIND=MPI_OFFSET_KIND), PARAMETER :: zero_size = 0 + INTEGER(KIND = MPI_OFFSET_KIND) :: header_size + INTEGER(KIND = MPI_OFFSET_KIND) :: write_offset + INTEGER(KIND = MPI_OFFSET_KIND) :: header_offset + INTEGER(KIND = MPI_OFFSET_KIND), PARAMETER :: zero_size = 0 !! Strings - CHARACTER(len=:), ALLOCATABLE :: header_line1 - CHARACTER(len=:), ALLOCATABLE :: header_line2 - CHARACTER(len=:), ALLOCATABLE :: write_buffer + CHARACTER(LEN = :), ALLOCATABLE :: header_line1 + CHARACTER(LEN = :), ALLOCATABLE :: header_line2 + CHARACTER(LEN = :), ALLOCATABLE :: write_buffer !! Temporary Values - INTEGER :: counter - INTEGER :: offset_counter + INTEGER :: II, OFF_JJ INTEGER :: NEW_LINE_LENGTH - CHARACTER(len=MAX_LINE_LENGTH*2) :: temp_string1 - CHARACTER(len=MAX_LINE_LENGTH) :: temp_string2 - CHARACTER(len=MAX_LINE_LENGTH) :: temp_string3 + CHARACTER(LEN = MAX_LINE_LENGTH*2) :: temp_string1 + CHARACTER(LEN = MAX_LINE_LENGTH) :: temp_string2 + CHARACTER(LEN = MAX_LINE_LENGTH) :: temp_string3 INTEGER :: temp_length INTEGER :: bytes_per_character INTEGER :: ierr @@ -31,43 +30,43 @@ !! Create the matrix size line NEW_LINE_LENGTH = LEN(new_LINE('A')) #ifdef ISCOMPLEX - WRITE(temp_string1,'(A)') "%%MatrixMarket matrix coordinate complex general" & - & //new_LINE('A')//"%"//new_LINE('A') + WRITE(temp_string1, '(A)') & + & "%%MatrixMarket matrix coordinate complex general" & + & // new_LINE('A') // "%" // new_LINE('A') #else - WRITE(temp_string1,'(A)') "%%MatrixMarket matrix coordinate real general" & - & //new_LINE('A')//"%"//new_LINE('A') + WRITE(temp_string1, '(A)') "%%MatrixMarket matrix coordinate real general" & + & // new_LINE('A') // "%" // new_LINE('A') #endif - ALLOCATE(CHARACTER(len=LEN_TRIM(temp_string1)) :: header_line1) + ALLOCATE(CHARACTER(LEN = LEN_TRIM(temp_string1)) :: header_line1) header_line1 = TRIM(temp_string1) CALL WriteMMSize(temp_string2, this%actual_matrix_dimension, & & this%actual_matrix_dimension, GetMatrixSize(this)) ALLOCATE(CHARACTER(& - & len=LEN_TRIM(temp_string2)+NEW_LINE_LENGTH+1) :: header_line2) - WRITE(header_line2,*) TRIM(temp_string2)//new_LINE('A') + & LEN = LEN_TRIM(temp_string2) + NEW_LINE_LENGTH + 1) :: header_line2) + WRITE(header_line2,*) TRIM(temp_string2) // new_LINE('A') header_size = LEN(header_line1) + LEN(header_line2) !! Local Data - CALL MatrixToTripletList(merged_local_data, triplet_list) + CALL MatrixToTripletList(merged_local_data, tlist) !! Absolute Positions - CALL ShiftTripletList(triplet_list, this%start_row - 1, & - & this%start_column - 1) + CALL ShiftTripletList(tlist, this%start_row - 1, this%start_column - 1) !! Figure out the length of the string for storing. triplet_list_string_length = 0 - DO counter = 1, triplet_list%CurrentSize + DO II = 1, tlist%CurrentSize #ifdef ISCOMPLEX - CALL WriteMMLine(temp_string3, triplet_list%DATA(counter)%index_row, & - & triplet_list%DATA(counter)%index_column, & - & REAL(triplet_list%DATA(counter)%point_value), & - & AIMAG(triplet_list%DATA(counter)%point_value), & - & add_newline_in=.TRUE.) + CALL WriteMMLine(temp_string3, tlist%DATA(II)%index_row, & + & tlist%DATA(II)%index_column, & + & REAL(tlist%DATA(II)%point_value), & + & AIMAG(tlist%DATA(II)%point_value), & + & add_newline_in = .TRUE.) #else - CALL WriteMMLine(temp_string3, triplet_list%DATA(counter)%index_row, & - & triplet_list%DATA(counter)%index_column, & - & triplet_list%DATA(counter)%point_value, add_newline_in=.TRUE.) + CALL WriteMMLine(temp_string3, tlist%DATA(II)%index_row, & + & tlist%DATA(II)%index_column, & + & tlist%DATA(II)%point_value, add_newline_in = .TRUE.) #endif WRITE(temp_string2, '(A)') ADJUSTL(temp_string3) triplet_list_string_length = triplet_list_string_length + & @@ -76,36 +75,34 @@ END DO !! Write that string to the write buffer - ALLOCATE(CHARACTER(len=triplet_list_string_length+1) :: write_buffer) - offset_counter = 1 - DO counter = 1, triplet_list%CurrentSize + ALLOCATE(CHARACTER(LEN = triplet_list_string_length + 1) :: write_buffer) + OFF_JJ = 1 + DO II = 1, tlist%CurrentSize #ifdef ISCOMPLEX - CALL WriteMMLine(temp_string3, triplet_list%DATA(counter)%index_row, & - & triplet_list%DATA(counter)%index_column, & - & REAL(triplet_list%DATA(counter)%point_value), & - & AIMAG(triplet_list%DATA(counter)%point_value), & - & add_newline_in=.TRUE.) + CALL WriteMMLine(temp_string3, tlist%DATA(II)%index_row, & + & tlist%DATA(II)%index_column, REAL(tlist%DATA(II)%point_value), & + & AIMAG(tlist%DATA(II)%point_value), add_newline_in = .TRUE.) #else - CALL WriteMMLine(temp_string3, triplet_list%DATA(counter)%index_row, & - & triplet_list%DATA(counter)%index_column, & - & triplet_list%DATA(counter)%point_value, add_newline_in=.TRUE.) + CALL WriteMMLine(temp_string3, tlist%DATA(II)%index_row, & + & tlist%DATA(II)%index_column,tlist%DATA(II)%point_value, & + & add_newline_in = .TRUE.) #endif WRITE(temp_string2, '(A)') ADJUSTL(temp_string3) - temp_length = LEN_TRIM(temp_string2)+NEW_LINE_LENGTH - WRITE(write_buffer(offset_counter:offset_counter+temp_length),*) & + temp_length = LEN_TRIM(temp_string2) + NEW_LINE_LENGTH + WRITE(write_buffer(OFF_JJ:OFF_JJ + temp_length), *) & & temp_string2(1:temp_length) - offset_counter = offset_counter + temp_length + OFF_JJ = OFF_JJ + temp_length END DO !! Figure out the offset sizes ALLOCATE(local_values_buffer(this%process_grid%slice_size)) CALL MPI_Allgather(triplet_list_string_length, 1, MPINTINTEGER,& & local_values_buffer, 1, MPINTINTEGER, & - & this%process_grid%within_slice_comm,ierr) + & this%process_grid%within_slice_comm, ierr) write_offset = 0 write_offset = write_offset + header_size - DO counter = 1,this%process_grid%within_slice_rank - write_offset = write_offset + local_values_buffer(counter) + DO II = 1,this%process_grid%within_slice_rank + write_offset = write_offset + local_values_buffer(II) END DO !! Global Write diff --git a/Source/Fortran/distributed_pool_includes/DestructMatrixMemoryPool.f90 b/Source/Fortran/distributed_pool_includes/DestructMatrixMemoryPool.f90 index 5f4f52d3..10d926cf 100644 --- a/Source/Fortran/distributed_pool_includes/DestructMatrixMemoryPool.f90 +++ b/Source/Fortran/distributed_pool_includes/DestructMatrixMemoryPool.f90 @@ -1,9 +1,8 @@ !! Allocate IF (ALLOCATED(this%grid)) THEN - DO column_counter = LBOUND(this%grid,2), UBOUND(this%grid,2) - DO row_counter = LBOUND(this%grid,1), UBOUND(this%grid,1) - CALL DestructMatrixMemoryPool( & - & this%grid(row_counter, column_counter)) + DO II = LBOUND(this%grid, 2), UBOUND(this%grid, 2) + DO JJ = LBOUND(this%grid, 1), UBOUND(this%grid, 1) + CALL DestructMatrixMemoryPool(this%grid(JJ, II)) END DO END DO DEALLOCATE(this%grid) diff --git a/Source/Fortran/eigenexa_includes/EigenExa_s.F90 b/Source/Fortran/eigenexa_includes/EigenExa_s.F90 index 1a1ba466..ecd9ca64 100644 --- a/Source/Fortran/eigenexa_includes/EigenExa_s.F90 +++ b/Source/Fortran/eigenexa_includes/EigenExa_s.F90 @@ -10,26 +10,20 @@ WD = 0 !! Convert to EigenExa - CALL StartTimer("NTToEigen") #ifdef ISCOMPLEX CALL NTToEigen_c(A, AD, exa) #else CALL NTToEigen_r(A, AD, exa) #endif - CALL StopTimer("NTToEigen") !! Calculate - CALL StartTimer("EigenExaCompute") #ifdef ISCOMPLEX CALL Compute_c(AD, VD, WD, exa) #else CALL Compute_r(AD, VD, WD, exa) #endif - CALL StopTimer("EigenExaCompute") !! Convert Back - CALL StartTimer("EigenToNT") - IF (PRESENT(eigenvectors_in)) THEN CALL ConstructEmptyMatrix(eigenvectors_in, A) #ifdef ISCOMPLEX @@ -42,8 +36,6 @@ CALL ConstructEmptyMatrix(eigenvalues, A) CALL ExtractEigenvalues(WD, eigenvalues, exa) - CALL StopTimer("EigenToNT") - !! Cleanup #ifdef ISCOMPLEX CALL CleanUp_c(AD, VD, WD) diff --git a/Source/Fortran/eigenexa_includes/EigenSerial.f90 b/Source/Fortran/eigenexa_includes/EigenSerial.f90 index 3df11b80..f9cb7812 100644 --- a/Source/Fortran/eigenexa_includes/EigenSerial.f90 +++ b/Source/Fortran/eigenexa_includes/EigenSerial.f90 @@ -7,14 +7,14 @@ !! Filter if necessary IF (nvals+1 .LE. V%rows) THEN - V%DATA(:, nvals+1:) = 0 - W%DATA(nvals+1:, :) = 0 - W%DATA(:, nvals+1:) = 0 + V%DATA(:, nvals + 1:) = 0 + W%DATA(nvals + 1:, :) = 0 + W%DATA(:, nvals + 1:) = 0 END IF !! Convert results to triplet lists - CALL ConstructMatrixSFromD(V, V_s, threshold_in=threshold) - CALL ConstructMatrixSFromD(W, W_s, threshold_in=threshold) + CALL ConstructMatrixSFromD(V, V_s, threshold_in = threshold) + CALL ConstructMatrixSFromD(W, W_s, threshold_in = threshold) CALL MatrixToTripletList(V_s, V_t) CALL MatrixToTripletList(W_s, W_t) @@ -23,7 +23,7 @@ IF (eigenvalues%process_grid%within_slice_rank .NE. 0) THEN CALL ConstructTripletList(W_t) END IF - CALL FillMatrixFromTripletList(eigenvalues, W_t, preduplicated_in=.TRUE.) + CALL FillMatrixFromTripletList(eigenvalues, W_t, preduplicated_in = .TRUE.) IF (PRESENT(eigenvectors_in)) THEN CALL ConstructEmptyMatrix(eigenvectors_in, this) @@ -31,7 +31,7 @@ CALL ConstructTripletList(V_t) END IF CALL FillMatrixFromTripletList(eigenvectors_in, V_t, & - & preduplicated_in=.TRUE.) + & preduplicated_in = .TRUE.) END IF !! Cleanup diff --git a/Source/Fortran/eigenexa_includes/EigenToNT.f90 b/Source/Fortran/eigenexa_includes/EigenToNT.f90 index ea1af8d8..cedc0481 100644 --- a/Source/Fortran/eigenexa_includes/EigenToNT.f90 +++ b/Source/Fortran/eigenexa_includes/EigenToNT.f90 @@ -10,28 +10,24 @@ col_end = eigen_loop_end(exa%mat_dim, exa%proc_cols, exa%colid) !! Convert to a 1D array for index ease. - ALLOCATE(VD1(SIZE(VD,DIM=1)*SIZE(VD,DIM=2))) + ALLOCATE(VD1(SIZE(VD, DIM = 1)*SIZE(VD, DIM = 2))) VD1 = PACK(VD, .TRUE.) - CALL StartTimer("EigenExaFilter") CALL ConstructTripletList(triplet_v) ind = 1 DO JJ = col_start, col_end jlookup = eigen_translate_l2g(JJ, exa%proc_cols, exa%colid) DO II = row_start, row_end - IF (ABS(VD1(ind+II-1)) .GT. params%threshold) THEN + IF (ABS(VD1(ind + II -1)) .GT. params%threshold) THEN ilookup = eigen_translate_l2g(II, exa%proc_rows, exa%rowid) - CALL SetTriplet(trip, jlookup, ilookup, VD1(ind+II-1)) + CALL SetTriplet(trip, jlookup, ilookup, VD1(ind + II -1)) CALL AppendToTripletList(triplet_v, trip) END IF END DO ind = ind + exa%offset END DO - CALL StopTimer("EigenExaFilter") - CALL StartTimer("EigenFill") CALL FillMatrixFromTripletList(V, triplet_v) - CALL StopTimer("EigenFill") !! Cleanup CALL DestructTripletList(triplet_v) diff --git a/Source/Fortran/eigenexa_includes/NTToEigen.f90 b/Source/Fortran/eigenexa_includes/NTToEigen.f90 index d5fe77d8..eee88dad 100644 --- a/Source/Fortran/eigenexa_includes/NTToEigen.f90 +++ b/Source/Fortran/eigenexa_includes/NTToEigen.f90 @@ -17,13 +17,11 @@ !! Determine where that triplet will reside iowner = eigen_owner_node(trip%index_row, exa%proc_rows, exa%rowid) jowner = eigen_owner_node(trip%index_column, exa%proc_cols, exa%colid) - ijowner = (jowner-1)*exa%proc_rows + iowner + ijowner = (jowner - 1) * exa%proc_rows + iowner !! New indices - ilookup = eigen_translate_g2l(trip%index_row, exa%proc_rows, & - & exa%rowid) - jlookup = eigen_translate_g2l(trip%index_column, exa%proc_cols, & - & exa%colid) + ilookup = eigen_translate_g2l(trip%index_row, exa%proc_rows, exa%rowid) + jlookup = eigen_translate_g2l(trip%index_column, exa%proc_cols, exa%colid) CALL SetTriplet(shifted_trip, jlookup, ilookup, trip%point_value) CALL AppendToTripletList(send_list(ijowner), shifted_trip) diff --git a/Source/Fortran/map_includes/MapMatrix.f90 b/Source/Fortran/map_includes/MapMatrix.f90 index 8d3920ca..d6242f1d 100644 --- a/Source/Fortran/map_includes/MapMatrix.f90 +++ b/Source/Fortran/map_includes/MapMatrix.f90 @@ -2,15 +2,15 @@ CALL ConstructEmptyMatrix(outmat, inmat) CALL GetMatrixTripletList(inmat, inlist) #ifdef MAPARRAY - CALL MapTripletList(inlist, outlist, proc, supp_in=supp_in, & - & num_slices_in=inmat%process_grid%num_process_slices, & - & my_slice_in=inmat%process_grid%my_slice) + CALL MapTripletList(inlist, outlist, proc, supp_in = supp_in, & + & num_slices_in = inmat%process_grid%num_process_slices, & + & my_slice_in = inmat%process_grid%my_slice) #else CALL MapTripletList(inlist, outlist, proc, & - & num_slices_in=inmat%process_grid%num_process_slices, & - & my_slice_in=inmat%process_grid%my_slice) + & num_slices_in = inmat%process_grid%num_process_slices, & + & my_slice_in = inmat%process_grid%my_slice) #endif - CALL FillMatrixFromTripletList(outmat, outlist, preduplicated_in=.FALSE.) + CALL FillMatrixFromTripletList(outmat, outlist, preduplicated_in = .FALSE.) !! Cleanup CALL DestructTripletList(inlist) diff --git a/Source/Fortran/solver_includes/ConstructDiag.f90 b/Source/Fortran/solver_includes/ConstructDiag.f90 index a728fbb0..44817242 100644 --- a/Source/Fortran/solver_includes/ConstructDiag.f90 +++ b/Source/Fortran/solver_includes/ConstructDiag.f90 @@ -15,12 +15,12 @@ fill_counter = fill_counter + 1 END IF END DO - diags_per_proc(process_grid%my_row+1) = fill_counter + diags_per_proc(process_grid%my_row + 1) = fill_counter !! Duplicate the diagonal entries along the process column (across rows) CALL MPI_Allgather(MPI_IN_PLACE, 1, MPINTINTEGER, diags_per_proc, 1, & & MPINTINTEGER, process_grid%column_comm, ierr) diag_displ(1) = 0 DO II = 2, process_grid%num_process_rows - diag_displ(II) = diag_displ(II-1) + diags_per_proc(II-1) + diag_displ(II) = diag_displ(II - 1) + diags_per_proc(II - 1) END DO diff --git a/Source/Fortran/solver_includes/DotAllHelper.f90 b/Source/Fortran/solver_includes/DotAllHelper.f90 index b1128ba5..fb12bf09 100644 --- a/Source/Fortran/solver_includes/DotAllHelper.f90 +++ b/Source/Fortran/solver_includes/DotAllHelper.f90 @@ -1,16 +1,16 @@ !! Local Variables INTEGER :: err - INTEGER :: counter + INTEGER :: II INTEGER :: inner_len_j !! Local Dot !$omp parallel private(inner_len_j) !$omp do - DO counter = 1, SIZE(num_values_j) - inner_len_j = num_values_j(counter) - out_values(counter) = DotSparseVectors(indices_i(:num_values_i), & - & values_i(:num_values_i), indices_j(:inner_len_j, counter), & - & values_j(:inner_len_j, counter)) + DO II = 1, SIZE(num_values_j) + inner_len_j = num_values_j(II) + out_values(II) = DotSparseVectors(indices_i(:num_values_i), & + & values_i(:num_values_i), indices_j(:inner_len_j, II), & + & values_j(:inner_len_j, II)) END DO !$omp end do !$omp end parallel diff --git a/Source/Fortran/solver_includes/DotAllPivoted.f90 b/Source/Fortran/solver_includes/DotAllPivoted.f90 index 4e2edd10..860e07c1 100644 --- a/Source/Fortran/solver_includes/DotAllPivoted.f90 +++ b/Source/Fortran/solver_includes/DotAllPivoted.f90 @@ -1,16 +1,16 @@ !! Local Variables INTEGER :: err - INTEGER :: counter + INTEGER :: II INTEGER :: inner_len_j INTEGER :: local_pi_i !! Local Dot !$omp parallel private(inner_len_j, local_pi_i) !$omp do - DO counter = 1, num_local_pivots - local_pi_i = pivot_vector(counter) + DO II = 1, num_local_pivots + local_pi_i = pivot_vector(II) inner_len_j = num_values_j(local_pi_i) - out_values(counter) = DotSparseVectors(indices_i(:num_values_i), & + out_values(II) = DotSparseVectors(indices_i(:num_values_i), & & values_i(:num_values_i), indices_j(:inner_len_j, local_pi_i), & & values_j(:inner_len_j, local_pi_i)) END DO diff --git a/Source/Fortran/solver_includes/GatherMatrixColumn.f90 b/Source/Fortran/solver_includes/GatherMatrixColumn.f90 index 6853a8b5..7f0f84dd 100644 --- a/Source/Fortran/solver_includes/GatherMatrixColumn.f90 +++ b/Source/Fortran/solver_includes/GatherMatrixColumn.f90 @@ -1,5 +1,5 @@ CALL TransposeMatrix(local_matrix, local_matrixT) - CALL ReduceAndComposeMatrix(local_matrixT, column_matrix, & - & process_grid%column_comm) + CALL ReduceAndComposeMatrix(local_matrixT, process_grid%column_comm, & + & column_matrix) CALL DestructMatrix(local_matrixT) \ No newline at end of file diff --git a/Source/Fortran/solver_includes/GershgorinBounds.f90 b/Source/Fortran/solver_includes/GershgorinBounds.f90 index 14f1a092..3a7a5fea 100644 --- a/Source/Fortran/solver_includes/GershgorinBounds.f90 +++ b/Source/Fortran/solver_includes/GershgorinBounds.f90 @@ -5,38 +5,37 @@ !! Compute The Local Contribution per_column_min = 0 per_column_max = 0 - CALL GetMatrixTripletList(this, triplet_list) - DO counter = 1, triplet_list%CurrentSize - local_column = triplet_list%DATA(counter)%index_column - & + CALL GetMatrixTripletList(this, tlist) + DO II = 1, tlist%CurrentSize + local_column = tlist%DATA(II)%index_column - & & this%start_column + 1 - IF (triplet_list%DATA(counter)%index_row .EQ. & - & triplet_list%DATA(counter)%index_column) THEN + IF (tlist%DATA(II)%index_row .EQ. tlist%DATA(II)%index_column) THEN per_column_min(local_column) = per_column_min(local_column) + & - & REAL(triplet_list%DATA(counter)%point_value,KIND=NTREAL) + & REAL(tlist%DATA(II)%point_value, KIND = NTREAL) per_column_max(local_column) = per_column_max(local_column) + & - & REAL(triplet_list%DATA(counter)%point_value,KIND=NTREAL) + & REAL(tlist%DATA(II)%point_value, KIND = NTREAL) ELSE per_column_min(local_column) = per_column_min(local_column) - & - & ABS(triplet_list%DATA(counter)%point_value) + & ABS(tlist%DATA(II)%point_value) per_column_max(local_column) = per_column_max(local_column) + & - & ABS(triplet_list%DATA(counter)%point_value) + & ABS(tlist%DATA(II)%point_value) END IF END DO !! Sum Along Columns - CALL MPI_Allreduce(MPI_IN_PLACE,per_column_min,SIZE(per_column_min), & - & MPINTREAL,MPI_SUM,this%process_grid%column_comm,ierr) - CALL MPI_Allreduce(MPI_IN_PLACE,per_column_max,SIZE(per_column_max), & - & MPINTREAL,MPI_SUM,this%process_grid%column_comm,ierr) + CALL MPI_Allreduce(MPI_IN_PLACE, per_column_min, SIZE(per_column_min), & + & MPINTREAL, MPI_SUM, this%process_grid%column_comm, ierr) + CALL MPI_Allreduce(MPI_IN_PLACE, per_column_max, SIZE(per_column_max), & + & MPINTREAL, MPI_SUM, this%process_grid%column_comm, ierr) min_value = MINVAL(per_column_min) max_value = MAXVAL(per_column_max) - CALL MPI_Allreduce(MPI_IN_PLACE,min_value,1,MPINTREAL,MPI_MIN, & + CALL MPI_Allreduce(MPI_IN_PLACE, min_value, 1, MPINTREAL, MPI_MIN, & & this%process_grid%row_comm, ierr) - CALL MPI_Allreduce(MPI_IN_PLACE,max_value,1,MPINTREAL,MPI_MAX, & + CALL MPI_Allreduce(MPI_IN_PLACE, max_value, 1, MPINTREAL, MPI_MAX, & & this%process_grid%row_comm, ierr) - CALL DestructTripletList(triplet_list) + CALL DestructTripletList(tlist) DEALLOCATE(per_column_min) DEALLOCATE(per_column_max) diff --git a/Source/Fortran/solver_includes/UnpackCholesky.f90 b/Source/Fortran/solver_includes/UnpackCholesky.f90 index 5bfd67af..8caef29b 100644 --- a/Source/Fortran/solver_includes/UnpackCholesky.f90 +++ b/Source/Fortran/solver_includes/UnpackCholesky.f90 @@ -13,8 +13,8 @@ temp%index_row = JJ + LMat%start_column - 1 DO II = 1, values_per_column(JJ) !! note transpose - temp%index_column = INDEX(II,JJ) + LMat%start_row - 1 - temp%point_value = values(II,JJ) + temp%index_column = INDEX(II, JJ) + LMat%start_row - 1 + temp%point_value = values(II, JJ) CALL AppendToTripletList(local_triplets, temp) END DO END DO diff --git a/Source/Fortran/sparse_includes/AddSparseVectors.f90 b/Source/Fortran/sparse_includes/AddSparseVectors.f90 index ba81fd84..2dedbfc0 100644 --- a/Source/Fortran/sparse_includes/AddSparseVectors.f90 +++ b/Source/Fortran/sparse_includes/AddSparseVectors.f90 @@ -4,7 +4,7 @@ !! Temporary Variables INTEGER :: working_index_a, working_index_b !! Counter Variables - INTEGER :: counter_a, counter_b, counter_c + INTEGER :: AA, BB, CC !! Process Optional Parameters IF (.NOT. PRESENT(alpha_in)) THEN @@ -18,54 +18,53 @@ threshold = threshold_in END IF - counter_a = 1 - counter_b = 1 - counter_c = 1 - sum_loop: DO WHILE(counter_a .LE. SIZE(inner_index_a) .AND. counter_b .LE. & - & SIZE(inner_index_b)) + AA = 1 + BB = 1 + CC = 1 + DO WHILE(AA .LE. SIZE(inner_index_a) .AND. BB .LE. SIZE(inner_index_b)) !! Current inner indices and values - working_index_a = inner_index_a(counter_a) - working_index_b = inner_index_b(counter_b) - working_value_a = alpha*values_a(counter_a) - working_value_b = values_b(counter_b) + working_index_a = inner_index_a(AA) + working_index_b = inner_index_b(BB) + working_value_a = alpha*values_a(AA) + working_value_b = values_b(BB) !! Figure out from which vector an insertion will be performed IF (working_index_a .EQ. working_index_b) THEN IF (ABS(working_value_a + working_value_b) .GT. threshold) THEN - inner_index_c(counter_c) = working_index_a - values_c(counter_c) = working_value_a + working_value_b - counter_c = counter_c + 1 + inner_index_c(CC) = working_index_a + values_c(CC) = working_value_a + working_value_b + CC = CC + 1 END IF - counter_a = counter_a + 1 - counter_b = counter_b + 1 + AA = AA + 1 + BB = BB + 1 ELSE IF (working_index_a .GT. working_index_b) THEN IF (ABS(working_value_b) .GT. threshold) THEN - inner_index_c(counter_c) = working_index_b - values_c(counter_c) = working_value_b - counter_c = counter_c + 1 + inner_index_c(CC) = working_index_b + values_c(CC) = working_value_b + CC = CC + 1 END IF - counter_b = counter_b + 1 - ELSE !! implies working_index_b > working_index_b + BB = BB + 1 + ELSE !! implies working_index_b > working_index_a IF (ABS(working_value_a) .GT. threshold) THEN - inner_index_c(counter_c) = working_index_a - values_c(counter_c) = working_value_a - counter_c = counter_c + 1 + inner_index_c(CC) = working_index_a + values_c(CC) = working_value_a + CC = CC + 1 END IF - counter_a = counter_a + 1 + AA = AA + 1 END IF - END DO sum_loop + END DO !! Handle case where one was blank - cleanup_a: DO WHILE (counter_a .LE. SIZE(inner_index_a)) - inner_index_c(counter_c) = inner_index_a(counter_a) - values_c(counter_c) = values_a(counter_a)*alpha - counter_a = counter_a + 1 - counter_c = counter_c + 1 - END DO cleanup_a - cleanup_b: DO WHILE (counter_b .LE. SIZE(inner_index_b)) - inner_index_c(counter_c) = inner_index_b(counter_b) - values_c(counter_c) = values_b(counter_b) - counter_b = counter_b + 1 - counter_c = counter_c + 1 - END DO cleanup_b + DO WHILE (AA .LE. SIZE(inner_index_a)) + inner_index_c(CC) = inner_index_a(AA) + values_c(CC) = values_a(AA)*alpha + AA = AA + 1 + CC = CC + 1 + END DO + DO WHILE (BB .LE. SIZE(inner_index_b)) + inner_index_c(CC) = inner_index_b(BB) + values_c(CC) = values_b(BB) + BB = BB + 1 + CC = CC + 1 + END DO - total_values_c = counter_c - 1 + total_values_c = CC - 1 diff --git a/Source/Fortran/sparse_includes/ComposeMatrix.f90 b/Source/Fortran/sparse_includes/ComposeMatrix.f90 index 7391c85f..8d548ce9 100644 --- a/Source/Fortran/sparse_includes/ComposeMatrix.f90 +++ b/Source/Fortran/sparse_includes/ComposeMatrix.f90 @@ -3,13 +3,13 @@ !! First transpose the matrices DO JJ = 1, block_columns DO II = 1, block_rows - CALL TransposeMatrix(mat_array(II,JJ), mat_t(II,JJ)) + CALL TransposeMatrix(mat_array(II, JJ), mat_t(II, JJ)) END DO END DO !! Next merge the columns DO JJ = 1, block_columns - CALL ComposeMatrixColumns(mat_t(:,JJ), Temp) + CALL ComposeMatrixColumns(mat_t(:, JJ), Temp) CALL TransposeMatrix(Temp, merged_columns(JJ)) END DO @@ -19,7 +19,7 @@ !! Cleanup DO JJ = 1, block_columns DO II = 1, block_rows - CALL DestructMatrix(mat_t(II,JJ)) + CALL DestructMatrix(mat_t(II, JJ)) END DO END DO DO JJ = 1, block_columns diff --git a/Source/Fortran/sparse_includes/ComposeMatrixColumns.f90 b/Source/Fortran/sparse_includes/ComposeMatrixColumns.f90 index 96bf7a22..6c68a43e 100644 --- a/Source/Fortran/sparse_includes/ComposeMatrixColumns.f90 +++ b/Source/Fortran/sparse_includes/ComposeMatrixColumns.f90 @@ -3,7 +3,7 @@ INTEGER :: inner_start, inner_length INTEGER :: outer_start, outer_length INTEGER :: outer_offset - INTEGER :: counter + INTEGER :: II INTEGER :: size_of_mat CALL DestructMatrix(out_matrix) @@ -11,9 +11,9 @@ !! Figure Out The Sizes total_columns = 0 total_values = 0 - DO counter = LBOUND(mat_list,dim=1), UBOUND(mat_list,dim=1) - total_columns = total_columns + mat_list(counter)%columns - size_of_mat = mat_list(counter)%outer_index(mat_list(counter)%columns+1) + DO II = LBOUND(mat_list, dim = 1), UBOUND(mat_list, dim = 1) + total_columns = total_columns + mat_list(II)%columns + size_of_mat = mat_list(II)%outer_index(mat_list(II)%columns + 1) total_values = total_values + size_of_mat END DO @@ -26,19 +26,19 @@ inner_start = 1 outer_start = 1 outer_offset = 0 - DO counter = LBOUND(mat_list,dim=1),UBOUND(mat_list,dim=1) + DO II = LBOUND(mat_list, dim = 1), UBOUND(mat_list, dim = 1) !! Inner indices and values - size_of_mat = mat_list(counter)%outer_index(mat_list(counter)%columns+1) + size_of_mat = mat_list(II)%outer_index(mat_list(II)%columns + 1) inner_length = size_of_mat - out_matrix%inner_index(inner_start:inner_start+inner_length-1) = & - & mat_list(counter)%inner_index - out_matrix%values(inner_start:inner_start+inner_length-1) = & - & mat_list(counter)%values + out_matrix%inner_index(inner_start:inner_start + inner_length - 1) = & + & mat_list(II)%inner_index + out_matrix%values(inner_start:inner_start + inner_length - 1) = & + & mat_list(II)%values inner_start = inner_start + inner_length !! Outer Indices - outer_length = mat_list(counter)%columns+1 - out_matrix%outer_index(outer_start:outer_start+outer_length-1) = & - & mat_list(counter)%outer_index + outer_offset + outer_length = mat_list(II)%columns + 1 + out_matrix%outer_index(outer_start:outer_start+outer_length - 1) = & + & mat_list(II)%outer_index + outer_offset outer_start = outer_start + outer_length - 1 outer_offset = out_matrix%outer_index(outer_start) END DO diff --git a/Source/Fortran/sparse_includes/ConstructEmptyMatrix.f90 b/Source/Fortran/sparse_includes/ConstructEmptyMatrix.f90 index 5b1724da..790ffb90 100644 --- a/Source/Fortran/sparse_includes/ConstructEmptyMatrix.f90 +++ b/Source/Fortran/sparse_includes/ConstructEmptyMatrix.f90 @@ -2,7 +2,7 @@ this%rows = rows this%columns = columns - ALLOCATE(this%outer_index(this%columns+1)) + ALLOCATE(this%outer_index(this%columns + 1)) this%outer_index = 0 IF (PRESENT(zero_in)) THEN diff --git a/Source/Fortran/sparse_includes/ConstructMatrixFromFile.f90 b/Source/Fortran/sparse_includes/ConstructMatrixFromFile.f90 index 28f92ce7..2e2e9349 100644 --- a/Source/Fortran/sparse_includes/ConstructMatrixFromFile.f90 +++ b/Source/Fortran/sparse_includes/ConstructMatrixFromFile.f90 @@ -1,13 +1,12 @@ !! Local Data - INTEGER :: temp_rows, temp_columns, temp_total_values - CHARACTER(len=81) :: input_buffer - INTEGER :: file_handler - INTEGER :: counter + INTEGER :: rows, columns, total_values + CHARACTER(LEN = 81) :: input_buffer + INTEGER, PARAMETER :: file_handler = 16 LOGICAL :: found_comment_line LOGICAL :: error_occured - file_handler = 16 + INTEGER :: II - OPEN(file_handler,file=file_name,status='old') + OPEN(file_handler, file = file_name, status='old') !! Parse the header. READ(file_handler,fmt='(A)') input_buffer @@ -17,36 +16,31 @@ !! Extra Comment Lines found_comment_line = .TRUE. DO WHILE(found_comment_line) - !read(file_handler,*) input_buffer - READ(file_handler,fmt='(A)') input_buffer + READ(file_handler, fmt = '(A)') input_buffer IF (.NOT. input_buffer(1:1) .EQ. '%') THEN found_comment_line = .FALSE. END IF END DO !! Main data - READ(input_buffer,*) temp_rows, temp_columns, temp_total_values - CALL ConstructTripletList(triplet_list) + READ(input_buffer,*) rows, columns, total_values + CALL ConstructTripletList(tlist) !! Read Values - DO counter = 1, temp_total_values + DO II = 1, total_values #ifdef ISCOMPLEX - READ(file_handler,*) temporary%index_row, temporary%index_column, & - & real_val, comp_val - temporary%point_value = CMPLX(real_val, comp_val, KIND=NTCOMPLEX) + READ(file_handler,*) temp%index_row, temp%index_column, real_val, comp_val + temp%point_value = CMPLX(real_val, comp_val, KIND = NTCOMPLEX) #else - READ(file_handler,*) temporary%index_row, temporary%index_column, & - & temporary%point_value + READ(file_handler,*) temp%index_row, temp%index_column, temp%point_value #endif - CALL AppendToTripletList(triplet_list,temporary) + CALL AppendToTripletList(tlist, temp) END DO CLOSE(file_handler) - CALL SymmetrizeTripletList(triplet_list, pattern_type) - CALL SortTripletList(triplet_list, temp_columns, temp_rows, & - & sorted_triplet_list) - CALL ConstructMatrixFromTripletList(this, sorted_triplet_list, temp_rows, & - & temp_columns) + CALL SymmetrizeTripletList(tlist, pattern_type) + CALL SortTripletList(tlist, columns, rows, sorted_tlist) + CALL ConstructMatrixFromTripletList(this, sorted_tlist, rows, columns) - CALL DestructTripletList(triplet_list) - CALL DestructTripletList(sorted_triplet_list) + CALL DestructTripletList(tlist) + CALL DestructTripletList(sorted_tlist) diff --git a/Source/Fortran/sparse_includes/ConstructMatrixFromTripletList.f90 b/Source/Fortran/sparse_includes/ConstructMatrixFromTripletList.f90 index e05af04c..ca0cb01d 100644 --- a/Source/Fortran/sparse_includes/ConstructMatrixFromTripletList.f90 +++ b/Source/Fortran/sparse_includes/ConstructMatrixFromTripletList.f90 @@ -1,6 +1,5 @@ !! Local Data - INTEGER :: outer_array_ptr - INTEGER :: values_counter + INTEGER :: II, outer_idx CALL DestructMatrix(this) @@ -8,29 +7,26 @@ this%columns = columns !! Allocate - ALLOCATE(this%outer_index(this%columns+1)) + ALLOCATE(this%outer_index(this%columns + 1)) this%outer_index = 0 ALLOCATE(this%inner_index(triplet_list%CurrentSize)) ALLOCATE(this%values(triplet_list%CurrentSize)) !! Insert Values - outer_array_ptr = 1 - DO values_counter = 1, triplet_list%CurrentSize + outer_idx = 1 + DO II = 1, triplet_list%CurrentSize !! Moving on to the next column? - DO WHILE(.NOT. triplet_list%DATA(values_counter)%index_column .EQ. & - & outer_array_ptr) - outer_array_ptr = outer_array_ptr + 1 - this%outer_index(outer_array_ptr+1) = this%outer_index(outer_array_ptr) + DO WHILE(.NOT. triplet_list%DATA(II)%index_column .EQ. outer_idx) + outer_idx = outer_idx + 1 + this%outer_index(outer_idx + 1) = this%outer_index(outer_idx) END DO - this%outer_index(outer_array_ptr+1)=this%outer_index(outer_array_ptr+1)+1 + this%outer_index(outer_idx + 1)=this%outer_index(outer_idx + 1) + 1 !! Insert inner index and value - this%inner_index(values_counter) = & - & triplet_list%DATA(values_counter)%index_row - this%values(values_counter) = & - & triplet_list%DATA(values_counter)%point_value + this%inner_index(II) = triplet_list%DATA(II)%index_row + this%values(II) = triplet_list%DATA(II)%point_value END DO !! Fill In The Rest Of The Outer Values - DO outer_array_ptr = outer_array_ptr+2, this%columns+1 - this%outer_index(outer_array_ptr) = this%outer_index(outer_array_ptr-1) + DO outer_idx = outer_idx + 2, this%columns + 1 + this%outer_index(outer_idx) = this%outer_index(outer_idx - 1) END DO diff --git a/Source/Fortran/sparse_includes/DenseBranch.f90 b/Source/Fortran/sparse_includes/DenseBranch.f90 index 66c17ffe..3cc06195 100644 --- a/Source/Fortran/sparse_includes/DenseBranch.f90 +++ b/Source/Fortran/sparse_includes/DenseBranch.f90 @@ -8,7 +8,7 @@ !! Convert Back CALL ConstructMatrixSFromD(DenseC, matC, threshold) - CALL ScaleMatrix(matC,alpha) + CALL ScaleMatrix(matC, alpha) !! Cleanup CALL DestructMatrix(DenseA) diff --git a/Source/Fortran/sparse_includes/DotSparseVectors.f90 b/Source/Fortran/sparse_includes/DotSparseVectors.f90 index e89175d5..def6c4c8 100644 --- a/Source/Fortran/sparse_includes/DotSparseVectors.f90 +++ b/Source/Fortran/sparse_includes/DotSparseVectors.f90 @@ -1,25 +1,24 @@ INTEGER :: working_index_a, working_index_b !! Counter Variables - INTEGER :: counter_a, counter_b + INTEGER :: AA, BB - counter_a = 1 - counter_b = 1 + AA = 1 + BB = 1 product = 0 - sum_loop: DO WHILE(counter_a .LE. SIZE(inner_index_a) .AND. counter_b .LE. & - & SIZE(inner_index_b)) + DO WHILE(AA .LE. SIZE(inner_index_a) .AND. BB .LE. SIZE(inner_index_b)) !! Current inner indices and values - working_index_a = inner_index_a(counter_a) - working_index_b = inner_index_b(counter_b) - working_value_a = values_a(counter_a) - working_value_b = values_b(counter_b) + working_index_a = inner_index_a(AA) + working_index_b = inner_index_b(BB) + working_value_a = values_a(AA) + working_value_b = values_b(BB) !! Figure out from which vector an insertion will be performed IF (working_index_a .EQ. working_index_b) THEN product = product + working_value_a * working_value_b - counter_a = counter_a + 1 - counter_b = counter_b + 1 + AA = AA + 1 + BB = BB + 1 ELSE IF (working_index_a .GT. working_index_b) THEN - counter_b = counter_b + 1 + BB = BB + 1 ELSE !! implies working_index_b > working_index_b - counter_a = counter_a + 1 + AA = AA + 1 END IF - END DO sum_loop + END DO diff --git a/Source/Fortran/sparse_includes/ExtractMatrixColumn.f90 b/Source/Fortran/sparse_includes/ExtractMatrixColumn.f90 index db45c383..336c4a93 100644 --- a/Source/Fortran/sparse_includes/ExtractMatrixColumn.f90 +++ b/Source/Fortran/sparse_includes/ExtractMatrixColumn.f90 @@ -1,12 +1,12 @@ !! Local variables INTEGER :: number_of_values INTEGER :: start_index - INTEGER :: counter + INTEGER :: II !! Allocate Memory CALL ConstructEmptyMatrix(column_out, this%rows, 1) start_index = this%outer_index(column_number) - number_of_values = this%outer_index(column_number+1) - & + number_of_values = this%outer_index(column_number + 1) - & & this%outer_index(column_number) ALLOCATE(column_out%inner_index(number_of_values)) ALLOCATE(column_out%values(number_of_values)) @@ -14,7 +14,7 @@ !! Copy Values column_out%outer_index(1) = 0 column_out%outer_index(2) = number_of_values - DO counter=1, number_of_values - column_out%inner_index(counter) = this%inner_index(start_index+counter) - column_out%values(counter) = this%values(start_index+counter) + DO II = 1, number_of_values + column_out%inner_index(II) = this%inner_index(start_index + II) + column_out%values(II) = this%values(start_index + II) END DO diff --git a/Source/Fortran/sparse_includes/ExtractMatrixRow.f90 b/Source/Fortran/sparse_includes/ExtractMatrixRow.f90 index 2dbc36e5..8ae3b4e0 100644 --- a/Source/Fortran/sparse_includes/ExtractMatrixRow.f90 +++ b/Source/Fortran/sparse_includes/ExtractMatrixRow.f90 @@ -1,29 +1,25 @@ !! Temporary Variables INTEGER :: values_found - INTEGER :: total_counter, elements_per_inner - INTEGER :: outer_counter - INTEGER :: inner_counter + INTEGER :: elements_per_inner + INTEGER :: II, JJ, KK !! Fill a value buffer CALL ConstructEmptyMatrix(row_out, 1, this%columns) ALLOCATE(value_buffer(this%columns)) values_found = 0 - total_counter = 1 + KK = 1 row_out%outer_index(1) = 0 - DO outer_counter = 1, this%columns - row_out%outer_index(outer_counter+1) = & - & row_out%outer_index(outer_counter+1) + & - & row_out%outer_index(outer_counter) - elements_per_inner = this%outer_index(outer_counter+1) - & - & this%outer_index(outer_counter) - DO inner_counter = 1, elements_per_inner - IF (this%inner_index(total_counter) .EQ. row_number) THEN + DO II = 1, this%columns + row_out%outer_index(II + 1) = row_out%outer_index(II + 1) + & + & row_out%outer_index(II) + elements_per_inner = this%outer_index(II + 1) - this%outer_index(II) + DO JJ = 1, elements_per_inner + IF (this%inner_index(KK) .EQ. row_number) THEN values_found = values_found + 1 - value_buffer(values_found) = this%values(total_counter) - row_out%outer_index(outer_counter+1) = & - & row_out%outer_index(outer_counter+1) + 1 + value_buffer(values_found) = this%values(KK) + row_out%outer_index(II + 1) = row_out%outer_index(II + 1) + 1 END IF - total_counter = total_counter + 1 + KK = KK + 1 END DO END DO diff --git a/Source/Fortran/sparse_includes/GemmMatrix.f90 b/Source/Fortran/sparse_includes/GemmMatrix.f90 index 14e13c61..01f8a7cb 100644 --- a/Source/Fortran/sparse_includes/GemmMatrix.f90 +++ b/Source/Fortran/sparse_includes/GemmMatrix.f90 @@ -46,9 +46,9 @@ END IF !! Initialization of Memory - sparsity_a = DBLE(SIZE(matA%values))/(matA%rows*matA%columns) - sparsity_b = DBLE(SIZE(matB%values))/(matB%rows*matB%columns) - sparsity_estimate = 4*MAX(sparsity_a,sparsity_b) + sparsity_a = DBLE(SIZE(matA%values)) / (matA%rows * matA%columns) + sparsity_b = DBLE(SIZE(matB%values)) / (matB%rows * matB%columns) + sparsity_estimate = 4*MAX(sparsity_a, sparsity_b) IF (sparsity_estimate > 1.0) THEN sparsity_estimate = 1.0 ELSE IF (sparsity_estimate < 1e-8) THEN @@ -88,13 +88,13 @@ !! Handle the add part of GEMM IF (PRESENT(beta_in)) THEN IF (ABS(beta_in) .GT. 0) THEN - CALL ScaleMatrix(matC,beta) - CALL IncrementMatrix(matAB,matC) + CALL ScaleMatrix(matC, beta) + CALL IncrementMatrix(matAB, matC) ELSE - CALL CopyMatrix(matAB,matC) + CALL CopyMatrix(matAB, matC) END IF ELSE - CALL CopyMatrix(matAB,matC) + CALL CopyMatrix(matAB, matC) END IF CALL DestructMatrix(matAB) diff --git a/Source/Fortran/sparse_includes/IncrementMatrix.f90 b/Source/Fortran/sparse_includes/IncrementMatrix.f90 index 64d146a7..1bc478fd 100644 --- a/Source/Fortran/sparse_includes/IncrementMatrix.f90 +++ b/Source/Fortran/sparse_includes/IncrementMatrix.f90 @@ -1,7 +1,7 @@ !! Counter Variables - INTEGER :: outer_counter + INTEGER :: II INTEGER :: inner_a, inner_b - INTEGER :: total_counter_a, total_counter_b, total_counter_c + INTEGER :: total_a, total_b, total_c !! Temporary Variables INTEGER :: indices_added_into_c REAL(NTREAL) :: alpha @@ -20,49 +20,46 @@ threshold = threshold_in END IF - size_of_a = matA%outer_index(matA%columns+1) + size_of_a = matA%outer_index(matA%columns + 1) !! Allocate sufficient space for matC CALL ConstructEmptyMatrix(matC, matA%rows, matA%columns) IF (ALLOCATED(matB%values)) THEN - size_of_b = matB%outer_index(matB%columns+1) - ALLOCATE(matC%inner_index(size_of_a+size_of_b)) - ALLOCATE(matC%values(size_of_a+size_of_b)) + size_of_b = matB%outer_index(matB%columns + 1) + ALLOCATE(matC%inner_index(size_of_a + size_of_b)) + ALLOCATE(matC%values(size_of_a + size_of_b)) ELSE ALLOCATE(matC%inner_index(size_of_a)) ALLOCATE(matC%values(size_of_a)) END IF !! Perform loops - total_counter_a = 1 - total_counter_b = 1 - total_counter_c = 1 - DO outer_counter = 1, matA%columns + total_a = 1 + total_b = 1 + total_c = 1 + DO II = 1, matA%columns !! Inner counters - inner_a = matA%outer_index(outer_counter+1) - & - & matA%outer_index(outer_counter) - inner_b = matB%outer_index(outer_counter+1) - & - & matB%outer_index(outer_counter) + inner_a = matA%outer_index(II + 1) - matA%outer_index(II) + inner_b = matB%outer_index(II+1) - matB%outer_index(II) CALL AddSparseVectors(& - matA%inner_index(total_counter_a:total_counter_a+inner_a-1),& - matA%values(total_counter_a:total_counter_a+inner_a-1),& - matB%inner_index(total_counter_b:total_counter_b+inner_b-1),& - matB%values(total_counter_b:total_counter_b+inner_b-1),& - matC%inner_index(total_counter_c:),matC%values(total_counter_c:),& + matA%inner_index(total_a:total_a + inner_a - 1), & + matA%values(total_a:total_a + inner_a - 1), & + matB%inner_index(total_b:total_b + inner_b - 1), & + matB%values(total_b:total_b + inner_b - 1), & + matC%inner_index(total_c:), matC%values(total_c:), & indices_added_into_c, alpha, threshold) - matC%outer_index(outer_counter+1) = matC%outer_index(outer_counter)+& - & indices_added_into_c - total_counter_a = total_counter_a + inner_a - total_counter_b = total_counter_b + inner_b - total_counter_c = total_counter_c + indices_added_into_c + matC%outer_index(II + 1) = matC%outer_index(II) + indices_added_into_c + total_a = total_a + inner_a + total_b = total_b + inner_b + total_c = total_c + indices_added_into_c END DO !! Cleanup CALL DestructMatrix(matB) CALL ConstructEmptyMatrix(matB, matC%rows, matC%columns) matB%outer_index = matC%outer_index - ALLOCATE(matB%inner_index(matC%outer_index(matC%columns+1))) - ALLOCATE(matB%values(matC%outer_index(matC%columns+1))) - matB%inner_index = matC%inner_index(:matC%outer_index(matC%columns+1)) - matB%values = matC%values(:matC%outer_index(matC%columns+1)) + ALLOCATE(matB%inner_index(matC%outer_index(matC%columns + 1))) + ALLOCATE(matB%values(matC%outer_index(matC%columns + 1))) + matB%inner_index = matC%inner_index(:matC%outer_index(matC%columns + 1)) + matB%values = matC%values(:matC%outer_index(matC%columns + 1)) CALL DestructMatrix(matC) diff --git a/Source/Fortran/sparse_includes/MatrixColumnNorm.f90 b/Source/Fortran/sparse_includes/MatrixColumnNorm.f90 index 74796e4b..4645209b 100644 --- a/Source/Fortran/sparse_includes/MatrixColumnNorm.f90 +++ b/Source/Fortran/sparse_includes/MatrixColumnNorm.f90 @@ -1,18 +1,15 @@ !! Local Data - INTEGER :: outer_counter, inner_counter + INTEGER :: II, JJ INTEGER :: elements_per_inner !! Allocate Space For Result norm_per_column = 0 !! Iterate Over Local Data - DO outer_counter = 1, this%columns - elements_per_inner = this%outer_index(outer_counter+1) - & - & this%outer_index(outer_counter) - DO inner_counter = 1, elements_per_inner - temp_value = this%values(this%outer_index(outer_counter)+ & - & inner_counter) - norm_per_column(outer_counter) = norm_per_column(outer_counter) + & - & ABS(temp_value) + DO II = 1, this%columns + elements_per_inner = this%outer_index(II + 1) - this%outer_index(II) + DO JJ = 1, elements_per_inner + temp_value = this%values(this%outer_index(II) + JJ) + norm_per_column(II) = norm_per_column(II) + ABS(temp_value) END DO END DO diff --git a/Source/Fortran/sparse_includes/MatrixNorm.f90 b/Source/Fortran/sparse_includes/MatrixNorm.f90 index 51d03a2a..9738c8b4 100644 --- a/Source/Fortran/sparse_includes/MatrixNorm.f90 +++ b/Source/Fortran/sparse_includes/MatrixNorm.f90 @@ -1,2 +1,2 @@ - CALL MatrixColumnNorm(this,column) + CALL MatrixColumnNorm(this, column) norm = MAXVAL(column) diff --git a/Source/Fortran/sparse_includes/MatrixToTripletList.f90 b/Source/Fortran/sparse_includes/MatrixToTripletList.f90 index 2e3c7be1..a22b4291 100644 --- a/Source/Fortran/sparse_includes/MatrixToTripletList.f90 +++ b/Source/Fortran/sparse_includes/MatrixToTripletList.f90 @@ -1,21 +1,18 @@ !! Helper variables - INTEGER :: outer_counter, inner_counter + INTEGER :: II, JJ, KK INTEGER :: elements_per_inner - INTEGER :: total_counter INTEGER :: size_of_this - size_of_this = this%outer_index(this%columns+1) + size_of_this = this%outer_index(this%columns + 1) CALL ConstructTripletList(triplet_list, size_of_this) - total_counter = 1 - DO outer_counter = 1, this%columns - elements_per_inner = this%outer_index(outer_counter+1) - & - & this%outer_index(outer_counter) - DO inner_counter = 1, elements_per_inner - temporary%index_column = outer_counter - temporary%index_row = this%inner_index(total_counter) - temporary%point_value = this%values(total_counter) - triplet_list%DATA(total_counter) = temporary - total_counter = total_counter + 1 + KK = 1 + DO II = 1, this%columns + elements_per_inner = this%outer_index(II + 1) - this%outer_index(II) + DO JJ = 1, elements_per_inner + triplet_list%DATA(KK)%index_column = II + triplet_list%DATA(KK)%index_row = this%inner_index(KK) + triplet_list%DATA(KK)%point_value = this%values(KK) + KK = KK + 1 END DO END DO diff --git a/Source/Fortran/sparse_includes/MultiplyBlock.f90 b/Source/Fortran/sparse_includes/MultiplyBlock.f90 index d3a5c43a..5d4aa945 100644 --- a/Source/Fortran/sparse_includes/MultiplyBlock.f90 +++ b/Source/Fortran/sparse_includes/MultiplyBlock.f90 @@ -1,43 +1,36 @@ - INTEGER :: temp_inserted_values - INTEGER :: temp_index_a, temp_index_b - INTEGER :: elements_per_inner_a - INTEGER :: elements_per_inner_b + INTEGER :: inserted_vals + INTEGER :: idx_a, idx_b, idx_hash + INTEGER :: elements_per_inner_a, elements_per_inner_b LOGICAL :: is_set !! Counters - INTEGER :: outer_counter, inner_counter_a, inner_counter_b + INTEGER :: II, AA, BB !! Multiply - DO outer_counter = 1, matAT%columns - elements_per_inner_a = matAT%outer_index(outer_counter+1) - & - & matAT%outer_index(outer_counter) - DO inner_counter_a = 1, elements_per_inner_a - temp_value_a = matAT%values(matAT%outer_index(outer_counter)+ & - & inner_counter_a) - temp_index_a = matAT%inner_index(matAT%outer_index(outer_counter)+ & - & inner_counter_a) - elements_per_inner_b = matBT%outer_index(temp_index_a+1) - & - & matBT%outer_index(temp_index_a) - DO inner_counter_b = 1, elements_per_inner_b - temp_index_b = matBT%inner_index(matBT%outer_index(temp_index_a)+ & - & inner_counter_b) - temp_value_b = matBT%values(matBT%outer_index(temp_index_a)+ & - & inner_counter_b) - temp_value_c = memorypool%value_array(temp_index_b,outer_counter) - is_set = memorypool%dirty_array(temp_index_b,outer_counter) + DO II = 1, matAT%columns + elements_per_inner_a = matAT%outer_index(II + 1) - & + & matAT%outer_index(II) + DO AA = 1, elements_per_inner_a + val_a = matAT%values(matAT%outer_index(II) + AA) + idx_a = matAT%inner_index(matAT%outer_index(II) + AA) + elements_per_inner_b = matBT%outer_index(idx_a + 1) - & + & matBT%outer_index(idx_a) + DO BB = 1, elements_per_inner_b + idx_b = matBT%inner_index(matBT%outer_index(idx_a) + BB) + val_b = matBT%values(matBT%outer_index(idx_a)+ BB) + val_c = memorypool%value_array(idx_b, II) + is_set = memorypool%dirty_array(idx_b, II) IF (is_set .EQV. .FALSE.) THEN - memorypool%dirty_array(temp_index_b,outer_counter) = .TRUE. - temp_inserted_values = memorypool%inserted_per_bucket(& - & (temp_index_b-1)/memorypool%hash_size+1,outer_counter) + 1 - memorypool%inserted_per_bucket(& - & (temp_index_b-1)/memorypool%hash_size+1,outer_counter) = & - & temp_inserted_values - memorypool%hash_index(temp_inserted_values+ & - & ((temp_index_b-1)/memorypool%hash_size)& - & *memorypool%hash_size, & - & outer_counter) = temp_index_b + memorypool%dirty_array(idx_b, II) = .TRUE. + idx_hash = (idx_b - 1) / memorypool%hash_size + inserted_vals = & + & memorypool%inserted_per_bucket(idx_hash + 1, II) + 1 + memorypool%inserted_per_bucket(idx_hash + 1, II) = & + & inserted_vals + memorypool%hash_index(& + & inserted_vals + idx_hash * memorypool%hash_size, & + & II) = idx_b END IF - memorypool%value_array(temp_index_b,outer_counter) = & - & temp_value_c + temp_value_a*temp_value_b + memorypool%value_array(idx_b, II) = val_c + val_a * val_b END DO END DO END DO diff --git a/Source/Fortran/sparse_includes/PairwiseMultiplyMatrix.f90 b/Source/Fortran/sparse_includes/PairwiseMultiplyMatrix.f90 index 103d722e..0feaba71 100644 --- a/Source/Fortran/sparse_includes/PairwiseMultiplyMatrix.f90 +++ b/Source/Fortran/sparse_includes/PairwiseMultiplyMatrix.f90 @@ -1,40 +1,38 @@ !! Counter Variables - INTEGER :: outer_counter + INTEGER :: II INTEGER :: inner_a, inner_b - INTEGER :: total_counter_a, total_counter_b, total_counter_c + INTEGER :: total_a, total_b, total_c !! Temporary Variables INTEGER :: indices_added_into_c INTEGER :: size_of_a, size_of_b CALL ConstructEmptyMatrix(TempMat, matA%rows, matA%columns) - size_of_a = matA%outer_index(matA%columns+1) - size_of_b = matB%outer_index(matB%columns+1) - ALLOCATE(TempMat%inner_index(MIN(size_of_a,size_of_b))) - ALLOCATE(TempMat%values(MIN(size_of_a,size_of_b))) + size_of_a = matA%outer_index(matA%columns + 1) + size_of_b = matB%outer_index(matB%columns + 1) + ALLOCATE(TempMat%inner_index(MIN(size_of_a, size_of_b))) + ALLOCATE(TempMat%values(MIN(size_of_a, size_of_b))) !! Perform loops - total_counter_a = 1 - total_counter_b = 1 - total_counter_c = 1 - DO outer_counter = 1, matA%columns + total_a = 1 + total_b = 1 + total_c = 1 + DO II = 1, matA%columns !! Inner counters - inner_a = matA%outer_index(outer_counter+1) - & - & matA%outer_index(outer_counter) - inner_b = matB%outer_index(outer_counter+1) - & - & matB%outer_index(outer_counter) + inner_a = matA%outer_index(II + 1) - matA%outer_index(II) + inner_b = matB%outer_index(II + 1) - matB%outer_index(II) CALL PairwiseMultiplyVectors(& - matA%inner_index(total_counter_a:total_counter_a+inner_a-1),& - matA%values(total_counter_a:total_counter_a+inner_a-1),& - matB%inner_index(total_counter_b:total_counter_b+inner_b-1),& - matB%values(total_counter_b:total_counter_b+inner_b-1),& - TempMat%inner_index(total_counter_c:),& - TempMat%values(total_counter_c:),& + matA%inner_index(total_a:total_a + inner_a - 1), & + matA%values(total_a:total_a + inner_a - 1), & + matB%inner_index(total_b:total_b + inner_b - 1), & + matB%values(total_b:total_b + inner_b - 1), & + TempMat%inner_index(total_c:), & + TempMat%values(total_c:), & indices_added_into_c) - TempMat%outer_index(outer_counter+1) = TempMat%outer_index(outer_counter)+& - & indices_added_into_c - total_counter_a = total_counter_a + inner_a - total_counter_b = total_counter_b + inner_b - total_counter_c = total_counter_c + indices_added_into_c + TempMat%outer_index(II + 1) = & + & TempMat%outer_index(II) + indices_added_into_c + total_a = total_a + inner_a + total_b = total_b + inner_b + total_c = total_c + indices_added_into_c END DO !! Cleanup diff --git a/Source/Fortran/sparse_includes/PairwiseMultiplyVectors.f90 b/Source/Fortran/sparse_includes/PairwiseMultiplyVectors.f90 index 12e0ba56..1b3a94de 100644 --- a/Source/Fortran/sparse_includes/PairwiseMultiplyVectors.f90 +++ b/Source/Fortran/sparse_includes/PairwiseMultiplyVectors.f90 @@ -1,28 +1,27 @@ INTEGER :: working_index_a, working_index_b !! Counter Variables - INTEGER :: counter_a, counter_b, counter_c + INTEGER :: AA, BB, CC - counter_a = 1 - counter_b = 1 - counter_c = 1 - sum_loop: DO WHILE(counter_a .LE. SIZE(inner_index_a) .AND. counter_b .LE. & - & SIZE(inner_index_b)) + AA = 1 + BB = 1 + CC = 1 + DO WHILE(AA .LE. SIZE(inner_index_a) .AND. BB .LE. SIZE(inner_index_b)) !! Current inner indices and values - working_index_a = inner_index_a(counter_a) - working_index_b = inner_index_b(counter_b) - working_value_a = values_a(counter_a) - working_value_b = values_b(counter_b) + working_index_a = inner_index_a(AA) + working_index_b = inner_index_b(BB) + working_value_a = values_a(AA) + working_value_b = values_b(BB) !! Figure out from which vector an insertion will be performed IF (working_index_a .EQ. working_index_b) THEN - inner_index_c(counter_c) = working_index_a - values_c(counter_c) = working_value_a * working_value_b - counter_c = counter_c + 1 - counter_a = counter_a + 1 - counter_b = counter_b + 1 + inner_index_c(CC) = working_index_a + values_c(CC) = working_value_a * working_value_b + AA = AA + 1 + BB = BB + 1 + CC = CC + 1 ELSE IF (working_index_a .GT. working_index_b) THEN - counter_b = counter_b + 1 + BB = BB + 1 ELSE !! implies working_index_b > working_index_b - counter_a = counter_a + 1 + AA = AA + 1 END IF - END DO sum_loop - total_values_c = counter_c - 1 + END DO + total_values_c = CC - 1 diff --git a/Source/Fortran/sparse_includes/PrintMatrix.f90 b/Source/Fortran/sparse_includes/PrintMatrix.f90 index 189b84de..858f4b18 100644 --- a/Source/Fortran/sparse_includes/PrintMatrix.f90 +++ b/Source/Fortran/sparse_includes/PrintMatrix.f90 @@ -1,8 +1,8 @@ !! Local Data INTEGER :: file_handler - INTEGER :: counter INTEGER :: size_of_this - CHARACTER(LEN=MAX_LINE_LENGTH) :: tempstr + CHARACTER(LEN = MAX_LINE_LENGTH) :: tempstr + INTEGER :: II !! Process Optional Parameters IF (PRESENT(file_name_in)) THEN @@ -13,9 +13,9 @@ END IF !! Print - CALL MatrixToTripletList(this,triplet_list) + CALL MatrixToTripletList(this, triplet_list) - size_of_this = this%outer_index(this%columns+1) + size_of_this = this%outer_index(this%columns + 1) #ifdef ISCOMPLEX WRITE(file_handler,'(A)') "%%MatrixMarket matrix coordinate complex general" @@ -25,19 +25,19 @@ WRITE(file_handler,'(A)') "%" CALL WriteMMSize(tempstr, this%rows, this%columns, & - & INT(size_of_this, KIND=NTLONG)) + & INT(size_of_this, KIND = NTLONG)) WRITE(file_handler,'(A)') ADJUSTL(TRIM(tempstr)) - DO counter = 1,size_of_this + DO II = 1, size_of_this #ifdef ISCOMPLEX - CALL WriteMMLine(tempstr, triplet_list%DATA(counter)%index_row, & - & triplet_list%DATA(counter)%index_column, & - & REAL(triplet_list%DATA(counter)%point_value), & - & AIMAG(triplet_list%DATA(counter)%point_value)) + CALL WriteMMLine(tempstr, triplet_list%DATA(II)%index_row, & + & triplet_list%DATA(II)%index_column, & + & REAL(triplet_list%DATA(II)%point_value), & + & AIMAG(triplet_list%DATA(II)%point_value)) WRITE(file_handler,'(A)') ADJUSTL(TRIM(tempstr)) #else - CALL WriteMMLine(tempstr, triplet_list%DATA(counter)%index_row, & - & triplet_list%DATA(counter)%index_column, & - & triplet_list%DATA(counter)%point_value) + CALL WriteMMLine(tempstr, triplet_list%DATA(II)%index_row, & + & triplet_list%DATA(II)%index_column, & + & triplet_list%DATA(II)%point_value) WRITE(file_handler,'(A)') ADJUSTL(TRIM(tempstr)) #endif END DO diff --git a/Source/Fortran/sparse_includes/PruneList.f90 b/Source/Fortran/sparse_includes/PruneList.f90 index d87f5426..b2db4a96 100644 --- a/Source/Fortran/sparse_includes/PruneList.f90 +++ b/Source/Fortran/sparse_includes/PruneList.f90 @@ -1,39 +1,39 @@ !! Local data - INTEGER :: row_counter_c, column_counter_c, hash_counter - INTEGER :: working_column - INTEGER :: temp_values_per_hash - INTEGER :: pruned_counter + INTEGER :: working_col + INTEGER :: values_per_hash + INTEGER :: PII, HII, RII, CII - pruned_counter = 1 - DO row_counter_c = 1, mat_c_rows - DO column_counter_c = 1, (mat_c_columns-1)/memorypool%hash_size+1 + !! Loop over the hash structure + PII = 1 + DO RII = 1, mat_c_rows + DO CII = 1, (mat_c_columns - 1) / memorypool%hash_size + 1 !! Sort the elements in a hash - temp_values_per_hash = memorypool%inserted_per_bucket(& - & column_counter_c,row_counter_c) - memorypool%inserted_per_bucket(column_counter_c,row_counter_c) = 0 + values_per_hash = memorypool%inserted_per_bucket(CII, RII) + memorypool%inserted_per_bucket(CII, RII) = 0 !! Copy them - DO hash_counter=1,temp_values_per_hash - working_column = memorypool%hash_index(hash_counter+ & - & (column_counter_c-1)*memorypool%hash_size, row_counter_c) - working_value = memorypool%value_array(working_column,row_counter_c) - memorypool%value_array(working_column,row_counter_c) = 0 - memorypool%dirty_array(working_column,row_counter_c) = .FALSE. + DO HII = 1, values_per_hash + working_col = memorypool%hash_index(HII + & + & (CII - 1) * memorypool%hash_size, RII) + working_value = & + & memorypool%value_array(working_col, RII) + memorypool%value_array(working_col, RII) = 0 + memorypool%dirty_array(working_col, RII) = .FALSE. + !! If above threshold, insert IF (ABS(alpha*working_value) .GT. threshold) THEN - memorypool%pruned_list(pruned_counter)%point_value = & - & alpha*working_value - memorypool%pruned_list(pruned_counter)%index_column = & - & working_column - memorypool%pruned_list(pruned_counter)%index_row = & - & row_counter_c - pruned_counter = pruned_counter + 1 + memorypool%pruned_list(PII)%point_value = alpha*working_value + memorypool%pruned_list(PII)%index_column = working_col + memorypool%pruned_list(PII)%index_row = RII + PII = PII + 1 END IF END DO END DO END DO - CALL ConstructTripletList(unsorted_pruned_list, pruned_counter-1) - unsorted_pruned_list%DATA = memorypool%pruned_list(1:pruned_counter-1) + + !! Convert to matrix + CALL ConstructTripletList(unsorted_pruned_list, PII - 1) + unsorted_pruned_list%DATA = memorypool%pruned_list(1:PII - 1) CALL SortTripletList(unsorted_pruned_list, mat_c_columns, mat_c_rows, & - & sorted_pruned_list, bubble_in=.TRUE.) + & sorted_pruned_list, bubble_in = .TRUE.) CALL ConstructMatrixFromTripletList(matAB, sorted_pruned_list, mat_c_rows, & & mat_c_columns) CALL DestructTripletList(sorted_pruned_list) diff --git a/Source/Fortran/sparse_includes/SparseBranch.f90 b/Source/Fortran/sparse_includes/SparseBranch.f90 index 490a28c9..a2e64c03 100644 --- a/Source/Fortran/sparse_includes/SparseBranch.f90 +++ b/Source/Fortran/sparse_includes/SparseBranch.f90 @@ -1,9 +1,9 @@ !! Block A and B IF (.NOT. IsATransposed) THEN - CALL TransposeMatrix(matA,matAT) + CALL TransposeMatrix(matA, matAT) END IF IF (.NOT. IsBTransposed) THEN - CALL TransposeMatrix(matB,matBT) + CALL TransposeMatrix(matB, matBT) END IF IF (IsATransposed .AND. IsBTransposed) THEN diff --git a/Source/Fortran/sparse_includes/SplitMatrix.f90 b/Source/Fortran/sparse_includes/SplitMatrix.f90 index 5a484039..e8cda76a 100644 --- a/Source/Fortran/sparse_includes/SplitMatrix.f90 +++ b/Source/Fortran/sparse_includes/SplitMatrix.f90 @@ -9,17 +9,17 @@ IF (PRESENT(block_size_row_in)) THEN block_size_row = block_size_row_in ELSE - divisor_row = this%rows/block_rows + divisor_row = this%rows / block_rows block_size_row = divisor_row - block_size_row(block_rows) = this%rows - divisor_row*(block_rows-1) + block_size_row(block_rows) = this%rows - divisor_row*(block_rows - 1) END IF IF (PRESENT(block_size_column_in)) THEN block_size_column = block_size_column_in ELSE - divisor_column = this%columns/block_columns + divisor_column = this%columns / block_columns block_size_column = divisor_column block_size_column(block_columns) = this%columns - & - & divisor_column*(block_columns-1) + & divisor_column*(block_columns - 1) END IF !! First split by columns which is easy with the CSR format @@ -33,7 +33,7 @@ & row_split) !! Copy into output array DO II = 1, block_rows - CALL TransposeMatrix(row_split(II), split_array(II,JJ)) + CALL TransposeMatrix(row_split(II), split_array(II, JJ)) END DO END DO diff --git a/Source/Fortran/sparse_includes/SplitMatrixColumns.f90 b/Source/Fortran/sparse_includes/SplitMatrixColumns.f90 index dc8143e0..9f3692e2 100644 --- a/Source/Fortran/sparse_includes/SplitMatrixColumns.f90 +++ b/Source/Fortran/sparse_includes/SplitMatrixColumns.f90 @@ -1,39 +1,37 @@ !! Local Data INTEGER, DIMENSION(num_blocks+1) :: block_offsets - !! Counters - INTEGER :: split_counter !! Temporary variables - INTEGER :: loffset, lcolumns, linner_offset, total_values + INTEGER :: II, loffset, lcolumns, linner_offset, total_values !! Compute Offsets block_offsets(1) = 1 - DO split_counter = 2, num_blocks+1 - block_offsets(split_counter) = block_offsets(split_counter-1) + & - & block_sizes(split_counter-1) + DO II = 2, num_blocks + 1 + block_offsets(II) = block_offsets(II - 1) + block_sizes(II - 1) END DO !! Split up the columns - DO split_counter = 1, num_blocks + DO II = 1, num_blocks !! Temporary variables - loffset = block_offsets(split_counter) - lcolumns = block_sizes(split_counter) - linner_offset = this%outer_index(loffset)+1 + loffset = block_offsets(II) + lcolumns = block_sizes(II) + linner_offset = this%outer_index(loffset) + 1 + !! Construct - CALL ConstructEmptyMatrix(split_list(split_counter), this%rows, lcolumns) + CALL ConstructEmptyMatrix(split_list(II), this%rows, lcolumns) + !! Copy Outer Index - split_list(split_counter)%outer_index = & - & this%outer_index(loffset:loffset+lcolumns) - split_list(split_counter)%outer_index = & - & split_list(split_counter)%outer_index - & - & split_list(split_counter)%outer_index(1) - total_values = split_list(split_counter)%outer_index(lcolumns+1) + split_list(II)%outer_index = this%outer_index(loffset:loffset + lcolumns) + split_list(II)%outer_index = split_list(II)%outer_index - & + & split_list(II)%outer_index(1) + total_values = split_list(II)%outer_index(lcolumns + 1) + !! Copy Inner Indices and Values IF (total_values .GT. 0) THEN - ALLOCATE(split_list(split_counter)%inner_index(total_values)) - split_list(split_counter)%inner_index = & - & this%inner_index(linner_offset:linner_offset+total_values-1) - ALLOCATE(split_list(split_counter)%values(total_values)) - split_list(split_counter)%values = & - & this%values(linner_offset:linner_offset+total_values-1) + ALLOCATE(split_list(II)%inner_index(total_values)) + split_list(II)%inner_index = & + & this%inner_index(linner_offset:linner_offset + total_values - 1) + ALLOCATE(split_list(II)%values(total_values)) + split_list(II)%values = & + & this%values(linner_offset:linner_offset + total_values - 1) END IF END DO diff --git a/Source/Fortran/sparse_includes/TransposeMatrix.f90 b/Source/Fortran/sparse_includes/TransposeMatrix.f90 index 8502f554..12f59a38 100644 --- a/Source/Fortran/sparse_includes/TransposeMatrix.f90 +++ b/Source/Fortran/sparse_includes/TransposeMatrix.f90 @@ -7,7 +7,7 @@ INTEGER :: num_values, elements_per_inner !! Allocate New Matrix - num_values = this%outer_index(this%columns+1) + num_values = this%outer_index(this%columns + 1) CALL ConstructEmptyMatrix(matT, this%columns, this%rows) ALLOCATE(matT%inner_index(num_values)) ALLOCATE(matT%values(num_values)) @@ -24,21 +24,21 @@ END DO offset_array(1) = 0 DO II = 2, this%rows - offset_array(II) = offset_array(II-1) + values_per_row(II-1) + offset_array(II) = offset_array(II - 1) + values_per_row(II - 1) END DO !! Insert matT%outer_index(:this%rows) = offset_array(:this%rows) - matT%outer_index(this%rows+1) = offset_array(this%rows) + & + matT%outer_index(this%rows + 1) = offset_array(this%rows) + & & values_per_row(this%rows) DO II = 1, this%columns - elements_per_inner = this%outer_index(II+1) - this%outer_index(II) + elements_per_inner = this%outer_index(II + 1) - this%outer_index(II) this_offset = this%outer_index(II) DO JJ = 1, elements_per_inner - inner_index = this%inner_index(this_offset+JJ) + inner_index = this%inner_index(this_offset + JJ) insert_pt = offset_array(inner_index)+1 matT%inner_index(insert_pt) = II - matT%values(insert_pt) = this%values(this_offset+JJ) + matT%values(insert_pt) = this%values(this_offset + JJ) offset_array(inner_index) = offset_array(inner_index) +1 END DO END DO diff --git a/Source/Fortran/triplet_includes/AppendToTripletList.f90 b/Source/Fortran/triplet_includes/AppendToTripletList.f90 index 7fd29de8..1a703c8b 100644 --- a/Source/Fortran/triplet_includes/AppendToTripletList.f90 +++ b/Source/Fortran/triplet_includes/AppendToTripletList.f90 @@ -10,7 +10,7 @@ ELSE new_size = INT(SIZE(this%DATA)*1.5) END IF - CALL ResizeTripletList(this,new_size) + CALL ResizeTripletList(this, new_size) END IF !! Append diff --git a/Source/Fortran/triplet_includes/CompareTriplets.f90 b/Source/Fortran/triplet_includes/CompareTriplets.f90 index 8cd021c3..be4b927c 100644 --- a/Source/Fortran/triplet_includes/CompareTriplets.f90 +++ b/Source/Fortran/triplet_includes/CompareTriplets.f90 @@ -1,7 +1,7 @@ IF (tripA%index_column .GT. tripB%index_column) THEN islessthan = .TRUE. - ELSE IF ((tripA%index_column .EQ. tripB%index_column) .AND. & - & (tripA%index_row .GT. tripB%index_row)) THEN + ELSE IF (tripA%index_column .EQ. tripB%index_column .AND. & + & tripA%index_row .GT. tripB%index_row) THEN islessthan = .TRUE. ELSE islessthan = .FALSE. diff --git a/Source/Fortran/triplet_includes/CopyTripletList.f90 b/Source/Fortran/triplet_includes/CopyTripletList.f90 new file mode 100644 index 00000000..caad918c --- /dev/null +++ b/Source/Fortran/triplet_includes/CopyTripletList.f90 @@ -0,0 +1,6 @@ + tripB%CurrentSize = tripA%CurrentSize + + !! We only will allocate as much space as needed, and not the additional + !! buffer. + ALLOCATE(tripB%DATA(tripB%CurrentSize)) + tripB%DATA(:tripB%CurrentSize) = tripA%DATA(:tripB%CurrentSize) \ No newline at end of file diff --git a/Source/Fortran/triplet_includes/RedistributeTripletLists.f90 b/Source/Fortran/triplet_includes/RedistributeTripletLists.f90 index 1f4940d0..af70b623 100644 --- a/Source/Fortran/triplet_includes/RedistributeTripletLists.f90 +++ b/Source/Fortran/triplet_includes/RedistributeTripletLists.f90 @@ -10,7 +10,7 @@ INTEGER, DIMENSION(:), ALLOCATABLE :: recv_buffer_col !! ETC INTEGER :: num_processes - INTEGER :: counter, inner_counter, insert_pt + INTEGER :: II, JJ, insert_pt INTEGER :: mpi_error !! Allocate Size Buffers @@ -21,22 +21,20 @@ ALLOCATE(recv_offsets(num_processes)) !! Figure Out How Much Data Gets Sent - DO counter = 1, num_processes - send_per_process(counter) = triplet_lists(counter)%CurrentSize + DO II = 1, num_processes + send_per_process(II) = triplet_lists(II)%CurrentSize END DO send_offsets(1) = 0 - DO counter = 2, num_processes - send_offsets(counter) = send_offsets(counter-1) + & - & send_per_process(counter-1) + DO II = 2, num_processes + send_offsets(II) = send_offsets(II - 1) + send_per_process(II - 1) END DO !! Figure Out How Much Data Gets Received CALL MPI_ALLTOALL(send_per_process, 1, MPINTINTEGER, recv_per_process, 1, & & MPINTINTEGER, comm, mpi_error) recv_offsets(1) = 0 - DO counter = 2, num_processes - recv_offsets(counter) = recv_offsets(counter-1) + & - & recv_per_process(counter-1) + DO II = 2, num_processes + recv_offsets(II) = recv_offsets(II - 1) + recv_per_process(II - 1) END DO !! Allocate And Fill Send Buffers @@ -49,9 +47,9 @@ !! Fill Send Buffer insert_pt = 1 - DO counter = 1, num_processes - DO inner_counter = 1, triplet_lists(counter)%CurrentSize - CALL GetTripletAt(triplet_lists(counter), inner_counter, temp_triplet) + DO II = 1, num_processes + DO JJ = 1, triplet_lists(II)%CurrentSize + CALL GetTripletAt(triplet_lists(II), JJ, temp_triplet) send_buffer_row(insert_pt) = temp_triplet%index_row send_buffer_col(insert_pt) = temp_triplet%index_column send_buffer_val(insert_pt) = temp_triplet%point_value @@ -71,11 +69,11 @@ & MPIDATATYPE, comm, mpi_error) !! Unpack Into The Output Triplet List - CALL ConstructTripletList(local_data_out, size_in=SUM(recv_per_process)) - DO counter = 1, SUM(recv_per_process) - local_data_out%DATA(counter)%index_column = recv_buffer_col(counter) - local_data_out%DATA(counter)%index_row = recv_buffer_row(counter) - local_data_out%DATA(counter)%point_value = recv_buffer_val(counter) + CALL ConstructTripletList(local_data_out, size_in = SUM(recv_per_process)) + DO II = 1, SUM(recv_per_process) + local_data_out%DATA(II)%index_column = recv_buffer_col(II) + local_data_out%DATA(II)%index_row = recv_buffer_row(II) + local_data_out%DATA(II)%point_value = recv_buffer_val(II) END DO !! Cleanup diff --git a/Source/Fortran/triplet_includes/ShiftTripletList.f90 b/Source/Fortran/triplet_includes/ShiftTripletList.f90 index d8fce510..9e814e80 100644 --- a/Source/Fortran/triplet_includes/ShiftTripletList.f90 +++ b/Source/Fortran/triplet_includes/ShiftTripletList.f90 @@ -1,7 +1,7 @@ !! Loop - DO counter = 1, triplet_list%CurrentSize - triplet_list%DATA(counter)%index_row = & - triplet_list%DATA(counter)%index_row + row_shift - triplet_list%DATA(counter)%index_column = & - triplet_list%DATA(counter)%index_column + column_shift + DO II = 1, triplet_list%CurrentSize + triplet_list%DATA(II)%index_row = & + triplet_list%DATA(II)%index_row + row_shift + triplet_list%DATA(II)%index_column = & + triplet_list%DATA(II)%index_column + column_shift END DO diff --git a/Source/Fortran/triplet_includes/SortDenseTripletList.f90 b/Source/Fortran/triplet_includes/SortDenseTripletList.f90 index 07304950..fa27b32c 100644 --- a/Source/Fortran/triplet_includes/SortDenseTripletList.f90 +++ b/Source/Fortran/triplet_includes/SortDenseTripletList.f90 @@ -5,8 +5,8 @@ INTEGER :: II, JJ !! Setup Memory - ALLOCATE(value_buffer(matrix_rows,matrix_columns)) - ALLOCATE(dirty_buffer(matrix_rows,matrix_columns)) + ALLOCATE(value_buffer(matrix_rows, matrix_columns)) + ALLOCATE(dirty_buffer(matrix_rows, matrix_columns)) value_buffer = 0 dirty_buffer = 0 list_length = input_list%CurrentSize @@ -27,7 +27,7 @@ IF (dirty_buffer(II,JJ) .EQ. 1) THEN sorted_list%DATA(ind)%index_row = II sorted_list%DATA(ind)%index_column = JJ - sorted_list%DATA(ind)%point_value = value_buffer(II,JJ) + sorted_list%DATA(ind)%point_value = value_buffer(II, JJ) ind = ind + 1 END IF END DO diff --git a/Source/Fortran/triplet_includes/SortTripletList.f90 b/Source/Fortran/triplet_includes/SortTripletList.f90 index 26babda3..04a686ea 100644 --- a/Source/Fortran/triplet_includes/SortTripletList.f90 +++ b/Source/Fortran/triplet_includes/SortTripletList.f90 @@ -5,8 +5,7 @@ INTEGER, DIMENSION(:), ALLOCATABLE :: offset_array INTEGER, DIMENSION(:), ALLOCATABLE :: inserted_per_row !! Counters and temporary variables - INTEGER :: counter - INTEGER :: idx + INTEGER :: II, idx INTEGER :: alloc_stat INTEGER :: list_length @@ -18,34 +17,34 @@ list_length = input_list%CurrentSize - IF (bubble .AND. list_length .GT. matrix_rows*matrix_columns*0.1) THEN + IF (bubble .AND. list_length .GT. matrix_rows*matrix_columns * 0.1) THEN CALL SortDenseTripletList(input_list, matrix_columns, matrix_rows, & & sorted_list) ELSE !! Data Allocation CALL ConstructTripletList(sorted_list, list_length) - ALLOCATE(values_per_row(matrix_columns), stat=alloc_stat) - ALLOCATE(offset_array(matrix_columns), stat=alloc_stat) - ALLOCATE(inserted_per_row(matrix_columns), stat=alloc_stat) + ALLOCATE(values_per_row(matrix_columns), stat = alloc_stat) + ALLOCATE(offset_array(matrix_columns), stat = alloc_stat) + ALLOCATE(inserted_per_row(matrix_columns), stat = alloc_stat) !! Initial one dimensional sort values_per_row = 0 inserted_per_row = 0 !! Do a first pass bucket sort - DO counter = 1, input_list%CurrentSize - values_per_row(input_list%DATA(counter)%index_column) = & - & values_per_row(input_list%DATA(counter)%index_column) + 1 + DO II = 1, input_list%CurrentSize + values_per_row(input_list%DATA(II)%index_column) = & + & values_per_row(input_list%DATA(II)%index_column) + 1 END DO offset_array(1) = 1 - DO counter = 2, UBOUND(offset_array,dim=1) - offset_array(counter) = offset_array(counter-1) + & - & values_per_row(counter-1) + DO II = 2, UBOUND(offset_array, dim = 1) + offset_array(II) = offset_array(II - 1) + & + & values_per_row(II - 1) END DO - DO counter = 1, input_list%CurrentSize - idx = input_list%DATA(counter)%index_column - sorted_list%DATA(offset_array(idx)+inserted_per_row(idx))=& - & input_list%DATA(counter) + DO II = 1, input_list%CurrentSize + idx = input_list%DATA(II)%index_column + sorted_list%DATA(offset_array(idx) + inserted_per_row(idx)) = & + & input_list%DATA(II) inserted_per_row(idx) = inserted_per_row(idx) + 1 END DO @@ -55,12 +54,12 @@ IF (bubble) THEN DO WHILE (swap_occured .EQV. .TRUE.) swap_occured = .FALSE. - DO counter = 2, sorted_list%CurrentSize - IF (CompareTriplets(sorted_list%DATA(counter-1), & - & sorted_list%DATA(counter))) THEN - temporary = sorted_list%DATA(counter) - sorted_list%DATA(counter) = sorted_list%DATA(counter-1) - sorted_list%DATA(counter-1) = temporary + DO II = 2, sorted_list%CurrentSize + IF (CompareTriplets(sorted_list%DATA(II - 1), & + & sorted_list%DATA(II))) THEN + trip = sorted_list%DATA(II) + sorted_list%DATA(II) = sorted_list%DATA(II - 1) + sorted_list%DATA(II - 1) = trip swap_occured = .TRUE. END IF END DO diff --git a/Source/Wrapper/SolverParametersModule_wrp.F90 b/Source/Wrapper/SolverParametersModule_wrp.F90 index 80ba7d4a..2eb75504 100644 --- a/Source/Wrapper/SolverParametersModule_wrp.F90 +++ b/Source/Wrapper/SolverParametersModule_wrp.F90 @@ -30,8 +30,8 @@ SUBROUTINE ConstructSolverParameters_wrp(ih_this) & TYPE(SolverParameters_wrp) :: h_this ALLOCATE(h_this%DATA) - h_this%DATA = SolverParameters_t() - ih_this = TRANSFER(h_this,ih_this) + CALL ConstructSolverParameters(h_this%DATA) + ih_this = TRANSFER(h_this, ih_this) END SUBROUTINE ConstructSolverParameters_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Destruct a iterative solver parameter type. @@ -40,10 +40,9 @@ SUBROUTINE DestructSolverParameters_wrp(ih_this) & INTEGER(kind=c_int), INTENT(INOUT) :: ih_this(SIZE_wrp) TYPE(SolverParameters_wrp) :: h_this - h_this = TRANSFER(ih_this,h_this) + h_this = TRANSFER(ih_this, h_this) CALL DestructSolverParameters(h_this%DATA) DEALLOCATE(h_this%DATA) - !ih_this = 0 END SUBROUTINE DestructSolverParameters_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Set the value of the convergence difference. @@ -53,8 +52,8 @@ SUBROUTINE SetParametersConvergeDiff_wrp(ih_this,new_value) & REAL(NTREAL), INTENT(IN) :: new_value TYPE(SolverParameters_wrp) :: h_this - h_this = TRANSFER(ih_this,h_this) - CALL SetParametersConvergeDiff(h_this%DATA,new_value) + h_this = TRANSFER(ih_this, h_this) + CALL SetParametersConvergeDiff(h_this%DATA, new_value) END SUBROUTINE SetParametersConvergeDiff_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Set the value of the max iterations. @@ -64,8 +63,8 @@ SUBROUTINE SetParametersMaxIterations_wrp(ih_this,new_value) & INTEGER(kind=c_int), INTENT(IN) :: new_value TYPE(SolverParameters_wrp) :: h_this - h_this = TRANSFER(ih_this,h_this) - CALL SetParametersMaxIterations(h_this%DATA,new_value) + h_this = TRANSFER(ih_this, h_this) + CALL SetParametersMaxIterations(h_this%DATA, new_value) END SUBROUTINE SetParametersMaxIterations_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Set the value of the threshold. @@ -75,8 +74,8 @@ SUBROUTINE SetParametersThreshold_wrp(ih_this,new_value) & REAL(NTREAL), INTENT(IN) :: new_value TYPE(SolverParameters_wrp) :: h_this - h_this = TRANSFER(ih_this,h_this) - CALL SetParametersThreshold(h_this%DATA,new_value) + h_this = TRANSFER(ih_this, h_this) + CALL SetParametersThreshold(h_this%DATA, new_value) END SUBROUTINE SetParametersThreshold_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Set the value of the verbosity. @@ -86,8 +85,8 @@ SUBROUTINE SetParametersBeVerbose_wrp(ih_this,new_value) & LOGICAL(kind=c_bool), INTENT(IN) :: new_value TYPE(SolverParameters_wrp) :: h_this - h_this = TRANSFER(ih_this,h_this) - CALL SetParametersBeVerbose(h_this%DATA,LOGICAL(new_value)) + h_this = TRANSFER(ih_this, h_this) + CALL SetParametersBeVerbose(h_this%DATA, LOGICAL(new_value)) END SUBROUTINE SetParametersBeVerbose_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Set the value of the load balancing permutation. @@ -98,9 +97,9 @@ SUBROUTINE SetParametersLoadBalance_wrp(ih_this,ih_new_value) & TYPE(SolverParameters_wrp) :: h_this TYPE(Permutation_wrp) :: h_new_value - h_this = TRANSFER(ih_this,h_this) - h_new_value = TRANSFER(ih_new_value,h_new_value) - CALL SetParametersLoadBalance(h_this%DATA,h_new_value%DATA) + h_this = TRANSFER(ih_this, h_this) + h_new_value = TRANSFER(ih_new_value, h_new_value) + CALL SetParametersLoadBalance(h_this%DATA, h_new_value%DATA) END SUBROUTINE SetParametersLoadBalance_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE SolverParametersModule_wrp