@z This file was created by Aleksandar Donev as part of the Network Optimization project. Feel free to use any portion of it and contact me at donev@pa.msu.edu @x @*0 Main program. This program is an example of how to use the spanning-tree routines in the modules |Graph_Algorithms| and |Network_Spanning_Trees|, and it also performs some timing of these, in particular, it compares the time it takes to build an MST with the greedy Kruskal approach from scratch as opposed to updating it using a non-greedy approach when the weights change randomly by at most |disorder| percent (so |disorder=0| means the weights did not change at all, while |disorder=1| means the weights changed almost completely). The perturbations in the weights are drawn from a {\em uniform distribution} here, but that can of course be changed to study the influence or large (but rare) weight fluctuations: @f index _index @f range _range @ @a PROGRAM Time_MST @; USE Precision @; // Kind parameters USE Error_Handling @; USE System_Monitors @; USE Random_Numbers @; USE Sorting_Ranking @; USE Initialization_Termination @; USE Network_Data_Structures @; USE Lattice_Geometry @; USE Network_Geometry @; USE Network_Graphics @; USE Lattice_Network_Optimization @; USE Graph_Algorithms @; USE Network_Spanning_Trees @; USE Power_Cost_Parameters @; IMPLICIT NONE @; REAL(KIND=r_wp), DIMENSION(:), ALLOCATABLE :: weights_changes, arcs_weights @; INTEGER(KIND=i_wp) :: arc, node, head, tail, n_pivoted @; REAL(KIND=r_wp) :: disorder, total_weight @; CALL StartProgram @; CALL InitializeLatticeNetworkProblem @; CALL CreateLatticeNetworkProblem @; ALLOCATE(arcs_weights(-n_special_arcs:n_arcs), weights_changes(-n_special_arcs:n_arcs) ) @; debug_graph_algs=.TRUE. @; OPEN(FILE="MST.dat", UNIT=101, STATUS="UNKNOWN", ACTION="WRITE", POSITION="APPEND") @; OPEN(FILE="MST.total.dat", UNIT=201, STATUS="UNKNOWN", ACTION="WRITE", POSITION="APPEND") @; WRITE(UNIT=101, FMT="(2I5,I15)", ADVANCE="NO") lengths, PRODUCT(lengths) @; WRITE(UNIT=201, FMT="(I15)", ADVANCE="NO") PRODUCT(lengths) @; arcs_weights=arcs_cost_parameters[1,:] @; CALL ResetTimer(1) @; CALL StartTimer(1) @; CALL CreateSpanningTree(tree_type=min_cost_tree, arcs_weights=arcs_weights, & weights_distribution=costs_distribution, & @%% total_weight=total_weight, & tree_timer=2, thread_timer=3) @; CALL StopTimer(1) @; @%% WRITE(*,*) "Total tree weight (min)=", total_weight @; WRITE(*,*) "Making the MST tree from scratch took:", ReadTimer(1) @; WRITE(*,*) "____________________ Tree bulding:", ReadTimer(2) @; WRITE(*,*) "____________________ Thread building:", ReadTimer(3) @; WRITE(UNIT=101, FMT="(3E10.3)", ADVANCE="NO") ReadTimer(2), ReadTimer(3), ReadTimer(1) @; // These do not depend on the disorder WRITE(UNIT=201, FMT="(E10.3)", ADVANCE="NO") ReadTimer(1) @; @%% PerturbWeights: DO disorder=0.0, 1.1, 0.1 @; @%% WRITE(*,*) "Disorder d=", disorder @; WRITE(*,*) "Enter the disorder:" @; READ(*,*) disorder @; WRITE(UNIT=101, FMT="(F6.2)", ADVANCE="NO") disorder @; CALL RandomUniform(weights_changes, range=(/1.0_r_wp-disorder, 1.0_r_wp+disorder/)) @; arcs_weights=weights_changes*arcs_weights @; // Change the weights of the arcs CALL ResetTimer(10) @; CALL StartTimer(10) @; CALL UpdateSpanningTree (tree_type=min_cost_tree, arcs_weights=arcs_weights, & @%% total_weight=total_weight, & n_pivots=n_pivoted, tree_timer=15, thread_timer=16) @; CALL StopTimer(10) @; @%% WRITE(*,*) "Total tree weight (min rebuilt)=", total_weight @; WRITE(*,*) "Rebuilding the MST tree took :", ReadTimer(10) @; WRITE(*,*) "____________________ Tree rebuilding:", ReadTimer(15) @; WRITE(*,*) "____________________ Thread building:", ReadTimer(16) @; WRITE(UNIT=101, FMT="(3E10.3,I10)", ADVANCE="NO") & ReadTimer(15), ReadTimer(16), ReadTimer(10), n_pivoted @; WRITE(UNIT=201, FMT="(1E10.3)", ADVANCE="NO") ReadTimer(10) @; @%% END DO PerturbWeights @; WRITE(101,*) @; // A new line CLOSE(UNIT=101) @; WRITE(201,*) @; // A new line CLOSE(UNIT=201) @; CALL DestroyLatticeNetworkProblem @; CALL EndProgram @; END PROGRAM Time_MST @; @%%