diff --git a/revdep/README.md b/revdep/README.md index b7ff53a7a4..3c1cc55928 100644 --- a/revdep/README.md +++ b/revdep/README.md @@ -1,26 +1,31 @@ # Revdeps -## Failed to check (3) +## Failed to check (7) -|package |version |error |warning |note | -|:---------|:-------|:-----|:-------|:----| -|bnlearn |5.0.2 |1 | | | -|datapack |1.4.1 |1 | | | -|streamDAG |? | | | | +|package |version |error |warning |note | +|:---------------|:-------|:-----|:-------|:----| +|bnlearn |5.0.2 |1 | | | +|dataone |2.2.2 |1 | | | +|datapack |1.4.1 |1 | | | +|FAIRmaterials |0.4.2.1 |1 | | | +|multinma |0.8.0 |1 | | | +|randomForestSRC |? | | | | +|streamDAG |? | | | | -## New problems (11) +## New problems (12) -|package |version |error |warning |note | -|:------------|:-------|:------|:-------|:----| -|[corpustools](problems.md#corpustools)|0.5.1 |__+1__ | |2 | -|[dosearch](problems.md#dosearch)|1.0.11 |__+1__ | |1 | -|[incidentally](problems.md#incidentally)|1.0.2 |__+1__ | | | -|[klassR](problems.md#klassr)|1.0.2 |__+1__ | |1 | -|[multinet](problems.md#multinet)|4.2.2 |__+1__ | |1 | -|[mwcsr](problems.md#mwcsr)|0.1.9 |__+2__ | |1 | -|[netdiffuseR](problems.md#netdiffuser)|1.22.6 |__+1__ | |1 | -|[remify](problems.md#remify)|3.2.8 |__+1__ | |1 | -|[SEMID](problems.md#semid)|0.4.1 |__+2__ | | | -|[ssifs](problems.md#ssifs)|1.0.4 |__+2__ | | | -|[tilemaps](problems.md#tilemaps)|0.2.0 |__+2__ | |1 | +|package |version |error |warning |note | +|:------------|:-------|:------|:-------|:------| +|[corpustools](problems.md#corpustools)|0.5.1 |__+1__ | |2 | +|[dosearch](problems.md#dosearch)|1.0.11 |__+1__ | |1 | +|[grec](problems.md#grec)|1.6.1 | | |__+1__ | +|[incidentally](problems.md#incidentally)|1.0.2 |__+1__ | | | +|[klassR](problems.md#klassr)|1.0.2 |__+1__ | |1 | +|[multinet](problems.md#multinet)|4.2.2 |__+1__ | |1 | +|[mwcsr](problems.md#mwcsr)|0.1.9 |__+2__ | |1 | +|[netdiffuseR](problems.md#netdiffuser)|1.22.6 |__+1__ | |1 | +|[remify](problems.md#remify)|3.2.8 |__+1__ | |1 | +|[SEMID](problems.md#semid)|0.4.1 |__+2__ | | | +|[ssifs](problems.md#ssifs)|1.0.4 |__+2__ | | | +|[tilemaps](problems.md#tilemaps)|0.2.0 |__+2__ | |1 | diff --git a/revdep/cran.md b/revdep/cran.md index 4a30a7f908..02d2b788b9 100644 --- a/revdep/cran.md +++ b/revdep/cran.md @@ -1,9 +1,9 @@ ## revdepcheck results -We checked 17 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. +We checked 2136 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. - * We saw 11 new problems - * We failed to check 3 packages + * We saw 12 new problems + * We failed to check 7 packages Issues with CRAN packages are summarised below. @@ -16,6 +16,9 @@ Issues with CRAN packages are summarised below. * dosearch checking tests ... ERROR +* grec + checking installed package size ... NOTE + * incidentally checking re-building of vignette outputs ... ERROR @@ -49,6 +52,10 @@ Issues with CRAN packages are summarised below. ### Failed to check -* bnlearn (NA) -* datapack (NA) -* streamDAG (NA) +* bnlearn (NA) +* dataone (NA) +* datapack (NA) +* FAIRmaterials (NA) +* multinma (NA) +* randomForestSRC (NA) +* streamDAG (NA) diff --git a/revdep/problems.md b/revdep/problems.md index df6e318f52..1f477ae249 100644 --- a/revdep/problems.md +++ b/revdep/problems.md @@ -166,6 +166,29 @@ Run `revdepcheck::cloud_details(, "dosearch")` for more info libs 5.0Mb ``` +# grec + +
+ +* Version: 1.6.1 +* GitHub: https://github.com/LuisLauM/grec +* Source code: https://github.com/cran/grec +* Date/Publication: 2025-01-23 09:30:02 UTC +* Number of recursive dependencies: 12 + +Run `revdepcheck::cloud_details(, "grec")` for more info + +
+ +## Newly broken + +* checking installed package size ... NOTE + ``` + installed size is 7.7Mb + sub-directories of 1Mb or more: + data 7.5Mb + ``` + # incidentally
@@ -582,7 +605,7 @@ Run `revdepcheck::cloud_details(, "remify")` for more info test-rehshape.R............... 24 tests OK test-rehshape.R............... 24 tests OK test-rehshape.R............... 25 tests OK - test-rehshape.R............... 26 tests OK 2.9s + test-rehshape.R............... 26 tests OK 3.1s test-remify-error-messages.R.. 1 tests OK test-remify-error-messages.R.. 1 tests OK @@ -797,7 +820,7 @@ Run `revdepcheck::cloud_details(, "remify")` for more info test-remify-methods.R......... 112 tests 10 fails test-remify-methods.R......... 112 tests 10 fails test-remify-methods.R......... 112 tests 10 fails - test-remify-methods.R......... 113 tests 10 fails 12.0s + test-remify-methods.R......... 113 tests 10 fails 12.3s test-remify-warning-messages.R 0 tests test-remify-warning-messages.R 0 tests diff --git a/src/sources.mk b/src/sources.mk index 60e40d0846..160f4b4b01 100644 --- a/src/sources.mk +++ b/src/sources.mk @@ -1 +1 @@ -SOURCES=cpp11.o cpprinterface.o init.o rinterface.o rinterface_extra.o rrandom.o simpleraytracer.o vendor/arpack/dgetv0.o vendor/arpack/dlaqrb.o vendor/arpack/dmout.o vendor/arpack/dnaitr.o vendor/arpack/dnapps.o vendor/arpack/dnaup2.o vendor/arpack/dnaupd.o vendor/arpack/dnconv.o vendor/arpack/dneigh.o vendor/arpack/dneupd.o vendor/arpack/dngets.o vendor/arpack/dsaitr.o vendor/arpack/dsapps.o vendor/arpack/dsaup2.o vendor/arpack/dsaupd.o vendor/arpack/dsconv.o vendor/arpack/dseigt.o vendor/arpack/dsesrt.o vendor/arpack/dseupd.o vendor/arpack/dsgets.o vendor/arpack/dsortc.o vendor/arpack/dsortr.o vendor/arpack/dstatn.o vendor/arpack/dstats.o vendor/arpack/dstqrb.o vendor/arpack/dvout.o vendor/arpack/ivout.o vendor/arpack/second.o vendor/arpack/wrap.o vendor/cigraph/src/centrality/betweenness.o vendor/cigraph/src/centrality/centrality_other.o vendor/cigraph/src/centrality/centralization.o vendor/cigraph/src/centrality/closeness.o vendor/cigraph/src/centrality/coreness.o vendor/cigraph/src/centrality/eigenvector.o vendor/cigraph/src/centrality/hub_authority.o vendor/cigraph/src/centrality/pagerank.o vendor/cigraph/src/centrality/prpack.o vendor/cigraph/src/centrality/prpack/prpack_base_graph.o vendor/cigraph/src/centrality/prpack/prpack_igraph_graph.o vendor/cigraph/src/centrality/prpack/prpack_preprocessed_ge_graph.o vendor/cigraph/src/centrality/prpack/prpack_preprocessed_gs_graph.o vendor/cigraph/src/centrality/prpack/prpack_preprocessed_scc_graph.o vendor/cigraph/src/centrality/prpack/prpack_preprocessed_schur_graph.o vendor/cigraph/src/centrality/prpack/prpack_result.o vendor/cigraph/src/centrality/prpack/prpack_solver.o vendor/cigraph/src/centrality/prpack/prpack_utils.o vendor/cigraph/src/centrality/truss.o vendor/cigraph/src/cliques/cliquer/cliquer.o vendor/cigraph/src/cliques/cliquer/cliquer_graph.o vendor/cigraph/src/cliques/cliquer/reorder.o vendor/cigraph/src/cliques/cliquer_wrapper.o vendor/cigraph/src/cliques/cliques.o vendor/cigraph/src/cliques/glet.o vendor/cigraph/src/cliques/maximal_cliques.o vendor/cigraph/src/community/community_misc.o vendor/cigraph/src/community/edge_betweenness.o vendor/cigraph/src/community/fast_modularity.o vendor/cigraph/src/community/fluid.o vendor/cigraph/src/community/infomap/infomap.o vendor/cigraph/src/community/infomap/infomap_FlowGraph.o vendor/cigraph/src/community/infomap/infomap_Greedy.o vendor/cigraph/src/community/label_propagation.o vendor/cigraph/src/community/leading_eigenvector.o vendor/cigraph/src/community/leiden.o vendor/cigraph/src/community/louvain.o vendor/cigraph/src/community/modularity.o vendor/cigraph/src/community/optimal_modularity.o vendor/cigraph/src/community/spinglass/NetDataTypes.o vendor/cigraph/src/community/spinglass/NetRoutines.o vendor/cigraph/src/community/spinglass/clustertool.o vendor/cigraph/src/community/spinglass/pottsmodel_2.o vendor/cigraph/src/community/voronoi.o vendor/cigraph/src/community/walktrap/walktrap.o vendor/cigraph/src/community/walktrap/walktrap_communities.o vendor/cigraph/src/community/walktrap/walktrap_graph.o vendor/cigraph/src/community/walktrap/walktrap_heap.o vendor/cigraph/src/connectivity/cohesive_blocks.o vendor/cigraph/src/connectivity/components.o vendor/cigraph/src/connectivity/reachability.o vendor/cigraph/src/connectivity/separators.o vendor/cigraph/src/constructors/adjacency.o vendor/cigraph/src/constructors/atlas.o vendor/cigraph/src/constructors/basic_constructors.o vendor/cigraph/src/constructors/circulant.o vendor/cigraph/src/constructors/de_bruijn.o vendor/cigraph/src/constructors/famous.o vendor/cigraph/src/constructors/full.o vendor/cigraph/src/constructors/generalized_petersen.o vendor/cigraph/src/constructors/kautz.o vendor/cigraph/src/constructors/lattices.o vendor/cigraph/src/constructors/lcf.o vendor/cigraph/src/constructors/linegraph.o vendor/cigraph/src/constructors/prufer.o vendor/cigraph/src/constructors/regular.o vendor/cigraph/src/constructors/trees.o vendor/cigraph/src/core/array.o vendor/cigraph/src/core/bitset.o vendor/cigraph/src/core/bitset_list.o vendor/cigraph/src/core/buckets.o vendor/cigraph/src/core/cutheap.o vendor/cigraph/src/core/dqueue.o vendor/cigraph/src/core/error.o vendor/cigraph/src/core/estack.o vendor/cigraph/src/core/fixed_vectorlist.o vendor/cigraph/src/core/genheap.o vendor/cigraph/src/core/grid.o vendor/cigraph/src/core/heap.o vendor/cigraph/src/core/indheap.o vendor/cigraph/src/core/interruption.o vendor/cigraph/src/core/marked_queue.o vendor/cigraph/src/core/matrix.o vendor/cigraph/src/core/matrix_list.o vendor/cigraph/src/core/memory.o vendor/cigraph/src/core/printing.o vendor/cigraph/src/core/progress.o vendor/cigraph/src/core/psumtree.o vendor/cigraph/src/core/set.o vendor/cigraph/src/core/sparsemat.o vendor/cigraph/src/core/stack.o vendor/cigraph/src/core/statusbar.o vendor/cigraph/src/core/strvector.o vendor/cigraph/src/core/trie.o vendor/cigraph/src/core/vector.o vendor/cigraph/src/core/vector_list.o vendor/cigraph/src/core/vector_ptr.o vendor/cigraph/src/cycles/simple_cycles.o vendor/cigraph/src/flow/flow.o vendor/cigraph/src/flow/flow_conversion.o vendor/cigraph/src/flow/st-cuts.o vendor/cigraph/src/games/barabasi.o vendor/cigraph/src/games/callaway_traits.o vendor/cigraph/src/games/chung_lu.o vendor/cigraph/src/games/citations.o vendor/cigraph/src/games/correlated.o vendor/cigraph/src/games/degree_sequence.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_degree_sequence.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_graph_molloy_hash.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_graph_molloy_optimized.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_mr-connected.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_random.o vendor/cigraph/src/games/dotproduct.o vendor/cigraph/src/games/erdos_renyi.o vendor/cigraph/src/games/establishment.o vendor/cigraph/src/games/forestfire.o vendor/cigraph/src/games/grg.o vendor/cigraph/src/games/growing_random.o vendor/cigraph/src/games/islands.o vendor/cigraph/src/games/k_regular.o vendor/cigraph/src/games/preference.o vendor/cigraph/src/games/recent_degree.o vendor/cigraph/src/games/sbm.o vendor/cigraph/src/games/static_fitness.o vendor/cigraph/src/games/tree.o vendor/cigraph/src/games/watts_strogatz.o vendor/cigraph/src/graph/adjlist.o vendor/cigraph/src/graph/attributes.o vendor/cigraph/src/graph/basic_query.o vendor/cigraph/src/graph/caching.o vendor/cigraph/src/graph/cattributes.o vendor/cigraph/src/graph/graph_list.o vendor/cigraph/src/graph/iterators.o vendor/cigraph/src/graph/type_common.o vendor/cigraph/src/graph/type_indexededgelist.o vendor/cigraph/src/graph/visitors.o vendor/cigraph/src/hrg/hrg.o vendor/cigraph/src/hrg/hrg_types.o vendor/cigraph/src/internal/glpk_support.o vendor/cigraph/src/internal/hacks.o vendor/cigraph/src/internal/lsap.o vendor/cigraph/src/internal/qsort.o vendor/cigraph/src/internal/qsort_r.o vendor/cigraph/src/internal/utils.o vendor/cigraph/src/internal/zeroin.o vendor/cigraph/src/io/dimacs.o vendor/cigraph/src/io/dl.o vendor/cigraph/src/io/dot.o vendor/cigraph/src/io/edgelist.o vendor/cigraph/src/io/gml-tree.o vendor/cigraph/src/io/gml.o vendor/cigraph/src/io/graphdb.o vendor/cigraph/src/io/graphml.o vendor/cigraph/src/io/leda.o vendor/cigraph/src/io/lgl.o vendor/cigraph/src/io/ncol.o vendor/cigraph/src/io/pajek.o vendor/cigraph/src/io/parse_utils.o vendor/cigraph/src/isomorphism/bliss.o vendor/cigraph/src/isomorphism/bliss/defs.o vendor/cigraph/src/isomorphism/bliss/graph.o vendor/cigraph/src/isomorphism/bliss/heap.o vendor/cigraph/src/isomorphism/bliss/orbit.o vendor/cigraph/src/isomorphism/bliss/partition.o vendor/cigraph/src/isomorphism/bliss/uintseqhash.o vendor/cigraph/src/isomorphism/bliss/utils.o vendor/cigraph/src/isomorphism/isoclasses.o vendor/cigraph/src/isomorphism/isomorphism_misc.o vendor/cigraph/src/isomorphism/lad.o vendor/cigraph/src/isomorphism/queries.o vendor/cigraph/src/isomorphism/vf2.o vendor/cigraph/src/layout/circular.o vendor/cigraph/src/layout/davidson_harel.o vendor/cigraph/src/layout/drl/DensityGrid.o vendor/cigraph/src/layout/drl/DensityGrid_3d.o vendor/cigraph/src/layout/drl/drl_graph.o vendor/cigraph/src/layout/drl/drl_graph_3d.o vendor/cigraph/src/layout/drl/drl_layout.o vendor/cigraph/src/layout/drl/drl_layout_3d.o vendor/cigraph/src/layout/drl/drl_parse.o vendor/cigraph/src/layout/fruchterman_reingold.o vendor/cigraph/src/layout/gem.o vendor/cigraph/src/layout/graphopt.o vendor/cigraph/src/layout/kamada_kawai.o vendor/cigraph/src/layout/large_graph.o vendor/cigraph/src/layout/layout_bipartite.o vendor/cigraph/src/layout/layout_grid.o vendor/cigraph/src/layout/layout_random.o vendor/cigraph/src/layout/mds.o vendor/cigraph/src/layout/merge_dla.o vendor/cigraph/src/layout/merge_grid.o vendor/cigraph/src/layout/reingold_tilford.o vendor/cigraph/src/layout/sugiyama.o vendor/cigraph/src/layout/umap.o vendor/cigraph/src/linalg/arpack.o vendor/cigraph/src/linalg/blas.o vendor/cigraph/src/linalg/eigen.o vendor/cigraph/src/linalg/lapack.o vendor/cigraph/src/math/complex.o vendor/cigraph/src/math/safe_intop.o vendor/cigraph/src/math/utils.o vendor/cigraph/src/misc/bipartite.o vendor/cigraph/src/misc/chordality.o vendor/cigraph/src/misc/cocitation.o vendor/cigraph/src/misc/coloring.o vendor/cigraph/src/misc/conversion.o vendor/cigraph/src/misc/cycle_bases.o vendor/cigraph/src/misc/degree_sequence.o vendor/cigraph/src/misc/embedding.o vendor/cigraph/src/misc/feedback_arc_set.o vendor/cigraph/src/misc/graphicality.o vendor/cigraph/src/misc/matching.o vendor/cigraph/src/misc/microscopic_update.o vendor/cigraph/src/misc/mixing.o vendor/cigraph/src/misc/motifs.o vendor/cigraph/src/misc/order_cycle.o vendor/cigraph/src/misc/other.o vendor/cigraph/src/misc/power_law_fit.o vendor/cigraph/src/misc/scan.o vendor/cigraph/src/misc/sir.o vendor/cigraph/src/misc/spanning_trees.o vendor/cigraph/src/operators/add_edge.o vendor/cigraph/src/operators/complementer.o vendor/cigraph/src/operators/compose.o vendor/cigraph/src/operators/connect_neighborhood.o vendor/cigraph/src/operators/contract.o vendor/cigraph/src/operators/difference.o vendor/cigraph/src/operators/disjoint_union.o vendor/cigraph/src/operators/intersection.o vendor/cigraph/src/operators/join.o vendor/cigraph/src/operators/misc_internal.o vendor/cigraph/src/operators/permute.o vendor/cigraph/src/operators/reverse.o vendor/cigraph/src/operators/rewire.o vendor/cigraph/src/operators/rewire_edges.o vendor/cigraph/src/operators/simplify.o vendor/cigraph/src/operators/subgraph.o vendor/cigraph/src/operators/union.o vendor/cigraph/src/paths/all_shortest_paths.o vendor/cigraph/src/paths/astar.o vendor/cigraph/src/paths/bellman_ford.o vendor/cigraph/src/paths/dijkstra.o vendor/cigraph/src/paths/distances.o vendor/cigraph/src/paths/eulerian.o vendor/cigraph/src/paths/floyd_warshall.o vendor/cigraph/src/paths/histogram.o vendor/cigraph/src/paths/johnson.o vendor/cigraph/src/paths/random_walk.o vendor/cigraph/src/paths/shortest_paths.o vendor/cigraph/src/paths/simple_paths.o vendor/cigraph/src/paths/sparsifier.o vendor/cigraph/src/paths/unweighted.o vendor/cigraph/src/paths/voronoi.o vendor/cigraph/src/paths/widest_paths.o vendor/cigraph/src/properties/basic_properties.o vendor/cigraph/src/properties/complete.o vendor/cigraph/src/properties/constraint.o vendor/cigraph/src/properties/convergence_degree.o vendor/cigraph/src/properties/dag.o vendor/cigraph/src/properties/degrees.o vendor/cigraph/src/properties/ecc.o vendor/cigraph/src/properties/girth.o vendor/cigraph/src/properties/loops.o vendor/cigraph/src/properties/multiplicity.o vendor/cigraph/src/properties/neighborhood.o vendor/cigraph/src/properties/perfect.o vendor/cigraph/src/properties/spectral.o vendor/cigraph/src/properties/trees.o vendor/cigraph/src/properties/triangles.o vendor/cigraph/src/random/random.o vendor/cigraph/src/random/rng_glibc2.o vendor/cigraph/src/random/rng_mt19937.o vendor/cigraph/src/random/rng_pcg32.o vendor/cigraph/src/random/rng_pcg64.o vendor/cigraph/src/version.o vendor/cigraph/vendor/cs/cs_add.o vendor/cigraph/vendor/cs/cs_amd.o vendor/cigraph/vendor/cs/cs_chol.o vendor/cigraph/vendor/cs/cs_cholsol.o vendor/cigraph/vendor/cs/cs_compress.o vendor/cigraph/vendor/cs/cs_counts.o vendor/cigraph/vendor/cs/cs_cumsum.o vendor/cigraph/vendor/cs/cs_dfs.o vendor/cigraph/vendor/cs/cs_dmperm.o vendor/cigraph/vendor/cs/cs_droptol.o vendor/cigraph/vendor/cs/cs_dropzeros.o vendor/cigraph/vendor/cs/cs_dupl.o vendor/cigraph/vendor/cs/cs_entry.o vendor/cigraph/vendor/cs/cs_ereach.o vendor/cigraph/vendor/cs/cs_etree.o vendor/cigraph/vendor/cs/cs_fkeep.o vendor/cigraph/vendor/cs/cs_gaxpy.o vendor/cigraph/vendor/cs/cs_happly.o vendor/cigraph/vendor/cs/cs_house.o vendor/cigraph/vendor/cs/cs_ipvec.o vendor/cigraph/vendor/cs/cs_leaf.o vendor/cigraph/vendor/cs/cs_load.o vendor/cigraph/vendor/cs/cs_lsolve.o vendor/cigraph/vendor/cs/cs_ltsolve.o vendor/cigraph/vendor/cs/cs_lu.o vendor/cigraph/vendor/cs/cs_lusol.o vendor/cigraph/vendor/cs/cs_malloc.o vendor/cigraph/vendor/cs/cs_maxtrans.o vendor/cigraph/vendor/cs/cs_multiply.o vendor/cigraph/vendor/cs/cs_norm.o vendor/cigraph/vendor/cs/cs_permute.o vendor/cigraph/vendor/cs/cs_pinv.o vendor/cigraph/vendor/cs/cs_post.o vendor/cigraph/vendor/cs/cs_print.o vendor/cigraph/vendor/cs/cs_pvec.o vendor/cigraph/vendor/cs/cs_qr.o vendor/cigraph/vendor/cs/cs_qrsol.o vendor/cigraph/vendor/cs/cs_randperm.o vendor/cigraph/vendor/cs/cs_reach.o vendor/cigraph/vendor/cs/cs_scatter.o vendor/cigraph/vendor/cs/cs_scc.o vendor/cigraph/vendor/cs/cs_schol.o vendor/cigraph/vendor/cs/cs_spsolve.o vendor/cigraph/vendor/cs/cs_sqr.o vendor/cigraph/vendor/cs/cs_symperm.o vendor/cigraph/vendor/cs/cs_tdfs.o vendor/cigraph/vendor/cs/cs_transpose.o vendor/cigraph/vendor/cs/cs_updown.o vendor/cigraph/vendor/cs/cs_usolve.o vendor/cigraph/vendor/cs/cs_util.o vendor/cigraph/vendor/cs/cs_utsolve.o vendor/cigraph/vendor/pcg/pcg-advance-128.o vendor/cigraph/vendor/pcg/pcg-advance-64.o vendor/cigraph/vendor/pcg/pcg-output-128.o vendor/cigraph/vendor/pcg/pcg-output-32.o vendor/cigraph/vendor/pcg/pcg-output-64.o vendor/cigraph/vendor/pcg/pcg-rngs-128.o vendor/cigraph/vendor/pcg/pcg-rngs-64.o vendor/cigraph/vendor/plfit/gss.o vendor/cigraph/vendor/plfit/hzeta.o vendor/cigraph/vendor/plfit/kolmogorov.o vendor/cigraph/vendor/plfit/lbfgs.o vendor/cigraph/vendor/plfit/mt.o vendor/cigraph/vendor/plfit/options.o vendor/cigraph/vendor/plfit/plfit.o vendor/cigraph/vendor/plfit/plfit_error.o vendor/cigraph/vendor/plfit/rbinom.o vendor/cigraph/vendor/plfit/sampling.o vendor/io/dl-lexer.o vendor/io/dl-parser.o vendor/io/gml-lexer.o vendor/io/gml-parser.o vendor/io/lgl-lexer.o vendor/io/lgl-parser.o vendor/io/ncol-lexer.o vendor/io/ncol-parser.o vendor/io/pajek-lexer.o vendor/io/pajek-parser.o vendor/simpleraytracer/Color.o vendor/simpleraytracer/Light.o vendor/simpleraytracer/Point.o vendor/simpleraytracer/Ray.o vendor/simpleraytracer/RayTracer.o vendor/simpleraytracer/RayVector.o vendor/simpleraytracer/Shape.o vendor/simpleraytracer/Sphere.o vendor/simpleraytracer/Triangle.o vendor/simpleraytracer/unit_limiter.o vendor/uuid/R.o vendor/uuid/clear.o vendor/uuid/compare.o vendor/uuid/copy.o vendor/uuid/gen_uuid.o vendor/uuid/isnull.o vendor/uuid/pack.o vendor/uuid/parse.o vendor/uuid/unpack.o vendor/uuid/unparse.o +SOURCES=cpp11.o cpprinterface.o init.o rinterface.o rinterface_extra.o rrandom.o simpleraytracer.o vendor/arpack/dgetv0.o vendor/arpack/dmout.o vendor/arpack/dnaitr.o vendor/arpack/dnapps.o vendor/arpack/dnaup2.o vendor/arpack/dnaupd.o vendor/arpack/dnconv.o vendor/arpack/dneigh.o vendor/arpack/dneupd.o vendor/arpack/dngets.o vendor/arpack/dsaitr.o vendor/arpack/dsapps.o vendor/arpack/dsaup2.o vendor/arpack/dsaupd.o vendor/arpack/dsconv.o vendor/arpack/dseigt.o vendor/arpack/dsesrt.o vendor/arpack/dseupd.o vendor/arpack/dsgets.o vendor/arpack/dsortc.o vendor/arpack/dsortr.o vendor/arpack/dstatn.o vendor/arpack/dstats.o vendor/arpack/dstqrb.o vendor/arpack/dvout.o vendor/arpack/ivout.o vendor/arpack/second.o vendor/arpack/wrap.o vendor/cigraph/src/centrality/betweenness.o vendor/cigraph/src/centrality/centrality_other.o vendor/cigraph/src/centrality/centralization.o vendor/cigraph/src/centrality/closeness.o vendor/cigraph/src/centrality/coreness.o vendor/cigraph/src/centrality/eigenvector.o vendor/cigraph/src/centrality/hub_authority.o vendor/cigraph/src/centrality/pagerank.o vendor/cigraph/src/centrality/prpack.o vendor/cigraph/src/centrality/prpack/prpack_base_graph.o vendor/cigraph/src/centrality/prpack/prpack_igraph_graph.o vendor/cigraph/src/centrality/prpack/prpack_preprocessed_ge_graph.o vendor/cigraph/src/centrality/prpack/prpack_preprocessed_gs_graph.o vendor/cigraph/src/centrality/prpack/prpack_preprocessed_scc_graph.o vendor/cigraph/src/centrality/prpack/prpack_preprocessed_schur_graph.o vendor/cigraph/src/centrality/prpack/prpack_result.o vendor/cigraph/src/centrality/prpack/prpack_solver.o vendor/cigraph/src/centrality/prpack/prpack_utils.o vendor/cigraph/src/centrality/truss.o vendor/cigraph/src/cliques/cliquer/cliquer.o vendor/cigraph/src/cliques/cliquer/cliquer_graph.o vendor/cigraph/src/cliques/cliquer/reorder.o vendor/cigraph/src/cliques/cliquer_wrapper.o vendor/cigraph/src/cliques/cliques.o vendor/cigraph/src/cliques/glet.o vendor/cigraph/src/cliques/maximal_cliques.o vendor/cigraph/src/community/community_misc.o vendor/cigraph/src/community/edge_betweenness.o vendor/cigraph/src/community/fast_modularity.o vendor/cigraph/src/community/fluid.o vendor/cigraph/src/community/infomap/infomap.o vendor/cigraph/src/community/infomap/infomap_FlowGraph.o vendor/cigraph/src/community/infomap/infomap_Greedy.o vendor/cigraph/src/community/label_propagation.o vendor/cigraph/src/community/leading_eigenvector.o vendor/cigraph/src/community/leiden.o vendor/cigraph/src/community/louvain.o vendor/cigraph/src/community/modularity.o vendor/cigraph/src/community/optimal_modularity.o vendor/cigraph/src/community/spinglass/NetDataTypes.o vendor/cigraph/src/community/spinglass/NetRoutines.o vendor/cigraph/src/community/spinglass/clustertool.o vendor/cigraph/src/community/spinglass/pottsmodel_2.o vendor/cigraph/src/community/voronoi.o vendor/cigraph/src/community/walktrap/walktrap.o vendor/cigraph/src/community/walktrap/walktrap_communities.o vendor/cigraph/src/community/walktrap/walktrap_graph.o vendor/cigraph/src/community/walktrap/walktrap_heap.o vendor/cigraph/src/connectivity/cohesive_blocks.o vendor/cigraph/src/connectivity/components.o vendor/cigraph/src/connectivity/reachability.o vendor/cigraph/src/connectivity/separators.o vendor/cigraph/src/constructors/adjacency.o vendor/cigraph/src/constructors/atlas.o vendor/cigraph/src/constructors/basic_constructors.o vendor/cigraph/src/constructors/circulant.o vendor/cigraph/src/constructors/de_bruijn.o vendor/cigraph/src/constructors/famous.o vendor/cigraph/src/constructors/full.o vendor/cigraph/src/constructors/generalized_petersen.o vendor/cigraph/src/constructors/kautz.o vendor/cigraph/src/constructors/lattices.o vendor/cigraph/src/constructors/lcf.o vendor/cigraph/src/constructors/linegraph.o vendor/cigraph/src/constructors/prufer.o vendor/cigraph/src/constructors/regular.o vendor/cigraph/src/constructors/trees.o vendor/cigraph/src/core/array.o vendor/cigraph/src/core/bitset.o vendor/cigraph/src/core/bitset_list.o vendor/cigraph/src/core/buckets.o vendor/cigraph/src/core/cutheap.o vendor/cigraph/src/core/dqueue.o vendor/cigraph/src/core/error.o vendor/cigraph/src/core/estack.o vendor/cigraph/src/core/fixed_vectorlist.o vendor/cigraph/src/core/genheap.o vendor/cigraph/src/core/grid.o vendor/cigraph/src/core/heap.o vendor/cigraph/src/core/indheap.o vendor/cigraph/src/core/interruption.o vendor/cigraph/src/core/marked_queue.o vendor/cigraph/src/core/matrix.o vendor/cigraph/src/core/matrix_list.o vendor/cigraph/src/core/memory.o vendor/cigraph/src/core/printing.o vendor/cigraph/src/core/progress.o vendor/cigraph/src/core/psumtree.o vendor/cigraph/src/core/set.o vendor/cigraph/src/core/sparsemat.o vendor/cigraph/src/core/stack.o vendor/cigraph/src/core/statusbar.o vendor/cigraph/src/core/strvector.o vendor/cigraph/src/core/trie.o vendor/cigraph/src/core/vector.o vendor/cigraph/src/core/vector_list.o vendor/cigraph/src/core/vector_ptr.o vendor/cigraph/src/cycles/simple_cycles.o vendor/cigraph/src/flow/flow.o vendor/cigraph/src/flow/flow_conversion.o vendor/cigraph/src/flow/st-cuts.o vendor/cigraph/src/games/barabasi.o vendor/cigraph/src/games/callaway_traits.o vendor/cigraph/src/games/chung_lu.o vendor/cigraph/src/games/citations.o vendor/cigraph/src/games/correlated.o vendor/cigraph/src/games/degree_sequence.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_degree_sequence.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_graph_molloy_hash.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_graph_molloy_optimized.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_mr-connected.o vendor/cigraph/src/games/degree_sequence_vl/gengraph_random.o vendor/cigraph/src/games/dotproduct.o vendor/cigraph/src/games/erdos_renyi.o vendor/cigraph/src/games/establishment.o vendor/cigraph/src/games/forestfire.o vendor/cigraph/src/games/grg.o vendor/cigraph/src/games/growing_random.o vendor/cigraph/src/games/islands.o vendor/cigraph/src/games/k_regular.o vendor/cigraph/src/games/preference.o vendor/cigraph/src/games/recent_degree.o vendor/cigraph/src/games/sbm.o vendor/cigraph/src/games/static_fitness.o vendor/cigraph/src/games/tree.o vendor/cigraph/src/games/watts_strogatz.o vendor/cigraph/src/graph/adjlist.o vendor/cigraph/src/graph/attributes.o vendor/cigraph/src/graph/basic_query.o vendor/cigraph/src/graph/caching.o vendor/cigraph/src/graph/cattributes.o vendor/cigraph/src/graph/graph_list.o vendor/cigraph/src/graph/iterators.o vendor/cigraph/src/graph/type_common.o vendor/cigraph/src/graph/type_indexededgelist.o vendor/cigraph/src/graph/visitors.o vendor/cigraph/src/hrg/hrg.o vendor/cigraph/src/hrg/hrg_types.o vendor/cigraph/src/internal/glpk_support.o vendor/cigraph/src/internal/hacks.o vendor/cigraph/src/internal/lsap.o vendor/cigraph/src/internal/qsort.o vendor/cigraph/src/internal/qsort_r.o vendor/cigraph/src/internal/utils.o vendor/cigraph/src/internal/zeroin.o vendor/cigraph/src/io/dimacs.o vendor/cigraph/src/io/dl.o vendor/cigraph/src/io/dot.o vendor/cigraph/src/io/edgelist.o vendor/cigraph/src/io/gml-tree.o vendor/cigraph/src/io/gml.o vendor/cigraph/src/io/graphdb.o vendor/cigraph/src/io/graphml.o vendor/cigraph/src/io/leda.o vendor/cigraph/src/io/lgl.o vendor/cigraph/src/io/ncol.o vendor/cigraph/src/io/pajek.o vendor/cigraph/src/io/parse_utils.o vendor/cigraph/src/isomorphism/bliss.o vendor/cigraph/src/isomorphism/bliss/defs.o vendor/cigraph/src/isomorphism/bliss/graph.o vendor/cigraph/src/isomorphism/bliss/heap.o vendor/cigraph/src/isomorphism/bliss/orbit.o vendor/cigraph/src/isomorphism/bliss/partition.o vendor/cigraph/src/isomorphism/bliss/uintseqhash.o vendor/cigraph/src/isomorphism/bliss/utils.o vendor/cigraph/src/isomorphism/isoclasses.o vendor/cigraph/src/isomorphism/isomorphism_misc.o vendor/cigraph/src/isomorphism/lad.o vendor/cigraph/src/isomorphism/queries.o vendor/cigraph/src/isomorphism/vf2.o vendor/cigraph/src/layout/circular.o vendor/cigraph/src/layout/davidson_harel.o vendor/cigraph/src/layout/drl/DensityGrid.o vendor/cigraph/src/layout/drl/DensityGrid_3d.o vendor/cigraph/src/layout/drl/drl_graph.o vendor/cigraph/src/layout/drl/drl_graph_3d.o vendor/cigraph/src/layout/drl/drl_layout.o vendor/cigraph/src/layout/drl/drl_layout_3d.o vendor/cigraph/src/layout/drl/drl_parse.o vendor/cigraph/src/layout/fruchterman_reingold.o vendor/cigraph/src/layout/gem.o vendor/cigraph/src/layout/graphopt.o vendor/cigraph/src/layout/kamada_kawai.o vendor/cigraph/src/layout/large_graph.o vendor/cigraph/src/layout/layout_bipartite.o vendor/cigraph/src/layout/layout_grid.o vendor/cigraph/src/layout/layout_random.o vendor/cigraph/src/layout/mds.o vendor/cigraph/src/layout/merge_dla.o vendor/cigraph/src/layout/merge_grid.o vendor/cigraph/src/layout/reingold_tilford.o vendor/cigraph/src/layout/sugiyama.o vendor/cigraph/src/layout/umap.o vendor/cigraph/src/linalg/arpack.o vendor/cigraph/src/linalg/blas.o vendor/cigraph/src/linalg/eigen.o vendor/cigraph/src/linalg/lapack.o vendor/cigraph/src/math/complex.o vendor/cigraph/src/math/safe_intop.o vendor/cigraph/src/math/utils.o vendor/cigraph/src/misc/bipartite.o vendor/cigraph/src/misc/chordality.o vendor/cigraph/src/misc/cocitation.o vendor/cigraph/src/misc/coloring.o vendor/cigraph/src/misc/conversion.o vendor/cigraph/src/misc/cycle_bases.o vendor/cigraph/src/misc/degree_sequence.o vendor/cigraph/src/misc/embedding.o vendor/cigraph/src/misc/feedback_arc_set.o vendor/cigraph/src/misc/graphicality.o vendor/cigraph/src/misc/matching.o vendor/cigraph/src/misc/microscopic_update.o vendor/cigraph/src/misc/mixing.o vendor/cigraph/src/misc/motifs.o vendor/cigraph/src/misc/order_cycle.o vendor/cigraph/src/misc/other.o vendor/cigraph/src/misc/power_law_fit.o vendor/cigraph/src/misc/scan.o vendor/cigraph/src/misc/sir.o vendor/cigraph/src/misc/spanning_trees.o vendor/cigraph/src/operators/add_edge.o vendor/cigraph/src/operators/complementer.o vendor/cigraph/src/operators/compose.o vendor/cigraph/src/operators/connect_neighborhood.o vendor/cigraph/src/operators/contract.o vendor/cigraph/src/operators/difference.o vendor/cigraph/src/operators/disjoint_union.o vendor/cigraph/src/operators/intersection.o vendor/cigraph/src/operators/join.o vendor/cigraph/src/operators/misc_internal.o vendor/cigraph/src/operators/permute.o vendor/cigraph/src/operators/reverse.o vendor/cigraph/src/operators/rewire.o vendor/cigraph/src/operators/rewire_edges.o vendor/cigraph/src/operators/simplify.o vendor/cigraph/src/operators/subgraph.o vendor/cigraph/src/operators/union.o vendor/cigraph/src/paths/all_shortest_paths.o vendor/cigraph/src/paths/astar.o vendor/cigraph/src/paths/bellman_ford.o vendor/cigraph/src/paths/dijkstra.o vendor/cigraph/src/paths/distances.o vendor/cigraph/src/paths/eulerian.o vendor/cigraph/src/paths/floyd_warshall.o vendor/cigraph/src/paths/histogram.o vendor/cigraph/src/paths/johnson.o vendor/cigraph/src/paths/random_walk.o vendor/cigraph/src/paths/shortest_paths.o vendor/cigraph/src/paths/simple_paths.o vendor/cigraph/src/paths/sparsifier.o vendor/cigraph/src/paths/unweighted.o vendor/cigraph/src/paths/voronoi.o vendor/cigraph/src/paths/widest_paths.o vendor/cigraph/src/properties/basic_properties.o vendor/cigraph/src/properties/complete.o vendor/cigraph/src/properties/constraint.o vendor/cigraph/src/properties/convergence_degree.o vendor/cigraph/src/properties/dag.o vendor/cigraph/src/properties/degrees.o vendor/cigraph/src/properties/ecc.o vendor/cigraph/src/properties/girth.o vendor/cigraph/src/properties/loops.o vendor/cigraph/src/properties/multiplicity.o vendor/cigraph/src/properties/neighborhood.o vendor/cigraph/src/properties/perfect.o vendor/cigraph/src/properties/spectral.o vendor/cigraph/src/properties/trees.o vendor/cigraph/src/properties/triangles.o vendor/cigraph/src/random/random.o vendor/cigraph/src/random/rng_glibc2.o vendor/cigraph/src/random/rng_mt19937.o vendor/cigraph/src/random/rng_pcg32.o vendor/cigraph/src/random/rng_pcg64.o vendor/cigraph/src/version.o vendor/cigraph/vendor/cs/cs_add.o vendor/cigraph/vendor/cs/cs_amd.o vendor/cigraph/vendor/cs/cs_chol.o vendor/cigraph/vendor/cs/cs_cholsol.o vendor/cigraph/vendor/cs/cs_compress.o vendor/cigraph/vendor/cs/cs_counts.o vendor/cigraph/vendor/cs/cs_cumsum.o vendor/cigraph/vendor/cs/cs_dfs.o vendor/cigraph/vendor/cs/cs_dmperm.o vendor/cigraph/vendor/cs/cs_droptol.o vendor/cigraph/vendor/cs/cs_dropzeros.o vendor/cigraph/vendor/cs/cs_dupl.o vendor/cigraph/vendor/cs/cs_entry.o vendor/cigraph/vendor/cs/cs_ereach.o vendor/cigraph/vendor/cs/cs_etree.o vendor/cigraph/vendor/cs/cs_fkeep.o vendor/cigraph/vendor/cs/cs_gaxpy.o vendor/cigraph/vendor/cs/cs_happly.o vendor/cigraph/vendor/cs/cs_house.o vendor/cigraph/vendor/cs/cs_ipvec.o vendor/cigraph/vendor/cs/cs_leaf.o vendor/cigraph/vendor/cs/cs_load.o vendor/cigraph/vendor/cs/cs_lsolve.o vendor/cigraph/vendor/cs/cs_ltsolve.o vendor/cigraph/vendor/cs/cs_lu.o vendor/cigraph/vendor/cs/cs_lusol.o vendor/cigraph/vendor/cs/cs_malloc.o vendor/cigraph/vendor/cs/cs_maxtrans.o vendor/cigraph/vendor/cs/cs_multiply.o vendor/cigraph/vendor/cs/cs_norm.o vendor/cigraph/vendor/cs/cs_permute.o vendor/cigraph/vendor/cs/cs_pinv.o vendor/cigraph/vendor/cs/cs_post.o vendor/cigraph/vendor/cs/cs_print.o vendor/cigraph/vendor/cs/cs_pvec.o vendor/cigraph/vendor/cs/cs_qr.o vendor/cigraph/vendor/cs/cs_qrsol.o vendor/cigraph/vendor/cs/cs_randperm.o vendor/cigraph/vendor/cs/cs_reach.o vendor/cigraph/vendor/cs/cs_scatter.o vendor/cigraph/vendor/cs/cs_scc.o vendor/cigraph/vendor/cs/cs_schol.o vendor/cigraph/vendor/cs/cs_spsolve.o vendor/cigraph/vendor/cs/cs_sqr.o vendor/cigraph/vendor/cs/cs_symperm.o vendor/cigraph/vendor/cs/cs_tdfs.o vendor/cigraph/vendor/cs/cs_transpose.o vendor/cigraph/vendor/cs/cs_updown.o vendor/cigraph/vendor/cs/cs_usolve.o vendor/cigraph/vendor/cs/cs_util.o vendor/cigraph/vendor/cs/cs_utsolve.o vendor/cigraph/vendor/pcg/pcg-advance-128.o vendor/cigraph/vendor/pcg/pcg-advance-64.o vendor/cigraph/vendor/pcg/pcg-output-128.o vendor/cigraph/vendor/pcg/pcg-output-32.o vendor/cigraph/vendor/pcg/pcg-output-64.o vendor/cigraph/vendor/pcg/pcg-rngs-128.o vendor/cigraph/vendor/pcg/pcg-rngs-64.o vendor/cigraph/vendor/plfit/gss.o vendor/cigraph/vendor/plfit/hzeta.o vendor/cigraph/vendor/plfit/kolmogorov.o vendor/cigraph/vendor/plfit/lbfgs.o vendor/cigraph/vendor/plfit/mt.o vendor/cigraph/vendor/plfit/options.o vendor/cigraph/vendor/plfit/plfit.o vendor/cigraph/vendor/plfit/plfit_error.o vendor/cigraph/vendor/plfit/rbinom.o vendor/cigraph/vendor/plfit/sampling.o vendor/io/dl-lexer.o vendor/io/dl-parser.o vendor/io/gml-lexer.o vendor/io/gml-parser.o vendor/io/lgl-lexer.o vendor/io/lgl-parser.o vendor/io/ncol-lexer.o vendor/io/ncol-parser.o vendor/io/pajek-lexer.o vendor/io/pajek-parser.o vendor/simpleraytracer/Color.o vendor/simpleraytracer/Light.o vendor/simpleraytracer/Point.o vendor/simpleraytracer/Ray.o vendor/simpleraytracer/RayTracer.o vendor/simpleraytracer/RayVector.o vendor/simpleraytracer/Shape.o vendor/simpleraytracer/Sphere.o vendor/simpleraytracer/Triangle.o vendor/simpleraytracer/unit_limiter.o vendor/uuid/R.o vendor/uuid/clear.o vendor/uuid/compare.o vendor/uuid/copy.o vendor/uuid/gen_uuid.o vendor/uuid/isnull.o vendor/uuid/pack.o vendor/uuid/parse.o vendor/uuid/unpack.o vendor/uuid/unparse.o diff --git a/src/vendor/arpack/debug.h b/src/vendor/arpack/debug.h index 5eb0bb1b3d..a8821c39a0 100644 --- a/src/vendor/arpack/debug.h +++ b/src/vendor/arpack/debug.h @@ -1,16 +1,16 @@ -c -c\SCCS Information: @(#) -c FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2 -c -c %---------------------------------% -c | See debug.doc for documentation | -c %---------------------------------% - integer logfil, ndigit, mgetv0, +! +!\SCCS Information: @(#) +! FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2 +! +! %---------------------------------% +! | See debug.doc for documentation | +! %---------------------------------% + integer logfil, ndigit, mgetv0, & msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd, & mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd, & mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd - common /debug/ - & logfil, ndigit, mgetv0, + common /debug/ + & logfil, ndigit, mgetv0, & msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd, & mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd, & mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd diff --git a/src/vendor/arpack/dgetv0.f b/src/vendor/arpack/dgetv0.f index b64d47a73f..35b2fa3a85 100644 --- a/src/vendor/arpack/dgetv0.f +++ b/src/vendor/arpack/dgetv0.f @@ -3,13 +3,13 @@ c c\Name: igraphdgetv0 c -c\Description: +c\Description: c Generate a random initial residual vector for the Arnoldi process. -c Force the residual vector to be in the range of the operator OP. +c Force the residual vector to be in the range of the operator OP. c c\Usage: c call igraphdgetv0 -c ( IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM, +c ( IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM, c IPNTR, WORKD, IERR ) c c\Arguments @@ -36,7 +36,7 @@ c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x c c ITRY Integer. (INPUT) -c ITRY counts the number of times that igraphdgetv0 is called. +c ITRY counts the number of times that igraphdgetv0 is called. c It should be set to 1 on the initial call to igraphdgetv0. c c INITV Logical variable. (INPUT) @@ -55,11 +55,11 @@ c if this is a "restart". c c LDV Integer. (INPUT) -c Leading dimension of V exactly as declared in the calling +c Leading dimension of V exactly as declared in the calling c program. c c RESID Double precision array of length N. (INPUT/OUTPUT) -c Initial residual vector to be generated. If RESID is +c Initial residual vector to be generated. If RESID is c provided, force RESID into the range of the operator OP. c c RNORM Double precision scalar. (OUTPUT) @@ -88,17 +88,17 @@ c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. -c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly +c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: -c igraphsecond ARPACK utility routine for timing. +c igrapharscnd ARPACK utility routine for timing. c igraphdvout ARPACK utility routine for vector output. c dlarnv LAPACK routine for generating a random vector. c dgemv Level 2 BLAS routine for matrix vector multiplication. c dcopy Level 1 BLAS that copies one vector to another. -c ddot Level 1 BLAS that computes the scalar product of two vectors. +c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c c\Author @@ -106,20 +106,20 @@ c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas +c Rice University +c Houston, Texas c -c\SCCS Information: @(#) -c FILE: getv0.F SID: 2.6 DATE OF SID: 8/27/96 RELEASE: 2 +c\SCCS Information: @(#) +c FILE: getv0.F SID: 2.7 DATE OF SID: 04/07/99 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c - subroutine igraphdgetv0 - & ( ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm, + subroutine igraphdgetv0 + & ( ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm, & ipntr, workd, ierr ) -c +c c %----------------------------------------------------% c | Include files for debugging and timing information | c %----------------------------------------------------% @@ -167,7 +167,7 @@ subroutine igraphdgetv0 c | External Subroutines | c %----------------------% c - external dlarnv, igraphdvout, dcopy, dgemv, igraphsecond + external dlarnv, igraphdvout, dcopy, dgemv, igrapharscnd c c %--------------------% c | External Functions | @@ -208,15 +208,15 @@ subroutine igraphdgetv0 end if c if (ido .eq. 0) then -c +c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c - call igraphsecond (t0) + call igrapharscnd (t0) msglvl = mgetv0 -c +c ierr = 0 iter = 0 first = .FALSE. @@ -235,23 +235,25 @@ subroutine igraphdgetv0 idist = 2 call dlarnv (idist, iseed, n, resid) end if -c +c c %----------------------------------------------------------% c | Force the starting vector into the range of OP to handle | c | the generalized problem when B is possibly (singular). | c %----------------------------------------------------------% c - call igraphsecond (t2) - if (bmat .eq. 'G') then + call igrapharscnd (t2) + if (itry .eq. 1) then nopx = nopx + 1 ipntr(1) = 1 ipntr(2) = n + 1 call dcopy (n, resid, 1, workd, 1) ido = -1 go to 9000 + else if (itry .gt. 1 .and. bmat .eq. 'G') then + call dcopy (n, resid, 1, workd(n + 1), 1) end if end if -c +c c %-----------------------------------------% c | Back from computing OP*(initial-vector) | c %-----------------------------------------% @@ -259,26 +261,26 @@ subroutine igraphdgetv0 if (first) go to 20 c c %-----------------------------------------------% -c | Back from computing B*(orthogonalized-vector) | +c | Back from computing OP*(orthogonalized-vector) | c %-----------------------------------------------% c if (orth) go to 40 -c +c if (bmat .eq. 'G') then - call igraphsecond (t3) + call igrapharscnd (t3) tmvopx = tmvopx + (t3 - t2) end if -c +c c %------------------------------------------------------% c | Starting vector is now in the range of OP; r = OP*r; | c | Compute B-norm of starting vector. | c %------------------------------------------------------% c - call igraphsecond (t2) + call igrapharscnd (t2) first = .TRUE. + if (itry .eq. 1) call dcopy (n, workd(n + 1), 1, resid, 1) if (bmat .eq. 'G') then nbx = nbx + 1 - call dcopy (n, workd(n+1), 1, resid, 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 @@ -286,14 +288,14 @@ subroutine igraphdgetv0 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd, 1) end if -c +c 20 continue c if (bmat .eq. 'G') then - call igraphsecond (t3) + call igrapharscnd (t3) tmvbx = tmvbx + (t3 - t2) end if -c +c first = .FALSE. if (bmat .eq. 'G') then rnorm0 = ddot (n, resid, 1, workd, 1) @@ -308,7 +310,7 @@ subroutine igraphdgetv0 c %---------------------------------------------% c if (j .eq. 1) go to 50 -c +c c %---------------------------------------------------------------- c | Otherwise need to B-orthogonalize the starting vector against | c | the current Arnoldi basis using Gram-Schmidt with iter. ref. | @@ -324,16 +326,16 @@ subroutine igraphdgetv0 orth = .TRUE. 30 continue c - call dgemv ('T', n, j-1, one, v, ldv, workd, 1, + call dgemv ('T', n, j-1, one, v, ldv, workd, 1, & zero, workd(n+1), 1) - call dgemv ('N', n, j-1, -one, v, ldv, workd(n+1), 1, + call dgemv ('N', n, j-1, -one, v, ldv, workd(n+1), 1, & one, resid, 1) -c +c c %----------------------------------------------------------% c | Compute the B-norm of the orthogonalized starting vector | c %----------------------------------------------------------% c - call igraphsecond (t2) + call igrapharscnd (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(n+1), 1) @@ -344,14 +346,14 @@ subroutine igraphdgetv0 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd, 1) end if -c +c 40 continue c if (bmat .eq. 'G') then - call igraphsecond (t3) + call igrapharscnd (t3) tmvbx = tmvbx + (t3 - t2) end if -c +c if (bmat .eq. 'G') then rnorm = ddot (n, resid, 1, workd, 1) rnorm = sqrt(abs(rnorm)) @@ -364,16 +366,16 @@ subroutine igraphdgetv0 c %--------------------------------------% c if (msglvl .gt. 2) then - call igraphdvout (logfil, 1, [rnorm0], ndigit, + call igraphdvout (logfil, 1, [rnorm0], ndigit, & '_getv0: re-orthonalization ; rnorm0 is') - call igraphdvout (logfil, 1, [rnorm], ndigit, + call igraphdvout (logfil, 1, [rnorm], ndigit, & '_getv0: re-orthonalization ; rnorm is') end if c if (rnorm .gt. 0.717*rnorm0) go to 50 -c +c iter = iter + 1 - if (iter .le. 1) then + if (iter .le. 5) then c c %-----------------------------------% c | Perform iterative refinement step | @@ -393,22 +395,22 @@ subroutine igraphdgetv0 rnorm = zero ierr = -1 end if -c +c 50 continue c if (msglvl .gt. 0) then call igraphdvout (logfil, 1, [rnorm], ndigit, & '_getv0: B-norm of initial / restarted starting vector') end if - if (msglvl .gt. 2) then + if (msglvl .gt. 3) then call igraphdvout (logfil, n, resid, ndigit, & '_getv0: initial / restarted starting vector') end if ido = 99 -c - call igraphsecond (t1) +c + call igrapharscnd (t1) tgetv0 = tgetv0 + (t1 - t0) -c +c 9000 continue return c diff --git a/src/vendor/arpack/dlaqrb.f b/src/vendor/arpack/dlaqrb.f deleted file mode 100644 index 5fcefece6b..0000000000 --- a/src/vendor/arpack/dlaqrb.f +++ /dev/null @@ -1,521 +0,0 @@ -c----------------------------------------------------------------------- -c\BeginDoc -c -c\Name: igraphdlaqrb -c -c\Description: -c Compute the eigenvalues and the Schur decomposition of an upper -c Hessenberg submatrix in rows and columns ILO to IHI. Only the -c last component of the Schur vectors are computed. -c -c This is mostly a modification of the LAPACK routine dlahqr. -c -c\Usage: -c call igraphdlaqrb -c ( WANTT, N, ILO, IHI, H, LDH, WR, WI, Z, INFO ) -c -c\Arguments -c WANTT Logical variable. (INPUT) -c = .TRUE. : the full Schur form T is required; -c = .FALSE.: only eigenvalues are required. -c -c N Integer. (INPUT) -c The order of the matrix H. N >= 0. -c -c ILO Integer. (INPUT) -c IHI Integer. (INPUT) -c It is assumed that H is already upper quasi-triangular in -c rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless -c ILO = 1). SLAQRB works primarily with the Hessenberg -c submatrix in rows and columns ILO to IHI, but applies -c transformations to all of H if WANTT is .TRUE.. -c 1 <= ILO <= max(1,IHI); IHI <= N. -c -c H Double precision array, dimension (LDH,N). (INPUT/OUTPUT) -c On entry, the upper Hessenberg matrix H. -c On exit, if WANTT is .TRUE., H is upper quasi-triangular in -c rows and columns ILO:IHI, with any 2-by-2 diagonal blocks in -c standard form. If WANTT is .FALSE., the contents of H are -c unspecified on exit. -c -c LDH Integer. (INPUT) -c The leading dimension of the array H. LDH >= max(1,N). -c -c WR Double precision array, dimension (N). (OUTPUT) -c WI Double precision array, dimension (N). (OUTPUT) -c The real and imaginary parts, respectively, of the computed -c eigenvalues ILO to IHI are stored in the corresponding -c elements of WR and WI. If two eigenvalues are computed as a -c complex conjugate pair, they are stored in consecutive -c elements of WR and WI, say the i-th and (i+1)th, with -c WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the -c eigenvalues are stored in the same order as on the diagonal -c of the Schur form returned in H, with WR(i) = H(i,i), and, if -c H(i:i+1,i:i+1) is a 2-by-2 diagonal block, -c WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i). -c -c Z Double precision array, dimension (N). (OUTPUT) -c On exit Z contains the last components of the Schur vectors. -c -c INFO Integer. (OUPUT) -c = 0: successful exit -c > 0: SLAQRB failed to compute all the eigenvalues ILO to IHI -c in a total of 30*(IHI-ILO+1) iterations; if INFO = i, -c elements i+1:ihi of WR and WI contain those eigenvalues -c which have been successfully computed. -c -c\Remarks -c 1. None. -c -c----------------------------------------------------------------------- -c -c\BeginLib -c -c\Local variables: -c xxxxxx real -c -c\Routines called: -c dlabad LAPACK routine that computes machine constants. -c dlamch LAPACK routine that determines machine constants. -c dlanhs LAPACK routine that computes various norms of a matrix. -c dlanv2 LAPACK routine that computes the Schur factorization of -c 2 by 2 nonsymmetric matrix in standard form. -c dlarfg LAPACK Householder reflection construction routine. -c dcopy Level 1 BLAS that copies one vector to another. -c drot Level 1 BLAS that applies a rotation to a 2 by 2 matrix. - -c -c\Author -c Danny Sorensen Phuong Vu -c Richard Lehoucq CRPC / Rice University -c Dept. of Computational & Houston, Texas -c Applied Mathematics -c Rice University -c Houston, Texas -c -c\Revision history: -c xx/xx/92: Version ' 2.4' -c Modified from the LAPACK routine dlahqr so that only the -c last component of the Schur vectors are computed. -c -c\SCCS Information: @(#) -c FILE: laqrb.F SID: 2.2 DATE OF SID: 8/27/96 RELEASE: 2 -c -c\Remarks -c 1. None -c -c\EndLib -c -c----------------------------------------------------------------------- -c - subroutine igraphdlaqrb ( wantt, n, ilo, ihi, h, ldh, wr, wi, - & z, info ) -c -c %------------------% -c | Scalar Arguments | -c %------------------% -c - logical wantt - integer ihi, ilo, info, ldh, n -c -c %-----------------% -c | Array Arguments | -c %-----------------% -c - Double precision - & h( ldh, * ), wi( * ), wr( * ), z( * ) -c -c %------------% -c | Parameters | -c %------------% -c - Double precision - & zero, one, dat1, dat2 - parameter (zero = 0.0D+0, one = 1.0D+0, dat1 = 7.5D-1, - & dat2 = -4.375D-1) -c -c %------------------------% -c | Local Scalars & Arrays | -c %------------------------% -c - integer i, i1, i2, itn, its, j, k, l, m, nh, nr - Double precision - & cs, h00, h10, h11, h12, h21, h22, h33, h33s, - & h43h34, h44, h44s, ovfl, s, smlnum, sn, sum, - & t1, t2, t3, tst1, ulp, unfl, v1, v2, v3 - Double precision - & v( 3 ), work( 1 ) -c -c %--------------------% -c | External Functions | -c %--------------------% -c - Double precision - & dlamch, dlanhs - external dlamch, dlanhs -c -c %----------------------% -c | External Subroutines | -c %----------------------% -c - external dcopy, dlabad, dlanv2, dlarfg, drot -c -c %-----------------------% -c | Executable Statements | -c %-----------------------% -c - info = 0 -c -c %--------------------------% -c | Quick return if possible | -c %--------------------------% -c - if( n.eq.0 ) - & return - if( ilo.eq.ihi ) then - wr( ilo ) = h( ilo, ilo ) - wi( ilo ) = zero - return - end if -c -c %---------------------------------------------% -c | Initialize the vector of last components of | -c | the Schur vectors for accumulation. | -c %---------------------------------------------% -c - do 5 j = 1, n-1 - z(j) = zero - 5 continue - z(n) = one -c - nh = ihi - ilo + 1 -c -c %-------------------------------------------------------------% -c | Set machine-dependent constants for the stopping criterion. | -c | If norm(H) <= sqrt(OVFL), overflow should not occur. | -c %-------------------------------------------------------------% -c - unfl = dlamch( 'safe minimum' ) - ovfl = one / unfl - call dlabad( unfl, ovfl ) - ulp = dlamch( 'precision' ) - smlnum = unfl*( nh / ulp ) -c -c %---------------------------------------------------------------% -c | I1 and I2 are the indices of the first row and last column | -c | of H to which transformations must be applied. If eigenvalues | -c | only are computed, I1 and I2 are set inside the main loop. | -c | Zero out H(J+2,J) = ZERO for J=1:N if WANTT = .TRUE. | -c | else H(J+2,J) for J=ILO:IHI-ILO-1 if WANTT = .FALSE. | -c %---------------------------------------------------------------% -c - if( wantt ) then - i1 = 1 - i2 = n - do 8 i=1,i2-2 - h(i1+i+1,i) = zero - 8 continue - else - do 9 i=1, ihi-ilo-1 - h(ilo+i+1,ilo+i-1) = zero - 9 continue - end if -c -c %---------------------------------------------------% -c | ITN is the total number of QR iterations allowed. | -c %---------------------------------------------------% -c - itn = 30*nh -c -c ------------------------------------------------------------------ -c The main loop begins here. I is the loop index and decreases from -c IHI to ILO in steps of 1 or 2. Each iteration of the loop works -c with the active submatrix in rows and columns L to I. -c Eigenvalues I+1 to IHI have already converged. Either L = ILO or -c H(L,L-1) is negligible so that the matrix splits. -c ------------------------------------------------------------------ -c - i = ihi - 10 continue - l = ilo - if( i.lt.ilo ) - & go to 150 - -c %--------------------------------------------------------------% -c | Perform QR iterations on rows and columns ILO to I until a | -c | submatrix of order 1 or 2 splits off at the bottom because a | -c | subdiagonal element has become negligible. | -c %--------------------------------------------------------------% - - do 130 its = 0, itn -c -c %----------------------------------------------% -c | Look for a single small subdiagonal element. | -c %----------------------------------------------% -c - do 20 k = i, l + 1, -1 - tst1 = abs( h( k-1, k-1 ) ) + abs( h( k, k ) ) - if( tst1.eq.zero ) - & tst1 = dlanhs( '1', i-l+1, h( l, l ), ldh, work ) - if( abs( h( k, k-1 ) ).le.max( ulp*tst1, smlnum ) ) - & go to 30 - 20 continue - 30 continue - l = k - if( l.gt.ilo ) then -c -c %------------------------% -c | H(L,L-1) is negligible | -c %------------------------% -c - h( l, l-1 ) = zero - end if -c -c %-------------------------------------------------------------% -c | Exit from loop if a submatrix of order 1 or 2 has split off | -c %-------------------------------------------------------------% -c - if( l.ge.i-1 ) - & go to 140 -c -c %---------------------------------------------------------% -c | Now the active submatrix is in rows and columns L to I. | -c | If eigenvalues only are being computed, only the active | -c | submatrix need be transformed. | -c %---------------------------------------------------------% -c - if( .not.wantt ) then - i1 = l - i2 = i - end if -c - if( its.eq.10 .or. its.eq.20 ) then -c -c %-------------------% -c | Exceptional shift | -c %-------------------% -c - s = abs( h( i, i-1 ) ) + abs( h( i-1, i-2 ) ) - h44 = dat1*s - h33 = h44 - h43h34 = dat2*s*s -c - else -c -c %-----------------------------------------% -c | Prepare to use Wilkinson's double shift | -c %-----------------------------------------% -c - h44 = h( i, i ) - h33 = h( i-1, i-1 ) - h43h34 = h( i, i-1 )*h( i-1, i ) - end if -c -c %-----------------------------------------------------% -c | Look for two consecutive small subdiagonal elements | -c %-----------------------------------------------------% -c - do 40 m = i - 2, l, -1 -c -c %---------------------------------------------------------% -c | Determine the effect of starting the double-shift QR | -c | iteration at row M, and see if this would make H(M,M-1) | -c | negligible. | -c %---------------------------------------------------------% -c - h11 = h( m, m ) - h22 = h( m+1, m+1 ) - h21 = h( m+1, m ) - h12 = h( m, m+1 ) - h44s = h44 - h11 - h33s = h33 - h11 - v1 = ( h33s*h44s-h43h34 ) / h21 + h12 - v2 = h22 - h11 - h33s - h44s - v3 = h( m+2, m+1 ) - s = abs( v1 ) + abs( v2 ) + abs( v3 ) - v1 = v1 / s - v2 = v2 / s - v3 = v3 / s - v( 1 ) = v1 - v( 2 ) = v2 - v( 3 ) = v3 - if( m.eq.l ) - & go to 50 - h00 = h( m-1, m-1 ) - h10 = h( m, m-1 ) - tst1 = abs( v1 )*( abs( h00 )+abs( h11 )+abs( h22 ) ) - if( abs( h10 )*( abs( v2 )+abs( v3 ) ).le.ulp*tst1 ) - & go to 50 - 40 continue - 50 continue -c -c %----------------------% -c | Double-shift QR step | -c %----------------------% -c - do 120 k = m, i - 1 -c -c ------------------------------------------------------------ -c The first iteration of this loop determines a reflection G -c from the vector V and applies it from left and right to H, -c thus creating a nonzero bulge below the subdiagonal. -c -c Each subsequent iteration determines a reflection G to -c restore the Hessenberg form in the (K-1)th column, and thus -c chases the bulge one step toward the bottom of the active -c submatrix. NR is the order of G. -c ------------------------------------------------------------ -c - nr = min( 3, i-k+1 ) - if( k.gt.m ) - & call dcopy( nr, h( k, k-1 ), 1, v, 1 ) - call dlarfg( nr, v( 1 ), v( 2 ), 1, t1 ) - if( k.gt.m ) then - h( k, k-1 ) = v( 1 ) - h( k+1, k-1 ) = zero - if( k.lt.i-1 ) - & h( k+2, k-1 ) = zero - else if( m.gt.l ) then - h( k, k-1 ) = -h( k, k-1 ) - end if - v2 = v( 2 ) - t2 = t1*v2 - if( nr.eq.3 ) then - v3 = v( 3 ) - t3 = t1*v3 -c -c %------------------------------------------------% -c | Apply G from the left to transform the rows of | -c | the matrix in columns K to I2. | -c %------------------------------------------------% -c - do 60 j = k, i2 - sum = h( k, j ) + v2*h( k+1, j ) + v3*h( k+2, j ) - h( k, j ) = h( k, j ) - sum*t1 - h( k+1, j ) = h( k+1, j ) - sum*t2 - h( k+2, j ) = h( k+2, j ) - sum*t3 - 60 continue -c -c %----------------------------------------------------% -c | Apply G from the right to transform the columns of | -c | the matrix in rows I1 to min(K+3,I). | -c %----------------------------------------------------% -c - do 70 j = i1, min( k+3, i ) - sum = h( j, k ) + v2*h( j, k+1 ) + v3*h( j, k+2 ) - h( j, k ) = h( j, k ) - sum*t1 - h( j, k+1 ) = h( j, k+1 ) - sum*t2 - h( j, k+2 ) = h( j, k+2 ) - sum*t3 - 70 continue -c -c %----------------------------------% -c | Accumulate transformations for Z | -c %----------------------------------% -c - sum = z( k ) + v2*z( k+1 ) + v3*z( k+2 ) - z( k ) = z( k ) - sum*t1 - z( k+1 ) = z( k+1 ) - sum*t2 - z( k+2 ) = z( k+2 ) - sum*t3 - - else if( nr.eq.2 ) then -c -c %------------------------------------------------% -c | Apply G from the left to transform the rows of | -c | the matrix in columns K to I2. | -c %------------------------------------------------% -c - do 90 j = k, i2 - sum = h( k, j ) + v2*h( k+1, j ) - h( k, j ) = h( k, j ) - sum*t1 - h( k+1, j ) = h( k+1, j ) - sum*t2 - 90 continue -c -c %----------------------------------------------------% -c | Apply G from the right to transform the columns of | -c | the matrix in rows I1 to min(K+3,I). | -c %----------------------------------------------------% -c - do 100 j = i1, i - sum = h( j, k ) + v2*h( j, k+1 ) - h( j, k ) = h( j, k ) - sum*t1 - h( j, k+1 ) = h( j, k+1 ) - sum*t2 - 100 continue -c -c %----------------------------------% -c | Accumulate transformations for Z | -c %----------------------------------% -c - sum = z( k ) + v2*z( k+1 ) - z( k ) = z( k ) - sum*t1 - z( k+1 ) = z( k+1 ) - sum*t2 - end if - 120 continue - - 130 continue -c -c %-------------------------------------------------------% -c | Failure to converge in remaining number of iterations | -c %-------------------------------------------------------% -c - info = i - return - - 140 continue - - if( l.eq.i ) then -c -c %------------------------------------------------------% -c | H(I,I-1) is negligible: one eigenvalue has converged | -c %------------------------------------------------------% -c - wr( i ) = h( i, i ) - wi( i ) = zero - - else if( l.eq.i-1 ) then -c -c %--------------------------------------------------------% -c | H(I-1,I-2) is negligible; | -c | a pair of eigenvalues have converged. | -c | | -c | Transform the 2-by-2 submatrix to standard Schur form, | -c | and compute and store the eigenvalues. | -c %--------------------------------------------------------% -c - call dlanv2( h( i-1, i-1 ), h( i-1, i ), h( i, i-1 ), - & h( i, i ), wr( i-1 ), wi( i-1 ), wr( i ), wi( i ), - & cs, sn ) - - if( wantt ) then -c -c %-----------------------------------------------------% -c | Apply the transformation to the rest of H and to Z, | -c | as required. | -c %-----------------------------------------------------% -c - if( i2.gt.i ) - & call drot( i2-i, h( i-1, i+1 ), ldh, h( i, i+1 ), ldh, - & cs, sn ) - call drot( i-i1-1, h( i1, i-1 ), 1, h( i1, i ), 1, cs, sn ) - sum = cs*z( i-1 ) + sn*z( i ) - z( i ) = cs*z( i ) - sn*z( i-1 ) - z( i-1 ) = sum - end if - end if -c -c %---------------------------------------------------------% -c | Decrement number of remaining iterations, and return to | -c | start of the main loop with new value of I. | -c %---------------------------------------------------------% -c - itn = itn - its - i = l - 1 - go to 10 - - 150 continue - return -c -c %---------------% -c | End of igraphdlaqrb | -c %---------------% -c - end diff --git a/src/vendor/arpack/dmout.f b/src/vendor/arpack/dmout.f index 59a407ab95..df2079ab80 100644 --- a/src/vendor/arpack/dmout.f +++ b/src/vendor/arpack/dmout.f @@ -1,9 +1,9 @@ *----------------------------------------------------------------------- -* Routine: DMOUT +* Routine: IGRAPHDMOUT * * Purpose: Real matrix output routine. * -* Usage: CALL DMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT) +* Usage: CALL IGRAPHDMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT) * * Arguments * M - Number of rows of A. (Input) @@ -31,7 +31,7 @@ SUBROUTINE IGRAPHDMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT ) DOUBLE PRECISION A( LDA, * ) * .. * .. Local Scalars .. - CHARACTER LINE*80 + CHARACTER*80 LINE INTEGER I, J, K1, K2, LLL, NDIGIT * .. * .. Local Arrays .. @@ -48,120 +48,120 @@ SUBROUTINE IGRAPHDMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT ) * ... * ... FIRST EXECUTABLE STATEMENT * -c$$$ LLL = MIN( LEN( IFMT ), 80 ) -c$$$ DO 10 I = 1, LLL -c$$$ LINE( I: I ) = '-' -c$$$ 10 CONTINUE -c$$$* -c$$$ DO 20 I = LLL + 1, 80 -c$$$ LINE( I: I ) = ' ' -c$$$ 20 CONTINUE -c$$$* -c$$$ WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL ) -c$$$ 9999 FORMAT( / 1X, A, / 1X, A ) -c$$$* -c$$$ IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 ) -c$$$ $ RETURN -c$$$ NDIGIT = IDIGIT -c$$$ IF( IDIGIT.EQ.0 ) -c$$$ $ NDIGIT = 4 -c$$$* -c$$$*======================================================================= -c$$$* CODE FOR OUTPUT USING 72 COLUMNS FORMAT -c$$$*======================================================================= -c$$$* -c$$$ IF( IDIGIT.LT.0 ) THEN -c$$$ NDIGIT = -IDIGIT -c$$$ IF( NDIGIT.LE.4 ) THEN -c$$$ DO 40 K1 = 1, N, 5 -c$$$ K2 = MIN0( N, K1+4 ) -c$$$ WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 ) -c$$$ DO 30 I = 1, M -c$$$ WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 ) -c$$$ 30 CONTINUE -c$$$ 40 CONTINUE -c$$$* -c$$$ ELSE IF( NDIGIT.LE.6 ) THEN -c$$$ DO 60 K1 = 1, N, 4 -c$$$ K2 = MIN0( N, K1+3 ) -c$$$ WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 ) -c$$$ DO 50 I = 1, M -c$$$ WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 ) -c$$$ 50 CONTINUE -c$$$ 60 CONTINUE -c$$$* -c$$$ ELSE IF( NDIGIT.LE.10 ) THEN -c$$$ DO 80 K1 = 1, N, 3 -c$$$ K2 = MIN0( N, K1+2 ) -c$$$ WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 ) -c$$$ DO 70 I = 1, M -c$$$ WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 ) -c$$$ 70 CONTINUE -c$$$ 80 CONTINUE -c$$$* -c$$$ ELSE -c$$$ DO 100 K1 = 1, N, 2 -c$$$ K2 = MIN0( N, K1+1 ) -c$$$ WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 ) -c$$$ DO 90 I = 1, M -c$$$ WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 ) -c$$$ 90 CONTINUE -c$$$ 100 CONTINUE -c$$$ END IF -c$$$* -c$$$*======================================================================= -c$$$* CODE FOR OUTPUT USING 132 COLUMNS FORMAT -c$$$*======================================================================= -c$$$* -c$$$ ELSE -c$$$ IF( NDIGIT.LE.4 ) THEN -c$$$ DO 120 K1 = 1, N, 10 -c$$$ K2 = MIN0( N, K1+9 ) -c$$$ WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 ) -c$$$ DO 110 I = 1, M -c$$$ WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 ) -c$$$ 110 CONTINUE -c$$$ 120 CONTINUE -c$$$* -c$$$ ELSE IF( NDIGIT.LE.6 ) THEN -c$$$ DO 140 K1 = 1, N, 8 -c$$$ K2 = MIN0( N, K1+7 ) -c$$$ WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 ) -c$$$ DO 130 I = 1, M -c$$$ WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 ) -c$$$ 130 CONTINUE -c$$$ 140 CONTINUE -c$$$* -c$$$ ELSE IF( NDIGIT.LE.10 ) THEN -c$$$ DO 160 K1 = 1, N, 6 -c$$$ K2 = MIN0( N, K1+5 ) -c$$$ WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 ) -c$$$ DO 150 I = 1, M -c$$$ WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 ) -c$$$ 150 CONTINUE -c$$$ 160 CONTINUE -c$$$* -c$$$ ELSE -c$$$ DO 180 K1 = 1, N, 5 -c$$$ K2 = MIN0( N, K1+4 ) -c$$$ WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 ) -c$$$ DO 170 I = 1, M -c$$$ WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 ) -c$$$ 170 CONTINUE -c$$$ 180 CONTINUE -c$$$ END IF -c$$$ END IF -c$$$ WRITE( LOUT, FMT = 9990 ) -c$$$* -c$$$ 9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) ) -c$$$ 9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) ) -c$$$ 9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) ) -c$$$ 9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) ) -c$$$ 9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 10D12.3 ) -c$$$ 9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 8D14.5 ) -c$$$ 9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 6D18.9 ) -c$$$ 9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 5D22.13 ) -c$$$ 9990 FORMAT( 1X, ' ' ) + LLL = MIN( LEN( IFMT ), 80 ) + DO 10 I = 1, LLL + LINE( I: I ) = '-' + 10 CONTINUE +* + DO 20 I = LLL + 1, 80 + LINE( I: I ) = ' ' + 20 CONTINUE +* + WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL ) + 9999 FORMAT( / 1X, A, / 1X, A ) +* + IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 ) + $ RETURN + NDIGIT = IDIGIT + IF( IDIGIT.EQ.0 ) + $ NDIGIT = 4 +* +*======================================================================= +* CODE FOR OUTPUT USING 72 COLUMNS FORMAT +*======================================================================= +* + IF( IDIGIT.LT.0 ) THEN + NDIGIT = -IDIGIT + IF( NDIGIT.LE.4 ) THEN + DO 40 K1 = 1, N, 5 + K2 = MIN0( N, K1+4 ) + WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 ) + DO 30 I = 1, M + WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 ) + 30 CONTINUE + 40 CONTINUE +* + ELSE IF( NDIGIT.LE.6 ) THEN + DO 60 K1 = 1, N, 4 + K2 = MIN0( N, K1+3 ) + WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 ) + DO 50 I = 1, M + WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 ) + 50 CONTINUE + 60 CONTINUE +* + ELSE IF( NDIGIT.LE.10 ) THEN + DO 80 K1 = 1, N, 3 + K2 = MIN0( N, K1+2 ) + WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 ) + DO 70 I = 1, M + WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 ) + 70 CONTINUE + 80 CONTINUE +* + ELSE + DO 100 K1 = 1, N, 2 + K2 = MIN0( N, K1+1 ) + WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 ) + DO 90 I = 1, M + WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 ) + 90 CONTINUE + 100 CONTINUE + END IF +* +*======================================================================= +* CODE FOR OUTPUT USING 132 COLUMNS FORMAT +*======================================================================= +* + ELSE + IF( NDIGIT.LE.4 ) THEN + DO 120 K1 = 1, N, 10 + K2 = MIN0( N, K1+9 ) + WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 ) + DO 110 I = 1, M + WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 ) + 110 CONTINUE + 120 CONTINUE +* + ELSE IF( NDIGIT.LE.6 ) THEN + DO 140 K1 = 1, N, 8 + K2 = MIN0( N, K1+7 ) + WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 ) + DO 130 I = 1, M + WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 ) + 130 CONTINUE + 140 CONTINUE +* + ELSE IF( NDIGIT.LE.10 ) THEN + DO 160 K1 = 1, N, 6 + K2 = MIN0( N, K1+5 ) + WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 ) + DO 150 I = 1, M + WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 ) + 150 CONTINUE + 160 CONTINUE +* + ELSE + DO 180 K1 = 1, N, 5 + K2 = MIN0( N, K1+4 ) + WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 ) + DO 170 I = 1, M + WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 ) + 170 CONTINUE + 180 CONTINUE + END IF + END IF + WRITE( LOUT, FMT = 9990 ) +* + 9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) ) + 9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) ) + 9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) ) + 9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) ) + 9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 10D12.3 ) + 9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 8D14.5 ) + 9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 6D18.9 ) + 9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 5D22.13 ) + 9990 FORMAT( 1X, ' ' ) * RETURN END diff --git a/src/vendor/arpack/dnaitr.f b/src/vendor/arpack/dnaitr.f index 8ec2569a19..7bd3f43336 100644 --- a/src/vendor/arpack/dnaitr.f +++ b/src/vendor/arpack/dnaitr.f @@ -3,8 +3,8 @@ c c\Name: igraphdnaitr c -c\Description: -c Reverse communication interface for applying NP additional steps to +c\Description: +c Reverse communication interface for applying NP additional steps to c a K step nonsymmetric Arnoldi factorization. c c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T @@ -20,7 +20,7 @@ c c\Usage: c call igraphdnaitr -c ( IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH, +c ( IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH, c IPNTR, WORKD, INFO ) c c\Arguments @@ -62,8 +62,8 @@ c Number of additional Arnoldi steps to take. c c NB Integer. (INPUT) -c Blocksize to be used in the recurrence. -c Only work for NB = 1 right now. The goal is to have a +c Blocksize to be used in the recurrence. +c Only work for NB = 1 right now. The goal is to have a c program that implement both the block and non-block method. c c RESID Double precision array of length N. (INPUT/OUTPUT) @@ -75,37 +75,37 @@ c B-norm of the updated residual r_{k+p} on output. c c V Double precision N by K+NP array. (INPUT/OUTPUT) -c On INPUT: V contains the Arnoldi vectors in the first K +c On INPUT: V contains the Arnoldi vectors in the first K c columns. c On OUTPUT: V contains the new NP Arnoldi vectors in the next c NP columns. The first K columns are unchanged. c c LDV Integer. (INPUT) -c Leading dimension of V exactly as declared in the calling +c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (K+NP) by (K+NP) array. (INPUT/OUTPUT) c H is used to store the generated upper Hessenberg matrix. c c LDH Integer. (INPUT) -c Leading dimension of H exactly as declared in the calling +c Leading dimension of H exactly as declared in the calling c program. c c IPNTR Integer array of length 3. (OUTPUT) -c Pointer to mark the starting locations in the WORK for +c Pointer to mark the starting locations in the WORK for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. -c IPNTR(3): pointer to the vector B * X when used in the +c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- -c +c c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration -c for reverse communication. The calling program should not +c for reverse communication. The calling program should not c use WORKD as temporary workspace during the iteration !!!!!! -c On input, WORKD(1:N) = B*RESID and is used to save some +c On input, WORKD(1:N) = B*RESID and is used to save some c computation at the first step. c c INFO Integer. (OUTPUT) @@ -125,14 +125,14 @@ c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. -c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly +c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: c igraphdgetv0 ARPACK routine to generate the initial vector. c igraphivout ARPACK utility routine that prints integers. -c igraphsecond ARPACK utility routine for timing. +c igrapharscnd ARPACK utility routine for timing. c igraphdmout ARPACK utility routine that prints matrices c igraphdvout ARPACK utility routine that prints vectors. c dlabad LAPACK routine that computes machine constants. @@ -143,7 +143,7 @@ c daxpy Level 1 BLAS that computes a vector triad. c dscal Level 1 BLAS that scales a vector. c dcopy Level 1 BLAS that copies one vector to another . -c ddot Level 1 BLAS that computes the scalar product of two vectors. +c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c c\Author @@ -151,22 +151,22 @@ c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas -c +c Rice University +c Houston, Texas +c c\Revision history: c xx/xx/92: Version ' 2.4' c -c\SCCS Information: @(#) +c\SCCS Information: @(#) c FILE: naitr.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c The algorithm implemented is: -c +c c restart = .false. -c Given V_{k} = [v_{1}, ..., v_{k}], r_{k}; +c Given V_{k} = [v_{1}, ..., v_{k}], r_{k}; c r_{k} contains the initial residual vector even for k = 0; -c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already +c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already c computed by the calling program. c c betaj = rnorm ; p_{k+1} = B*r_{k} ; @@ -174,7 +174,7 @@ c 1) if ( betaj < tol ) stop or restart depending on j. c ( At present tol is zero ) c if ( restart ) generate a new starting vector. -c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}]; +c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}]; c p_{j} = p_{j}/betaj c 3) r_{j} = OP*v_{j} where OP is defined as in igraphdnaupd c For shift-invert mode p_{j} = B*v_{j} is already available. @@ -189,7 +189,7 @@ c 5) Re-orthogonalization step: c s = V_{j}'*B*r_{j} c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} || -c alphaj = alphaj + s_{j}; +c alphaj = alphaj + s_{j}; c 6) Iterative refinement step: c If (rnorm1 > 0.717*rnorm) then c rnorm = rnorm1 @@ -199,7 +199,7 @@ c If this is the first time in step 6), go to 5) c Else r_{j} lies in the span of V_{j} numerically. c Set r_{j} = 0 and rnorm = 0; go to 1) -c EndIf +c EndIf c End Do c c\EndLib @@ -207,7 +207,7 @@ c----------------------------------------------------------------------- c subroutine igraphdnaitr - & (ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh, + & (ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh, & ipntr, workd, info) c c %----------------------------------------------------% @@ -250,14 +250,14 @@ subroutine igraphdnaitr integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl, & jj Double precision - & betaj, ovfl, temp1, rnorm1, smlnum, tst1, ulp, unfl, + & betaj, ovfl, temp1, rnorm1, smlnum, tst1, ulp, unfl, & wnorm save first, orth1, orth2, rstart, step3, step4, & ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl, & betaj, rnorm1, smlnum, ulp, unfl, wnorm c c %-----------------------% -c | Local Array Arguments | +c | Local Array Arguments | c %-----------------------% c Double precision @@ -267,8 +267,8 @@ subroutine igraphdnaitr c | External Subroutines | c %----------------------% c - external daxpy, dcopy, dscal, dgemv, igraphdgetv0, dlabad, - & igraphdvout, igraphdmout, igraphivout, igraphsecond + external daxpy, dcopy, dscal, dgemv, igraphdgetv0, dlabad, + & igraphdvout, igraphdmout, igraphivout, igrapharscnd c c %--------------------% c | External Functions | @@ -313,15 +313,15 @@ subroutine igraphdnaitr end if c if (ido .eq. 0) then -c +c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c - call igraphsecond (t0) + call igrapharscnd (t0) msglvl = mnaitr -c +c c %------------------------------% c | Initial call to this routine | c %------------------------------% @@ -337,7 +337,7 @@ subroutine igraphdnaitr irj = ipj + n ivj = irj + n end if -c +c c %-------------------------------------------------% c | When in reverse communication mode one of: | c | STEP3, STEP4, ORTH1, ORTH2, RSTART | @@ -367,19 +367,19 @@ subroutine igraphdnaitr c | | c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) | c %--------------------------------------------------------------% - + 1000 continue c if (msglvl .gt. 1) then - call igraphivout (logfil, 1, [j], ndigit, + call igraphivout (logfil, 1, [j], ndigit, & '_naitr: generating Arnoldi vector number') - call igraphdvout (logfil, 1, [rnorm], ndigit, + call igraphdvout (logfil, 1, [rnorm], ndigit, & '_naitr: B-norm of the current residual is') end if -c +c c %---------------------------------------------------% c | STEP 1: Check if the B norm of j-th residual | -c | vector is zero. Equivalent to determing whether | +c | vector is zero. Equivalent to determining whether | c | an exact j-step Arnoldi factorization is present. | c %---------------------------------------------------% c @@ -396,13 +396,13 @@ subroutine igraphdnaitr call igraphivout (logfil, 1, [j], ndigit, & '_naitr: ****** RESTART AT STEP ******') end if -c +c c %---------------------------------------------% c | ITRY is the loop variable that controls the | c | maximum amount of times that a restart is | c | attempted. NRSTRT is used by stat.h | c %---------------------------------------------% -c +c betaj = zero nrstrt = nrstrt + 1 itry = 1 @@ -416,7 +416,7 @@ subroutine igraphdnaitr c | RSTART = .true. flow returns here. | c %--------------------------------------% c - call igraphdgetv0 (ido, bmat, itry, .false., n, j, v, ldv, + call igraphdgetv0 (ido, bmat, itry, .false., n, j, v, ldv, & resid, rnorm, ipntr, workd, ierr) if (ido .ne. 99) go to 9000 if (ierr .lt. 0) then @@ -430,12 +430,12 @@ subroutine igraphdnaitr c %------------------------------------------------% c info = j - 1 - call igraphsecond (t1) + call igrapharscnd (t1) tnaitr = tnaitr + (t1 - t0) ido = 99 go to 9000 end if -c +c 40 continue c c %---------------------------------------------------------% @@ -457,9 +457,9 @@ subroutine igraphdnaitr c | use LAPACK routine SLASCL | c %-----------------------------------------% c - call dlascl ('General', i, i, rnorm, one, n, 1, + call dlascl ('General', i, i, rnorm, one, n, 1, & v(1,j), n, infol) - call dlascl ('General', i, i, rnorm, one, n, 1, + call dlascl ('General', i, i, rnorm, one, n, 1, & workd(ipj), n, infol) end if c @@ -470,29 +470,29 @@ subroutine igraphdnaitr c step3 = .true. nopx = nopx + 1 - call igraphsecond (t2) + call igrapharscnd (t2) call dcopy (n, v(1,j), 1, workd(ivj), 1) ipntr(1) = ivj ipntr(2) = irj ipntr(3) = ipj ido = 1 -c +c c %-----------------------------------% c | Exit in order to compute OP*v_{j} | c %-----------------------------------% -c - go to 9000 +c + go to 9000 50 continue -c +c c %----------------------------------% c | Back from reverse communication; | c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} | c | if step3 = .true. | c %----------------------------------% c - call igraphsecond (t3) + call igrapharscnd (t3) tmvopx = tmvopx + (t3 - t2) - + step3 = .false. c c %------------------------------------------% @@ -500,30 +500,30 @@ subroutine igraphdnaitr c %------------------------------------------% c call dcopy (n, workd(irj), 1, resid, 1) -c +c c %---------------------------------------% c | STEP 4: Finish extending the Arnoldi | c | factorization to length j. | c %---------------------------------------% c - call igraphsecond (t2) + call igrapharscnd (t2) if (bmat .eq. 'G') then nbx = nbx + 1 step4 = .true. ipntr(1) = irj ipntr(2) = ipj ido = 2 -c +c c %-------------------------------------% c | Exit in order to compute B*OP*v_{j} | c %-------------------------------------% -c +c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) end if 60 continue -c +c c %----------------------------------% c | Back from reverse communication; | c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} | @@ -531,10 +531,10 @@ subroutine igraphdnaitr c %----------------------------------% c if (bmat .eq. 'G') then - call igraphsecond (t3) + call igrapharscnd (t3) tmvbx = tmvbx + (t3 - t2) end if -c +c step4 = .false. c c %-------------------------------------% @@ -542,7 +542,7 @@ subroutine igraphdnaitr c | Compute the B-norm of OP*v_{j}. | c %-------------------------------------% c - if (bmat .eq. 'G') then + if (bmat .eq. 'G') then wnorm = ddot (n, resid, 1, workd(ipj), 1) wnorm = sqrt(abs(wnorm)) else if (bmat .eq. 'I') then @@ -562,13 +562,13 @@ subroutine igraphdnaitr c | Compute the j Fourier coefficients w_{j} | c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. | c %------------------------------------------% -c +c call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1, & zero, h(1,j), 1) c c %--------------------------------------% c | Orthogonalize r_{j} against V_{j}. | -c | RESID contains OP*v_{j}. See STEP 3. | +c | RESID contains OP*v_{j}. See STEP 3. | c %--------------------------------------% c call dgemv ('N', n, j, -one, v, ldv, h(1,j), 1, @@ -576,51 +576,51 @@ subroutine igraphdnaitr c if (j .gt. 1) h(j,j-1) = betaj c - call igraphsecond (t4) -c + call igrapharscnd (t4) +c orth1 = .true. c - call igraphsecond (t2) + call igrapharscnd (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 -c +c c %----------------------------------% c | Exit in order to compute B*r_{j} | c %----------------------------------% -c +c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) - end if + end if 70 continue -c +c c %---------------------------------------------------% c | Back from reverse communication if ORTH1 = .true. | c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. | c %---------------------------------------------------% c if (bmat .eq. 'G') then - call igraphsecond (t3) + call igrapharscnd (t3) tmvbx = tmvbx + (t3 - t2) end if -c +c orth1 = .false. c c %------------------------------% c | Compute the B-norm of r_{j}. | c %------------------------------% c - if (bmat .eq. 'G') then + if (bmat .eq. 'G') then rnorm = ddot (n, resid, 1, workd(ipj), 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then rnorm = dnrm2(n, resid, 1) end if -c +c c %-----------------------------------------------------------% c | STEP 5: Re-orthogonalization / Iterative refinement phase | c | Maximum NITER_ITREF tries. | @@ -642,20 +642,20 @@ subroutine igraphdnaitr if (rnorm .gt. 0.717*wnorm) go to 100 iter = 0 nrorth = nrorth + 1 -c +c c %---------------------------------------------------% c | Enter the Iterative refinement phase. If further | c | refinement is necessary, loop back here. The loop | c | variable is ITER. Perform a step of Classical | c | Gram-Schmidt using all the Arnoldi vectors V_{j} | c %---------------------------------------------------% -c +c 80 continue c if (msglvl .gt. 2) then xtemp(1) = wnorm xtemp(2) = rnorm - call igraphdvout (logfil, 2, xtemp, ndigit, + call igraphdvout (logfil, 2, xtemp, ndigit, & '_naitr: re-orthonalization; wnorm and rnorm are') call igraphdvout (logfil, j, h(1,j), ndigit, & '_naitr: j-th column of H') @@ -666,7 +666,7 @@ subroutine igraphdnaitr c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). | c %----------------------------------------------------% c - call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1, + call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1, & zero, workd(irj), 1) c c %---------------------------------------------% @@ -676,28 +676,28 @@ subroutine igraphdnaitr c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. | c %---------------------------------------------% c - call dgemv ('N', n, j, -one, v, ldv, workd(irj), 1, + call dgemv ('N', n, j, -one, v, ldv, workd(irj), 1, & one, resid, 1) call daxpy (j, one, workd(irj), 1, h(1,j), 1) -c +c orth2 = .true. - call igraphsecond (t2) + call igrapharscnd (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 -c +c c %-----------------------------------% c | Exit in order to compute B*r_{j}. | c | r_{j} is the corrected residual. | c %-----------------------------------% -c +c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) - end if + end if 90 continue c c %---------------------------------------------------% @@ -705,15 +705,15 @@ subroutine igraphdnaitr c %---------------------------------------------------% c if (bmat .eq. 'G') then - call igraphsecond (t3) + call igrapharscnd (t3) tmvbx = tmvbx + (t3 - t2) end if c c %-----------------------------------------------------% c | Compute the B-norm of the corrected residual r_{j}. | c %-----------------------------------------------------% -c - if (bmat .eq. 'G') then +c + if (bmat .eq. 'G') then rnorm1 = ddot (n, resid, 1, workd(ipj), 1) rnorm1 = sqrt(abs(rnorm1)) else if (bmat .eq. 'I') then @@ -749,7 +749,7 @@ subroutine igraphdnaitr c %---------------------------------------% c rnorm = rnorm1 -c +c else c c %-------------------------------------------% @@ -771,50 +771,50 @@ subroutine igraphdnaitr 95 continue rnorm = zero end if -c +c c %----------------------------------------------% c | Branch here directly if iterative refinement | c | wasn't necessary or after at most NITER_REF | c | steps of iterative refinement. | c %----------------------------------------------% -c +c 100 continue -c +c rstart = .false. orth2 = .false. -c - call igraphsecond (t5) +c + call igrapharscnd (t5) titref = titref + (t5 - t4) -c +c c %------------------------------------% c | STEP 6: Update j = j+1; Continue | c %------------------------------------% c j = j + 1 if (j .gt. k+np) then - call igraphsecond (t1) + call igrapharscnd (t1) tnaitr = tnaitr + (t1 - t0) ido = 99 do 110 i = max(1,k), k+np-1 -c +c c %--------------------------------------------% c | Check for splitting and deflation. | c | Use a standard test as in the QR algorithm | c | REFERENCE: LAPACK subroutine dlahqr | c %--------------------------------------------% -c +c tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) ) if( tst1.eq.zero ) & tst1 = dlanhs( '1', k+np, h, ldh, workd(n+1) ) - if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) + if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) & h(i+1,i) = zero 110 continue -c +c if (msglvl .gt. 2) then - call igraphdmout (logfil, k+np, k+np, h, ldh, ndigit, + call igraphdmout (logfil, k+np, k+np, h, ldh, ndigit, & '_naitr: Final upper Hessenberg matrix H of order K+NP') end if -c +c go to 9000 end if c @@ -823,7 +823,7 @@ subroutine igraphdnaitr c %--------------------------------------------------------% c go to 1000 -c +c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | diff --git a/src/vendor/arpack/dnapps.f b/src/vendor/arpack/dnapps.f index 247e66b744..d8ecfd3e51 100644 --- a/src/vendor/arpack/dnapps.f +++ b/src/vendor/arpack/dnapps.f @@ -13,14 +13,14 @@ c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q c c where Q is an orthogonal matrix which is the product of rotations -c and reflections resulting from the NP bulge chage sweeps. +c and reflections resulting from the NP bulge change sweeps. c The updated Arnoldi factorization becomes: c c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T. c c\Usage: c call igraphdnapps -c ( N, KEV, NP, SHIFTR, SHIFTI, V, LDV, H, LDH, RESID, Q, LDQ, +c ( N, KEV, NP, SHIFTR, SHIFTI, V, LDV, H, LDH, RESID, Q, LDQ, c WORKL, WORKD ) c c\Arguments @@ -29,8 +29,8 @@ c c KEV Integer. (INPUT/OUTPUT) c KEV+NP is the size of the input matrix H. -c KEV is the size of the updated matrix HNEW. KEV is only -c updated on ouput when fewer than NP shifts are applied in +c KEV is the size of the updated matrix HNEW. KEV is only +c updated on output when fewer than NP shifts are applied in c order to keep the conjugate pair together. c c NP Integer. (INPUT) @@ -38,7 +38,7 @@ c c SHIFTR, Double precision array of length NP. (INPUT) c SHIFTI Real and imaginary part of the shifts to be applied. -c Upon, entry to igraphdnapps, the shifts must be sorted so that the +c Upon, entry to igraphdnapps, the shifts must be sorted so that the c conjugate pairs are in consecutive locations. c c V Double precision N by (KEV+NP) array. (INPUT/OUTPUT) @@ -51,7 +51,7 @@ c program. c c H Double precision (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT) -c On INPUT, H contains the current KEV+NP by KEV+NP upper +c On INPUT, H contains the current KEV+NP by KEV+NP upper c Hessenber matrix of the Arnoldi factorization. c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg c matrix in the KEV leading submatrix. @@ -62,7 +62,7 @@ c c RESID Double precision array of length N. (INPUT/OUTPUT) c On INPUT, RESID contains the the residual vector r_{k+p}. -c On OUTPUT, RESID is the update residual vector rnew_{k} +c On OUTPUT, RESID is the update residual vector rnew_{k} c in the first KEV locations. c c Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE) @@ -97,12 +97,12 @@ c c\Routines called: c igraphivout ARPACK utility routine that prints integers. -c igraphsecond ARPACK utility routine for timing. +c igrapharscnd ARPACK utility routine for timing. c igraphdmout ARPACK utility routine that prints matrices. c igraphdvout ARPACK utility routine that prints vectors. c dlabad LAPACK routine that computes machine constants. c dlacpy LAPACK matrix copy routine. -c dlamch LAPACK routine that determines machine constants. +c dlamch LAPACK routine that determines machine constants. c dlanhs LAPACK routine that computes various norms of a matrix. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c dlarf LAPACK routine that applies Householder reflection to @@ -120,14 +120,14 @@ c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas +c Rice University +c Houston, Texas c c\Revision history: -c xx/xx/92: Version ' 2.1' +c xx/xx/92: Version ' 2.4' c -c\SCCS Information: @(#) -c FILE: napps.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 +c\SCCS Information: @(#) +c FILE: napps.F SID: 2.4 DATE OF SID: 3/28/97 RELEASE: 2 c c\Remarks c 1. In this version, each shift is applied to all the sublocks of @@ -141,7 +141,7 @@ c----------------------------------------------------------------------- c subroutine igraphdnapps - & ( n, kev, np, shiftr, shifti, v, ldv, h, ldh, resid, q, ldq, + & ( n, kev, np, shiftr, shifti, v, ldv, h, ldh, resid, q, ldq, & workl, workd ) c c %----------------------------------------------------% @@ -162,7 +162,7 @@ subroutine igraphdnapps c %-----------------% c Double precision - & h(ldh,kev+np), resid(n), shifti(np), shiftr(np), + & h(ldh,kev+np), resid(n), shifti(np), shiftr(np), & v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np) c c %------------% @@ -180,16 +180,16 @@ subroutine igraphdnapps integer i, iend, ir, istart, j, jj, kplusp, msglvl, nr logical cconj, first Double precision - & c, f, g, h11, h12, h21, h22, h32, ovfl, r, s, sigmai, + & c, f, g, h11, h12, h21, h22, h32, ovfl, r, s, sigmai, & sigmar, smlnum, ulp, unfl, u(3), t, tau, tst1 - save first, ovfl, smlnum, ulp, unfl + save first, ovfl, smlnum, ulp, unfl c c %----------------------% c | External Subroutines | c %----------------------% c external daxpy, dcopy, dscal, dlacpy, dlarfg, dlarf, - & dlaset, dlabad, igraphsecond, dlartg + & dlaset, dlabad, igrapharscnd, dlartg c c %--------------------% c | External Functions | @@ -206,7 +206,7 @@ subroutine igraphdnapps intrinsic abs, max, min c c %----------------% -c | Data statments | +c | Data statements | c %----------------% c data first / .true. / @@ -237,10 +237,10 @@ subroutine igraphdnapps c | & message level for debugging | c %-------------------------------% c - call igraphsecond (t0) + call igrapharscnd (t0) msglvl = mnapps - kplusp = kev + np -c + kplusp = kev + np +c c %--------------------------------------------% c | Initialize Q to the identity to accumulate | c | the rotations and reflections | @@ -266,11 +266,11 @@ subroutine igraphdnapps sigmai = shifti(jj) c if (msglvl .gt. 2 ) then - call igraphivout (logfil, 1, [jj], ndigit, + call igraphivout (logfil, 1, [jj], ndigit, & '_napps: shift number.') - call igraphdvout (logfil, 1, [sigmar], ndigit, + call igraphdvout (logfil, 1, [sigmar], ndigit, & '_napps: The real part of the shift ') - call igraphdvout (logfil, 1, [sigmai], ndigit, + call igraphdvout (logfil, 1, [sigmai], ndigit, & '_napps: The imaginary part of the shift ') end if c @@ -335,11 +335,11 @@ subroutine igraphdnapps & tst1 = dlanhs( '1', kplusp-jj+1, h, ldh, workl ) if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then if (msglvl .gt. 0) then - call igraphivout (logfil, 1, [i], ndigit, + call igraphivout (logfil, 1, [i], ndigit, & '_napps: matrix splitting at row/column no.') - call igraphivout (logfil, 1, [jj], ndigit, + call igraphivout (logfil, 1, [jj], ndigit, & '_napps: matrix splitting with shift number.') - call igraphdvout (logfil, 1, h(i+1,i), ndigit, + call igraphdvout (logfil, 1, h(i+1,i), ndigit, & '_napps: off diagonal element.') end if iend = i @@ -351,9 +351,9 @@ subroutine igraphdnapps 40 continue c if (msglvl .gt. 2) then - call igraphivout (logfil, 1, [istart], ndigit, + call igraphivout (logfil, 1, [istart], ndigit, & '_napps: Start of current block ') - call igraphivout (logfil, 1, [iend], ndigit, + call igraphivout (logfil, 1, [iend], ndigit, & '_napps: End of current block ') end if c @@ -368,7 +368,7 @@ subroutine igraphdnapps c | complex conjugate pair of shifts on a 2 by 2 matrix. | c %------------------------------------------------------% c - if ( istart + 1 .eq. iend .and. abs( sigmai ) .gt. zero ) + if ( istart + 1 .eq. iend .and. abs( sigmai ) .gt. zero ) & go to 100 c h11 = h(istart,istart) @@ -381,11 +381,11 @@ subroutine igraphdnapps c f = h11 - sigmar g = h21 -c +c do 80 i = istart, iend-1 c c %-----------------------------------------------------% -c | Contruct the plane rotation G to zero out the bulge | +c | Construct the plane rotation G to zero out the bulge | c %-----------------------------------------------------% c call dlartg (f, g, c, s, r) @@ -413,7 +413,7 @@ subroutine igraphdnapps do 50 j = i, kplusp t = c*h(i,j) + s*h(i+1,j) h(i+1,j) = -s*h(i,j) + c*h(i+1,j) - h(i,j) = t + h(i,j) = t 50 continue c c %---------------------------------------------% @@ -423,17 +423,17 @@ subroutine igraphdnapps do 60 j = 1, min(i+2,iend) t = c*h(j,i) + s*h(j,i+1) h(j,i+1) = -s*h(j,i) + c*h(j,i+1) - h(j,i) = t + h(j,i) = t 60 continue c c %----------------------------------------------------% c | Accumulate the rotation in the matrix Q; Q <- Q*G | c %----------------------------------------------------% c - do 70 j = 1, min( j+jj, kplusp ) + do 70 j = 1, min( i+jj, kplusp ) t = c*q(j,i) + s*q(j,i+1) q(j,i+1) = - s*q(j,i) + c*q(j,i+1) - q(j,i) = t + q(j,i) = t 70 continue c c %---------------------------% @@ -449,7 +449,7 @@ subroutine igraphdnapps c %-----------------------------------% c | Finished applying the real shift. | c %-----------------------------------% -c +c else c c %----------------------------------------------------% @@ -465,9 +465,9 @@ subroutine igraphdnapps c %---------------------------------------------------------% c s = 2.0*sigmar - t = dlapy2 ( sigmar, sigmai ) + t = dlapy2 ( sigmar, sigmai ) u(1) = ( h11 * (h11 - s) + t * t ) / h21 + h12 - u(2) = h11 + h22 - s + u(2) = h11 + h22 - s u(3) = h32 c do 90 i = istart, iend-1 @@ -507,7 +507,7 @@ subroutine igraphdnapps c | Accumulate the reflector in the matrix Q; Q <- Q*G | c %-----------------------------------------------------% c - call dlarf ('Right', kplusp, nr, u, 1, tau, + call dlarf ('Right', kplusp, nr, u, 1, tau, & q(1,i), ldq, workl) c c %----------------------------% @@ -526,7 +526,7 @@ subroutine igraphdnapps c | Finished applying a complex pair of shifts | c | to the current block | c %--------------------------------------------% -c +c end if c 100 continue @@ -568,7 +568,7 @@ subroutine igraphdnapps tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) ) if( tst1.eq.zero ) & tst1 = dlanhs( '1', kev, h, ldh, workl ) - if( h( i+1,i ) .le. max( ulp*tst1, smlnum ) ) + if( h( i+1,i ) .le. max( ulp*tst1, smlnum ) ) & h(i+1,i) = zero 130 continue c @@ -581,9 +581,9 @@ subroutine igraphdnapps c %-------------------------------------------------% c if (h(kev+1,kev) .gt. zero) - & call dgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero, + & call dgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero, & workd(n+1), 1) -c +c c %----------------------------------------------------------% c | Compute column 1 to kev of (V*Q) in backward order | c | taking advantage of the upper Hessenberg structure of Q. | @@ -599,15 +599,17 @@ subroutine igraphdnapps c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). | c %-------------------------------------------------% c - call dlacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv) -c + do 150 i = 1, kev + call dcopy(n, v(1,kplusp-kev+i), 1, v(1,i), 1) + 150 continue +c c %--------------------------------------------------------------% c | Copy the (kev+1)-st column of (V*Q) in the appropriate place | c %--------------------------------------------------------------% c if (h(kev+1,kev) .gt. zero) & call dcopy (n, workd(n+1), 1, v(1,kev+1), 1) -c +c c %-------------------------------------% c | Update the residual vector: | c | r <- sigmak*r + betak*v(:,kev+1) | @@ -625,7 +627,7 @@ subroutine igraphdnapps & '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}') call igraphdvout (logfil, 1, h(kev+1,kev), ndigit, & '_napps: betak = e_{kev+1}^T*H*e_{kev}') - call igraphivout (logfil, 1, [kev], ndigit, + call igraphivout (logfil, 1, [kev], ndigit, & '_napps: Order of the final Hessenberg matrix ') if (msglvl .gt. 2) then call igraphdmout (logfil, kev, kev, h, ldh, ndigit, @@ -633,11 +635,11 @@ subroutine igraphdnapps end if c end if -c +c 9000 continue - call igraphsecond (t1) + call igrapharscnd (t1) tnapps = tnapps + (t1 - t0) -c +c return c c %---------------% diff --git a/src/vendor/arpack/dnaup2.f b/src/vendor/arpack/dnaup2.f index e060689775..6a95afb6fc 100644 --- a/src/vendor/arpack/dnaup2.f +++ b/src/vendor/arpack/dnaup2.f @@ -2,67 +2,67 @@ c c\Name: igraphdnaup2 c -c\Description: -c Intermediate level interface called by igraphdnaupd. +c\Description: +c Intermediate level interface called by igraphdnaupd . c c\Usage: c call igraphdnaup2 c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD, -c ISHIFT, MXITER, V, LDV, H, LDH, RITZR, RITZI, BOUNDS, +c ISHIFT, MXITER, V, LDV, H, LDH, RITZR, RITZI, BOUNDS, c Q, LDQ, WORKL, IPNTR, WORKD, INFO ) c c\Arguments c -c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in igraphdnaupd. -c MODE, ISHIFT, MXITER: see the definition of IPARAM in igraphdnaupd. +c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in igraphdnaupd . +c MODE, ISHIFT, MXITER: see the definition of IPARAM in igraphdnaupd . c c NP Integer. (INPUT/OUTPUT) -c Contains the number of implicit shifts to apply during -c each Arnoldi iteration. -c If ISHIFT=1, NP is adjusted dynamically at each iteration +c Contains the number of implicit shifts to apply during +c each Arnoldi iteration. +c If ISHIFT=1, NP is adjusted dynamically at each iteration c to accelerate convergence and prevent stagnation. -c This is also roughly equal to the number of matrix-vector +c This is also roughly equal to the number of matrix-vector c products (involving the operator OP) per Arnoldi iteration. c The logic for adjusting is contained within the current c subroutine. c If ISHIFT=0, NP is the number of shifts the user needs -c to provide via reverse comunication. 0 < NP < NCV-NEV. +c to provide via reverse communication. 0 < NP < NCV-NEV. c NP may be less than NCV-NEV for two reasons. The first, is -c to keep complex conjugate pairs of "wanted" Ritz values -c together. The igraphsecond, is that a leading block of the current +c to keep complex conjugate pairs of "wanted" Ritz values +c together. The second, is that a leading block of the current c upper Hessenberg matrix has split off and contains "unwanted" c Ritz values. -c Upon termination of the IRA iteration, NP contains the number +c Upon termination of the IRA iteration, NP contains the number c of "converged" wanted Ritz values. c c IUPD Integer. (INPUT) c IUPD .EQ. 0: use explicit restart instead implicit update. c IUPD .NE. 0: use implicit update. c -c V Double precision N by (NEV+NP) array. (INPUT/OUTPUT) -c The Arnoldi basis vectors are returned in the first NEV +c V Double precision N by (NEV+NP) array. (INPUT/OUTPUT) +c The Arnoldi basis vectors are returned in the first NEV c columns of V. c c LDV Integer. (INPUT) -c Leading dimension of V exactly as declared in the calling +c Leading dimension of V exactly as declared in the calling c program. c -c H Double precision (NEV+NP) by (NEV+NP) array. (OUTPUT) +c H Double precision (NEV+NP) by (NEV+NP) array. (OUTPUT) c H is used to store the generated upper Hessenberg matrix c c LDH Integer. (INPUT) -c Leading dimension of H exactly as declared in the calling +c Leading dimension of H exactly as declared in the calling c program. c -c RITZR, Double precision arrays of length NEV+NP. (OUTPUT) +c RITZR, Double precision arrays of length NEV+NP. (OUTPUT) c RITZI RITZR(1:NEV) (resp. RITZI(1:NEV)) contains the real (resp. c imaginary) part of the computed Ritz values of OP. c -c BOUNDS Double precision array of length NEV+NP. (OUTPUT) -c BOUNDS(1:NEV) contain the error bounds corresponding to +c BOUNDS Double precision array of length NEV+NP. (OUTPUT) +c BOUNDS(1:NEV) contain the error bounds corresponding to c the computed Ritz values. -c -c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE) +c +c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE) c Private (replicated) work array used to accumulate the c rotation in the shift application step. c @@ -70,7 +70,7 @@ c Leading dimension of Q exactly as declared in the calling c program. c -c WORKL Double precision work array of length at least +c WORKL Double precision work array of length at least c (NEV+NP)**2 + 3*(NEV+NP). (INPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. It is used in shifts calculation, shifts @@ -79,27 +79,27 @@ c On exit, the last 3*(NEV+NP) locations of WORKL contain c the Ritz values (real,imaginary) and associated Ritz c estimates of the current Hessenberg matrix. They are -c listed in the same order as returned from igraphdneigh. +c listed in the same order as returned from igraphdneigh . c c If ISHIFT .EQ. O and IDO .EQ. 3, the first 2*NP locations -c of WORKL are used in reverse communication to hold the user +c of WORKL are used in reverse communication to hold the user c supplied shifts. c c IPNTR Integer array of length 3. (OUTPUT) -c Pointer to mark the starting locations in the WORKD for +c Pointer to mark the starting locations in the WORKD for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. -c IPNTR(3): pointer to the vector B * X when used in the +c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- -c -c WORKD Double precision work array of length 3*N. (WORKSPACE) +c +c WORKD Double precision work array of length 3*N. (WORKSPACE) c Distributed array to be used in the basic Arnoldi iteration c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration !!!!!!!!!! -c See Data Distribution Note in DNAUPD. +c See Data Distribution Note in IGRAPHDNAUPD. c c INFO Integer. (INPUT/OUTPUT) c If INFO .EQ. 0, a randomly initial residual vector is used. @@ -108,7 +108,7 @@ c Error flag on output. c = 0: Normal return. c = 1: Maximum number of iterations taken. -c All possible eigenvalues of OP has been found. +c All possible eigenvalues of OP has been found. c NP returns the number of converged Ritz values. c = 2: No shifts could be applied. c = -8: Error return from LAPACK eigenvalue calculation; @@ -130,39 +130,39 @@ c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. -c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly +c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: -c igraphdgetv0 ARPACK initial vector generation routine. -c igraphdnaitr ARPACK Arnoldi factorization routine. -c igraphdnapps ARPACK application of implicit shifts routine. -c igraphdnconv ARPACK convergence of Ritz values routine. -c igraphdneigh ARPACK compute Ritz values and error bounds routine. -c igraphdngets ARPACK reorder Ritz values and error bounds routine. -c igraphdsortc ARPACK sorting routine. +c igraphdgetv0 ARPACK initial vector generation routine. +c igraphdnaitr ARPACK Arnoldi factorization routine. +c igraphdnapps ARPACK application of implicit shifts routine. +c igraphdnconv ARPACK convergence of Ritz values routine. +c igraphdneigh ARPACK compute Ritz values and error bounds routine. +c igraphdngets ARPACK reorder Ritz values and error bounds routine. +c igraphdsortc ARPACK sorting routine. c igraphivout ARPACK utility routine that prints integers. -c igraphsecond ARPACK utility routine for timing. -c igraphdmout ARPACK utility routine that prints matrices -c igraphdvout ARPACK utility routine that prints vectors. -c dlamch LAPACK routine that determines machine constants. -c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. -c dcopy Level 1 BLAS that copies one vector to another . -c ddot Level 1 BLAS that computes the scalar product of two vectors. -c dnrm2 Level 1 BLAS that computes the norm of a vector. -c dswap Level 1 BLAS that swaps two vectors. +c igrapharscnd ARPACK utility routine for timing. +c igraphdmout ARPACK utility routine that prints matrices +c igraphdvout ARPACK utility routine that prints vectors. +c dlamch LAPACK routine that determines machine constants. +c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. +c dcopy Level 1 BLAS that copies one vector to another . +c ddot Level 1 BLAS that computes the scalar product of two vectors. +c dnrm2 Level 1 BLAS that computes the norm of a vector. +c dswap Level 1 BLAS that swaps two vectors. c c\Author c Danny Sorensen Phuong Vu -c Richard Lehoucq CRPC / Rice University -c Dept. of Computational & Houston, Texas +c Richard Lehoucq CRPC / Rice University +c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas -c -c\SCCS Information: @(#) -c FILE: naup2.F SID: 2.4 DATE OF SID: 7/30/96 RELEASE: 2 +c Rice University +c Houston, Texas +c +c\SCCS Information: @(#) +c FILE: naup2.F SID: 2.8 DATE OF SID: 10/17/00 RELEASE: 2 c c\Remarks c 1. None @@ -172,8 +172,8 @@ c----------------------------------------------------------------------- c subroutine igraphdnaup2 - & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd, - & ishift, mxiter, v, ldv, h, ldh, ritzr, ritzi, bounds, + & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd, + & ishift, mxiter, v, ldv, h, ldh, ritzr, ritzi, bounds, & q, ldq, workl, ipntr, workd, info ) c c %----------------------------------------------------% @@ -200,7 +200,7 @@ subroutine igraphdnaup2 integer ipntr(13) Double precision & bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), resid(n), - & ritzi(nev+np), ritzr(nev+np), v(ldv,nev+np), + & ritzi(nev+np), ritzr(nev+np), v(ldv,nev+np), & workd(3*n), workl( (nev+np)*(nev+np+3) ) c c %------------% @@ -209,41 +209,43 @@ subroutine igraphdnaup2 c Double precision & one, zero - parameter (one = 1.0D+0, zero = 0.0D+0) + parameter (one = 1.0D+0 , zero = 0.0D+0 ) c c %---------------% c | Local Scalars | c %---------------% c character wprime*2 - logical cnorm, getv0, initv, update, ushift - integer ierr, iter, j, kplusp, msglvl, nconv, nevbef, nev0, - & np0, nptemp, numcnv + logical cnorm , getv0, initv, update, ushift + integer ierr , iter , j , kplusp, msglvl, nconv, + & nevbef, nev0 , np0 , nptemp, numcnv Double precision - & rnorm, temp, eps23 + & rnorm , temp , eps23 + save cnorm , getv0, initv, update, ushift, + & rnorm , iter , eps23, kplusp, msglvl, nconv , + & nevbef, nev0 , np0 , numcnv c c %-----------------------% c | Local array arguments | c %-----------------------% c integer kp(4) - save c c %----------------------% c | External Subroutines | c %----------------------% c - external dcopy, igraphdgetv0, igraphdnaitr, igraphdnconv, - & igraphdneigh, igraphdngets, igraphdnapps, - & igraphdvout, igraphivout, igraphsecond + external dcopy , igraphdgetv0 , igraphdnaitr , igraphdnconv , + & igraphdneigh , igraphdngets , igraphdnapps , + & igraphdvout , igraphivout , igrapharscnd c c %--------------------% c | External Functions | c %--------------------% c Double precision - & ddot, dnrm2, dlapy2, dlamch - external ddot, dnrm2, dlapy2, dlamch + & ddot , dnrm2 , dlapy2 , dlamch + external ddot , dnrm2 , dlapy2 , dlamch c c %---------------------% c | Intrinsic Functions | @@ -256,17 +258,17 @@ subroutine igraphdnaup2 c %-----------------------% c if (ido .eq. 0) then -c - call igraphsecond (t0) -c +c + call igrapharscnd (t0) +c msglvl = mnaup2 -c +c c %-------------------------------------% c | Get the machine dependent constant. | c %-------------------------------------% c - eps23 = dlamch('Epsilon-Machine') - eps23 = eps23**(2.0D+0 / 3.0D+0) + eps23 = dlamch ('Epsilon-Machine') + eps23 = eps23**(2.0D+0 / 3.0D+0 ) c nev0 = nev np0 = np @@ -283,7 +285,7 @@ subroutine igraphdnaup2 kplusp = nev + np nconv = 0 iter = 0 -c +c c %---------------------------------------% c | Set flags for computing the first NEV | c | steps of the Arnoldi factorization. | @@ -306,7 +308,7 @@ subroutine igraphdnaup2 initv = .false. end if end if -c +c c %---------------------------------------------% c | Get a possibly random starting vector and | c | force it into the range of the operator OP. | @@ -315,15 +317,15 @@ subroutine igraphdnaup2 10 continue c if (getv0) then - call igraphdgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, - & rnorm, ipntr, workd, info) + call igraphdgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, + & rnorm, ipntr, workd, info) c if (ido .ne. 99) go to 9000 c if (rnorm .eq. zero) then c c %-----------------------------------------% -c | The initial vector is zero. Error exit. | +c | The initial vector is zero. Error exit. | c %-----------------------------------------% c info = -9 @@ -332,7 +334,7 @@ subroutine igraphdnaup2 getv0 = .false. ido = 0 end if -c +c c %-----------------------------------% c | Back from reverse communication : | c | continue with update step | @@ -352,14 +354,14 @@ subroutine igraphdnaup2 c %-------------------------------------% c if (cnorm) go to 100 -c +c c %----------------------------------------------------------% c | Compute the first NEV steps of the Arnoldi factorization | c %----------------------------------------------------------% c - call igraphdnaitr (ido, bmat, n, 0, nev, mode, resid, rnorm, v, - & ldv, h, ldh, ipntr, workd, info) -c + call igraphdnaitr (ido, bmat, n, 0, nev, mode, resid, rnorm, v, + & ldv, h, ldh, ipntr, workd, info) +c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | @@ -373,7 +375,7 @@ subroutine igraphdnaup2 info = -9999 go to 1200 end if -c +c c %--------------------------------------------------------------% c | | c | M A I N ARNOLDI I T E R A T I O N L O O P | @@ -381,28 +383,28 @@ subroutine igraphdnaup2 c | factorization in place. | c | | c %--------------------------------------------------------------% -c +c 1000 continue c iter = iter + 1 c if (msglvl .gt. 0) then - call igraphivout (logfil, 1, [iter], ndigit, + call igraphivout (logfil, 1, [iter], ndigit, & '_naup2: **** Start of major iteration number ****') end if -c +c c %-----------------------------------------------------------% c | Compute NP additional steps of the Arnoldi factorization. | c | Adjust NP since NEV might have been updated by last call | -c | to the shift application routine igraphdnapps. | +c | to the shift application routine igraphdnapps . | c %-----------------------------------------------------------% c np = kplusp - nev c if (msglvl .gt. 1) then - call igraphivout (logfil, 1, [nev], ndigit, + call igraphivout (logfil, 1, [nev], ndigit, & '_naup2: The length of the current Arnoldi factorization') - call igraphivout (logfil, 1, [np], ndigit, + call igraphivout (logfil, 1, [np], ndigit, & '_naup2: Extend the Arnoldi factorization by') end if c @@ -414,9 +416,10 @@ subroutine igraphdnaup2 20 continue update = .true. c - call igraphdnaitr (ido, bmat, n, nev, np, mode, resid, rnorm, - & v, ldv, h, ldh, ipntr, workd, info) -c + call igraphdnaitr (ido , bmat, n , nev, np , mode , resid, + & rnorm, v , ldv, h , ldh, ipntr, workd, + & info) +c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | @@ -433,17 +436,17 @@ subroutine igraphdnaup2 update = .false. c if (msglvl .gt. 1) then - call igraphdvout (logfil, 1, [rnorm], ndigit, + call igraphdvout (logfil, 1, [rnorm], ndigit, & '_naup2: Corresponding B-norm of the residual') end if -c +c c %--------------------------------------------------------% c | Compute the eigenvalues and corresponding error bounds | c | of the current upper Hessenberg matrix. | c %--------------------------------------------------------% c - call igraphdneigh (rnorm, kplusp, h, ldh, ritzr, ritzi, bounds, - & q, ldq, workl, ierr) + call igraphdneigh (rnorm, kplusp, h, ldh, ritzr, ritzi, + & bounds, q, ldq, workl, ierr) c if (ierr .ne. 0) then info = -8 @@ -452,12 +455,12 @@ subroutine igraphdnaup2 c c %----------------------------------------------------% c | Make a copy of eigenvalues and corresponding error | -c | bounds obtained from igraphdneigh. | +c | bounds obtained from igraphdneigh . | c %----------------------------------------------------% c - call dcopy(kplusp, ritzr, 1, workl(kplusp**2+1), 1) - call dcopy(kplusp, ritzi, 1, workl(kplusp**2+kplusp+1), 1) - call dcopy(kplusp, bounds, 1, workl(kplusp**2+2*kplusp+1), 1) + call dcopy (kplusp, ritzr, 1, workl(kplusp**2+1), 1) + call dcopy (kplusp, ritzi, 1, workl(kplusp**2+kplusp+1), 1) + call dcopy (kplusp, bounds, 1, workl(kplusp**2+2*kplusp+1), 1) c c %---------------------------------------------------% c | Select the wanted Ritz values and their bounds | @@ -468,37 +471,37 @@ subroutine igraphdnaup2 c | and NP may be updated if the NEV-th wanted Ritz | c | value has a non zero imaginary part. In this case | c | NEV is increased by one and NP decreased by one. | -c | NOTE: The last two arguments of igraphdngets are no | +c | NOTE: The last two arguments of igraphdngets are no | c | longer used as of version 2.1. | c %---------------------------------------------------% c nev = nev0 np = np0 numcnv = nev - call igraphdngets (ishift, which, nev, np, ritzr, ritzi, + call igraphdngets (ishift, which, nev, np, ritzr, ritzi, & bounds, workl, workl(np+1)) if (nev .eq. nev0+1) numcnv = nev0+1 -c +c c %-------------------% -c | Convergence test. | +c | Convergence test. | c %-------------------% c - call dcopy (nev, bounds(np+1), 1, workl(2*np+1), 1) - call igraphdnconv (nev, ritzr(np+1), ritzi(np+1), + call dcopy (nev, bounds(np+1), 1, workl(2*np+1), 1) + call igraphdnconv (nev, ritzr(np+1), ritzi(np+1), & workl(2*np+1), tol, nconv) -c +c if (msglvl .gt. 2) then kp(1) = nev kp(2) = np kp(3) = numcnv kp(4) = nconv - call igraphivout (logfil, 4, kp, ndigit, + call igraphivout (logfil, 4, kp, ndigit, & '_naup2: NEV, NP, NUMCNV, NCONV are') - call igraphdvout (logfil, kplusp, ritzr, ndigit, + call igraphdvout (logfil, kplusp, ritzr, ndigit, & '_naup2: Real part of the eigenvalues of H') - call igraphdvout (logfil, kplusp, ritzi, ndigit, + call igraphdvout (logfil, kplusp, ritzi, ndigit, & '_naup2: Imaginary part of the eigenvalues of H') - call igraphdvout (logfil, kplusp, bounds, ndigit, + call igraphdvout (logfil, kplusp, bounds, ndigit, & '_naup2: Ritz estimates of the current NCV Ritz values') end if c @@ -519,23 +522,23 @@ subroutine igraphdnaup2 nev = nev + 1 end if 30 continue -c - if ( (nconv .ge. numcnv) .or. +c + if ( (nconv .ge. numcnv) .or. & (iter .gt. mxiter) .or. & (np .eq. 0) ) then c if (msglvl .gt. 4) then - call igraphdvout(logfil, kplusp, workl(kplusp**2+1), - & ndigit, + call igraphdvout (logfil, kplusp, workl(kplusp**2+1), + & ndigit, & '_naup2: Real part of the eig computed by _neigh:') - call igraphdvout(logfil, kplusp, - & workl(kplusp**2+kplusp+1), ndigit, + call igraphdvout (logfil, kplusp, + & workl(kplusp**2+kplusp+1), ndigit, & '_naup2: Imag part of the eig computed by _neigh:') - call igraphdvout(logfil, kplusp, - & workl(kplusp**2+kplusp*2+1), ndigit, + call igraphdvout (logfil, kplusp, + & workl(kplusp**2+kplusp*2+1), ndigit, & '_naup2: Ritz eistmates computed by _neigh:') end if -c +c c %------------------------------------------------% c | Prepare to exit. Put the converged Ritz values | c | and corresponding bounds in RITZ(1:NCONV) and | @@ -551,10 +554,10 @@ subroutine igraphdnaup2 h(3,1) = rnorm c c %----------------------------------------------% -c | To be consistent with igraphdngets, we first do a | +c | To be consistent with igraphdngets , we first do a | c | pre-processing sort in order to keep complex | c | conjugate pairs together. This is similar | -c | to the pre-processing sort used in igraphdngets | +c | to the pre-processing sort used in igraphdngets | c | except that the sort is done in the opposite | c | order. | c %----------------------------------------------% @@ -566,7 +569,7 @@ subroutine igraphdnaup2 if (which .eq. 'LI') wprime = 'SM' if (which .eq. 'SI') wprime = 'LM' c - call igraphdsortc (wprime, .true., kplusp, ritzr, ritzi, + call igraphdsortc (wprime, .true., kplusp, ritzr, ritzi, & bounds) c c %----------------------------------------------% @@ -583,7 +586,7 @@ subroutine igraphdnaup2 if (which .eq. 'LI') wprime = 'SI' if (which .eq. 'SI') wprime = 'LI' c - call igraphdsortc(wprime, .true., kplusp, ritzr, ritzi, + call igraphdsortc (wprime, .true., kplusp, ritzr, ritzi, & bounds) c c %--------------------------------------------------% @@ -591,21 +594,21 @@ subroutine igraphdnaup2 c | by 1 / max(eps23,magnitude of the Ritz value). | c %--------------------------------------------------% c - do 35 j = 1, nev0 - temp = max(eps23,dlapy2(ritzr(j), + do 35 j = 1, numcnv + temp = max(eps23,dlapy2 (ritzr(j), & ritzi(j))) bounds(j) = bounds(j)/temp 35 continue c c %----------------------------------------------------% c | Sort the Ritz values according to the scaled Ritz | -c | esitmates. This will push all the converged ones | +c | estimates. This will push all the converged ones | c | towards the front of ritzr, ritzi, bounds | c | (in the case when NCONV < NEV.) | c %----------------------------------------------------% c wprime = 'LR' - call igraphdsortc(wprime, .true., nev0, bounds, ritzr, + call igraphdsortc (wprime, .true., numcnv, bounds, ritzr, & ritzi) c c %----------------------------------------------% @@ -613,8 +616,8 @@ subroutine igraphdnaup2 c | value. | c %----------------------------------------------% c - do 40 j = 1, nev0 - temp = max(eps23, dlapy2(ritzr(j), + do 40 j = 1, numcnv + temp = max(eps23, dlapy2 (ritzr(j), & ritzi(j))) bounds(j) = bounds(j)*temp 40 continue @@ -625,26 +628,26 @@ subroutine igraphdnaup2 c | ritzr, ritzi and bound. | c %------------------------------------------------% c - call igraphdsortc(which, .true., nconv, ritzr, ritzi, + call igraphdsortc (which, .true., nconv, ritzr, ritzi, & bounds) c if (msglvl .gt. 1) then - call igraphdvout (logfil, kplusp, ritzr, ndigit, + call igraphdvout (logfil, kplusp, ritzr, ndigit, & '_naup2: Sorted real part of the eigenvalues') - call igraphdvout (logfil, kplusp, ritzi, ndigit, + call igraphdvout (logfil, kplusp, ritzi, ndigit, & '_naup2: Sorted imaginary part of the eigenvalues') - call igraphdvout (logfil, kplusp, bounds, ndigit, + call igraphdvout (logfil, kplusp, bounds, ndigit, & '_naup2: Sorted ritz estimates.') end if c c %------------------------------------% -c | Max iterations have been exceeded. | +c | Max iterations have been exceeded. | c %------------------------------------% c if (iter .gt. mxiter .and. nconv .lt. numcnv) info = 1 c c %---------------------% -c | No shifts to apply. | +c | No shifts to apply. | c %---------------------% c if (np .eq. 0 .and. nconv .lt. numcnv) info = 2 @@ -653,7 +656,7 @@ subroutine igraphdnaup2 go to 1100 c else if ( (nconv .lt. numcnv) .and. (ishift .eq. 1) ) then -c +c c %-------------------------------------------------% c | Do not have all the requested eigenvalues yet. | c | To prevent possible stagnation, adjust the size | @@ -667,32 +670,43 @@ subroutine igraphdnaup2 else if (nev .eq. 1 .and. kplusp .gt. 3) then nev = 2 end if +c %---- Scipy fix ------------------------------------------------ +c | We must keep nev below this value, as otherwise we can get +c | np == 0 (note that igraphdngets below can bump nev by 1). If np == 0, +c | the next call to `igraphdnaitr` will write out-of-bounds. +c | + if (nev .gt. kplusp - 2) then + nev = kplusp - 2 + end if +c | +c %---- Scipy fix end -------------------------------------------- +c np = kplusp - nev -c +c c %---------------------------------------% c | If the size of NEV was just increased | c | resort the eigenvalues. | c %---------------------------------------% -c - if (nevbef .lt. nev) - & call igraphdngets (ishift, which, nev, np, ritzr, ritzi, +c + if (nevbef .lt. nev) + & call igraphdngets (ishift, which, nev, np, ritzr, ritzi, & bounds, workl, workl(np+1)) c - end if -c + end if +c if (msglvl .gt. 0) then - call igraphivout (logfil, 1, [nconv], ndigit, + call igraphivout (logfil, 1, [nconv], ndigit, & '_naup2: no. of "converged" Ritz values at this iter.') if (msglvl .gt. 1) then kp(1) = nev kp(2) = np - call igraphivout (logfil, 2, kp, ndigit, + call igraphivout (logfil, 2, kp, ndigit, & '_naup2: NEV and NP are') - call igraphdvout (logfil, nev, ritzr(np+1), ndigit, + call igraphdvout (logfil, nev, ritzr(np+1), ndigit, & '_naup2: "wanted" Ritz values -- real part') - call igraphdvout (logfil, nev, ritzi(np+1), ndigit, + call igraphdvout (logfil, nev, ritzi(np+1), ndigit, & '_naup2: "wanted" Ritz values -- imag part') - call igraphdvout (logfil, nev, bounds(np+1), ndigit, + call igraphdvout (logfil, nev, bounds(np+1), ndigit, & '_naup2: Ritz estimates of the "wanted" values ') end if end if @@ -700,7 +714,7 @@ subroutine igraphdnaup2 if (ishift .eq. 0) then c c %-------------------------------------------------------% -c | User specified shifts: reverse comminucation to | +c | User specified shifts: reverse communication to | c | compute the shifts. They are returned in the first | c | 2*NP locations of WORKL. | c %-------------------------------------------------------% @@ -709,7 +723,7 @@ subroutine igraphdnaup2 ido = 3 go to 9000 end if -c +c 50 continue c c %------------------------------------% @@ -721,26 +735,26 @@ subroutine igraphdnaup2 ushift = .false. c if ( ishift .eq. 0 ) then -c +c c %----------------------------------% c | Move the NP shifts from WORKL to | c | RITZR, RITZI to free up WORKL | c | for non-exact shift case. | c %----------------------------------% c - call dcopy (np, workl, 1, ritzr, 1) - call dcopy (np, workl(np+1), 1, ritzi, 1) + call dcopy (np, workl, 1, ritzr, 1) + call dcopy (np, workl(np+1), 1, ritzi, 1) end if c - if (msglvl .gt. 2) then - call igraphivout (logfil, 1, [np], ndigit, + if (msglvl .gt. 2) then + call igraphivout (logfil, 1, [np], ndigit, & '_naup2: The number of shifts to apply ') - call igraphdvout (logfil, np, ritzr, ndigit, + call igraphdvout (logfil, np, ritzr, ndigit, & '_naup2: Real part of the shifts') - call igraphdvout (logfil, np, ritzi, ndigit, + call igraphdvout (logfil, np, ritzi, ndigit, & '_naup2: Imaginary part of the shifts') - if ( ishift .eq. 1 ) - & call igraphdvout (logfil, np, bounds, ndigit, + if ( ishift .eq. 1 ) + & call igraphdvout (logfil, np, bounds, ndigit, & '_naup2: Ritz estimates of the shifts') end if c @@ -751,60 +765,60 @@ subroutine igraphdnaup2 c | The first 2*N locations of WORKD are used as workspace. | c %---------------------------------------------------------% c - call igraphdnapps (n, nev, np, ritzr, ritzi, v, ldv, + call igraphdnapps (n, nev, np, ritzr, ritzi, v, ldv, & h, ldh, resid, q, ldq, workl, workd) c c %---------------------------------------------% c | Compute the B-norm of the updated residual. | c | Keep B*RESID in WORKD(1:N) to be used in | -c | the first step of the next call to igraphdnaitr. | +c | the first step of the next call to igraphdnaitr . | c %---------------------------------------------% c cnorm = .true. - call igraphsecond (t2) + call igrapharscnd (t2) if (bmat .eq. 'G') then nbx = nbx + 1 - call dcopy (n, resid, 1, workd(n+1), 1) + call dcopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 -c +c c %----------------------------------% c | Exit in order to compute B*RESID | c %----------------------------------% -c +c go to 9000 else if (bmat .eq. 'I') then - call dcopy (n, resid, 1, workd, 1) + call dcopy (n, resid, 1, workd, 1) end if -c +c 100 continue -c +c c %----------------------------------% c | Back from reverse communication; | c | WORKD(1:N) := B*RESID | c %----------------------------------% c if (bmat .eq. 'G') then - call igraphsecond (t3) + call igrapharscnd (t3) tmvbx = tmvbx + (t3 - t2) end if -c - if (bmat .eq. 'G') then - rnorm = ddot (n, resid, 1, workd, 1) +c + if (bmat .eq. 'G') then + rnorm = ddot (n, resid, 1, workd, 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then - rnorm = dnrm2(n, resid, 1) + rnorm = dnrm2 (n, resid, 1) end if cnorm = .false. c if (msglvl .gt. 2) then - call igraphdvout (logfil, 1, [rnorm], ndigit, + call igraphdvout (logfil, 1, [rnorm], ndigit, & '_naup2: B-norm of residual for compressed factorization') - call igraphdmout (logfil, nev, nev, h, ldh, ndigit, + call igraphdmout (logfil, nev, nev, h, ldh, ndigit, & '_naup2: Compressed upper Hessenberg matrix H') end if -c +c go to 1000 c c %---------------------------------------------------------------% @@ -817,7 +831,7 @@ subroutine igraphdnaup2 c mxiter = iter nev = numcnv -c +c 1200 continue ido = 99 c @@ -825,13 +839,13 @@ subroutine igraphdnaup2 c | Error Exit | c %------------% c - call igraphsecond (t1) + call igrapharscnd (t1) tnaup2 = t1 - t0 -c +c 9000 continue c c %---------------% -c | End of igraphdnaup2 | +c | End of igraphdnaup2 | c %---------------% c return diff --git a/src/vendor/arpack/dnaupd.f b/src/vendor/arpack/dnaupd.f index 4133022b2c..86aab0fee7 100644 --- a/src/vendor/arpack/dnaupd.f +++ b/src/vendor/arpack/dnaupd.f @@ -2,19 +2,19 @@ c c\Name: igraphdnaupd c -c\Description: +c\Description: c Reverse communication interface for the Implicitly Restarted Arnoldi -c iteration. This subroutine computes approximations to a few eigenpairs -c of a linear operator "OP" with respect to a semi-inner product defined by -c a symmetric positive semi-definite real matrix B. B may be the identity -c matrix. NOTE: If the linear operator "OP" is real and symmetric -c with respect to the real positive semi-definite symmetric matrix B, -c i.e. B*OP = (OP')*B, then subroutine ssaupd should be used instead. +c iteration. This subroutine computes approximations to a few eigenpairs +c of a linear operator "OP" with respect to a semi-inner product defined by +c a symmetric positive semi-definite real matrix B. B may be the identity +c matrix. NOTE: If the linear operator "OP" is real and symmetric +c with respect to the real positive semi-definite symmetric matrix B, +c i.e. B*OP = (OP`)*B, then subroutine igraphdsaupd should be used instead. c c The computed approximate eigenvalues are called Ritz values and c the corresponding approximate eigenvectors are called Ritz vectors. c -c igraphdnaupd is usually called iteratively to solve one of the +c igraphdnaupd is usually called iteratively to solve one of the c following problems: c c Mode 1: A*x = lambda*x. @@ -25,18 +25,18 @@ c ===> (If M can be factored see remark 3 below) c c Mode 3: A*x = lambda*M*x, M symmetric semi-definite -c ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M. +c ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M. c ===> shift-and-invert mode (in real arithmetic) -c If OP*x = amu*x, then +c If OP*x = amu*x, then c amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ]. c Note: If sigma is real, i.e. imaginary part of sigma is zero; -c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M -c amu == 1/(lambda-sigma). -c +c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M +c amu == 1/(lambda-sigma). +c c Mode 4: A*x = lambda*M*x, M symmetric semi-definite -c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M. +c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M. c ===> shift-and-invert mode (in real arithmetic) -c If OP*x = amu*x, then +c If OP*x = amu*x, then c amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ]. c c Both mode 3 and 4 give the same enhancement to eigenvalues close to @@ -63,12 +63,12 @@ c c\Arguments c IDO Integer. (INPUT/OUTPUT) -c Reverse communication flag. IDO must be zero on the first -c call to igraphdnaupd. IDO will be set internally to +c Reverse communication flag. IDO must be zero on the first +c call to igraphdnaupd . IDO will be set internally to c indicate the type of operation to be performed. Control is c then given back to the calling routine which has the c responsibility to carry out the requested operation and call -c igraphdnaupd with the result. The operand is given in +c igraphdnaupd with the result. The operand is given in c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). c ------------------------------------------------------------- c IDO = 0: first call to the reverse communication interface @@ -86,13 +86,13 @@ c IDO = 2: compute Y = B * X where c IPNTR(1) is the pointer into WORKD for X, c IPNTR(2) is the pointer into WORKD for Y. -c IDO = 3: compute the IPARAM(8) real and imaginary parts +c IDO = 3: compute the IPARAM(8) real and imaginary parts c of the shifts where INPTR(14) is the pointer c into WORKL for placing the shifts. See Remark c 5 below. c IDO = 99: done c ------------------------------------------------------------- -c +c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. @@ -113,15 +113,15 @@ c NEV Integer. (INPUT) c Number of eigenvalues of OP to be computed. 0 < NEV < N-1. c -c TOL Double precision scalar. (INPUT) -c Stopping criterion: the relative accuracy of the Ritz value +c TOL Double precision scalar. (INPUT/OUTPUT) +c Stopping criterion: the relative accuracy of the Ritz value c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)) c where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex. -c DEFAULT = DLAMCH('EPS') (machine precision as computed -c by the LAPACK auxiliary subroutine DLAMCH). +c DEFAULT = DLAMCH ('EPS') (machine precision as computed +c by the LAPACK auxiliary subroutine DLAMCH ). c -c RESID Double precision array of length N. (INPUT/OUTPUT) -c On INPUT: +c RESID Double precision array of length N. (INPUT/OUTPUT) +c On INPUT: c If INFO .EQ. 0, a random initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. @@ -131,17 +131,17 @@ c NCV Integer. (INPUT) c Number of columns of the matrix V. NCV must satisfy the two c inequalities 2 <= NCV-NEV and NCV <= N. -c This will indicate how many Arnoldi vectors are generated -c at each iteration. After the startup phase in which NEV -c Arnoldi vectors are generated, the algorithm generates -c approximately NCV-NEV Arnoldi vectors at each subsequent update -c iteration. Most of the cost in generating each Arnoldi vector is -c in the matrix-vector operation OP*x. -c NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz +c This will indicate how many Arnoldi vectors are generated +c at each iteration. After the startup phase in which NEV +c Arnoldi vectors are generated, the algorithm generates +c approximately NCV-NEV Arnoldi vectors at each subsequent update +c iteration. Most of the cost in generating each Arnoldi vector is +c in the matrix-vector operation OP*x. +c NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz c values are kept together. (See remark 4 below) c -c V Double precision array N by NCV. (OUTPUT) -c Contains the final set of Arnoldi basis vectors. +c V Double precision array N by NCV. (OUTPUT) +c Contains the final set of Arnoldi basis vectors. c c LDV Integer. (INPUT) c Leading dimension of V exactly as declared in the calling program. @@ -154,11 +154,11 @@ c ISHIFT = 0: the shifts are provided by the user via c reverse communication. The real and imaginary c parts of the NCV eigenvalues of the Hessenberg -c matrix H are returned in the part of the WORKL -c array corresponding to RITZR and RITZI. See remark +c matrix H are returned in the part of the WORKL +c array corresponding to RITZR and RITZI. See remark c 5 below. c ISHIFT = 1: exact shifts with respect to the current -c Hessenberg matrix H. This is equivalent to +c Hessenberg matrix H. This is equivalent to c restarting the iteration with a starting vector c that is a linear combination of approximate Schur c vectors associated with the "wanted" Ritz values. @@ -167,8 +167,8 @@ c IPARAM(2) = No longer referenced. c c IPARAM(3) = MXITER -c On INPUT: maximum number of Arnoldi update iterations allowed. -c On OUTPUT: actual number of Arnoldi update iterations taken. +c On INPUT: maximum number of Arnoldi update iterations allowed. +c On OUTPUT: actual number of Arnoldi update iterations taken. c c IPARAM(4) = NB: blocksize to be used in the recurrence. c The code currently works only for NB = 1. @@ -178,23 +178,23 @@ c the convergence criterion. c c IPARAM(6) = IUPD -c No longer referenced. Implicit restarting is ALWAYS used. +c No longer referenced. Implicit restarting is ALWAYS used. c c IPARAM(7) = MODE c On INPUT determines what type of eigenproblem is being solved. -c Must be 1,2,3,4; See under \Description of igraphdnaupd for the +c Must be 1,2,3,4; See under \Description of igraphdnaupd for the c four modes available. c c IPARAM(8) = NP c When ido = 3 and the user provides shifts through reverse -c communication (IPARAM(1)=0), igraphdnaupd returns NP, the number +c communication (IPARAM(1)=0), igraphdnaupd returns NP, the number c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark c 5 below. c c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO, c OUTPUT: NUMOP = total number of OP*x operations, c NUMOPB = total number of B*x operations if BMAT='G', -c NUMREO = total number of steps of re-orthogonalization. +c NUMREO = total number of steps of re-orthogonalization. c c IPNTR Integer array of length 14. (OUTPUT) c Pointer to mark the starting locations in the WORKD and WORKL @@ -202,13 +202,13 @@ c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X in WORKD. c IPNTR(2): pointer to the current result vector Y in WORKD. -c IPNTR(3): pointer to the vector B * X in WORKD when used in +c IPNTR(3): pointer to the vector B * X in WORKD when used in c the shift-and-invert mode. c IPNTR(4): pointer to the next available location in WORKL c that is untouched by the program. c IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix c H in WORKL. -c IPNTR(6): pointer to the real part of the ritz value array +c IPNTR(6): pointer to the real part of the ritz value array c RITZR in WORKL. c IPNTR(7): pointer to the imaginary part of the ritz value array c RITZI in WORKL. @@ -217,30 +217,30 @@ c c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below. c -c Note: IPNTR(9:13) is only referenced by igraphdneupd. See Remark 2 below. +c Note: IPNTR(9:13) is only referenced by igraphdneupd . See Remark 2 below. c -c IPNTR(9): pointer to the real part of the NCV RITZ values of the +c IPNTR(9): pointer to the real part of the NCV RITZ values of the c original system. -c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of +c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of c the original system. c IPNTR(11): pointer to the NCV corresponding error bounds. c IPNTR(12): pointer to the NCV by NCV upper quasi-triangular c Schur matrix for H. c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors c of the upper Hessenberg matrix H. Only referenced by -c igraphdneupd if RVEC = .TRUE. See Remark 2 below. +c igraphdneupd if RVEC = .TRUE. See Remark 2 below. c ------------------------------------------------------------- -c -c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) +c +c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration -c for reverse communication. The user should not use WORKD +c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration. Upon termination c WORKD(1:N) contains B*RESID(1:N). If an invariant subspace c associated with the converged Ritz values is desired, see remark -c 2 below, subroutine igraphdneupd uses this output. -c See Data Distribution Note below. +c 2 below, subroutine igraphdneupd uses this output. +c See Data Distribution Note below. c -c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) +c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. See Data Distribution Note below. c @@ -254,18 +254,18 @@ c Error flag on output. c = 0: Normal exit. c = 1: Maximum number of iterations taken. -c All possible eigenvalues of OP has been found. IPARAM(5) +c All possible eigenvalues of OP has been found. IPARAM(5) c returns the number of wanted converged Ritz values. c = 2: No longer an informational error. Deprecated starting c with release 2 of ARPACK. -c = 3: No shifts could be applied during a cycle of the -c Implicitly restarted Arnoldi iteration. One possibility -c is to increase the size of NCV relative to NEV. +c = 3: No shifts could be applied during a cycle of the +c Implicitly restarted Arnoldi iteration. One possibility +c is to increase the size of NCV relative to NEV. c See remark 4 below. c = -1: N must be positive. c = -2: NEV must be positive. c = -3: NCV-NEV >= 2 and less than or equal to N. -c = -4: The maximum number of Arnoldi update iteration +c = -4: The maximum number of Arnoldi update iteration c must be greater than zero. c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' c = -6: BMAT must be one of 'I' or 'G'. @@ -273,7 +273,7 @@ c = -8: Error return from LAPACK eigenvalue calculation; c = -9: Starting vector is zero. c = -10: IPARAM(7) must be 1,2,3,4. -c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable. +c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. c = -12: IPARAM(1) must be equal to 0 or 1. c = -9999: Could not build an Arnoldi factorization. c IPARAM(5) returns the size of the current Arnoldi @@ -283,33 +283,33 @@ c 1. The computed Ritz values are approximate eigenvalues of OP. The c selection of WHICH should be made with this in mind when c Mode = 3 and 4. After convergence, approximate eigenvalues of the -c original problem may be obtained with the ARPACK subroutine igraphdneupd. +c original problem may be obtained with the ARPACK subroutine igraphdneupd . c -c 2. If a basis for the invariant subspace corresponding to the converged Ritz -c values is needed, the user must call igraphdneupd immediately following -c completion of igraphdnaupd. This is new starting with release 2 of ARPACK. +c 2. If a basis for the invariant subspace corresponding to the converged Ritz +c values is needed, the user must call igraphdneupd immediately following +c completion of igraphdnaupd . This is new starting with release 2 of ARPACK. c -c 3. If M can be factored into a Cholesky factorization M = LL' +c 3. If M can be factored into a Cholesky factorization M = LL` c then Mode = 2 should not be selected. Instead one should use -c Mode = 1 with OP = inv(L)*A*inv(L'). Appropriate triangular -c linear systems should be solved with L and L' rather +c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular +c linear systems should be solved with L and L` rather c than computing inverses. After convergence, an approximate c eigenvector z of the original problem is recovered by solving -c L'z = x where x is a Ritz vector of OP. +c L`z = x where x is a Ritz vector of OP. c c 4. At present there is no a-priori analysis to guide the selection -c of NCV relative to NEV. The only formal requrement is that NCV > NEV + 2. +c of NCV relative to NEV. The only formal requirement is that NCV > NEV + 2. c However, it is recommended that NCV .ge. 2*NEV+1. If many problems of c the same type are to be solved, one should experiment with increasing -c NCV while keeping NEV fixed for a given test problem. This will +c NCV while keeping NEV fixed for a given test problem. This will c usually decrease the required number of OP*x operations but it c also increases the work and storage required to maintain the orthogonal c basis vectors. The optimal "cross-over" with respect to CPU time -c is problem dependent and must be determined empirically. +c is problem dependent and must be determined empirically. c See Chapter 8 of Reference 2 for further information. c -c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the -c NP = IPARAM(8) real and imaginary parts of the shifts in locations +c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the +c NP = IPARAM(8) real and imaginary parts of the shifts in locations c real part imaginary part c ----------------------- -------------- c 1 WORKL(IPNTR(14)) WORKL(IPNTR(14)+NP) @@ -319,10 +319,10 @@ c . . c NP WORKL(IPNTR(14)+NP-1) WORKL(IPNTR(14)+2*NP-1). c -c Only complex conjugate pairs of shifts may be applied and the pairs -c must be placed in consecutive locations. The real part of the -c eigenvalues of the current upper Hessenberg matrix are located in -c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part +c Only complex conjugate pairs of shifts may be applied and the pairs +c must be placed in consecutive locations. The real part of the +c eigenvalues of the current upper Hessenberg matrix are located in +c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part c in WORKL(IPNTR(7)) through WORKL(IPNTR(7)+NCV-1). They are ordered c according to the order defined by WHICH. The complex conjugate c pairs are kept together and the associated Ritz estimates are located in @@ -330,11 +330,11 @@ c c----------------------------------------------------------------------- c -c\Data Distribution Note: +c\Data Distribution Note: c c Fortran-D syntax: c ================ -c Double precision resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) +c Double precision resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) c decompose d1(n), d2(n,ncv) c align resid(i) with d1(i) c align v(i,j) with d2(i,j) @@ -346,13 +346,13 @@ c c Cray MPP syntax: c =============== -c Double precision resid(n), v(ldv,ncv), workd(n,3), workl(lworkl) +c Double precision resid(n), v(ldv,ncv), workd(n,3), workl(lworkl) c shared resid(block), v(block,:), workd(block,:) c replicated workl(lworkl) -c +c c CM2/CM5 syntax: c ============== -c +c c----------------------------------------------------------------------- c c include 'ex-nonsym.doc' @@ -368,7 +368,7 @@ c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. -c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly +c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for @@ -376,26 +376,26 @@ c pp 575-595, (1987). c c\Routines called: -c igraphdnaup2 ARPACK routine that implements the Implicitly Restarted +c igraphdnaup2 ARPACK routine that implements the Implicitly Restarted c Arnoldi Iteration. c igraphivout ARPACK utility routine that prints integers. -c igraphsecond ARPACK utility routine for timing. -c igraphdvout ARPACK utility routine that prints vectors. -c dlamch LAPACK routine that determines machine constants. +c igrapharscnd ARPACK utility routine for timing. +c igraphdvout ARPACK utility routine that prints vectors. +c dlamch LAPACK routine that determines machine constants. c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas -c +c Rice University +c Houston, Texas +c c\Revision history: c 12/16/93: Version '1.1' c -c\SCCS Information: @(#) -c FILE: naupd.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2 +c\SCCS Information: @(#) +c FILE: naupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2 c c\Remarks c @@ -404,7 +404,7 @@ c----------------------------------------------------------------------- c subroutine igraphdnaupd - & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, + & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, & ipntr, workd, workl, lworkl, info ) c c %----------------------------------------------------% @@ -437,13 +437,13 @@ subroutine igraphdnaupd c Double precision & one, zero - parameter (one = 1.0D+0, zero = 0.0D+0) + parameter (one = 1.0D+0 , zero = 0.0D+0 ) c c %---------------% c | Local Scalars | c %---------------% c - integer bounds, ierr, ih, iq, ishift, iupd, iw, + integer bounds, ierr, ih, iq, ishift, iupd, iw, & ldh, ldq, levec, mode, msglvl, mxiter, nb, & nev0, next, np, ritzi, ritzr, j save bounds, ih, iq, ishift, iupd, iw, ldh, ldq, @@ -454,8 +454,8 @@ subroutine igraphdnaupd c | External Subroutines | c %----------------------% c - external igraphdnaup2, igraphdvout, igraphivout, - & igraphsecond, igraphdstatn + external igraphdnaup2, igraphdvout, igraphivout, igrapharscnd, + & igraphdstatn c c %--------------------% c | External Functions | @@ -468,16 +468,16 @@ subroutine igraphdnaupd c %-----------------------% c | Executable Statements | c %-----------------------% -c +c if (ido .eq. 0) then -c +c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c call igraphdstatn - call igraphsecond (t0) + call igrapharscnd (t0) msglvl = mnaupd c c %----------------% @@ -486,9 +486,10 @@ subroutine igraphdnaupd c ierr = 0 ishift = iparam(1) - levec = iparam(2) +c levec = iparam(2) mxiter = iparam(3) - nb = iparam(4) +c nb = iparam(4) + nb = 1 c c %--------------------------------------------% c | Revision 2 performs only implicit restart. | @@ -516,14 +517,14 @@ subroutine igraphdnaupd ierr = -6 else if (lworkl .lt. 3*ncv**2 + 6*ncv) then ierr = -7 - else if (mode .lt. 1 .or. mode .gt. 5) then + else if (mode .lt. 1 .or. mode .gt. 4) then ierr = -10 else if (mode .eq. 1 .and. bmat .eq. 'G') then ierr = -11 else if (ishift .lt. 0 .or. ishift .gt. 1) then ierr = -12 end if -c +c c %------------% c | Error Exit | c %------------% @@ -533,13 +534,13 @@ subroutine igraphdnaupd ido = 99 go to 9000 end if -c +c c %------------------------% c | Set default parameters | c %------------------------% c if (nb .le. 0) nb = 1 - if (tol .le. zero) tol = dlamch('EpsMach') + if (tol .le. zero) tol = dlamch ('EpsMach') c c %----------------------------------------------% c | NP is the number of additional steps to | @@ -549,8 +550,8 @@ subroutine igraphdnaupd c %----------------------------------------------% c np = ncv - nev - nev0 = nev -c + nev0 = nev +c c %-----------------------------% c | Zero out internal workspace | c %-----------------------------% @@ -558,7 +559,7 @@ subroutine igraphdnaupd do 10 j = 1, 3*ncv**2 + 6*ncv workl(j) = zero 10 continue -c +c c %-------------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | @@ -570,8 +571,8 @@ subroutine igraphdnaupd c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds | c | workl(ncv*ncv+3*ncv+1:2*ncv*ncv+3*ncv) := rotation matrix Q | c | workl(2*ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) := workspace | -c | The final workspace is needed by subroutine igraphdneigh called | -c | by igraphdnaup2. Subroutine igraphdneigh calls LAPACK routines for | +c | The final workspace is needed by subroutine igraphdneigh called | +c | by igraphdnaup2 . Subroutine igraphdneigh calls LAPACK routines for | c | calculating eigenvalues and the last row of the eigenvector | c | matrix. | c %-------------------------------------------------------------% @@ -591,7 +592,7 @@ subroutine igraphdnaupd ipntr(6) = ritzr ipntr(7) = ritzi ipntr(8) = bounds - ipntr(14) = iw + ipntr(14) = iw c end if c @@ -599,12 +600,12 @@ subroutine igraphdnaupd c | Carry out the Implicitly restarted Arnoldi Iteration. | c %-------------------------------------------------------% c - call igraphdnaup2 + call igraphdnaup2 & ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd, - & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritzr), - & workl(ritzi), workl(bounds), workl(iq), ldq, workl(iw), + & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritzr), + & workl(ritzi), workl(bounds), workl(iq), ldq, workl(iw), & ipntr, workd, info ) -c +c c %--------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP or shifts. | @@ -612,7 +613,7 @@ subroutine igraphdnaupd c if (ido .eq. 3) iparam(8) = np if (ido .ne. 99) go to 9000 -c +c iparam(3) = mxiter iparam(5) = np iparam(9) = nopx @@ -621,7 +622,7 @@ subroutine igraphdnaupd c c %------------------------------------% c | Exit if there was an informational | -c | error within igraphdnaup2. | +c | error within igraphdnaup2 . | c %------------------------------------% c if (info .lt. 0) go to 9000 @@ -632,24 +633,62 @@ subroutine igraphdnaupd & '_naupd: Number of update iterations taken') call igraphivout (logfil, 1, [np], ndigit, & '_naupd: Number of wanted "converged" Ritz values') - call igraphdvout (logfil, np, workl(ritzr), ndigit, + call igraphdvout (logfil, np, workl(ritzr), ndigit, & '_naupd: Real part of the final Ritz values') - call igraphdvout (logfil, np, workl(ritzi), ndigit, + call igraphdvout (logfil, np, workl(ritzi), ndigit, & '_naupd: Imaginary part of the final Ritz values') - call igraphdvout (logfil, np, workl(bounds), ndigit, + call igraphdvout (logfil, np, workl(bounds), ndigit, & '_naupd: Associated Ritz estimates') end if c - call igraphsecond (t1) + call igrapharscnd (t1) tnaupd = t1 - t0 c + if (msglvl .gt. 0) then +c +c %--------------------------------------------------------% +c | Version Number & Version Date are defined in version.h | +c %--------------------------------------------------------% +c + write (6,1000) + write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt, + & tmvopx, tmvbx, tnaupd, tnaup2, tnaitr, titref, + & tgetv0, tneigh, tngets, tnapps, tnconv, trvec + 1000 format (//, + & 5x, '=============================================',/ + & 5x, '= Nonsymmetric implicit Arnoldi update code =',/ + & 5x, '= Version Number: ', ' 2.4' , 21x, ' =',/ + & 5x, '= Version Date: ', ' 07/31/96' , 16x, ' =',/ + & 5x, '=============================================',/ + & 5x, '= Summary of timing statistics =',/ + & 5x, '=============================================',//) + 1100 format ( + & 5x, 'Total number update iterations = ', i5,/ + & 5x, 'Total number of OP*x operations = ', i5,/ + & 5x, 'Total number of B*x operations = ', i5,/ + & 5x, 'Total number of reorthogonalization steps = ', i5,/ + & 5x, 'Total number of iterative refinement steps = ', i5,/ + & 5x, 'Total number of restart steps = ', i5,/ + & 5x, 'Total time in user OP*x operation = ', f12.6,/ + & 5x, 'Total time in user B*x operation = ', f12.6,/ + & 5x, 'Total time in Arnoldi update routine = ', f12.6,/ + & 5x, 'Total time in naup2 routine = ', f12.6,/ + & 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/ + & 5x, 'Total time in reorthogonalization phase = ', f12.6,/ + & 5x, 'Total time in (re)start vector generation = ', f12.6,/ + & 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/ + & 5x, 'Total time in getting the shifts = ', f12.6,/ + & 5x, 'Total time in applying the shifts = ', f12.6,/ + & 5x, 'Total time in convergence testing = ', f12.6,/ + & 5x, 'Total time in computing final Ritz vectors = ', f12.6/) + end if c 9000 continue c return c c %---------------% -c | End of igraphdnaupd | +c | End of igraphdnaupd | c %---------------% c end diff --git a/src/vendor/arpack/dnconv.f b/src/vendor/arpack/dnconv.f index 4735159429..16e513983e 100644 --- a/src/vendor/arpack/dnconv.f +++ b/src/vendor/arpack/dnconv.f @@ -3,7 +3,7 @@ c c\Name: igraphdnconv c -c\Description: +c\Description: c Convergence testing for the nonsymmetric Arnoldi eigenvalue routine. c c\Usage: @@ -38,22 +38,22 @@ c xxxxxx real c c\Routines called: -c igraphsecond ARPACK utility routine for timing. +c igrapharscnd ARPACK utility routine for timing. c dlamch LAPACK routine that determines machine constants. c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. c c\Author c Danny Sorensen Phuong Vu -c Richard Lehoucq CRPC / Rice University +c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas -c Applied Mathematics -c Rice University -c Houston, Texas +c Applied Mathematics +c Rice University +c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c -c\SCCS Information: @(#) +c\SCCS Information: @(#) c FILE: nconv.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks @@ -106,7 +106,7 @@ subroutine igraphdnconv (n, ritzr, ritzi, bounds, tol, nconv) c %-----------------------% c | Executable Statements | c %-----------------------% -c +c c %-------------------------------------------------------------% c | Convergence test: unlike in the symmetric code, I am not | c | using things like refined error bounds and gap condition | @@ -119,7 +119,7 @@ subroutine igraphdnconv (n, ritzr, ritzi, bounds, tol, nconv) c | for some appropriate choice of norm. | c %-------------------------------------------------------------% c - call igraphsecond (t0) + call igrapharscnd (t0) c c %---------------------------------% c | Get machine dependent constant. | @@ -133,10 +133,10 @@ subroutine igraphdnconv (n, ritzr, ritzi, bounds, tol, nconv) temp = max( eps23, dlapy2( ritzr(i), ritzi(i) ) ) if (bounds(i) .le. tol*temp) nconv = nconv + 1 20 continue -c - call igraphsecond (t1) +c + call igrapharscnd (t1) tnconv = tnconv + (t1 - t0) -c +c return c c %---------------% diff --git a/src/vendor/arpack/dneigh.f b/src/vendor/arpack/dneigh.f index 53c7c89ba7..2e02c19d14 100644 --- a/src/vendor/arpack/dneigh.f +++ b/src/vendor/arpack/dneigh.f @@ -13,7 +13,7 @@ c c\Arguments c RNORM Double precision scalar. (INPUT) -c Residual norm corresponding to the current upper Hessenberg +c Residual norm corresponding to the current upper Hessenberg c matrix H. c c N Integer. (INPUT) @@ -27,13 +27,13 @@ c program. c c RITZR, Double precision arrays of length N. (OUTPUT) -c RITZI On output, RITZR(1:N) (resp. RITZI(1:N)) contains the real +c RITZI On output, RITZR(1:N) (resp. RITZI(1:N)) contains the real c (respectively imaginary) parts of the eigenvalues of H. c c BOUNDS Double precision array of length N. (OUTPUT) c On output, BOUNDS contains the Ritz estimates associated with -c the eigenvalues RITZR and RITZI. This is equal to RNORM -c times the last components of the eigenvectors corresponding +c the eigenvalues RITZR and RITZI. This is equal to RNORM +c times the last components of the eigenvectors corresponding c to the eigenvalues in RITZR and RITZI. c c Q Double precision N by N array. (WORKSPACE) @@ -49,7 +49,7 @@ c of H and also in the calculation of the eigenvectors of H. c c IERR Integer. (OUTPUT) -c Error exit flag from igraphdlaqrb or dtrevc. +c Error exit flag from dlahqr or dtrevc. c c\EndDoc c @@ -61,9 +61,9 @@ c xxxxxx real c c\Routines called: -c igraphdlaqrb ARPACK routine to compute the real Schur form of an +c dlahqr LAPACK routine to compute the real Schur form of an c upper Hessenberg matrix and last row of the Schur vectors. -c igraphsecond ARPACK utility routine for timing. +c igrapharscnd ARPACK utility routine for timing. c igraphdmout ARPACK utility routine that prints matrices c igraphdvout ARPACK utility routine that prints vectors. c dlacpy LAPACK matrix copy routine. @@ -74,20 +74,20 @@ c dcopy Level 1 BLAS that copies one vector to another . c dnrm2 Level 1 BLAS that computes the norm of a vector. c dscal Level 1 BLAS that scales a vector. -c +c c c\Author c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas +c Rice University +c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c -c\SCCS Information: @(#) +c\SCCS Information: @(#) c FILE: neigh.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks @@ -97,7 +97,7 @@ c c----------------------------------------------------------------------- c - subroutine igraphdneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds, + subroutine igraphdneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds, & q, ldq, workl, ierr) c c %----------------------------------------------------% @@ -112,40 +112,40 @@ subroutine igraphdneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds, c %------------------% c integer ierr, n, ldh, ldq - Double precision + Double precision & rnorm c c %-----------------% c | Array Arguments | c %-----------------% c - Double precision + Double precision & bounds(n), h(ldh,n), q(ldq,n), ritzi(n), ritzr(n), & workl(n*(n+3)) -c +c c %------------% c | Parameters | c %------------% c - Double precision + Double precision & one, zero parameter (one = 1.0D+0, zero = 0.0D+0) -c +c c %------------------------% c | Local Scalars & Arrays | c %------------------------% c logical select(1) integer i, iconj, msglvl - Double precision + Double precision & temp, vl(1) c c %----------------------% c | External Subroutines | c %----------------------% c - external dcopy, dlacpy, igraphdlaqrb, dtrevc, igraphdvout, - & igraphsecond + external dcopy, dlacpy, dlahqr, dtrevc, igraphdvout, + & igrapharscnd c c %--------------------% c | External Functions | @@ -171,25 +171,29 @@ subroutine igraphdneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds, c | & message level for debugging | c %-------------------------------% c - call igraphsecond (t0) + call igrapharscnd (t0) msglvl = mneigh -c +c if (msglvl .gt. 2) then - call igraphdmout (logfil, n, n, h, ldh, ndigit, + call igraphdmout (logfil, n, n, h, ldh, ndigit, & '_neigh: Entering upper Hessenberg matrix H ') end if -c +c c %-----------------------------------------------------------% c | 1. Compute the eigenvalues, the last components of the | c | corresponding Schur vectors and the full Schur form T | c | of the current upper Hessenberg matrix H. | -c | igraphdlaqrb returns the full Schur form of H in WORKL(1:N**2) | +c | dlahqr returns the full Schur form of H in WORKL(1:N**2) | c | and the last components of the Schur vectors in BOUNDS. | c %-----------------------------------------------------------% c call dlacpy ('All', n, n, h, ldh, workl, n) - call igraphdlaqrb (.true., n, 1, n, workl, n, ritzr, ritzi, - & bounds, ierr) + do 5 j = 1, n-1 + bounds(j) = zero + 5 continue + bounds(n) = 1 + call dlahqr(.true., .true., n, 1, n, workl, n, ritzr, ritzi, 1, 1, + & bounds, 1, ierr) if (ierr .ne. 0) go to 9000 c if (msglvl .gt. 1) then @@ -228,7 +232,7 @@ subroutine igraphdneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds, c %----------------------% c | Real eigenvalue case | c %----------------------% -c +c temp = dnrm2( n, q(1,i), 1 ) call dscal ( n, one / temp, q(1,i), 1 ) else @@ -242,7 +246,7 @@ subroutine igraphdneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds, c %-------------------------------------------% c if (iconj .eq. 0) then - temp = dlapy2( dnrm2( n, q(1,i), 1 ), + temp = dlapy2( dnrm2( n, q(1,i), 1 ), & dnrm2( n, q(1,i+1), 1 ) ) call dscal ( n, one / temp, q(1,i), 1 ) call dscal ( n, one / temp, q(1,i+1), 1 ) @@ -250,7 +254,7 @@ subroutine igraphdneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds, else iconj = 0 end if - end if + end if 10 continue c call dgemv ('T', n, n, one, q, ldq, bounds, 1, zero, workl, 1) @@ -271,7 +275,7 @@ subroutine igraphdneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds, c %----------------------% c | Real eigenvalue case | c %----------------------% -c +c bounds(i) = rnorm * abs( workl(i) ) else c @@ -302,7 +306,7 @@ subroutine igraphdneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds, & '_neigh: Ritz estimates for the eigenvalues of H') end if c - call igraphsecond (t1) + call igrapharscnd (t1) tneigh = tneigh + (t1 - t0) c 9000 continue diff --git a/src/vendor/arpack/dneupd.f b/src/vendor/arpack/dneupd.f index 92b4bc3ad4..2e3268dffd 100644 --- a/src/vendor/arpack/dneupd.f +++ b/src/vendor/arpack/dneupd.f @@ -2,7 +2,7 @@ c c\Name: igraphdneupd c -c\Description: +c\Description: c c This subroutine returns the converged approximations to eigenvalues c of A*z = lambda*B*z and (optionally): @@ -21,41 +21,41 @@ c The approximate eigenvalues and eigenvectors of A*z = lambda*B*z c are derived from approximate eigenvalues and eigenvectors of c of the linear operator OP prescribed by the MODE selection in the -c call to DNAUPD. DNAUPD must be called before this routine is called. +c call to IGRAPHDNAUPD . IGRAPHDNAUPD must be called before this routine is called. c These approximate eigenvalues and vectors are commonly called Ritz c values and Ritz vectors respectively. They are referred to as such c in the comments that follow. The computed orthonormal basis for the c invariant subspace corresponding to these Ritz values is referred to as a c Schur basis. c -c See documentation in the header of the subroutine DNAUPD for +c See documentation in the header of the subroutine IGRAPHDNAUPD for c definition of OP as well as other terms and the relation of computed c Ritz values and Ritz vectors of OP with respect to the given problem -c A*z = lambda*B*z. For a brief description, see definitions of -c IPARAM(7), MODE and WHICH in the documentation of DNAUPD. +c A*z = lambda*B*z. For a brief description, see definitions of +c IPARAM(7), MODE and WHICH in the documentation of IGRAPHDNAUPD . c c\Usage: -c call igraphdneupd -c ( RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI, WORKEV, BMAT, -c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, +c call igraphdneupd +c ( RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI, WORKEV, BMAT, +c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, c LWORKL, INFO ) c c\Arguments: -c RVEC LOGICAL (INPUT) -c Specifies whether a basis for the invariant subspace corresponding -c to the converged Ritz value approximations for the eigenproblem +c RVEC LOGICAL (INPUT) +c Specifies whether a basis for the invariant subspace corresponding +c to the converged Ritz value approximations for the eigenproblem c A*z = lambda*B*z is computed. c c RVEC = .FALSE. Compute Ritz values only. c c RVEC = .TRUE. Compute the Ritz vectors or Schur vectors. -c See Remarks below. -c -c HOWMNY Character*1 (INPUT) -c Specifies the form of the basis for the invariant subspace +c See Remarks below. +c +c HOWMNY Character*1 (INPUT) +c Specifies the form of the basis for the invariant subspace c corresponding to the converged Ritz values that is to be computed. c -c = 'A': Compute NEV Ritz vectors; +c = 'A': Compute NEV Ritz vectors; c = 'P': Compute NEV Schur vectors; c = 'S': compute some of the Ritz vectors, specified c by the logical array SELECT. @@ -63,84 +63,84 @@ c SELECT Logical array of dimension NCV. (INPUT) c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be c computed. To select the Ritz vector corresponding to a -c Ritz value (DR(j), DI(j)), SELECT(j) must be set to .TRUE.. +c Ritz value (DR(j), DI(j)), SELECT(j) must be set to .TRUE.. c If HOWMNY = 'A' or 'P', SELECT is used as internal workspace. c -c DR Double precision array of dimension NEV+1. (OUTPUT) -c If IPARAM(7) = 1,2 or 3 and SIGMAI=0.0 then on exit: DR contains -c the real part of the Ritz approximations to the eigenvalues of -c A*z = lambda*B*z. +c DR Double precision array of dimension NEV+1. (OUTPUT) +c If IPARAM(7) = 1,2 or 3 and SIGMAI=0.0 then on exit: DR contains +c the real part of the Ritz approximations to the eigenvalues of +c A*z = lambda*B*z. c If IPARAM(7) = 3, 4 and SIGMAI is not equal to zero, then on exit: -c DR contains the real part of the Ritz values of OP computed by -c DNAUPD. A further computation must be performed by the user -c to transform the Ritz values computed for OP by DNAUPD to those +c DR contains the real part of the Ritz values of OP computed by +c IGRAPHDNAUPD . A further computation must be performed by the user +c to transform the Ritz values computed for OP by IGRAPHDNAUPD to those c of the original system A*z = lambda*B*z. See remark 3 below. c -c DI Double precision array of dimension NEV+1. (OUTPUT) -c On exit, DI contains the imaginary part of the Ritz value +c DI Double precision array of dimension NEV+1. (OUTPUT) +c On exit, DI contains the imaginary part of the Ritz value c approximations to the eigenvalues of A*z = lambda*B*z associated c with DR. c -c NOTE: When Ritz values are complex, they will come in complex -c conjugate pairs. If eigenvectors are requested, the -c corresponding Ritz vectors will also come in conjugate -c pairs and the real and imaginary parts of these are -c represented in two consecutive columns of the array Z +c NOTE: When Ritz values are complex, they will come in complex +c conjugate pairs. If eigenvectors are requested, the +c corresponding Ritz vectors will also come in conjugate +c pairs and the real and imaginary parts of these are +c represented in two consecutive columns of the array Z c (see below). c -c Z Double precision N by NEV+1 array if RVEC = .TRUE. and HOWMNY = 'A'. (OUTPUT) -c On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of -c Z represent approximate eigenvectors (Ritz vectors) corresponding -c to the NCONV=IPARAM(5) Ritz values for eigensystem -c A*z = lambda*B*z. -c -c The complex Ritz vector associated with the Ritz value -c with positive imaginary part is stored in two consecutive -c columns. The first column holds the real part of the Ritz -c vector and the igraphsecond column holds the imaginary part. The -c Ritz vector associated with the Ritz value with negative -c imaginary part is simply the complex conjugate of the Ritz vector +c Z Double precision N by NEV+1 array if RVEC = .TRUE. and HOWMNY = 'A'. (OUTPUT) +c On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of +c Z represent approximate eigenvectors (Ritz vectors) corresponding +c to the NCONV=IPARAM(5) Ritz values for eigensystem +c A*z = lambda*B*z. +c +c The complex Ritz vector associated with the Ritz value +c with positive imaginary part is stored in two consecutive +c columns. The first column holds the real part of the Ritz +c vector and the second column holds the imaginary part. The +c Ritz vector associated with the Ritz value with negative +c imaginary part is simply the complex conjugate of the Ritz vector c associated with the positive imaginary part. c c If RVEC = .FALSE. or HOWMNY = 'P', then Z is not referenced. c c NOTE: If if RVEC = .TRUE. and a Schur basis is not required, c the array Z may be set equal to first NEV+1 columns of the Arnoldi -c basis array V computed by DNAUPD. In this case the Arnoldi basis +c basis array V computed by IGRAPHDNAUPD . In this case the Arnoldi basis c will be destroyed and overwritten with the eigenvector basis. c c LDZ Integer. (INPUT) c The leading dimension of the array Z. If Ritz vectors are c desired, then LDZ >= max( 1, N ). In any case, LDZ >= 1. c -c SIGMAR Double precision (INPUT) -c If IPARAM(7) = 3 or 4, represents the real part of the shift. +c SIGMAR Double precision (INPUT) +c If IPARAM(7) = 3 or 4, represents the real part of the shift. c Not referenced if IPARAM(7) = 1 or 2. c -c SIGMAI Double precision (INPUT) -c If IPARAM(7) = 3 or 4, represents the imaginary part of the shift. +c SIGMAI Double precision (INPUT) +c If IPARAM(7) = 3 or 4, represents the imaginary part of the shift. c Not referenced if IPARAM(7) = 1 or 2. See remark 3 below. c -c WORKEV Double precision work array of dimension 3*NCV. (WORKSPACE) +c WORKEV Double precision work array of dimension 3*NCV. (WORKSPACE) c c **** The remaining arguments MUST be the same as for the **** -c **** call to DNAUPD that was just completed. **** +c **** call to IGRAPHDNAUPD that was just completed. **** c c NOTE: The remaining arguments c c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, c WORKD, WORKL, LWORKL, INFO c -c must be passed directly to DNEUPD following the last call -c to DNAUPD. These arguments MUST NOT BE MODIFIED between -c the the last call to DNAUPD and the call to DNEUPD. +c must be passed directly to IGRAPHDNEUPD following the last call +c to IGRAPHDNAUPD . These arguments MUST NOT BE MODIFIED between +c the the last call to IGRAPHDNAUPD and the call to IGRAPHDNEUPD . c c Three of these parameters (V, WORKL, INFO) are also output parameters: c -c V Double precision N by NCV array. (INPUT/OUTPUT) +c V Double precision N by NCV array. (INPUT/OUTPUT) c c Upon INPUT: the NCV columns of V contain the Arnoldi basis -c vectors for OP as constructed by DNAUPD . +c vectors for OP as constructed by IGRAPHDNAUPD . c c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns c contain approximate Schur vectors that span the @@ -153,16 +153,16 @@ c the first NCONV=IPARAM(5) columns of V will contain approximate c Schur vectors that span the desired invariant subspace. c -c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) +c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) c WORKL(1:ncv*ncv+3*ncv) contains information obtained in -c igraphdnaupd. They are not changed by igraphdneupd. +c igraphdnaupd . They are not changed by igraphdneupd . c WORKL(ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) holds the c real and imaginary part of the untransformed Ritz values, c the upper quasi-triangular matrix for H, and the c associated matrix representation of the invariant subspace for H. c c Note: IPNTR(9:13) contains the pointer into WORKL for addresses -c of the above information computed by igraphdneupd. +c of the above information computed by igraphdneupd . c ------------------------------------------------------------- c IPNTR(9): pointer to the real part of the NCV RITZ values of the c original system. @@ -173,7 +173,7 @@ c Schur matrix for H. c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors c of the upper Hessenberg matrix H. Only referenced by -c igraphdneupd if RVEC = .TRUE. See Remark 2 below. +c igraphdneupd if RVEC = .TRUE. See Remark 2 below. c ------------------------------------------------------------- c c INFO Integer. (OUTPUT) @@ -182,11 +182,11 @@ c = 0: Normal exit. c c = 1: The Schur form computed by LAPACK routine dlahqr -c could not be reordered by LAPACK routine dtrsen. -c Re-enter subroutine igraphdneupd with IPARAM(5)=NCV and -c increase the size of the arrays DR and DI to have -c dimension at least dimension NCV and allocate at least NCV -c columns for Z. NOTE: Not necessary if Z and V share +c could not be reordered by LAPACK routine dtrsen . +c Re-enter subroutine igraphdneupd with IPARAM(5)=NCV and +c increase the size of the arrays DR and DI to have +c dimension at least dimension NCV and allocate at least NCV +c columns for Z. NOTE: Not necessary if Z and V share c the same space. Please notify the authors if this error c occurs. c @@ -197,15 +197,20 @@ c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work WORKL array is not sufficient. c = -8: Error return from calculation of a real Schur form. -c Informational error from LAPACK routine dlahqr. +c Informational error from LAPACK routine dlahqr . c = -9: Error return from calculation of eigenvectors. -c Informational error from LAPACK routine dtrevc. +c Informational error from LAPACK routine dtrevc . c = -10: IPARAM(7) must be 1,2,3,4. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. c = -12: HOWMNY = 'S' not yet implemented c = -13: HOWMNY must be one of 'A' or 'P' if RVEC = .true. -c = -14: DNAUPD did not find any eigenvalues to sufficient +c = -14: IGRAPHDNAUPD did not find any eigenvalues to sufficient c accuracy. +c = -15: IGRAPHDNEUPD got a different count of the number of converged +c Ritz values than IGRAPHDNAUPD got. This indicates the user +c probably made an error in passing data from IGRAPHDNAUPD to +c IGRAPHDNEUPD or that the data was modified before entering +c IGRAPHDNEUPD c c\BeginLib c @@ -213,7 +218,7 @@ c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. -c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly +c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for @@ -222,42 +227,42 @@ c c\Routines called: c igraphivout ARPACK utility routine that prints integers. -c igraphdmout ARPACK utility routine that prints matrices -c igraphdvout ARPACK utility routine that prints vectors. -c dgeqr2 LAPACK routine that computes the QR factorization of +c igraphdmout ARPACK utility routine that prints matrices +c igraphdvout ARPACK utility routine that prints vectors. +c dgeqr2 LAPACK routine that computes the QR factorization of c a matrix. -c dlacpy LAPACK matrix copy routine. -c dlahqr LAPACK routine to compute the real Schur form of an +c dlacpy LAPACK matrix copy routine. +c dlahqr LAPACK routine to compute the real Schur form of an c upper Hessenberg matrix. -c dlamch LAPACK routine that determines machine constants. -c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. -c dlaset LAPACK matrix initialization routine. -c dorm2r LAPACK routine that applies an orthogonal matrix in +c dlamch LAPACK routine that determines machine constants. +c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully. +c dlaset LAPACK matrix initialization routine. +c dorm2r LAPACK routine that applies an orthogonal matrix in c factored form. -c dtrevc LAPACK routine to compute the eigenvectors of a matrix +c dtrevc LAPACK routine to compute the eigenvectors of a matrix c in upper quasi-triangular form. -c dtrsen LAPACK routine that re-orders the Schur form. -c dtrmm Level 3 BLAS matrix times an upper triangular matrix. -c dger Level 2 BLAS rank one update to a matrix. -c dcopy Level 1 BLAS that copies one vector to another . -c ddot Level 1 BLAS that computes the scalar product of two vectors. -c dnrm2 Level 1 BLAS that computes the norm of a vector. -c dscal Level 1 BLAS that scales a vector. +c dtrsen LAPACK routine that re-orders the Schur form. +c dtrmm Level 3 BLAS matrix times an upper triangular matrix. +c dger Level 2 BLAS rank one update to a matrix. +c dcopy Level 1 BLAS that copies one vector to another . +c ddot Level 1 BLAS that computes the scalar product of two vectors. +c dnrm2 Level 1 BLAS that computes the norm of a vector. +c dscal Level 1 BLAS that scales a vector. c c\Remarks c c 1. Currently only HOWMNY = 'A' and 'P' are implemented. c -c Let X' denote the transpose of X. +c Let trans(X) denote the transpose of X. c c 2. Schur vectors are an orthogonal representation for the basis of c Ritz vectors. Thus, their numerical properties are often superior. c If RVEC = .TRUE. then the relationship c A * V(:,1:IPARAM(5)) = V(:,1:IPARAM(5)) * T, and -c V(:,1:IPARAM(5))' * V(:,1:IPARAM(5)) = I are approximately satisfied. -c Here T is the leading submatrix of order IPARAM(5) of the real -c upper quasi-triangular matrix stored workl(ipntr(12)). That is, -c T is block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; +c trans(V(:,1:IPARAM(5))) * V(:,1:IPARAM(5)) = I are approximately +c satisfied. Here T is the leading submatrix of order IPARAM(5) of the +c real upper quasi-triangular matrix stored workl(ipntr(12)). That is, +c T is block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; c each 2-by-2 diagonal block has its diagonal elements equal and its c off-diagonal elements of opposite sign. Corresponding to each 2-by-2 c diagonal block is a complex conjugate pair of Ritz values. The real @@ -265,38 +270,40 @@ c c 3. If IPARAM(7) = 3 or 4 and SIGMAI is not equal zero, then the user must c form the IPARAM(5) Rayleigh quotients in order to transform the Ritz -c values computed by DNAUPD for OP to those of A*z = lambda*B*z. +c values computed by IGRAPHDNAUPD for OP to those of A*z = lambda*B*z. c Set RVEC = .true. and HOWMNY = 'A', and -c compute -c Z(:,I)' * A * Z(:,I) if DI(I) = 0. -c If DI(I) is not equal to zero and DI(I+1) = - D(I), +c compute +c trans(Z(:,I)) * A * Z(:,I) if DI(I) = 0. +c If DI(I) is not equal to zero and DI(I+1) = - D(I), c then the desired real and imaginary parts of the Ritz value are -c Z(:,I)' * A * Z(:,I) + Z(:,I+1)' * A * Z(:,I+1), -c Z(:,I)' * A * Z(:,I+1) - Z(:,I+1)' * A * Z(:,I), respectively. +c trans(Z(:,I)) * A * Z(:,I) + trans(Z(:,I+1)) * A * Z(:,I+1), +c trans(Z(:,I)) * A * Z(:,I+1) - trans(Z(:,I+1)) * A * Z(:,I), +c respectively. c Another possibility is to set RVEC = .true. and HOWMNY = 'P' and -c compute V(:,1:IPARAM(5))' * A * V(:,1:IPARAM(5)) and then an upper +c compute trans(V(:,1:IPARAM(5))) * A * V(:,1:IPARAM(5)) and then an upper c quasi-triangular matrix of order IPARAM(5) is computed. See remark c 2 above. c c\Authors c Danny Sorensen Phuong Vu -c Richard Lehoucq CRPC / Rice University +c Richard Lehoucq CRPC / Rice University c Chao Yang Houston, Texas c Dept. of Computational & -c Applied Mathematics -c Rice University -c Houston, Texas -c -c\SCCS Information: @(#) -c FILE: neupd.F SID: 2.5 DATE OF SID: 7/31/96 RELEASE: 2 +c Applied Mathematics +c Rice University +c Houston, Texas +c +c\SCCS Information: @(#) +c FILE: neupd.F SID: 2.7 DATE OF SID: 09/20/00 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- - subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, - & sigmar, sigmai, workev, bmat, n, which, nev, tol, - & resid, ncv, v, ldv, iparam, ipntr, workd, - & workl, lworkl, info) + subroutine igraphdneupd (rvec , howmny, select, dr , di, + & z , ldz , sigmar, sigmai, workev, + & bmat , n , which , nev , tol, + & resid, ncv , v , ldv , iparam, + & ipntr, workd , workl , lworkl, info) c c %----------------------------------------------------% c | Include files for debugging and timing information | @@ -312,7 +319,7 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, character bmat, howmny, which*2 logical rvec integer info, ldz, ldv, lworkl, n, ncv, nev - Double precision + Double precision & sigmar, sigmai, tol c c %-----------------% @@ -322,8 +329,9 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, integer iparam(11), ipntr(14) logical select(ncv) Double precision - & dr(nev+1), di(nev+1), resid(n), v(ldv,ncv), z(ldz,*), - & workd(3*n), workl(lworkl), workev(3*ncv) + & dr(nev+1) , di(nev+1), resid(n) , + & v(ldv,ncv) , z(ldz,*) , workd(3*n), + & workl(lworkl), workev(3*ncv) c c %------------% c | Parameters | @@ -331,36 +339,42 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c Double precision & one, zero - parameter (one = 1.0D+0, zero = 0.0D+0) + parameter (one = 1.0D+0 , zero = 0.0D+0 ) c c %---------------% c | Local Scalars | c %---------------% c character type*6 - integer bounds, ierr, ih, ihbds, iheigr, iheigi, iconj, nconv, - & invsub, iuptri, iwev, iwork(1), j, k, ktrord, - & ldh, ldq, mode, msglvl, outncv, ritzr, ritzi, wri, wrr, - & irr, iri, ibd + integer bounds, ierr , ih , ihbds , + & iheigr, iheigi, iconj , nconv , + & invsub, iuptri, iwev , iwork(1), + & j , k , ldh , ldq , + & mode , msglvl, outncv, ritzr , + & ritzi , wri , wrr , irr , + & iri , ibd , ishift, numcnv , + & np , jj , nconv2 logical reord Double precision - & conds, rnorm, sep, temp, thres, vl(1,1), temp1, eps23 + & conds , rnorm, sep , temp, + & vl(1,1), temp1, eps23 c c %----------------------% c | External Subroutines | c %----------------------% c - external dcopy, dger, dgeqr2, dlacpy, dlahqr, dlaset, - & igraphdmout, dorm2r, dtrevc, dtrmm, dtrsen, dscal, - & igraphdvout, igraphivout + external dcopy , dger , dgeqr2 , dlacpy , + & dlahqr , dlaset , igraphdmout , dorm2r , + & dtrevc , dtrmm , dtrsen , dscal , + & igraphdvout , igraphivout c c %--------------------% c | External Functions | c %--------------------% c Double precision - & dlapy2, dnrm2, dlamch, ddot - external dlapy2, dnrm2, dlamch, ddot + & dlapy2 , dnrm2 , dlamch , ddot + external dlapy2 , dnrm2 , dlamch , ddot c c %---------------------% c | Intrinsic Functions | @@ -371,7 +385,7 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c %-----------------------% c | Executable Statements | c %-----------------------% -c +c c %------------------------% c | Set default parameters | c %------------------------% @@ -385,8 +399,8 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c | Get machine dependent constant. | c %---------------------------------% c - eps23 = dlamch('Epsilon-Machine') - eps23 = eps23**(2.0D+0 / 3.0D+0) + eps23 = dlamch ('Epsilon-Machine') + eps23 = eps23**(2.0D+0 / 3.0D+0 ) c c %--------------% c | Quick return | @@ -420,7 +434,7 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, else if (howmny .eq. 'S' ) then ierr = -12 end if -c +c if (mode .eq. 1 .or. mode .eq. 2) then type = 'REGULR' else if (mode .eq. 3 .and. sigmai .eq. zero) then @@ -429,7 +443,7 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, type = 'REALPT' else if (mode .eq. 4 ) then type = 'IMAGPT' - else + else ierr = -10 end if if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11 @@ -442,7 +456,7 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, info = ierr go to 9000 end if -c +c c %--------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | @@ -455,7 +469,7 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c %--------------------------------------------------------% c c %-----------------------------------------------------------% -c | The following is used and set by DNEUPD. | +c | The following is used and set by IGRAPHDNEUPD . | c | workl(ncv*ncv+3*ncv+1:ncv*ncv+4*ncv) := The untransformed | c | real part of the Ritz values. | c | workl(ncv*ncv+4*ncv+1:ncv*ncv+5*ncv) := The untransformed | @@ -469,7 +483,7 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c | subspace for H. | c | GRAND total of NCV * ( 3 * NCV + 6 ) locations. | c %-----------------------------------------------------------% -c +c ih = ipntr(5) ritzr = ipntr(6) ritzi = ipntr(7) @@ -512,130 +526,116 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c rnorm = workl(ih+2) workl(ih+2) = zero -c +c + if (msglvl .gt. 2) then + call igraphdvout (logfil, ncv, workl(irr), ndigit, + & '_neupd: Real part of Ritz values passed in from _NAUPD.') + call igraphdvout (logfil, ncv, workl(iri), ndigit, + & '_neupd: Imag part of Ritz values passed in from _NAUPD.') + call igraphdvout (logfil, ncv, workl(ibd), ndigit, + & '_neupd: Ritz estimates passed in from _NAUPD.') + end if +c if (rvec) then -c -c %-------------------------------------------% -c | Get converged Ritz value on the boundary. | -c | Note: converged Ritz values have been | -c | placed in the first NCONV locations in | -c | workl(ritzr) and workl(ritzi). They have | -c | been sorted (in _naup2) according to the | -c | WHICH selection criterion. | -c %-------------------------------------------% -c - if (which .eq. 'LM' .or. which .eq. 'SM') then - thres = dlapy2( workl(ritzr), workl(ritzi) ) - else if (which .eq. 'LR' .or. which .eq. 'SR') then - thres = workl(ritzr) - else if (which .eq. 'LI' .or. which .eq. 'SI') then - thres = abs( workl(ritzi) ) - end if +c + reord = .false. +c +c %---------------------------------------------------% +c | Use the temporary bounds array to store indices | +c | These will be used to mark the select array later | +c %---------------------------------------------------% +c + do 10 j = 1,ncv + workl(bounds+j-1) = j + select(j) = .false. + 10 continue +c +c %-------------------------------------% +c | Select the wanted Ritz values. | +c | Sort the Ritz values so that the | +c | wanted ones appear at the tailing | +c | NEV positions of workl(irr) and | +c | workl(iri). Move the corresponding | +c | error estimates in workl(bound) | +c | accordingly. | +c %-------------------------------------% +c + np = ncv - nev + ishift = 0 + call igraphdngets (ishift , which , nev , + & np , workl(irr), workl(iri), + & workl(bounds), workl , workl(np+1)) c if (msglvl .gt. 2) then - call igraphdvout(logfil, 1, [thres], ndigit, - & '_neupd: Threshold eigenvalue used for re-ordering') + call igraphdvout (logfil, ncv, workl(irr), ndigit, + & '_neupd: Real part of Ritz values after calling _NGETS.') + call igraphdvout (logfil, ncv, workl(iri), ndigit, + & '_neupd: Imag part of Ritz values after calling _NGETS.') + call igraphdvout (logfil, ncv, workl(bounds), ndigit, + & '_neupd: Ritz value indices after calling _NGETS.') end if c -c %----------------------------------------------------------% -c | Check to see if all converged Ritz values appear at the | -c | top of the upper quasi-triangular matrix computed by | -c | _neigh in _naup2. This is done in the following way: | -c | | -c | 1) For each Ritz value obtained from _neigh, compare it | -c | with the threshold Ritz value computed above to | -c | determine whether it is a wanted one. | -c | | -c | 2) If it is wanted, then check the corresponding Ritz | -c | estimate to see if it has converged. If it has, set | -c | correponding entry in the logical array SELECT to | -c | .TRUE.. | -c | | -c | If SELECT(j) = .TRUE. and j > NCONV, then there is a | -c | converged Ritz value that does not appear at the top of | -c | the upper quasi-triangular matrix computed by _neigh in | -c | _naup2. Reordering is needed. | -c %----------------------------------------------------------% +c %-----------------------------------------------------% +c | Record indices of the converged wanted Ritz values | +c | Mark the select array for possible reordering | +c %-----------------------------------------------------% +c + numcnv = 0 + do 11 j = 1,ncv + temp1 = max(eps23, + & dlapy2 ( workl(irr+ncv-j), workl(iri+ncv-j) )) + jj = workl(bounds + ncv - j) + if (numcnv .lt. nconv .and. + & workl(ibd+jj-1) .le. tol*temp1) then + select(jj) = .true. + numcnv = numcnv + 1 + if (jj .gt. nconv) reord = .true. + endif + 11 continue c - reord = .false. - ktrord = 0 - do 10 j = 0, ncv-1 - select(j+1) = .false. - if (which .eq. 'LM') then - if (dlapy2(workl(irr+j), workl(iri+j)) - & .ge. thres) then - temp1 = max( eps23, - & dlapy2( workl(irr+j), workl(iri+j) ) ) - if (workl(ibd+j) .le. tol*temp1) - & select(j+1) = .true. - end if - else if (which .eq. 'SM') then - if (dlapy2(workl(irr+j), workl(iri+j)) - & .le. thres) then - temp1 = max( eps23, - & dlapy2( workl(irr+j), workl(iri+j) ) ) - if (workl(ibd+j) .le. tol*temp1) - & select(j+1) = .true. - end if - else if (which .eq. 'LR') then - if (workl(irr+j) .ge. thres) then - temp1 = max( eps23, - & dlapy2( workl(irr+j), workl(iri+j) ) ) - if (workl(ibd+j) .le. tol*temp1) - & select(j+1) = .true. - end if - else if (which .eq. 'SR') then - if (workl(irr+j) .le. thres) then - temp1 = max( eps23, - & dlapy2( workl(irr+j), workl(iri+j) ) ) - if (workl(ibd+j) .le. tol*temp1) - & select(j+1) = .true. - end if - else if (which .eq. 'LI') then - if (abs(workl(iri+j)) .ge. thres) then - temp1 = max( eps23, - & dlapy2( workl(irr+j), workl(iri+j) ) ) - if (workl(ibd+j) .le. tol*temp1) - & select(j+1) = .true. - end if - else if (which .eq. 'SI') then - if (abs(workl(iri+j)) .le. thres) then - temp1 = max( eps23, - & dlapy2( workl(irr+j), workl(iri+j) ) ) - if (workl(ibd+j) .le. tol*temp1) - & select(j+1) = .true. - end if - end if - if (j+1 .gt. nconv ) reord = ( select(j+1) .or. reord ) - if (select(j+1)) ktrord = ktrord + 1 - 10 continue +c %-----------------------------------------------------------% +c | Check the count (numcnv) of converged Ritz values with | +c | the number (nconv) reported by igraphdnaupd. If these two | +c | are different then there has probably been an error | +c | caused by incorrect passing of the igraphdnaupd data. | +c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call igraphivout(logfil, 1, [ktrord], ndigit, + call igraphivout(logfil, 1, [numcnv], ndigit, & '_neupd: Number of specified eigenvalues') call igraphivout(logfil, 1, [nconv], ndigit, & '_neupd: Number of "converged" eigenvalues') end if +c + if (numcnv .ne. nconv) then + info = -15 + go to 9000 + end if c c %-----------------------------------------------------------% -c | Call LAPACK routine dlahqr to compute the real Schur form | -c | of the upper Hessenberg matrix returned by DNAUPD. | +c | Call LAPACK routine dlahqr to compute the real Schur form | +c | of the upper Hessenberg matrix returned by IGRAPHDNAUPD . | c | Make a copy of the upper Hessenberg matrix. | c | Initialize the Schur vector matrix Q to the identity. | c %-----------------------------------------------------------% -c +c call dcopy (ldh*ncv, workl(ih), 1, workl(iuptri), 1) - call dlaset ('All', ncv, ncv, zero, one, workl(invsub), ldq) - call dlahqr (.true., .true., ncv, 1, ncv, workl(iuptri), ldh, - & workl(iheigr), workl(iheigi), 1, ncv, - & workl(invsub), ldq, ierr) - call dcopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1) -c + call dlaset ('All', ncv, ncv, + & zero , one, workl(invsub), + & ldq) + call dlahqr (.true., .true. , ncv, + & 1 , ncv , workl(iuptri), + & ldh , workl(iheigr), workl(iheigi), + & 1 , ncv , workl(invsub), + & ldq , ierr) + call dcopy (ncv , workl(invsub+ncv-1), ldq, + & workl(ihbds), 1) +c if (ierr .ne. 0) then info = -8 go to 9000 end if -c +c if (msglvl .gt. 1) then call igraphdvout (logfil, ncv, workl(iheigr), ndigit, & '_neupd: Real part of the eigenvalues of H') @@ -644,39 +644,50 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, call igraphdvout (logfil, ncv, workl(ihbds), ndigit, & '_neupd: Last row of the Schur vector matrix') if (msglvl .gt. 3) then - call igraphdmout (logfil, ncv, ncv, workl(iuptri), ldh, - & ndigit, + call igraphdmout (logfil , ncv, ncv , + & workl(iuptri), ldh, ndigit, & '_neupd: The upper quasi-triangular matrix ') end if - end if + end if c if (reord) then -c +c c %-----------------------------------------------------% -c | Reorder the computed upper quasi-triangular matrix. | +c | Reorder the computed upper quasi-triangular matrix. | c %-----------------------------------------------------% -c - call dtrsen ('None', 'V', select, ncv, workl(iuptri), ldh, - & workl(invsub), ldq, workl(iheigr), workl(iheigi), - & nconv, conds, sep, workl(ihbds), ncv, iwork, 1, ierr) c + call dtrsen ('None' , 'V' , + & select , ncv , + & workl(iuptri), ldh , + & workl(invsub), ldq , + & workl(iheigr), workl(iheigi), + & nconv2 , conds , + & sep , workl(ihbds) , + & ncv , iwork , + & 1 , ierr) +c + if (nconv2 .lt. nconv) then + nconv = nconv2 + end if + if (ierr .eq. 1) then info = 1 go to 9000 end if c + if (msglvl .gt. 2) then call igraphdvout (logfil, ncv, workl(iheigr), ndigit, & '_neupd: Real part of the eigenvalues of H--reordered') call igraphdvout (logfil, ncv, workl(iheigi), ndigit, & '_neupd: Imag part of the eigenvalues of H--reordered') if (msglvl .gt. 3) then - call igraphdmout (logfil, ncv, ncv, workl(iuptri), - & ldq, ndigit, - & '_neupd: Quasi-triangular matrix after re-ordering') + call igraphdmout (logfil , ncv, ncv , + & workl(iuptri), ldq, ndigit, + & '_neupd: Quasi-triangular matrix after re-ordering') end if end if -c +c end if c c %---------------------------------------% @@ -686,29 +697,30 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c | converged Ritz values. | c %---------------------------------------% c - call dcopy(ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1) + call dcopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1) c c %----------------------------------------------------% c | Place the computed eigenvalues of H into DR and DI | c | if a spectral transformation was not used. | c %----------------------------------------------------% c - if (type .eq. 'REGULR') then + if (type .eq. 'REGULR') then call dcopy (nconv, workl(iheigr), 1, dr, 1) call dcopy (nconv, workl(iheigi), 1, di, 1) end if -c +c c %----------------------------------------------------------% c | Compute the QR factorization of the matrix representing | c | the wanted invariant subspace located in the first NCONV | c | columns of workl(invsub,ldq). | c %----------------------------------------------------------% -c - call dgeqr2 (ncv, nconv, workl(invsub), ldq, workev, - & workev(ncv+1), ierr) +c + call dgeqr2 (ncv, nconv , workl(invsub), + & ldq, workev, workev(ncv+1), + & ierr) c c %---------------------------------------------------------% -c | * Postmultiply V by Q using dorm2r. | +c | * Postmultiply V by Q using dorm2r . | c | * Copy the first NCONV columns of VQ into Z. | c | * Postmultiply Z by R. | c | The N by NCONV matrix Z is now a matrix representation | @@ -718,13 +730,15 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c | vectors associated with the real upper quasi-triangular | c | matrix of order NCONV in workl(iuptri) | c %---------------------------------------------------------% -c - call dorm2r ('Right', 'Notranspose', n, ncv, nconv, - & workl(invsub), ldq, workev, v, ldv, workd(n+1), ierr) +c + call dorm2r ('Right', 'Notranspose', n , + & ncv , nconv , workl(invsub), + & ldq , workev , v , + & ldv , workd(n+1) , ierr) call dlacpy ('All', n, nconv, v, ldv, z, ldz) c do 20 j=1, nconv -c +c c %---------------------------------------------------% c | Perform both a column and row scaling if the | c | diagonal element of workl(invsub,ldq) is negative | @@ -733,21 +747,21 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c | Note that since Q is orthogonal, R is a diagonal | c | matrix consisting of plus or minus ones | c %---------------------------------------------------% -c +c if (workl(invsub+(j-1)*ldq+j-1) .lt. zero) then call dscal (nconv, -one, workl(iuptri+j-1), ldq) call dscal (nconv, -one, workl(iuptri+(j-1)*ldq), 1) end if -c +c 20 continue -c +c if (howmny .eq. 'A') then -c +c c %--------------------------------------------% -c | Compute the NCONV wanted eigenvectors of T | +c | Compute the NCONV wanted eigenvectors of T | c | located in workl(iuptri,ldq). | c %--------------------------------------------% -c +c do 30 j=1, ncv if (j .le. nconv) then select(j) = .true. @@ -756,38 +770,40 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, end if 30 continue c - call dtrevc ('Right', 'Select', select, ncv, workl(iuptri), - & ldq, vl, 1, workl(invsub), ldq, ncv, outncv, workev, - & ierr) + call dtrevc ('Right', 'Select' , select , + & ncv , workl(iuptri), ldq , + & vl , 1 , workl(invsub), + & ldq , ncv , outncv , + & workev , ierr) c if (ierr .ne. 0) then info = -9 go to 9000 end if -c +c c %------------------------------------------------% c | Scale the returning eigenvectors so that their | c | Euclidean norms are all one. LAPACK subroutine | -c | dtrevc returns each eigenvector normalized so | +c | dtrevc returns each eigenvector normalized so | c | that the element of largest magnitude has | c | magnitude 1; | c %------------------------------------------------% -c +c iconj = 0 do 40 j=1, nconv c if ( workl(iheigi+j-1) .eq. zero ) then -c +c c %----------------------% c | real eigenvalue case | c %----------------------% -c - temp = dnrm2( ncv, workl(invsub+(j-1)*ldq), 1 ) - call dscal ( ncv, one / temp, +c + temp = dnrm2 ( ncv, workl(invsub+(j-1)*ldq), 1 ) + call dscal ( ncv, one / temp, & workl(invsub+(j-1)*ldq), 1 ) c else -c +c c %-------------------------------------------% c | Complex conjugate pair case. Note that | c | since the real and imaginary part of | @@ -797,12 +813,16 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c %-------------------------------------------% c if (iconj .eq. 0) then - temp = dlapy2( dnrm2( ncv, workl(invsub+(j-1)*ldq), - & 1 ), dnrm2( ncv, workl(invsub+j*ldq), 1) ) - call dscal ( ncv, one / temp, - & workl(invsub+(j-1)*ldq), 1 ) - call dscal ( ncv, one / temp, - & workl(invsub+j*ldq), 1 ) + temp = dlapy2 (dnrm2 (ncv, + & workl(invsub+(j-1)*ldq), + & 1), + & dnrm2 (ncv, + & workl(invsub+j*ldq), + & 1)) + call dscal (ncv, one/temp, + & workl(invsub+(j-1)*ldq), 1 ) + call dscal (ncv, one/temp, + & workl(invsub+j*ldq), 1 ) iconj = 1 else iconj = 0 @@ -812,8 +832,8 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c 40 continue c - call dgemv('T', ncv, nconv, one, workl(invsub), - & ldq, workl(ihbds), 1, zero, workev, 1) + call dgemv ('T', ncv, nconv, one, workl(invsub), + & ldq, workl(ihbds), 1, zero, workev, 1) c iconj = 0 do 45 j=1, nconv @@ -826,7 +846,7 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c %-------------------------------------------% c if (iconj .eq. 0) then - workev(j) = dlapy2(workev(j), workev(j+1)) + workev(j) = dlapy2 (workev(j), workev(j+1)) workev(j+1) = workev(j) iconj = 1 else @@ -836,13 +856,13 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, 45 continue c if (msglvl .gt. 2) then - call dcopy(ncv, workl(invsub+ncv-1), ldq, + call dcopy (ncv, workl(invsub+ncv-1), ldq, & workl(ihbds), 1) call igraphdvout (logfil, ncv, workl(ihbds), ndigit, & '_neupd: Last row of the eigenvector matrix for T') if (msglvl .gt. 3) then - call igraphdmout (logfil, ncv, ncv, workl(invsub), - & ldq, ndigit, + call igraphdmout (logfil, ncv, ncv, workl(invsub), + & ldq, ndigit, & '_neupd: The eigenvector matrix for T') end if end if @@ -851,38 +871,43 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c | Copy Ritz estimates into workl(ihbds) | c %---------------------------------------% c - call dcopy(nconv, workev, 1, workl(ihbds), 1) + call dcopy (nconv, workev, 1, workl(ihbds), 1) c c %---------------------------------------------------------% c | Compute the QR factorization of the eigenvector matrix | c | associated with leading portion of T in the first NCONV | c | columns of workl(invsub,ldq). | c %---------------------------------------------------------% -c - call dgeqr2 (ncv, nconv, workl(invsub), ldq, workev, - & workev(ncv+1), ierr) -c +c + call dgeqr2 (ncv, nconv , workl(invsub), + & ldq, workev, workev(ncv+1), + & ierr) +c c %----------------------------------------------% -c | * Postmultiply Z by Q. | +c | * Postmultiply Z by Q. | c | * Postmultiply Z by R. | -c | The N by NCONV matrix Z is now contains the | +c | The N by NCONV matrix Z is now contains the | c | Ritz vectors associated with the Ritz values | c | in workl(iheigr) and workl(iheigi). | c %----------------------------------------------% -c - call dorm2r ('Right', 'Notranspose', n, ncv, nconv, - & workl(invsub), ldq, workev, z, ldz, workd(n+1), ierr) -c - call dtrmm ('Right', 'Upper', 'No transpose', 'Non-unit', - & n, nconv, one, workl(invsub), ldq, z, ldz) -c +c + call dorm2r ('Right', 'Notranspose', n , + & ncv , nconv , workl(invsub), + & ldq , workev , z , + & ldz , workd(n+1) , ierr) +c + call dtrmm ('Right' , 'Upper' , 'No transpose', + & 'Non-unit', n , nconv , + & one , workl(invsub), ldq , + & z , ldz) +c end if -c - else +c + else c c %------------------------------------------------------% c | An approximate invariant subspace is not needed. | -c | Place the Ritz values computed DNAUPD into DR and DI | +c | Place the Ritz values computed IGRAPHDNAUPD into DR and DI | c %------------------------------------------------------% c call dcopy (nconv, workl(ritzr), 1, dr, 1) @@ -891,7 +916,7 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, call dcopy (nconv, workl(ritzi), 1, workl(iheigi), 1) call dcopy (nconv, workl(bounds), 1, workl(ihbds), 1) end if -c +c c %------------------------------------------------% c | Transform the Ritz values and possibly vectors | c | and corresponding error bounds of OP to those | @@ -900,26 +925,26 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c if (type .eq. 'REGULR') then c - if (rvec) - & call dscal (ncv, rnorm, workl(ihbds), 1) -c - else -c + if (rvec) + & call dscal (ncv, rnorm, workl(ihbds), 1) +c + else +c c %---------------------------------------% c | A spectral transformation was used. | c | * Determine the Ritz estimates of the | c | Ritz values in the original system. | c %---------------------------------------% -c +c if (type .eq. 'SHIFTI') then c - if (rvec) + if (rvec) & call dscal (ncv, rnorm, workl(ihbds), 1) c do 50 k=1, ncv - temp = dlapy2( workl(iheigr+k-1), + temp = dlapy2 ( workl(iheigr+k-1), & workl(iheigi+k-1) ) - workl(ihbds+k-1) = abs( workl(ihbds+k-1) ) + workl(ihbds+k-1) = abs( workl(ihbds+k-1) ) & / temp / temp 50 continue c @@ -934,26 +959,26 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, 70 continue c end if -c +c c %-----------------------------------------------------------% c | * Transform the Ritz values back to the original system. | c | For TYPE = 'SHIFTI' the transformation is | c | lambda = 1/theta + sigma | c | For TYPE = 'REALPT' or 'IMAGPT' the user must from | -c | Rayleigh quotients or a projection. See remark 3 above.| +c | Rayleigh quotients or a projection. See remark 3 above.| c | NOTES: | c | *The Ritz vectors are not affected by the transformation. | c %-----------------------------------------------------------% -c - if (type .eq. 'SHIFTI') then +c + if (type .eq. 'SHIFTI') then c do 80 k=1, ncv - temp = dlapy2( workl(iheigr+k-1), + temp = dlapy2 ( workl(iheigr+k-1), & workl(iheigi+k-1) ) - workl(iheigr+k-1) = workl(iheigr+k-1) / temp / temp - & + sigmar - workl(iheigi+k-1) = -workl(iheigi+k-1) / temp / temp - & + sigmai + workl(iheigr+k-1) = workl(iheigr+k-1)/temp/temp + & + sigmar + workl(iheigi+k-1) = -workl(iheigi+k-1)/temp/temp + & + sigmai 80 continue c call dcopy (nconv, workl(iheigr), 1, dr, 1) @@ -970,20 +995,20 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c if (type .eq. 'SHIFTI' .and. msglvl .gt. 1) then call igraphdvout (logfil, nconv, dr, ndigit, - & '_neupd: Untransformed real part of the Ritz valuess.') - call igraphdvout (logfil, nconv, di, ndigit, - & '_neupd: Untransformed imag part of the Ritz valuess.') + & '_neupd: Untransformed real part of the Ritz values.') + call igraphdvout (logfil, nconv, di, ndigit, + & '_neupd: Untransformed imag part of the Ritz values.') call igraphdvout (logfil, nconv, workl(ihbds), ndigit, & '_neupd: Ritz estimates of untransformed Ritz values.') else if (type .eq. 'REGULR' .and. msglvl .gt. 1) then call igraphdvout (logfil, nconv, dr, ndigit, & '_neupd: Real parts of converged Ritz values.') - call igraphdvout (logfil, nconv, di, ndigit, + call igraphdvout (logfil, nconv, di, ndigit, & '_neupd: Imag parts of converged Ritz values.') call igraphdvout (logfil, nconv, workl(ihbds), ndigit, & '_neupd: Associated Ritz estimates.') end if -c +c c %-------------------------------------------------% c | Eigenvector Purification step. Formally perform | c | one of inverse subspace iteration. Only used | @@ -1005,19 +1030,22 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, c iconj = 0 do 110 j=1, nconv - if (workl(iheigi+j-1) .eq. zero) then + if ((workl(iheigi+j-1) .eq. zero) .and. + & (workl(iheigr+j-1) .ne. zero)) then workev(j) = workl(invsub+(j-1)*ldq+ncv-1) / & workl(iheigr+j-1) else if (iconj .eq. 0) then - temp = dlapy2( workl(iheigr+j-1), workl(iheigi+j-1) ) - workev(j) = ( workl(invsub+(j-1)*ldq+ncv-1) * - & workl(iheigr+j-1) + - & workl(invsub+j*ldq+ncv-1) * - & workl(iheigi+j-1) ) / temp / temp - workev(j+1) = ( workl(invsub+j*ldq+ncv-1) * - & workl(iheigr+j-1) - - & workl(invsub+(j-1)*ldq+ncv-1) * - & workl(iheigi+j-1) ) / temp / temp + temp = dlapy2 ( workl(iheigr+j-1), workl(iheigi+j-1) ) + if (temp .ne. zero) then + workev(j) = ( workl(invsub+(j-1)*ldq+ncv-1) * + & workl(iheigr+j-1) + + & workl(invsub+j*ldq+ncv-1) * + & workl(iheigi+j-1) ) / temp / temp + workev(j+1) = ( workl(invsub+j*ldq+ncv-1) * + & workl(iheigr+j-1) - + & workl(invsub+(j-1)*ldq+ncv-1) * + & workl(iheigi+j-1) ) / temp / temp + end if iconj = 1 else iconj = 0 @@ -1036,9 +1064,9 @@ subroutine igraphdneupd (rvec, howmny, select, dr, di, z, ldz, 9000 continue c return -c +c c %---------------% -c | End of DNEUPD | +c | End of IGRAPHDNEUPD | c %---------------% c end diff --git a/src/vendor/arpack/dngets.f b/src/vendor/arpack/dngets.f index 0b2b0775c8..17ae883a59 100644 --- a/src/vendor/arpack/dngets.f +++ b/src/vendor/arpack/dngets.f @@ -3,9 +3,9 @@ c c\Name: igraphdngets c -c\Description: +c\Description: c Given the eigenvalues of the upper Hessenberg matrix H, -c computes the NP shifts AMU that are zeros of the polynomial of +c computes the NP shifts AMU that are zeros of the polynomial of c degree NP which filters out components of the unwanted eigenvectors c corresponding to the AMU's based on some given criteria. c @@ -42,12 +42,12 @@ c pairs together. c c RITZR, Double precision array of length KEV+NP. (INPUT/OUTPUT) -c RITZI On INPUT, RITZR and RITZI contain the real and imaginary +c RITZI On INPUT, RITZR and RITZI contain the real and imaginary c parts of the eigenvalues of H. c On OUTPUT, RITZR and RITZI are sorted so that the unwanted c eigenvalues are in the first NP locations and the wanted -c portion is in the last KEV locations. When exact shifts are -c selected, the unwanted part corresponds to the shifts to +c portion is in the last KEV locations. When exact shifts are +c selected, the unwanted part corresponds to the shifts to c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues c are further sorted so that the ones with largest Ritz values c are first. @@ -56,7 +56,7 @@ c Error bounds corresponding to the ordering in RITZ. c c SHIFTR, SHIFTI *** USE deprecated as of version 2.1. *** -c +c c c\EndDoc c @@ -76,13 +76,13 @@ c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas +c Rice University +c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c -c\SCCS Information: @(#) +c\SCCS Information: @(#) c FILE: ngets.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\Remarks @@ -93,7 +93,7 @@ c----------------------------------------------------------------------- c subroutine igraphdngets ( ishift, which, kev, np, ritzr, ritzi, - & bounds, shiftr, shifti ) + & bounds, shiftr, shifti ) c c %----------------------------------------------------% c | Include files for debugging and timing information | @@ -106,7 +106,7 @@ subroutine igraphdngets ( ishift, which, kev, np, ritzr, ritzi, c | Scalar Arguments | c %------------------% c - character which*2 + character*2 which integer ishift, kev, np c c %-----------------% @@ -114,7 +114,7 @@ subroutine igraphdngets ( ishift, which, kev, np, ritzr, ritzi, c %-----------------% c Double precision - & bounds(kev+np), ritzr(kev+np), ritzi(kev+np), + & bounds(kev+np), ritzr(kev+np), ritzi(kev+np), & shiftr(1), shifti(1) c c %------------% @@ -135,7 +135,7 @@ subroutine igraphdngets ( ishift, which, kev, np, ritzr, ritzi, c | External Subroutines | c %----------------------% c - external dcopy, igraphdsortc, igraphsecond + external dcopy, igraphdsortc, igrapharscnd c c %----------------------% c | Intrinsics Functions | @@ -151,10 +151,10 @@ subroutine igraphdngets ( ishift, which, kev, np, ritzr, ritzi, c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% -c - call igraphsecond (t0) +c + call igrapharscnd (t0) msglvl = mngets -c +c c %----------------------------------------------------% c | LM, SM, LR, SR, LI, SI case. | c | Sort the eigenvalues of H into the desired order | @@ -178,16 +178,16 @@ subroutine igraphdngets ( ishift, which, kev, np, ritzr, ritzi, else if (which .eq. 'SI') then call igraphdsortc ('SM', .true., kev+np, ritzr, ritzi, bounds) end if -c +c call igraphdsortc (which, .true., kev+np, ritzr, ritzi, bounds) -c +c c %-------------------------------------------------------% c | Increase KEV by one if the ( ritzr(np),ritzi(np) ) | c | = ( ritzr(np+1),-ritzi(np+1) ) and ritz(np) .ne. zero | c | Accordingly decrease NP by one. In other words keep | c | complex conjugate pairs together. | c %-------------------------------------------------------% -c +c if ( ( ritzr(np+1) - ritzr(np) ) .eq. zero & .and. ( ritzi(np+1) + ritzi(np) ) .eq. zero ) then np = np - 1 @@ -195,7 +195,7 @@ subroutine igraphdngets ( ishift, which, kev, np, ritzr, ritzi, end if c if ( ishift .eq. 1 ) then -c +c c %-------------------------------------------------------% c | Sort the unwanted Ritz values used as shifts so that | c | the ones with largest Ritz estimates are first | @@ -204,11 +204,11 @@ subroutine igraphdngets ( ishift, which, kev, np, ritzr, ritzi, c | are applied in subroutine igraphdnapps. | c | Be careful and use 'SR' since we want to sort BOUNDS! | c %-------------------------------------------------------% -c +c call igraphdsortc ( 'SR', .true., np, bounds, ritzr, ritzi ) end if -c - call igraphsecond (t1) +c + call igrapharscnd (t1) tngets = tngets + (t1 - t0) c if (msglvl .gt. 0) then @@ -218,14 +218,14 @@ subroutine igraphdngets ( ishift, which, kev, np, ritzr, ritzi, & '_ngets: Eigenvalues of current H matrix -- real part') call igraphdvout (logfil, kev+np, ritzi, ndigit, & '_ngets: Eigenvalues of current H matrix -- imag part') - call igraphdvout (logfil, kev+np, bounds, ndigit, + call igraphdvout (logfil, kev+np, bounds, ndigit, & '_ngets: Ritz estimates of the current KEV+NP Ritz values') end if -c +c return -c +c c %---------------% c | End of igraphdngets | c %---------------% -c +c end diff --git a/src/vendor/arpack/dsaitr.f b/src/vendor/arpack/dsaitr.f index 4a4698c184..3f275c941c 100644 --- a/src/vendor/arpack/dsaitr.f +++ b/src/vendor/arpack/dsaitr.f @@ -3,8 +3,8 @@ c c\Name: igraphdsaitr c -c\Description: -c Reverse communication interface for applying NP additional steps to +c\Description: +c Reverse communication interface for applying NP additional steps to c a K step symmetric Arnoldi factorization. c c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T @@ -20,7 +20,7 @@ c c\Usage: c call igraphdsaitr -c ( IDO, BMAT, N, K, NP, MODE, RESID, RNORM, V, LDV, H, LDH, +c ( IDO, BMAT, N, K, NP, MODE, RESID, RNORM, V, LDV, H, LDH, c IPNTR, WORKD, INFO ) c c\Arguments @@ -76,41 +76,41 @@ c On OUTPUT the B-norm of the updated residual r_{k+p}. c c V Double precision N by K+NP array. (INPUT/OUTPUT) -c On INPUT: V contains the Arnoldi vectors in the first K +c On INPUT: V contains the Arnoldi vectors in the first K c columns. c On OUTPUT: V contains the new NP Arnoldi vectors in the next c NP columns. The first K columns are unchanged. c c LDV Integer. (INPUT) -c Leading dimension of V exactly as declared in the calling +c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (K+NP) by 2 array. (INPUT/OUTPUT) c H is used to store the generated symmetric tridiagonal matrix c with the subdiagonal in the first column starting at H(2,1) -c and the main diagonal in the igraphsecond column. +c and the main diagonal in the second column. c c LDH Integer. (INPUT) -c Leading dimension of H exactly as declared in the calling +c Leading dimension of H exactly as declared in the calling c program. c c IPNTR Integer array of length 3. (OUTPUT) -c Pointer to mark the starting locations in the WORK for +c Pointer to mark the starting locations in the WORK for c vectors used by the Arnoldi iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. -c IPNTR(3): pointer to the vector B * X when used in the +c IPNTR(3): pointer to the vector B * X when used in the c shift-and-invert mode. X is the current operand. c ------------------------------------------------------------- -c +c c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration -c for reverse communication. The calling program should not +c for reverse communication. The calling program should not c use WORKD as temporary workspace during the iteration !!!!!! c On INPUT, WORKD(1:N) = B*RESID where RESID is associated -c with the K step Arnoldi factorization. Used to save some -c computation at the first step. +c with the K step Arnoldi factorization. Used to save some +c computation at the first step. c On OUTPUT, WORKD(1:N) = B*RESID where RESID is associated c with the K+NP step Arnoldi factorization. c @@ -139,7 +139,7 @@ c daxpy Level 1 BLAS that computes a vector triad. c dscal Level 1 BLAS that scales a vector. c dcopy Level 1 BLAS that copies one vector to another . -c ddot Level 1 BLAS that computes the scalar product of two vectors. +c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c c\Author @@ -147,29 +147,29 @@ c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas -c +c Rice University +c Houston, Texas +c c\Revision history: c xx/xx/93: Version ' 2.4' c -c\SCCS Information: @(#) +c\SCCS Information: @(#) c FILE: saitr.F SID: 2.6 DATE OF SID: 8/28/96 RELEASE: 2 c c\Remarks c The algorithm implemented is: -c +c c restart = .false. -c Given V_{k} = [v_{1}, ..., v_{k}], r_{k}; +c Given V_{k} = [v_{1}, ..., v_{k}], r_{k}; c r_{k} contains the initial residual vector even for k = 0; -c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already +c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already c computed by the calling program. c c betaj = rnorm ; p_{k+1} = B*r_{k} ; c For j = k+1, ..., k+np Do c 1) if ( betaj < tol ) stop or restart depending on j. c if ( restart ) generate a new starting vector. -c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}]; +c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}]; c p_{j} = p_{j}/betaj c 3) r_{j} = OP*v_{j} where OP is defined as in igraphdsaupd c For shift-invert mode p_{j} = B*v_{j} is already available. @@ -184,7 +184,7 @@ c 5) Re-orthogonalization step: c s = V_{j}'*B*r_{j} c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} || -c alphaj = alphaj + s_{j}; +c alphaj = alphaj + s_{j}; c 6) Iterative refinement step: c If (rnorm1 > 0.717*rnorm) then c rnorm = rnorm1 @@ -194,7 +194,7 @@ c If this is the first time in step 6), go to 5) c Else r_{j} lies in the span of V_{j} numerically. c Set r_{j} = 0 and rnorm = 0; go to 1) -c EndIf +c EndIf c End Do c c\EndLib @@ -202,7 +202,7 @@ c----------------------------------------------------------------------- c subroutine igraphdsaitr - & (ido, bmat, n, k, np, mode, resid, rnorm, v, ldv, h, ldh, + & (ido, bmat, n, k, np, mode, resid, rnorm, v, ldv, h, ldh, & ipntr, workd, info) c c %----------------------------------------------------% @@ -242,7 +242,7 @@ subroutine igraphdsaitr c %---------------% c logical first, orth1, orth2, rstart, step3, step4 - integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl, + integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl, & infol, jj Double precision & rnorm1, wnorm, safmin, temp1 @@ -251,7 +251,7 @@ subroutine igraphdsaitr & rnorm1, safmin, wnorm c c %-----------------------% -c | Local Array Arguments | +c | Local Array Arguments | c %-----------------------% c Double precision @@ -261,9 +261,9 @@ subroutine igraphdsaitr c | External Subroutines | c %----------------------% c - external daxpy, dcopy, dscal, dgemv, igraphdgetv0, - & igraphdvout, igraphdmout, - & dlascl, igraphivout, igraphsecond + external daxpy, dcopy, dscal, dgemv, igraphdgetv0, + & igraphdvout, igraphdmout, + & dlascl, igraphivout, igrapharscnd c c %--------------------% c | External Functions | @@ -295,15 +295,15 @@ subroutine igraphdsaitr end if c if (ido .eq. 0) then -c +c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c - call igraphsecond (t0) + call igrapharscnd (t0) msglvl = msaitr -c +c c %------------------------------% c | Initial call to this routine | c %------------------------------% @@ -314,14 +314,14 @@ subroutine igraphdsaitr rstart = .false. orth1 = .false. orth2 = .false. -c +c c %--------------------------------% c | Pointer to the current step of | c | the factorization to build | c %--------------------------------% c j = k + 1 -c +c c %------------------------------------------% c | Pointers used for reverse communication | c | when using WORKD. | @@ -331,7 +331,7 @@ subroutine igraphdsaitr irj = ipj + n ivj = irj + n end if -c +c c %-------------------------------------------------% c | When in reverse communication mode one of: | c | STEP3, STEP4, ORTH1, ORTH2, RSTART | @@ -354,7 +354,7 @@ subroutine igraphdsaitr c %------------------------------% c | Else this is the first step. | c %------------------------------% -c +c c %--------------------------------------------------------------% c | | c | A R N O L D I I T E R A T I O N L O O P | @@ -365,15 +365,15 @@ subroutine igraphdsaitr 1000 continue c if (msglvl .gt. 2) then - call igraphivout (logfil, 1, [j], ndigit, + call igraphivout (logfil, 1, [j], ndigit, & '_saitr: generating Arnoldi vector no.') - call igraphdvout (logfil, 1, [rnorm], ndigit, + call igraphdvout (logfil, 1, [rnorm], ndigit, & '_saitr: B-norm of the current residual =') end if -c +c c %---------------------------------------------------------% -c | Check for exact zero. Equivalent to determing whether a | -c | j-step Arnoldi factorization is present. | +c | Check for exact zero. Equivalent to determining whether | +c | a j-step Arnoldi factorization is present. | c %---------------------------------------------------------% c if (rnorm .gt. zero) go to 40 @@ -388,7 +388,7 @@ subroutine igraphdsaitr call igraphivout (logfil, 1, [j], ndigit, & '_saitr: ****** restart at step ******') end if -c +c c %---------------------------------------------% c | ITRY is the loop variable that controls the | c | maximum amount of times that a restart is | @@ -407,7 +407,7 @@ subroutine igraphdsaitr c | RSTART = .true. flow returns here. | c %--------------------------------------% c - call igraphdgetv0 (ido, bmat, itry, .false., n, j, v, ldv, + call igraphdgetv0 (ido, bmat, itry, .false., n, j, v, ldv, & resid, rnorm, ipntr, workd, ierr) if (ido .ne. 99) go to 9000 if (ierr .lt. 0) then @@ -421,12 +421,12 @@ subroutine igraphdsaitr c %------------------------------------------------% c info = j - 1 - call igraphsecond (t1) + call igrapharscnd (t1) tsaitr = tsaitr + (t1 - t0) ido = 99 go to 9000 end if -c +c 40 continue c c %---------------------------------------------------------% @@ -448,12 +448,12 @@ subroutine igraphdsaitr c | use LAPACK routine SLASCL | c %-----------------------------------------% c - call dlascl ('General', i, i, rnorm, one, n, 1, + call dlascl ('General', i, i, rnorm, one, n, 1, & v(1,j), n, infol) - call dlascl ('General', i, i, rnorm, one, n, 1, + call dlascl ('General', i, i, rnorm, one, n, 1, & workd(ipj), n, infol) end if -c +c c %------------------------------------------------------% c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} | c | Note that this is not quite yet r_{j}. See STEP 4 | @@ -461,28 +461,28 @@ subroutine igraphdsaitr c step3 = .true. nopx = nopx + 1 - call igraphsecond (t2) + call igrapharscnd (t2) call dcopy (n, v(1,j), 1, workd(ivj), 1) ipntr(1) = ivj ipntr(2) = irj ipntr(3) = ipj ido = 1 -c +c c %-----------------------------------% c | Exit in order to compute OP*v_{j} | c %-----------------------------------% -c +c go to 9000 50 continue -c +c c %-----------------------------------% c | Back from reverse communication; | c | WORKD(IRJ:IRJ+N-1) := OP*v_{j}. | c %-----------------------------------% c - call igraphsecond (t3) + call igrapharscnd (t3) tmvopx = tmvopx + (t3 - t2) -c +c step3 = .false. c c %------------------------------------------% @@ -490,7 +490,7 @@ subroutine igraphdsaitr c %------------------------------------------% c call dcopy (n, workd(irj), 1, resid, 1) -c +c c %-------------------------------------------% c | STEP 4: Finish extending the symmetric | c | Arnoldi to length j. If MODE = 2 | @@ -501,33 +501,33 @@ subroutine igraphdsaitr c %-------------------------------------------% c if (mode .eq. 2) go to 65 - call igraphsecond (t2) + call igrapharscnd (t2) if (bmat .eq. 'G') then nbx = nbx + 1 step4 = .true. ipntr(1) = irj ipntr(2) = ipj ido = 2 -c +c c %-------------------------------------% c | Exit in order to compute B*OP*v_{j} | c %-------------------------------------% -c +c go to 9000 else if (bmat .eq. 'I') then call dcopy(n, resid, 1 , workd(ipj), 1) end if 60 continue -c +c c %-----------------------------------% c | Back from reverse communication; | c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j}. | c %-----------------------------------% c if (bmat .eq. 'G') then - call igraphsecond (t3) + call igrapharscnd (t3) tmvbx = tmvbx + (t3 - t2) - end if + end if c step4 = .false. c @@ -546,7 +546,7 @@ subroutine igraphdsaitr c wnorm = ddot (n, resid, 1, workd(ivj), 1) wnorm = sqrt(abs(wnorm)) - else if (bmat .eq. 'G') then + else if (bmat .eq. 'G') then wnorm = ddot (n, resid, 1, workd(ipj), 1) wnorm = sqrt(abs(wnorm)) else if (bmat .eq. 'I') then @@ -568,19 +568,19 @@ subroutine igraphdsaitr c %------------------------------------------% c if (mode .ne. 2 ) then - call dgemv('T', n, j, one, v, ldv, workd(ipj), 1, zero, + call dgemv('T', n, j, one, v, ldv, workd(ipj), 1, zero, & workd(irj), 1) else if (mode .eq. 2) then - call dgemv('T', n, j, one, v, ldv, workd(ivj), 1, zero, + call dgemv('T', n, j, one, v, ldv, workd(ivj), 1, zero, & workd(irj), 1) end if c c %--------------------------------------% c | Orthgonalize r_{j} against V_{j}. | -c | RESID contains OP*v_{j}. See STEP 3. | +c | RESID contains OP*v_{j}. See STEP 3. | c %--------------------------------------% c - call dgemv('N', n, j, -one, v, ldv, workd(irj), 1, one, + call dgemv('N', n, j, -one, v, ldv, workd(irj), 1, one, & resid, 1) c c %--------------------------------------% @@ -593,46 +593,46 @@ subroutine igraphdsaitr else h(j,1) = rnorm end if - call igraphsecond (t4) -c + call igrapharscnd (t4) +c orth1 = .true. iter = 0 -c - call igraphsecond (t2) +c + call igrapharscnd (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 -c +c c %----------------------------------% c | Exit in order to compute B*r_{j} | c %----------------------------------% -c +c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) end if 70 continue -c +c c %---------------------------------------------------% c | Back from reverse communication if ORTH1 = .true. | c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. | c %---------------------------------------------------% c if (bmat .eq. 'G') then - call igraphsecond (t3) + call igrapharscnd (t3) tmvbx = tmvbx + (t3 - t2) end if -c +c orth1 = .false. c c %------------------------------% c | Compute the B-norm of r_{j}. | c %------------------------------% c - if (bmat .eq. 'G') then + if (bmat .eq. 'G') then rnorm = ddot (n, resid, 1, workd(ipj), 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then @@ -656,7 +656,7 @@ subroutine igraphdsaitr c if (rnorm .gt. 0.717*wnorm) go to 100 nrorth = nrorth + 1 -c +c c %---------------------------------------------------% c | Enter the Iterative refinement phase. If further | c | refinement is necessary, loop back here. The loop | @@ -669,7 +669,7 @@ subroutine igraphdsaitr if (msglvl .gt. 2) then xtemp(1) = wnorm xtemp(2) = rnorm - call igraphdvout (logfil, 2, xtemp, ndigit, + call igraphdvout (logfil, 2, xtemp, ndigit, & '_saitr: re-orthonalization ; wnorm and rnorm are') end if c @@ -678,7 +678,7 @@ subroutine igraphdsaitr c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). | c %----------------------------------------------------% c - call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1, + call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1, & zero, workd(irj), 1) c c %----------------------------------------------% @@ -689,26 +689,26 @@ subroutine igraphdsaitr c | H(j,j) is updated. | c %----------------------------------------------% c - call dgemv ('N', n, j, -one, v, ldv, workd(irj), 1, + call dgemv ('N', n, j, -one, v, ldv, workd(irj), 1, & one, resid, 1) c if (j .eq. 1 .or. rstart) h(j,1) = zero h(j,2) = h(j,2) + workd(irj + j - 1) -c +c orth2 = .true. - call igraphsecond (t2) + call igrapharscnd (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(irj), 1) ipntr(1) = irj ipntr(2) = ipj ido = 2 -c +c c %-----------------------------------% c | Exit in order to compute B*r_{j}. | c | r_{j} is the corrected residual. | c %-----------------------------------% -c +c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd(ipj), 1) @@ -720,15 +720,15 @@ subroutine igraphdsaitr c %---------------------------------------------------% c if (bmat .eq. 'G') then - call igraphsecond (t3) + call igrapharscnd (t3) tmvbx = tmvbx + (t3 - t2) end if c c %-----------------------------------------------------% c | Compute the B-norm of the corrected residual r_{j}. | c %-----------------------------------------------------% -c - if (bmat .eq. 'G') then +c + if (bmat .eq. 'G') then rnorm1 = ddot (n, resid, 1, workd(ipj), 1) rnorm1 = sqrt(abs(rnorm1)) else if (bmat .eq. 'I') then @@ -745,7 +745,7 @@ subroutine igraphdsaitr & '_saitr: iterative refinement ; rnorm and rnorm1 are') end if end if -c +c c %-----------------------------------------% c | Determine if we need to perform another | c | step of re-orthogonalization. | @@ -758,7 +758,7 @@ subroutine igraphdsaitr c %--------------------------------% c rnorm = rnorm1 -c +c else c c %-------------------------------------------% @@ -780,7 +780,7 @@ subroutine igraphdsaitr 95 continue rnorm = zero end if -c +c c %----------------------------------------------% c | Branch here directly if iterative refinement | c | wasn't necessary or after at most NITER_REF | @@ -788,13 +788,13 @@ subroutine igraphdsaitr c %----------------------------------------------% c 100 continue -c +c rstart = .false. orth2 = .false. -c - call igraphsecond (t5) +c + call igrapharscnd (t5) titref = titref + (t5 - t4) -c +c c %----------------------------------------------------------% c | Make sure the last off-diagonal element is non negative | c | If not perform a similarity transformation on H(1:j,1:j) | @@ -803,28 +803,28 @@ subroutine igraphdsaitr c if (h(j,1) .lt. zero) then h(j,1) = -h(j,1) - if ( j .lt. k+np) then + if ( j .lt. k+np) then call dscal(n, -one, v(1,j+1), 1) else call dscal(n, -one, resid, 1) end if end if -c +c c %------------------------------------% c | STEP 6: Update j = j+1; Continue | c %------------------------------------% c j = j + 1 if (j .gt. k+np) then - call igraphsecond (t1) + call igrapharscnd (t1) tsaitr = tsaitr + (t1 - t0) ido = 99 c if (msglvl .gt. 1) then - call igraphdvout (logfil, k+np, h(1,2), ndigit, + call igraphdvout (logfil, k+np, h(1,2), ndigit, & '_saitr: main diagonal of matrix H of step K+NP.') if (k+np .gt. 1) then - call igraphdvout (logfil, k+np-1, h(2,1), ndigit, + call igraphdvout (logfil, k+np-1, h(2,1), ndigit, & '_saitr: sub diagonal of matrix H of step K+NP.') end if end if @@ -837,7 +837,7 @@ subroutine igraphdsaitr c %--------------------------------------------------------% c go to 1000 -c +c c %---------------------------------------------------------------% c | | c | E N D O F M A I N I T E R A T I O N L O O P | diff --git a/src/vendor/arpack/dsapps.f b/src/vendor/arpack/dsapps.f index 850e3fd34f..36ee8293a0 100644 --- a/src/vendor/arpack/dsapps.f +++ b/src/vendor/arpack/dsapps.f @@ -12,8 +12,8 @@ c c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q c -c where Q is an orthogonal matrix of order KEV+NP. Q is the product of -c rotations resulting from the NP bulge chasing sweeps. The updated Arnoldi +c where Q is an orthogonal matrix of order KEV+NP. Q is the product of +c rotations resulting from the NP bulge chasing sweeps. The updated Arnoldi c factorization becomes: c c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T. @@ -49,7 +49,7 @@ c INPUT: H contains the symmetric tridiagonal matrix of the c Arnoldi factorization with the subdiagonal in the 1st column c starting at H(2,1) and the main diagonal in the 2nd column. -c OUTPUT: H contains the updated tridiagonal matrix in the +c OUTPUT: H contains the updated tridiagonal matrix in the c KEV leading submatrix. c c LDH Integer. (INPUT) @@ -85,13 +85,13 @@ c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. -c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly +c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c c\Routines called: -c igraphivout ARPACK utility routine that prints integers. -c igraphsecond ARPACK utility routine for timing. +c igraphivout ARPACK utility routine that prints integers. +c igrapharscnd ARPACK utility routine for timing. c igraphdvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c dlartg LAPACK Givens rotation construction routine. @@ -107,19 +107,19 @@ c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas +c Rice University +c Houston, Texas c c\Revision history: -c 12/16/93: Version ' 2.1' +c 12/16/93: Version ' 2.4' c -c\SCCS Information: @(#) -c FILE: sapps.F SID: 2.5 DATE OF SID: 4/19/96 RELEASE: 2 +c\SCCS Information: @(#) +c FILE: sapps.F SID: 2.6 DATE OF SID: 3/28/97 RELEASE: 2 c c\Remarks c 1. In this version, each shift is applied to all the subblocks of -c the tridiagonal matrix H and not just to the submatrix that it -c comes from. This routine assumes that the subdiagonal elements +c the tridiagonal matrix H and not just to the submatrix that it +c comes from. This routine assumes that the subdiagonal elements c of H that are stored in h(1:kev+np,1) are nonegative upon input c and enforce this condition upon output. This version incorporates c deflation. See code for documentation. @@ -149,7 +149,7 @@ subroutine igraphdsapps c %-----------------% c Double precision - & h(ldh,2), q(ldq,kev+np), resid(n), shift(np), + & h(ldh,2), q(ldq,kev+np), resid(n), shift(np), & v(ldv,kev+np), workd(2*n) c c %------------% @@ -175,8 +175,8 @@ subroutine igraphdsapps c | External Subroutines | c %----------------------% c - external daxpy, dcopy, dscal, dlacpy, dlartg, dlaset, - & igraphdvout, igraphivout, igraphsecond, dgemv + external daxpy, dcopy, dscal, dlacpy, dlartg, dlaset, + & igraphdvout, igraphivout, igrapharscnd, dgemv c c %--------------------% c | External Functions | @@ -193,7 +193,7 @@ subroutine igraphdsapps intrinsic abs c c %----------------% -c | Data statments | +c | Data statements | c %----------------% c data first / .true. / @@ -213,11 +213,11 @@ subroutine igraphdsapps c | & message level for debugging | c %-------------------------------% c - call igraphsecond (t0) + call igrapharscnd (t0) msglvl = msapps -c - kplusp = kev + np -c +c + kplusp = kev + np +c c %----------------------------------------------% c | Initialize Q to the identity matrix of order | c | kplusp used to accumulate the rotations. | @@ -230,7 +230,7 @@ subroutine igraphdsapps c %----------------------------------------------% c if (np .eq. 0) go to 9000 -c +c c %----------------------------------------------------------% c | Apply the np shifts implicitly. Apply each shift to the | c | whole matrix and not just to the submatrix from which it | @@ -238,7 +238,7 @@ subroutine igraphdsapps c %----------------------------------------------------------% c do 90 jj = 1, np -c +c istart = itop c c %----------------------------------------------------------% @@ -261,11 +261,11 @@ subroutine igraphdsapps big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then - call igraphivout (logfil, 1, i, ndigit, + call igraphivout (logfil, 1, [i], ndigit, & '_sapps: deflation at row/column no.') - call igraphivout (logfil, 1, jj, ndigit, - & '_sapps: occured before shift number.') - call igraphdvout (logfil, 1, h(i+1,1), ndigit, + call igraphivout (logfil, 1, [jj], ndigit, + & '_sapps: occurred before shift number.') + call igraphdvout (logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') end if h(i+1,1) = zero @@ -277,7 +277,7 @@ subroutine igraphdsapps 40 continue c if (istart .lt. iend) then -c +c c %--------------------------------------------------------% c | Construct the plane rotation G'(istart,istart+1,theta) | c | that attempts to drive h(istart+1,1) to zero. | @@ -286,7 +286,7 @@ subroutine igraphdsapps f = h(istart,2) - shift(jj) g = h(istart+1,1) call dlartg (f, g, c, s, r) -c +c c %-------------------------------------------------------% c | Apply rotation to the left and right of H; | c | H <- G' * H * G, where G = G(istart,istart+1,theta). | @@ -296,11 +296,11 @@ subroutine igraphdsapps a1 = c*h(istart,2) + s*h(istart+1,1) a2 = c*h(istart+1,1) + s*h(istart+1,2) a4 = c*h(istart+1,2) - s*h(istart+1,1) - a3 = c*h(istart+1,1) - s*h(istart,2) + a3 = c*h(istart+1,1) - s*h(istart,2) h(istart,2) = c*a1 + s*a2 h(istart+1,2) = c*a4 - s*a3 h(istart+1,1) = c*a3 + s*a4 -c +c c %----------------------------------------------------% c | Accumulate the rotation in the matrix Q; Q <- Q*G | c %----------------------------------------------------% @@ -323,7 +323,7 @@ subroutine igraphdsapps c %----------------------------------------------% c do 70 i = istart+1, iend-1 -c +c c %----------------------------------------------% c | Construct the plane rotation G'(i,i+1,theta) | c | that zeros the i-th bulge that was created | @@ -351,28 +351,28 @@ subroutine igraphdsapps c = -c s = -s end if -c +c c %--------------------------------------------% c | Apply rotation to the left and right of H; | c | H <- G * H * G', where G = G(i,i+1,theta) | c %--------------------------------------------% c h(i,1) = r -c +c a1 = c*h(i,2) + s*h(i+1,1) a2 = c*h(i+1,1) + s*h(i+1,2) a3 = c*h(i+1,1) - s*h(i,2) a4 = c*h(i+1,2) - s*h(i+1,1) -c +c h(i,2) = c*a1 + s*a2 h(i+1,2) = c*a4 - s*a3 h(i+1,1) = c*a3 + s*a4 -c +c c %----------------------------------------------------% c | Accumulate the rotation in the matrix Q; Q <- Q*G | c %----------------------------------------------------% c - do 50 j = 1, min( j+jj, kplusp ) + do 50 j = 1, min( i+jj, kplusp ) a1 = c*q(j,i) + s*q(j,i+1) q(j,i+1) = - s*q(j,i) + c*q(j,i+1) q(j,i) = a1 @@ -425,16 +425,16 @@ subroutine igraphdsapps c %------------------------------------------% c | All shifts have been applied. Check for | c | more possible deflation that might occur | -c | after the last shift is applied. | +c | after the last shift is applied. | c %------------------------------------------% c do 100 i = itop, kplusp-1 big = abs(h(i,2)) + abs(h(i+1,2)) if (h(i+1,1) .le. epsmch*big) then if (msglvl .gt. 0) then - call igraphivout (logfil, 1, i, ndigit, + call igraphivout (logfil, 1, [i], ndigit, & '_sapps: deflation at row/column no.') - call igraphdvout (logfil, 1, h(i+1,1), ndigit, + call igraphdvout (logfil, 1, h(i+1,1), ndigit, & '_sapps: the corresponding off diagonal element') end if h(i+1,1) = zero @@ -447,13 +447,13 @@ subroutine igraphdsapps c | This is not necessary if h(kev+1,1) = 0. | c %-------------------------------------------------% c - if ( h(kev+1,1) .gt. zero ) + if ( h(kev+1,1) .gt. zero ) & call dgemv ('N', n, kplusp, one, v, ldv, & q(1,kev+1), 1, zero, workd(n+1), 1) -c +c c %-------------------------------------------------------% c | Compute column 1 to kev of (V*Q) in backward order | -c | taking advantage that Q is an upper triangular matrix | +c | taking advantage that Q is an upper triangular matrix | c | with lower bandwidth np. | c | Place results in v(:,kplusp-kev:kplusp) temporarily. | c %-------------------------------------------------------% @@ -468,16 +468,18 @@ subroutine igraphdsapps c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). | c %-------------------------------------------------% c - call dlacpy ('All', n, kev, v(1,np+1), ldv, v, ldv) -c + do 140 i = 1, kev + call dcopy (n, v(1,np+i), 1, v(1,i), 1) + 140 continue +c c %--------------------------------------------% c | Copy the (kev+1)-st column of (V*Q) in the | c | appropriate place if h(kev+1,1) .ne. zero. | c %--------------------------------------------% c - if ( h(kev+1,1) .gt. zero ) + if ( h(kev+1,1) .gt. zero ) & call dcopy (n, workd(n+1), 1, v(1,kev+1), 1) -c +c c %-------------------------------------% c | Update the residual vector: | c | r <- sigmak*r + betak*v(:,kev+1) | @@ -487,26 +489,26 @@ subroutine igraphdsapps c %-------------------------------------% c call dscal (n, q(kplusp,kev), resid, 1) - if (h(kev+1,1) .gt. zero) + if (h(kev+1,1) .gt. zero) & call daxpy (n, h(kev+1,1), v(1,kev+1), 1, resid, 1) c if (msglvl .gt. 1) then - call igraphdvout (logfil, 1, q(kplusp,kev), ndigit, + call igraphdvout (logfil, 1, q(kplusp,kev), ndigit, & '_sapps: sigmak of the updated residual vector') - call igraphdvout (logfil, 1, h(kev+1,1), ndigit, + call igraphdvout (logfil, 1, h(kev+1,1), ndigit, & '_sapps: betak of the updated residual vector') - call igraphdvout (logfil, kev, h(1,2), ndigit, + call igraphdvout (logfil, kev, h(1,2), ndigit, & '_sapps: updated main diagonal of H for next iteration') if (kev .gt. 1) then - call igraphdvout (logfil, kev-1, h(2,1), ndigit, + call igraphdvout (logfil, kev-1, h(2,1), ndigit, & '_sapps: updated sub diagonal of H for next iteration') end if end if c - call igraphsecond (t1) + call igrapharscnd (t1) tsapps = tsapps + (t1 - t0) -c - 9000 continue +c + 9000 continue return c c %---------------% diff --git a/src/vendor/arpack/dsaup2.f b/src/vendor/arpack/dsaup2.f index 116dd3113b..f69d6e41b3 100644 --- a/src/vendor/arpack/dsaup2.f +++ b/src/vendor/arpack/dsaup2.f @@ -3,35 +3,35 @@ c c\Name: igraphdsaup2 c -c\Description: +c\Description: c Intermediate level interface called by igraphdsaupd. c c\Usage: -c call igraphdsaup2 +c call igraphdsaup2 c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD, -c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL, +c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL, c IPNTR, WORKD, INFO ) c c\Arguments c c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in igraphdsaupd. c MODE, ISHIFT, MXITER: see the definition of IPARAM in igraphdsaupd. -c +c c NP Integer. (INPUT/OUTPUT) -c Contains the number of implicit shifts to apply during -c each Arnoldi/Lanczos iteration. -c If ISHIFT=1, NP is adjusted dynamically at each iteration +c Contains the number of implicit shifts to apply during +c each Arnoldi/Lanczos iteration. +c If ISHIFT=1, NP is adjusted dynamically at each iteration c to accelerate convergence and prevent stagnation. -c This is also roughly equal to the number of matrix-vector +c This is also roughly equal to the number of matrix-vector c products (involving the operator OP) per Arnoldi iteration. c The logic for adjusting is contained within the current c subroutine. c If ISHIFT=0, NP is the number of shifts the user needs -c to provide via reverse comunication. 0 < NP < NCV-NEV. +c to provide via reverse communication. 0 < NP < NCV-NEV. c NP may be less than NCV-NEV since a leading block of the current c upper Tridiagonal matrix has split off and contains "unwanted" c Ritz values. -c Upon termination of the IRA iteration, NP contains the number +c Upon termination of the IRA iteration, NP contains the number c of "converged" wanted Ritz values. c c IUPD Integer. (INPUT) @@ -42,18 +42,18 @@ c The Lanczos basis vectors. c c LDV Integer. (INPUT) -c Leading dimension of V exactly as declared in the calling +c Leading dimension of V exactly as declared in the calling c program. c c H Double precision (NEV+NP) by 2 array. (OUTPUT) c H is used to store the generated symmetric tridiagonal matrix -c The subdiagonal is stored in the first column of H starting -c at H(2,1). The main diagonal is stored in the igraphsecond column -c of H starting at H(1,2). If igraphdsaup2 converges store the +c The subdiagonal is stored in the first column of H starting +c at H(2,1). The main diagonal is stored in the igrapharscnd column +c of H starting at H(1,2). If igraphdsaup2 converges store the c B-norm of the final residual vector in H(1,1). c c LDH Integer. (INPUT) -c Leading dimension of H exactly as declared in the calling +c Leading dimension of H exactly as declared in the calling c program. c c RITZ Double precision array of length NEV+NP. (OUTPUT) @@ -63,33 +63,33 @@ c BOUNDS(1:NEV) contain the error bounds corresponding to RITZ. c c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE) -c Private (replicated) work array used to accumulate the +c Private (replicated) work array used to accumulate the c rotation in the shift application step. c c LDQ Integer. (INPUT) c Leading dimension of Q exactly as declared in the calling c program. -c +c c WORKL Double precision array of length at least 3*(NEV+NP). (INPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on -c the front end. It is used in the computation of the +c the front end. It is used in the computation of the c tridiagonal eigenvalue problem, the calculation and c application of the shifts and convergence checking. c If ISHIFT .EQ. O and IDO .EQ. 3, the first NP locations -c of WORKL are used in reverse communication to hold the user +c of WORKL are used in reverse communication to hold the user c supplied shifts. c c IPNTR Integer array of length 3. (OUTPUT) -c Pointer to mark the starting locations in the WORKD for +c Pointer to mark the starting locations in the WORKD for c vectors used by the Lanczos iteration. c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X. c IPNTR(2): pointer to the current result vector Y. -c IPNTR(3): pointer to the vector B * X when used in one of +c IPNTR(3): pointer to the vector B * X when used in one of c the spectral transformation modes. X is the current c operand. c ------------------------------------------------------------- -c +c c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Lanczos iteration c for reverse communication. The user should not use WORKD @@ -102,9 +102,9 @@ c possibly from a previous run. c Error flag on output. c = 0: Normal return. -c = 1: All possible eigenvalues of OP has been found. +c = 1: All possible eigenvalues of OP has been found. c NP returns the size of the invariant subspace -c spanning the operator OP. +c spanning the operator OP. c = 2: No shifts could be applied. c = -8: Error return from trid. eigenvalue calculation; c This should never happen. @@ -122,7 +122,7 @@ c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. -c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly +c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, @@ -132,15 +132,15 @@ c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to c Implement the Spectral Transformation", Math. Comp., 48 (1987), c pp 663-673. -c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos -c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", +c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos +c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", c SIAM J. Matr. Anal. Apps., January (1993). c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines c for Updating the QR decomposition", ACM TOMS, December 1990, c Volume 16 Number 4, pp 369-377. c c\Routines called: -c igraphdgetv0 ARPACK initial vector generation routine. +c igraphdgetv0 ARPACK initial vector generation routine. c igraphdsaitr ARPACK Lanczos factorization routine. c igraphdsapps ARPACK application of implicit shifts routine. c igraphdsconv ARPACK convergence of Ritz values routine. @@ -148,11 +148,11 @@ c igraphdsgets ARPACK reorder Ritz values and error bounds routine. c igraphdsortr ARPACK sorting routine. c igraphivout ARPACK utility routine that prints integers. -c igraphsecond ARPACK utility routine for timing. +c igrapharscnd ARPACK utility routine for timing. c igraphdvout ARPACK utility routine that prints vectors. c dlamch LAPACK routine that determines machine constants. c dcopy Level 1 BLAS that copies one vector to another. -c ddot Level 1 BLAS that computes the scalar product of two vectors. +c ddot Level 1 BLAS that computes the scalar product of two vectors. c dnrm2 Level 1 BLAS that computes the norm of a vector. c dscal Level 1 BLAS that scales a vector. c dswap Level 1 BLAS that swaps two vectors. @@ -162,23 +162,23 @@ c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas -c +c Rice University +c Houston, Texas +c c\Revision history: c 12/15/93: Version ' 2.4' c xx/xx/95: Version ' 2.4'. (R.B. Lehoucq) c -c\SCCS Information: @(#) -c FILE: saup2.F SID: 2.6 DATE OF SID: 8/16/96 RELEASE: 2 +c\SCCS Information: @(#) +c FILE: saup2.F SID: 2.7 DATE OF SID: 5/19/98 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- c subroutine igraphdsaup2 - & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd, - & ishift, mxiter, v, ldv, h, ldh, ritz, bounds, + & ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd, + & ishift, mxiter, v, ldv, h, ldh, ritz, bounds, & q, ldq, workl, ipntr, workd, info ) c c %----------------------------------------------------% @@ -204,8 +204,8 @@ subroutine igraphdsaup2 c integer ipntr(3) Double precision - & bounds(nev+np), h(ldh,2), q(ldq,nev+np), resid(n), - & ritz(nev+np), v(ldv,nev+np), workd(3*n), + & bounds(nev+np), h(ldh,2), q(ldq,nev+np), resid(n), + & ritz(nev+np), v(ldv,nev+np), workd(3*n), & workl(3*(nev+np)) c c %------------% @@ -222,8 +222,8 @@ subroutine igraphdsaup2 c character wprime*2 logical cnorm, getv0, initv, update, ushift - integer ierr, iter, j, kplusp, msglvl, nconv, nevbef, nev0, - & np0, nptemp, nevd2, nevm2, kp(3) + integer ierr, iter, j, kplusp, msglvl, nconv, nevbef, nev0, + & np0, nptemp, nevd2, nevm2, kp(3) Double precision & rnorm, temp, eps23 save cnorm, getv0, initv, update, ushift, @@ -234,10 +234,10 @@ subroutine igraphdsaup2 c | External Subroutines | c %----------------------% c - external dcopy, igraphdgetv0, igraphdsaitr, dscal, - & igraphdsconv, igraphdseigt, igraphdsgets, - & igraphdsapps, igraphdsortr, igraphdvout, igraphivout, - & igraphsecond, dswap + external dcopy, igraphdgetv0, igraphdsaitr, dscal, + & igraphdsconv, igraphdseigt, igraphdsgets, + & igraphdsapps, igraphdsortr, igraphdvout, + & igraphivout, igrapharscnd , dswap c c %--------------------% c | External Functions | @@ -258,13 +258,13 @@ subroutine igraphdsaup2 c %-----------------------% c if (ido .eq. 0) then -c +c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c - call igraphsecond (t0) + call igrapharscnd (t0) msglvl = msaup2 c c %---------------------------------% @@ -294,7 +294,7 @@ subroutine igraphdsaup2 kplusp = nev0 + np0 nconv = 0 iter = 0 -c +c c %--------------------------------------------% c | Set flags for computing the first NEV steps | c | of the Lanczos factorization. | @@ -317,7 +317,7 @@ subroutine igraphdsaup2 initv = .false. end if end if -c +c c %---------------------------------------------% c | Get a possibly random starting vector and | c | force it into the range of the operator OP. | @@ -327,14 +327,14 @@ subroutine igraphdsaup2 c if (getv0) then call igraphdgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, - & rnorm, ipntr, workd, info) + & rnorm, ipntr, workd, info) c if (ido .ne. 99) go to 9000 c if (rnorm .eq. zero) then c c %-----------------------------------------% -c | The initial vector is zero. Error exit. | +c | The initial vector is zero. Error exit. | c %-----------------------------------------% c info = -9 @@ -343,7 +343,7 @@ subroutine igraphdsaup2 getv0 = .false. ido = 0 end if -c +c c %------------------------------------------------------------% c | Back from reverse communication: continue with update step | c %------------------------------------------------------------% @@ -362,14 +362,14 @@ subroutine igraphdsaup2 c %-------------------------------------% c if (cnorm) go to 100 -c +c c %----------------------------------------------------------% c | Compute the first NEV steps of the Lanczos factorization | c %----------------------------------------------------------% c - call igraphdsaitr (ido, bmat, n, 0, nev0, mode, resid, rnorm, v, - & ldv, h, ldh, ipntr, workd, info) -c + call igraphdsaitr (ido, bmat, n, 0, nev0, mode, resid, rnorm, v, + & ldv, h, ldh, ipntr, workd, info) +c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | @@ -390,7 +390,7 @@ subroutine igraphdsaup2 info = -9999 go to 1200 end if -c +c c %--------------------------------------------------------------% c | | c | M A I N LANCZOS I T E R A T I O N L O O P | @@ -398,22 +398,22 @@ subroutine igraphdsaup2 c | factorization in place. | c | | c %--------------------------------------------------------------% -c +c 1000 continue c iter = iter + 1 c if (msglvl .gt. 0) then - call igraphivout (logfil, 1, [iter], ndigit, + call igraphivout (logfil, 1, [iter], ndigit, & '_saup2: **** Start of major iteration number ****') end if if (msglvl .gt. 1) then - call igraphivout (logfil, 1, [nev], ndigit, + call igraphivout (logfil, 1, [nev], ndigit, & '_saup2: The length of the current Lanczos factorization') - call igraphivout (logfil, 1, [np], ndigit, + call igraphivout (logfil, 1, [np], ndigit, & '_saup2: Extend the Lanczos factorization by') end if -c +c c %------------------------------------------------------------% c | Compute NP additional steps of the Lanczos factorization. | c %------------------------------------------------------------% @@ -422,9 +422,10 @@ subroutine igraphdsaup2 20 continue update = .true. c - call igraphdsaitr (ido, bmat, n, nev, np, mode, resid, rnorm, - & v, ldv, h, ldh, ipntr, workd, info) -c + call igraphdsaitr (ido, bmat, n, nev, np, mode, resid, + & rnorm, v, + & ldv, h, ldh, ipntr, workd, info) +c c %---------------------------------------------------% c | ido .ne. 99 implies use of reverse communication | c | to compute operations involving OP and possibly B | @@ -436,7 +437,7 @@ subroutine igraphdsaup2 c c %-----------------------------------------------------% c | igraphdsaitr was unable to build an Lanczos factorization | -c | of length NEV0+NP0. INFO is returned with the size | +c | of length NEV0+NP0. INFO is returned with the size | c | of the factorization built. Exit main loop. | c %-----------------------------------------------------% c @@ -448,17 +449,17 @@ subroutine igraphdsaup2 update = .false. c if (msglvl .gt. 1) then - call igraphdvout (logfil, 1, [rnorm], ndigit, + call igraphdvout (logfil, 1, [rnorm], ndigit, & '_saup2: Current B-norm of residual for factorization') end if -c +c c %--------------------------------------------------------% c | Compute the eigenvalues and corresponding error bounds | c | of the current symmetric tridiagonal matrix. | c %--------------------------------------------------------% c - call igraphdseigt (rnorm, kplusp, h, ldh, ritz, bounds, workl, - & ierr) + call igraphdseigt (rnorm, kplusp, h, ldh, ritz, bounds, + & workl, ierr) c if (ierr .ne. 0) then info = -8 @@ -486,7 +487,7 @@ subroutine igraphdsaup2 nev = nev0 np = np0 call igraphdsgets (ishift, which, nev, np, ritz, bounds, workl) -c +c c %-------------------% c | Convergence test. | c %-------------------% @@ -523,11 +524,11 @@ subroutine igraphdsaup2 nev = nev + 1 end if 30 continue -c - if ( (nconv .ge. nev0) .or. +c + if ( (nconv .ge. nev0) .or. & (iter .gt. mxiter) .or. & (np .eq. 0) ) then -c +c c %------------------------------------------------% c | Prepare to exit. Put the converged Ritz values | c | and corresponding bounds in RITZ(1:NCONV) and | @@ -549,13 +550,14 @@ subroutine igraphdsaup2 c wprime = 'SA' call igraphdsortr (wprime, .true., kplusp, ritz, bounds) - nevd2 = nev / 2 - nevm2 = nev - nevd2 + nevd2 = nev0 / 2 + nevm2 = nev0 - nevd2 if ( nev .gt. 1 ) then + np = kplusp - nev0 call dswap ( min(nevd2,np), ritz(nevm2+1), 1, & ritz( max(kplusp-nevd2+1,kplusp-np+1) ), 1) call dswap ( min(nevd2,np), bounds(nevm2+1), 1, - & bounds( max(kplusp-nevd2+1,kplusp-np)+1 ), 1) + & bounds( max(kplusp-nevd2+1,kplusp-np+1)), 1) end if c else @@ -590,7 +592,7 @@ subroutine igraphdsaup2 c c %----------------------------------------------------% c | Sort the Ritz values according to the scaled Ritz | -c | esitmates. This will push all the converged ones | +c | estimates. This will push all the converged ones | c | towards the front of ritzr, ritzi, bounds | c | (in the case when NCONV < NEV.) | c %----------------------------------------------------% @@ -654,13 +656,13 @@ subroutine igraphdsaup2 end if c c %------------------------------------% -c | Max iterations have been exceeded. | +c | Max iterations have been exceeded. | c %------------------------------------% c if (iter .gt. mxiter .and. nconv .lt. nev) info = 1 c c %---------------------% -c | No shifts to apply. | +c | No shifts to apply. | c %---------------------% c if (np .eq. 0 .and. nconv .lt. nev0) info = 2 @@ -684,13 +686,13 @@ subroutine igraphdsaup2 nev = 2 end if np = kplusp - nev -c +c c %---------------------------------------% c | If the size of NEV was just increased | c | resort the eigenvalues. | c %---------------------------------------% -c - if (nevbef .lt. nev) +c + if (nevbef .lt. nev) & call igraphdsgets (ishift, which, nev, np, ritz, bounds, & workl) c @@ -711,7 +713,7 @@ subroutine igraphdsaup2 end if end if -c +c if (ishift .eq. 0) then c c %-----------------------------------------------------% @@ -734,8 +736,8 @@ subroutine igraphdsaup2 c %------------------------------------% c ushift = .false. -c -c +c +c c %---------------------------------------------------------% c | Move the NP shifts to the first NP locations of RITZ to | c | free up WORKL. This is for the non-exact shift case; | @@ -754,7 +756,7 @@ subroutine igraphdsaup2 & '_saup2: corresponding Ritz estimates') end if end if -c +c c %---------------------------------------------------------% c | Apply the NP0 implicit shifts by QR bulge chasing. | c | Each shift is applied to the entire tridiagonal matrix. | @@ -763,8 +765,8 @@ subroutine igraphdsaup2 c | factorization of length NEV. | c %---------------------------------------------------------% c - call igraphdsapps (n, nev, np, ritz, v, ldv, h, ldh, resid, - & q, ldq, workd) + call igraphdsapps (n, nev, np, ritz, v, ldv, h, ldh, resid, + & q, ldq, workd) c c %---------------------------------------------% c | Compute the B-norm of the updated residual. | @@ -773,36 +775,36 @@ subroutine igraphdsaup2 c %---------------------------------------------% c cnorm = .true. - call igraphsecond (t2) + call igrapharscnd (t2) if (bmat .eq. 'G') then nbx = nbx + 1 call dcopy (n, resid, 1, workd(n+1), 1) ipntr(1) = n + 1 ipntr(2) = 1 ido = 2 -c +c c %----------------------------------% c | Exit in order to compute B*RESID | c %----------------------------------% -c +c go to 9000 else if (bmat .eq. 'I') then call dcopy (n, resid, 1, workd, 1) end if -c +c 100 continue -c +c c %----------------------------------% c | Back from reverse communication; | c | WORKD(1:N) := B*RESID | c %----------------------------------% c if (bmat .eq. 'G') then - call igraphsecond (t3) + call igrapharscnd (t3) tmvbx = tmvbx + (t3 - t2) end if -c - if (bmat .eq. 'G') then +c + if (bmat .eq. 'G') then rnorm = ddot (n, resid, 1, workd, 1) rnorm = sqrt(abs(rnorm)) else if (bmat .eq. 'I') then @@ -812,14 +814,14 @@ subroutine igraphdsaup2 130 continue c if (msglvl .gt. 2) then - call igraphdvout (logfil, 1, [rnorm], ndigit, + call igraphdvout (logfil, 1, [rnorm], ndigit, & '_saup2: B-norm of residual for NEV factorization') call igraphdvout (logfil, nev, h(1,2), ndigit, & '_saup2: main diagonal of compressed H matrix') call igraphdvout (logfil, nev-1, h(2,1), ndigit, & '_saup2: subdiagonal of compressed H matrix') end if -c +c go to 1000 c c %---------------------------------------------------------------% @@ -827,12 +829,12 @@ subroutine igraphdsaup2 c | E N D O F M A I N I T E R A T I O N L O O P | c | | c %---------------------------------------------------------------% -c +c 1100 continue c mxiter = iter nev = nconv -c +c 1200 continue ido = 99 c @@ -840,9 +842,9 @@ subroutine igraphdsaup2 c | Error exit | c %------------% c - call igraphsecond (t1) + call igrapharscnd (t1) tsaup2 = t1 - t0 -c +c 9000 continue return c diff --git a/src/vendor/arpack/dsaupd.f b/src/vendor/arpack/dsaupd.f index 7e85781c73..5f40f11715 100644 --- a/src/vendor/arpack/dsaupd.f +++ b/src/vendor/arpack/dsaupd.f @@ -3,31 +3,31 @@ c c\Name: igraphdsaupd c -c\Description: +c\Description: c -c Reverse communication interface for the Implicitly Restarted Arnoldi -c Iteration. For symmetric problems this reduces to a variant of the Lanczos -c method. This method has been designed to compute approximations to a -c few eigenpairs of a linear operator OP that is real and symmetric -c with respect to a real positive semi-definite symmetric matrix B, +c Reverse communication interface for the Implicitly Restarted Arnoldi +c Iteration. For symmetric problems this reduces to a variant of the Lanczos +c method. This method has been designed to compute approximations to a +c few eigenpairs of a linear operator OP that is real and symmetric +c with respect to a real positive semi-definite symmetric matrix B, c i.e. -c -c B*OP = (OP')*B. c -c Another way to express this condition is +c B*OP = (OP`)*B. c -c < x,OPy > = < OPx,y > where < z,w > = z'Bw . -c -c In the standard eigenproblem B is the identity matrix. -c ( A' denotes transpose of A) +c Another way to express this condition is +c +c < x,OPy > = < OPx,y > where < z,w > = z`Bw . +c +c In the standard eigenproblem B is the identity matrix. +c ( A` denotes transpose of A) c c The computed approximate eigenvalues are called Ritz values and c the corresponding approximate eigenvectors are called Ritz vectors. c -c igraphdsaupd is usually called iteratively to solve one of the +c igraphdsaupd is usually called iteratively to solve one of the c following problems: c -c Mode 1: A*x = lambda*x, A symmetric +c Mode 1: A*x = lambda*x, A symmetric c ===> OP = A and B = I. c c Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite @@ -35,10 +35,10 @@ c ===> (If M can be factored see remark 3 below) c c Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite -c ===> OP = (inv[K - sigma*M])*M and B = M. +c ===> OP = (inv[K - sigma*M])*M and B = M. c ===> Shift-and-Invert mode c -c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite, +c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite, c KG symmetric indefinite c ===> OP = (inv[K - sigma*KG])*K and B = K. c ===> Buckling mode @@ -60,18 +60,18 @@ c approximations. c c\Usage: -c call igraphdsaupd +c call igraphdsaupd c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, c IPNTR, WORKD, WORKL, LWORKL, INFO ) c c\Arguments c IDO Integer. (INPUT/OUTPUT) -c Reverse communication flag. IDO must be zero on the first -c call to igraphdsaupd. IDO will be set internally to +c Reverse communication flag. IDO must be zero on the first +c call to igraphdsaupd . IDO will be set internally to c indicate the type of operation to be performed. Control is c then given back to the calling routine which has the c responsibility to carry out the requested operation and call -c igraphdsaupd with the result. The operand is given in +c igraphdsaupd with the result. The operand is given in c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). c (If Mode = 2 see remark 5 below) c ------------------------------------------------------------- @@ -95,7 +95,7 @@ c placing the shifts. See remark 6 below. c IDO = 99: done c ------------------------------------------------------------- -c +c c BMAT Character*1. (INPUT) c BMAT specifies the type of the matrix B that defines the c semi-inner product for the operator OP. @@ -111,7 +111,7 @@ c 'LA' - compute the NEV largest (algebraic) eigenvalues. c 'SA' - compute the NEV smallest (algebraic) eigenvalues. c 'LM' - compute the NEV largest (in magnitude) eigenvalues. -c 'SM' - compute the NEV smallest (in magnitude) eigenvalues. +c 'SM' - compute the NEV smallest (in magnitude) eigenvalues. c 'BE' - compute NEV eigenvalues, half from each end of the c spectrum. When NEV is odd, compute one more from the c high end than from the low end. @@ -120,31 +120,31 @@ c NEV Integer. (INPUT) c Number of eigenvalues of OP to be computed. 0 < NEV < N. c -c TOL Double precision scalar. (INPUT) -c Stopping criterion: the relative accuracy of the Ritz value +c TOL Double precision scalar. (INPUT) +c Stopping criterion: the relative accuracy of the Ritz value c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)). c If TOL .LE. 0. is passed a default is set: -c DEFAULT = DLAMCH('EPS') (machine precision as computed -c by the LAPACK auxiliary subroutine DLAMCH). +c DEFAULT = DLAMCH ('EPS') (machine precision as computed +c by the LAPACK auxiliary subroutine DLAMCH ). c -c RESID Double precision array of length N. (INPUT/OUTPUT) -c On INPUT: +c RESID Double precision array of length N. (INPUT/OUTPUT) +c On INPUT: c If INFO .EQ. 0, a random initial residual vector is used. c If INFO .NE. 0, RESID contains the initial residual vector, c possibly from a previous run. c On OUTPUT: -c RESID contains the final residual vector. +c RESID contains the final residual vector. c c NCV Integer. (INPUT) c Number of columns of the matrix V (less than or equal to N). -c This will indicate how many Lanczos vectors are generated -c at each iteration. After the startup phase in which NEV -c Lanczos vectors are generated, the algorithm generates +c This will indicate how many Lanczos vectors are generated +c at each iteration. After the startup phase in which NEV +c Lanczos vectors are generated, the algorithm generates c NCV-NEV Lanczos vectors at each subsequent update iteration. -c Most of the cost in generating each Lanczos vector is in the +c Most of the cost in generating each Lanczos vector is in the c matrix-vector product OP*x. (See remark 4 below). c -c V Double precision N by NCV array. (OUTPUT) +c V Double precision N by NCV array. (OUTPUT) c The NCV columns of V contain the Lanczos basis vectors. c c LDV Integer. (INPUT) @@ -161,10 +161,10 @@ c the current tridiagonal matrix T are returned in c the part of WORKL array corresponding to RITZ. c See remark 6 below. -c ISHIFT = 1: exact shifts with respect to the reduced -c tridiagonal matrix T. This is equivalent to -c restarting the iteration with a starting vector -c that is a linear combination of Ritz vectors +c ISHIFT = 1: exact shifts with respect to the reduced +c tridiagonal matrix T. This is equivalent to +c restarting the iteration with a starting vector +c that is a linear combination of Ritz vectors c associated with the "wanted" Ritz values. c ------------------------------------------------------------- c @@ -172,8 +172,8 @@ c No longer referenced. See remark 2 below. c c IPARAM(3) = MXITER -c On INPUT: maximum number of Arnoldi update iterations allowed. -c On OUTPUT: actual number of Arnoldi update iterations taken. +c On INPUT: maximum number of Arnoldi update iterations allowed. +c On OUTPUT: actual number of Arnoldi update iterations taken. c c IPARAM(4) = NB: blocksize to be used in the recurrence. c The code currently works only for NB = 1. @@ -183,23 +183,23 @@ c the convergence criterion. c c IPARAM(6) = IUPD -c No longer referenced. Implicit restarting is ALWAYS used. +c No longer referenced. Implicit restarting is ALWAYS used. c c IPARAM(7) = MODE c On INPUT determines what type of eigenproblem is being solved. -c Must be 1,2,3,4,5; See under \Description of igraphdsaupd for the +c Must be 1,2,3,4,5; See under \Description of igraphdsaupd for the c five modes available. c c IPARAM(8) = NP c When ido = 3 and the user provides shifts through reverse -c communication (IPARAM(1)=0), igraphdsaupd returns NP, the number +c communication (IPARAM(1)=0), igraphdsaupd returns NP, the number c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark c 6 below. c c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO, c OUTPUT: NUMOP = total number of OP*x operations, c NUMOPB = total number of B*x operations if BMAT='G', -c NUMREO = total number of steps of re-orthogonalization. +c NUMREO = total number of steps of re-orthogonalization. c c IPNTR Integer array of length 11. (OUTPUT) c Pointer to mark the starting locations in the WORKD and WORKL @@ -207,7 +207,7 @@ c ------------------------------------------------------------- c IPNTR(1): pointer to the current operand vector X in WORKD. c IPNTR(2): pointer to the current result vector Y in WORKD. -c IPNTR(3): pointer to the vector B * X in WORKD when used in +c IPNTR(3): pointer to the vector B * X in WORKD when used in c the shift-and-invert mode. c IPNTR(4): pointer to the next available location in WORKL c that is untouched by the program. @@ -217,23 +217,23 @@ c with the Ritz values located in RITZ in WORKL. c IPNTR(11): pointer to the NP shifts in WORKL. See Remark 6 below. c -c Note: IPNTR(8:10) is only referenced by igraphdseupd. See Remark 2. +c Note: IPNTR(8:10) is only referenced by igraphdseupd . See Remark 2. c IPNTR(8): pointer to the NCV RITZ values of the original system. c IPNTR(9): pointer to the NCV corresponding error bounds. c IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors c of the tridiagonal matrix T. Only referenced by -c igraphdseupd if RVEC = .TRUE. See Remarks. +c igraphdseupd if RVEC = .TRUE. See Remarks. c ------------------------------------------------------------- -c -c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) +c +c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) c Distributed array to be used in the basic Arnoldi iteration -c for reverse communication. The user should not use WORKD +c for reverse communication. The user should not use WORKD c as temporary workspace during the iteration. Upon termination c WORKD(1:N) contains B*RESID(1:N). If the Ritz vectors are desired -c subroutine igraphdseupd uses this output. -c See Data Distribution Note below. +c subroutine igraphdseupd uses this output. +c See Data Distribution Note below. c -c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) +c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) c Private (replicated) array on each PE or array allocated on c the front end. See Data Distribution Note below. c @@ -247,13 +247,13 @@ c Error flag on output. c = 0: Normal exit. c = 1: Maximum number of iterations taken. -c All possible eigenvalues of OP has been found. IPARAM(5) +c All possible eigenvalues of OP has been found. IPARAM(5) c returns the number of wanted converged Ritz values. c = 2: No longer an informational error. Deprecated starting c with release 2 of ARPACK. -c = 3: No shifts could be applied during a cycle of the -c Implicitly restarted Arnoldi iteration. One possibility -c is to increase the size of NCV relative to NEV. +c = 3: No shifts could be applied during a cycle of the +c Implicitly restarted Arnoldi iteration. One possibility +c is to increase the size of NCV relative to NEV. c See remark 4 below. c = -1: N must be positive. c = -2: NEV must be positive. @@ -264,12 +264,12 @@ c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work array WORKL is not sufficient. c = -8: Error return from trid. eigenvalue calculation; -c Informatinal error from LAPACK routine dsteqr. +c Informatinal error from LAPACK routine dsteqr . c = -9: Starting vector is zero. c = -10: IPARAM(7) must be 1,2,3,4,5. -c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable. +c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. c = -12: IPARAM(1) must be equal to 0 or 1. -c = -13: NEV and WHICH = 'BE' are incompatable. +c = -13: NEV and WHICH = 'BE' are incompatible. c = -9999: Could not build an Arnoldi factorization. c IPARAM(5) returns the size of the current Arnoldi c factorization. The user is advised to check that @@ -277,51 +277,51 @@ c c c\Remarks -c 1. The converged Ritz values are always returned in ascending +c 1. The converged Ritz values are always returned in ascending c algebraic order. The computed Ritz values are approximate c eigenvalues of OP. The selection of WHICH should be made -c with this in mind when Mode = 3,4,5. After convergence, -c approximate eigenvalues of the original problem may be obtained -c with the ARPACK subroutine igraphdseupd. +c with this in mind when Mode = 3,4,5. After convergence, +c approximate eigenvalues of the original problem may be obtained +c with the ARPACK subroutine igraphdseupd . c c 2. If the Ritz vectors corresponding to the converged Ritz values -c are needed, the user must call igraphdseupd immediately following completion -c of igraphdsaupd. This is new starting with version 2.1 of ARPACK. +c are needed, the user must call igraphdseupd immediately following completion +c of igraphdsaupd . This is new starting with version 2.1 of ARPACK. c -c 3. If M can be factored into a Cholesky factorization M = LL' +c 3. If M can be factored into a Cholesky factorization M = LL` c then Mode = 2 should not be selected. Instead one should use -c Mode = 1 with OP = inv(L)*A*inv(L'). Appropriate triangular -c linear systems should be solved with L and L' rather +c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular +c linear systems should be solved with L and L` rather c than computing inverses. After convergence, an approximate c eigenvector z of the original problem is recovered by solving -c L'z = x where x is a Ritz vector of OP. +c L`z = x where x is a Ritz vector of OP. c c 4. At present there is no a-priori analysis to guide the selection -c of NCV relative to NEV. The only formal requrement is that NCV > NEV. +c of NCV relative to NEV. The only formal requirement is that NCV > NEV. c However, it is recommended that NCV .ge. 2*NEV. If many problems of c the same type are to be solved, one should experiment with increasing -c NCV while keeping NEV fixed for a given test problem. This will +c NCV while keeping NEV fixed for a given test problem. This will c usually decrease the required number of OP*x operations but it c also increases the work and storage required to maintain the orthogonal c basis vectors. The optimal "cross-over" with respect to CPU time c is problem dependent and must be determined empirically. c -c 5. If IPARAM(7) = 2 then in the Reverse commuication interface the user +c 5. If IPARAM(7) = 2 then in the Reverse communication interface the user c must do the following. When IDO = 1, Y = OP * X is to be computed. c When IPARAM(7) = 2 OP = inv(B)*A. After computing A*X the user c must overwrite X with A*X. Y is then the solution to the linear set c of equations B*Y = A*X. c -c 6. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the -c NP = IPARAM(8) shifts in locations: -c 1 WORKL(IPNTR(11)) -c 2 WORKL(IPNTR(11)+1) -c . -c . -c . -c NP WORKL(IPNTR(11)+NP-1). +c 6. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the +c NP = IPARAM(8) shifts in locations: +c 1 WORKL(IPNTR(11)) +c 2 WORKL(IPNTR(11)+1) +c . +c . +c . +c NP WORKL(IPNTR(11)+NP-1). c -c The eigenvalues of the current tridiagonal matrix are located in +c The eigenvalues of the current tridiagonal matrix are located in c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are in the c order defined by WHICH. The associated Ritz estimates are located in c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1). @@ -347,7 +347,7 @@ c REAL RESID(N), V(LDV,NCV), WORKD(N,3), WORKL(LWORKL) c SHARED RESID(BLOCK), V(BLOCK,:), WORKD(BLOCK,:) c REPLICATED WORKL(LWORKL) -c +c c c\BeginLib c @@ -355,7 +355,7 @@ c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. -c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly +c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, @@ -365,8 +365,8 @@ c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to c Implement the Spectral Transformation", Math. Comp., 48 (1987), c pp 663-673. -c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos -c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", +c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos +c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", c SIAM J. Matr. Anal. Apps., January (1993). c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines c for Updating the QR decomposition", ACM TOMS, December 1990, @@ -375,28 +375,28 @@ c Transformations in a k-Step Arnoldi Method". In Preparation. c c\Routines called: -c igraphdsaup2 ARPACK routine that implements the Implicitly Restarted +c igraphdsaup2 ARPACK routine that implements the Implicitly Restarted c Arnoldi Iteration. -c igraphdstats ARPACK routine that initialize timing and other statistics +c igraphdstats ARPACK routine that initialize timing and other statistics c variables. c igraphivout ARPACK utility routine that prints integers. -c igraphsecond ARPACK utility routine for timing. -c igraphdvout ARPACK utility routine that prints vectors. -c dlamch LAPACK routine that determines machine constants. +c igrapharscnd ARPACK utility routine for timing. +c igraphdvout ARPACK utility routine that prints vectors. +c dlamch LAPACK routine that determines machine constants. c c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas -c +c Rice University +c Houston, Texas +c c\Revision history: c 12/15/93: Version ' 2.4' c -c\SCCS Information: @(#) -c FILE: saupd.F SID: 2.7 DATE OF SID: 8/27/96 RELEASE: 2 +c\SCCS Information: @(#) +c FILE: saupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2 c c\Remarks c 1. None @@ -406,7 +406,7 @@ c----------------------------------------------------------------------- c subroutine igraphdsaupd - & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, + & ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, & ipntr, workd, workl, lworkl, info ) c c %----------------------------------------------------% @@ -439,13 +439,13 @@ subroutine igraphdsaupd c Double precision & one, zero - parameter (one = 1.0D+0, zero = 0.0D+0) + parameter (one = 1.0D+0 , zero = 0.0D+0 ) c c %---------------% c | Local Scalars | c %---------------% c - integer bounds, ierr, ih, iq, ishift, iupd, iw, + integer bounds, ierr, ih, iq, ishift, iupd, iw, & ldh, ldq, msglvl, mxiter, mode, nb, & nev0, next, np, ritz, j save bounds, ierr, ih, iq, ishift, iupd, iw, @@ -456,8 +456,8 @@ subroutine igraphdsaupd c | External Subroutines | c %----------------------% c - external igraphdsaup2, igraphdvout, igraphivout, - & igraphsecond, igraphdstats + external igraphdsaup2, igraphdvout, igraphivout, + & igrapharscnd, igraphdstats c c %--------------------% c | External Functions | @@ -470,7 +470,7 @@ subroutine igraphdsaupd c %-----------------------% c | Executable Statements | c %-----------------------% -c +c if (ido .eq. 0) then c c %-------------------------------% @@ -479,13 +479,14 @@ subroutine igraphdsaupd c %-------------------------------% c call igraphdstats - call igraphsecond (t0) + call igrapharscnd (t0) msglvl = msaupd c ierr = 0 ishift = iparam(1) mxiter = iparam(3) - nb = iparam(4) +c nb = iparam(4) + nb = 1 c c %--------------------------------------------% c | Revision 2 performs only implicit restart. | @@ -512,7 +513,7 @@ subroutine igraphdsaupd c %----------------------------------------------% c np = ncv - nev -c +c if (mxiter .le. 0) ierr = -4 if (which .ne. 'LM' .and. & which .ne. 'SM' .and. @@ -531,7 +532,7 @@ subroutine igraphdsaupd else if (nev .eq. 1 .and. which .eq. 'BE') then ierr = -13 end if -c +c c %------------% c | Error Exit | c %------------% @@ -541,13 +542,13 @@ subroutine igraphdsaupd ido = 99 go to 9000 end if -c +c c %------------------------% c | Set default parameters | c %------------------------% c if (nb .le. 0) nb = 1 - if (tol .le. zero) tol = dlamch('EpsMach') + if (tol .le. zero) tol = dlamch ('EpsMach') c c %----------------------------------------------% c | NP is the number of additional steps to | @@ -557,8 +558,8 @@ subroutine igraphdsaupd c %----------------------------------------------% c np = ncv - nev - nev0 = nev -c + nev0 = nev +c c %-----------------------------% c | Zero out internal workspace | c %-----------------------------% @@ -566,7 +567,7 @@ subroutine igraphdsaupd do 10 j = 1, ncv**2 + 8*ncv workl(j) = zero 10 continue -c +c c %-------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | @@ -599,7 +600,7 @@ subroutine igraphdsaupd c | Carry out the Implicitly restarted Lanczos Iteration. | c %-------------------------------------------------------% c - call igraphdsaup2 + call igraphdsaup2 & ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd, & ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritz), & workl(bounds), workl(iq), ldq, workl(iw), ipntr, workd, @@ -612,7 +613,7 @@ subroutine igraphdsaupd c if (ido .eq. 3) iparam(8) = np if (ido .ne. 99) go to 9000 -c +c iparam(3) = mxiter iparam(5) = np iparam(9) = nopx @@ -621,33 +622,70 @@ subroutine igraphdsaupd c c %------------------------------------% c | Exit if there was an informational | -c | error within igraphdsaup2. | +c | error within igraphdsaup2 . | c %------------------------------------% c if (info .lt. 0) go to 9000 if (info .eq. 2) info = 3 c if (msglvl .gt. 0) then - call igraphivout (logfil, 1, mxiter, ndigit, + call igraphivout (logfil, 1, [mxiter], ndigit, & '_saupd: number of update iterations taken') - call igraphivout (logfil, 1, np, ndigit, + call igraphivout (logfil, 1, [np], ndigit, & '_saupd: number of "converged" Ritz values') - call igraphdvout (logfil, np, workl(Ritz), ndigit, + call igraphdvout (logfil, np, workl(Ritz), ndigit, & '_saupd: final Ritz values') - call igraphdvout (logfil, np, workl(Bounds), ndigit, + call igraphdvout (logfil, np, workl(Bounds), ndigit, & '_saupd: corresponding error bounds') - end if + end if c - call igraphsecond (t1) + call igrapharscnd (t1) tsaupd = t1 - t0 -c -c +c + if (msglvl .gt. 0) then +c +c %--------------------------------------------------------% +c | Version Number & Version Date are defined in version.h | +c %--------------------------------------------------------% +c + write (6,1000) + write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt, + & tmvopx, tmvbx, tsaupd, tsaup2, tsaitr, titref, + & tgetv0, tseigt, tsgets, tsapps, tsconv + 1000 format (//, + & 5x, '==========================================',/ + & 5x, '= Symmetric implicit Arnoldi update code =',/ + & 5x, '= Version Number:', ' 2.4' , 19x, ' =',/ + & 5x, '= Version Date: ', ' 07/31/96' , 14x, ' =',/ + & 5x, '==========================================',/ + & 5x, '= Summary of timing statistics =',/ + & 5x, '==========================================',//) + 1100 format ( + & 5x, 'Total number update iterations = ', i5,/ + & 5x, 'Total number of OP*x operations = ', i5,/ + & 5x, 'Total number of B*x operations = ', i5,/ + & 5x, 'Total number of reorthogonalization steps = ', i5,/ + & 5x, 'Total number of iterative refinement steps = ', i5,/ + & 5x, 'Total number of restart steps = ', i5,/ + & 5x, 'Total time in user OP*x operation = ', f12.6,/ + & 5x, 'Total time in user B*x operation = ', f12.6,/ + & 5x, 'Total time in Arnoldi update routine = ', f12.6,/ + & 5x, 'Total time in saup2 routine = ', f12.6,/ + & 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/ + & 5x, 'Total time in reorthogonalization phase = ', f12.6,/ + & 5x, 'Total time in (re)start vector generation = ', f12.6,/ + & 5x, 'Total time in trid eigenvalue subproblem = ', f12.6,/ + & 5x, 'Total time in getting the shifts = ', f12.6,/ + & 5x, 'Total time in applying the shifts = ', f12.6,/ + & 5x, 'Total time in convergence testing = ', f12.6) + end if +c 9000 continue -c +c return c c %---------------% -c | End of igraphdsaupd | +c | End of igraphdsaupd | c %---------------% c end diff --git a/src/vendor/arpack/dsconv.f b/src/vendor/arpack/dsconv.f index d8bac2e408..a73cc1449d 100644 --- a/src/vendor/arpack/dsconv.f +++ b/src/vendor/arpack/dsconv.f @@ -3,7 +3,7 @@ c c\Name: igraphdsconv c -c\Description: +c\Description: c Convergence testing for the symmetric Arnoldi eigenvalue routine. c c\Usage: @@ -34,23 +34,23 @@ c\BeginLib c c\Routines called: -c igraphsecond ARPACK utility routine for timing. -c dlamch LAPACK routine that determines machine constants. +c igrapharscnd ARPACK utility routine for timing. +c dlamch LAPACK routine that determines machine constants. c c\Author c Danny Sorensen Phuong Vu -c Richard Lehoucq CRPC / Rice University -c Dept. of Computational & Houston, Texas +c Richard Lehoucq CRPC / Rice University +c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas +c Rice University +c Houston, Texas c -c\SCCS Information: @(#) +c\SCCS Information: @(#) c FILE: sconv.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2 c c\Remarks c 1. Starting with version 2.4, this routine no longer uses the -c Parlett strategy using the gap conditions. +c Parlett strategy using the gap conditions. c c\EndLib c @@ -106,9 +106,9 @@ subroutine igraphdsconv (n, ritz, bounds, tol, nconv) c | Executable Statements | c %-----------------------% c - call igraphsecond (t0) + call igrapharscnd (t0) c - eps23 = dlamch('Epsilon-Machine') + eps23 = dlamch('Epsilon-Machine') eps23 = eps23**(2.0D+0 / 3.0D+0) c nconv = 0 @@ -125,10 +125,10 @@ subroutine igraphdsconv (n, ritz, bounds, tol, nconv) end if c 10 continue -c - call igraphsecond (t1) +c + call igrapharscnd (t1) tsconv = tsconv + (t1 - t0) -c +c return c c %---------------% diff --git a/src/vendor/arpack/dseigt.f b/src/vendor/arpack/dseigt.f index dc5dccdfc6..999e3d5f98 100644 --- a/src/vendor/arpack/dseigt.f +++ b/src/vendor/arpack/dseigt.f @@ -3,7 +3,7 @@ c c\Name: igraphdseigt c -c\Description: +c\Description: c Compute the eigenvalues of the current symmetric tridiagonal matrix c and the corresponding error bounds given the current residual norm. c @@ -20,16 +20,16 @@ c Size of the symmetric tridiagonal matrix H. c c H Double precision N by 2 array. (INPUT) -c H contains the symmetric tridiagonal matrix with the -c subdiagonal in the first column starting at H(2,1) and the -c main diagonal in igraphsecond column. +c H contains the symmetric tridiagonal matrix with the +c subdiagonal in the first column starting at H(2,1) and the +c main diagonal in second column. c c LDH Integer. (INPUT) -c Leading dimension of H exactly as declared in the calling +c Leading dimension of H exactly as declared in the calling c program. c c EIG Double precision array of length N. (OUTPUT) -c On output, EIG contains the N eigenvalues of H possibly +c On output, EIG contains the N eigenvalues of H possibly c unsorted. The BOUNDS arrays are returned in the c same sorted order as EIG. c @@ -59,22 +59,22 @@ c igraphdstqrb ARPACK routine that computes the eigenvalues and the c last components of the eigenvectors of a symmetric c and tridiagonal matrix. -c igraphsecond ARPACK utility routine for timing. +c igrapharscnd ARPACK utility routine for timing. c igraphdvout ARPACK utility routine that prints vectors. c dcopy Level 1 BLAS that copies one vector to another. c c\Author c Danny Sorensen Phuong Vu -c Richard Lehoucq CRPC / Rice University -c Dept. of Computational & Houston, Texas +c Richard Lehoucq CRPC / Rice University +c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas +c Rice University +c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.4' c -c\SCCS Information: @(#) +c\SCCS Information: @(#) c FILE: seigt.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks @@ -84,7 +84,7 @@ c c----------------------------------------------------------------------- c - subroutine igraphdseigt + subroutine igraphdseigt & ( rnorm, n, h, ldh, eig, bounds, workl, ierr ) c c %----------------------------------------------------% @@ -127,7 +127,7 @@ subroutine igraphdseigt c | External Subroutines | c %----------------------% c - external dcopy, igraphdstqrb, igraphdvout, igraphsecond + external dcopy, igraphdstqrb, igraphdvout, igrapharscnd c c %-----------------------% c | Executable Statements | @@ -136,9 +136,9 @@ subroutine igraphdseigt c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | -c %-------------------------------% +c %-------------------------------% c - call igraphsecond (t0) + call igrapharscnd (t0) msglvl = mseigt c if (msglvl .gt. 0) then @@ -167,8 +167,8 @@ subroutine igraphdseigt do 30 k = 1, n bounds(k) = rnorm*abs(bounds(k)) 30 continue -c - call igraphsecond (t1) +c + call igrapharscnd (t1) tseigt = tseigt + (t1 - t0) c 9000 continue diff --git a/src/vendor/arpack/dsesrt.f b/src/vendor/arpack/dsesrt.f index 393e150dc1..3fe54e866a 100644 --- a/src/vendor/arpack/dsesrt.f +++ b/src/vendor/arpack/dsesrt.f @@ -4,7 +4,7 @@ c\Name: igraphdsesrt c c\Description: -c Sort the array X in the order specified by WHICH and optionally +c Sort the array X in the order specified by WHICH and optionally c apply the permutation to the columns of the matrix A. c c\Usage: @@ -32,7 +32,7 @@ c Number of rows of the matrix A. c c A Double precision array of length NA by N. (INPUT/OUTPUT) -c +c c LDA Integer. (INPUT) c Leading dimension of A. c @@ -47,18 +47,18 @@ c c\Authors c Danny Sorensen Phuong Vu -c Richard Lehoucq CRPC / Rice University -c Dept. of Computational & Houston, Texas +c Richard Lehoucq CRPC / Rice University +c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas +c Rice University +c Houston, Texas c c\Revision history: c 12/15/93: Version ' 2.1'. -c Adapted from the sort routine in LANSO and +c Adapted from the sort routine in LANSO and c the ARPACK code igraphdsortr c -c\SCCS Information: @(#) +c\SCCS Information: @(#) c FILE: sesrt.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2 c c\EndLib @@ -71,7 +71,7 @@ subroutine igraphdsesrt (which, apply, n, x, na, a, lda) c | Scalar Arguments | c %------------------% c - character which*2 + character*2 which logical apply integer lda, n, na c @@ -101,7 +101,7 @@ subroutine igraphdsesrt (which, apply, n, x, na, a, lda) c %-----------------------% c igap = n / 2 -c +c if (which .eq. 'SA') then c c X is sorted into decreasing order of algebraic. @@ -165,7 +165,7 @@ subroutine igraphdsesrt (which, apply, n, x, na, a, lda) 80 continue c if (j.lt.0) go to 90 -c +c if (x(j).gt.x(j+igap)) then temp = x(j) x(j) = x(j+igap) @@ -179,7 +179,7 @@ subroutine igraphdsesrt (which, apply, n, x, na, a, lda) 90 continue igap = igap / 2 go to 70 -c +c else if (which .eq. 'LM') then c c X is sorted into increasing order of magnitude. diff --git a/src/vendor/arpack/dseupd.f b/src/vendor/arpack/dseupd.f index 0336c3a290..75d5c6dcf7 100644 --- a/src/vendor/arpack/dseupd.f +++ b/src/vendor/arpack/dseupd.f @@ -2,7 +2,7 @@ c c\Name: igraphdseupd c -c\Description: +c\Description: c c This subroutine returns the converged approximations to eigenvalues c of A*z = lambda*B*z and (optionally): @@ -15,22 +15,22 @@ c (3) Both. c c There is negligible additional cost to obtain eigenvectors. An orthonormal -c (Lanczos) basis is always computed. There is an additional storage cost -c of n*nev if both are requested (in this case a separate array Z must be +c (Lanczos) basis is always computed. There is an additional storage cost +c of n*nev if both are requested (in this case a separate array Z must be c supplied). c c These quantities are obtained from the Lanczos factorization computed -c by DSAUPD for the linear operator OP prescribed by the MODE selection -c (see IPARAM(7) in DSAUPD documentation.) DSAUPD must be called before -c this routine is called. These approximate eigenvalues and vectors are -c commonly called Ritz values and Ritz vectors respectively. They are -c referred to as such in the comments that follow. The computed orthonormal -c basis for the invariant subspace corresponding to these Ritz values is +c by IGRAPHDSAUPD for the linear operator OP prescribed by the MODE selection +c (see IPARAM(7) in IGRAPHDSAUPD documentation.) IGRAPHDSAUPD must be called before +c this routine is called. These approximate eigenvalues and vectors are +c commonly called Ritz values and Ritz vectors respectively. They are +c referred to as such in the comments that follow. The computed orthonormal +c basis for the invariant subspace corresponding to these Ritz values is c referred to as a Lanczos basis. c -c See documentation in the header of the subroutine DSAUPD for a definition -c of OP as well as other terms and the relation of computed Ritz values -c and vectors of OP with respect to the given problem A*z = lambda*B*z. +c See documentation in the header of the subroutine IGRAPHDSAUPD for a definition +c of OP as well as other terms and the relation of computed Ritz values +c and vectors of OP with respect to the given problem A*z = lambda*B*z. c c The approximate eigenvalues of the original problem are returned in c ascending algebraic order. The user may elect to call this routine @@ -39,86 +39,87 @@ c with a single call. c c\Usage: -c call igraphdseupd +c call igraphdseupd c ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, BMAT, N, WHICH, NEV, TOL, c RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO ) c -c RVEC LOGICAL (INPUT) -c Specifies whether Ritz vectors corresponding to the Ritz value +c RVEC LOGICAL (INPUT) +c Specifies whether Ritz vectors corresponding to the Ritz value c approximations to the eigenproblem A*z = lambda*B*z are computed. c c RVEC = .FALSE. Compute Ritz values only. c c RVEC = .TRUE. Compute Ritz vectors. c -c HOWMNY Character*1 (INPUT) +c HOWMNY Character*1 (INPUT) c Specifies how many Ritz vectors are wanted and the form of Z c the matrix of Ritz vectors. See remark 1 below. c = 'A': compute NEV Ritz vectors; c = 'S': compute some of the Ritz vectors, specified c by the logical array SELECT. c -c SELECT Logical array of dimension NEV. (INPUT) +c SELECT Logical array of dimension NCV. (INPUT/WORKSPACE) c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be c computed. To select the Ritz vector corresponding to a -c Ritz value D(j), SELECT(j) must be set to .TRUE.. -c If HOWMNY = 'A' , SELECT is not referenced. +c Ritz value D(j), SELECT(j) must be set to .TRUE.. +c If HOWMNY = 'A' , SELECT is used as a workspace for +c reordering the Ritz values. c -c D Double precision array of dimension NEV. (OUTPUT) +c D Double precision array of dimension NEV. (OUTPUT) c On exit, D contains the Ritz value approximations to the c eigenvalues of A*z = lambda*B*z. The values are returned c in ascending order. If IPARAM(7) = 3,4,5 then D represents -c the Ritz values of OP computed by igraphdsaupd transformed to -c those of the original eigensystem A*z = lambda*B*z. If -c IPARAM(7) = 1,2 then the Ritz values of OP are the same +c the Ritz values of OP computed by igraphdsaupd transformed to +c those of the original eigensystem A*z = lambda*B*z. If +c IPARAM(7) = 1,2 then the Ritz values of OP are the same c as the those of A*z = lambda*B*z. c -c Z Double precision N by NEV array if HOWMNY = 'A'. (OUTPUT) +c Z Double precision N by NEV array if HOWMNY = 'A'. (OUTPUT) c On exit, Z contains the B-orthonormal Ritz vectors of the c eigensystem A*z = lambda*B*z corresponding to the Ritz c value approximations. c If RVEC = .FALSE. then Z is not referenced. -c NOTE: The array Z may be set equal to first NEV columns of the -c Arnoldi/Lanczos basis array V computed by DSAUPD. +c NOTE: The array Z may be set equal to first NEV columns of the +c Arnoldi/Lanczos basis array V computed by IGRAPHDSAUPD . c c LDZ Integer. (INPUT) c The leading dimension of the array Z. If Ritz vectors are c desired, then LDZ .ge. max( 1, N ). In any case, LDZ .ge. 1. c -c SIGMA Double precision (INPUT) +c SIGMA Double precision (INPUT) c If IPARAM(7) = 3,4,5 represents the shift. Not referenced if c IPARAM(7) = 1 or 2. c c c **** The remaining arguments MUST be the same as for the **** -c **** call to DNAUPD that was just completed. **** +c **** call to IGRAPHDSAUPD that was just completed. **** c c NOTE: The remaining arguments c c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, c WORKD, WORKL, LWORKL, INFO c -c must be passed directly to DSEUPD following the last call -c to DSAUPD. These arguments MUST NOT BE MODIFIED between -c the the last call to DSAUPD and the call to DSEUPD. +c must be passed directly to IGRAPHDSEUPD following the last call +c to IGRAPHDSAUPD . These arguments MUST NOT BE MODIFIED between +c the the last call to IGRAPHDSAUPD and the call to IGRAPHDSEUPD . c c Two of these parameters (WORKL, INFO) are also output parameters: c -c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) +c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) c WORKL(1:4*ncv) contains information obtained in -c igraphdsaupd. They are not changed by igraphdseupd. +c igraphdsaupd . They are not changed by igraphdseupd . c WORKL(4*ncv+1:ncv*ncv+8*ncv) holds the c untransformed Ritz values, the computed error estimates, c and the associated eigenvector matrix of H. c c Note: IPNTR(8:10) contains the pointer into WORKL for addresses -c of the above information computed by igraphdseupd. +c of the above information computed by igraphdseupd . c ------------------------------------------------------------- c IPNTR(8): pointer to the NCV RITZ values of the original system. c IPNTR(9): pointer to the NCV corresponding error bounds. c IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors c of the tridiagonal matrix T. Only referenced by -c igraphdseupd if RVEC = .TRUE. See Remarks. +c igraphdseupd if RVEC = .TRUE. See Remarks. c ------------------------------------------------------------- c c INFO Integer. (OUTPUT) @@ -131,15 +132,20 @@ c = -6: BMAT must be one of 'I' or 'G'. c = -7: Length of private work WORKL array is not sufficient. c = -8: Error return from trid. eigenvalue calculation; -c Information error from LAPACK routine dsteqr. +c Information error from LAPACK routine dsteqr . c = -9: Starting vector is zero. c = -10: IPARAM(7) must be 1,2,3,4,5. c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible. c = -12: NEV and WHICH = 'BE' are incompatible. -c = -14: DSAUPD did not find any eigenvalues to sufficient +c = -14: IGRAPHDSAUPD did not find any eigenvalues to sufficient c accuracy. c = -15: HOWMNY must be one of 'A' or 'S' if RVEC = .true. c = -16: HOWMNY = 'S' not yet implemented +c = -17: IGRAPHDSEUPD got a different count of the number of converged +c Ritz values than IGRAPHDSAUPD got. This indicates the user +c probably made an error in passing data from IGRAPHDSAUPD to +c IGRAPHDSEUPD or that the data was modified before entering +c IGRAPHDSEUPD . c c\BeginLib c @@ -147,7 +153,7 @@ c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), c pp 357-385. -c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly +c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly c Restarted Arnoldi Iteration", Rice University Technical Report c TR95-13, Department of Computational and Applied Mathematics. c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall, @@ -157,61 +163,64 @@ c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to c Implement the Spectral Transformation", Math. Comp., 48 (1987), c pp 663-673. -c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos -c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", +c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos +c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems", c SIAM J. Matr. Anal. Apps., January (1993). c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines c for Updating the QR decomposition", ACM TOMS, December 1990, c Volume 16 Number 4, pp 369-377. c c\Remarks -c 1. The converged Ritz values are always returned in increasing +c 1. The converged Ritz values are always returned in increasing c (algebraic) order. c c 2. Currently only HOWMNY = 'A' is implemented. It is included at this -c stage for the user who wants to incorporate it. +c stage for the user who wants to incorporate it. c c\Routines called: -c igraphdsesrt ARPACK routine that sorts an array X, and applies the +c igraphdsesrt ARPACK routine that sorts an array X, and applies the c corresponding permutation to a matrix A. -c igraphdsortr igraphdsortr ARPACK sorting routine. +c igraphdsortr igraphdsortr ARPACK sorting routine. c igraphivout ARPACK utility routine that prints integers. -c igraphdvout ARPACK utility routine that prints vectors. -c dgeqr2 LAPACK routine that computes the QR factorization of +c igraphdvout ARPACK utility routine that prints vectors. +c dgeqr2 LAPACK routine that computes the QR factorization of c a matrix. -c dlacpy LAPACK matrix copy routine. -c dlamch LAPACK routine that determines machine constants. -c dorm2r LAPACK routine that applies an orthogonal matrix in +c dlacpy LAPACK matrix copy routine. +c dlamch LAPACK routine that determines machine constants. +c dorm2r LAPACK routine that applies an orthogonal matrix in c factored form. -c dsteqr LAPACK routine that computes eigenvalues and eigenvectors +c dsteqr LAPACK routine that computes eigenvalues and eigenvectors c of a tridiagonal matrix. -c dger Level 2 BLAS rank one update to a matrix. -c dcopy Level 1 BLAS that copies one vector to another . -c dnrm2 Level 1 BLAS that computes the norm of a vector. -c dscal Level 1 BLAS that scales a vector. -c dswap Level 1 BLAS that swaps the contents of two vectors. +c dger Level 2 BLAS rank one update to a matrix. +c dcopy Level 1 BLAS that copies one vector to another . +c dnrm2 Level 1 BLAS that computes the norm of a vector. +c dscal Level 1 BLAS that scales a vector. +c dswap Level 1 BLAS that swaps the contents of two vectors. c\Authors c Danny Sorensen Phuong Vu c Richard Lehoucq CRPC / Rice University c Chao Yang Houston, Texas -c Dept. of Computational & +c Dept. of Computational & c Applied Mathematics -c Rice University -c Houston, Texas -c +c Rice University +c Houston, Texas +c c\Revision history: c 12/15/93: Version ' 2.1' c -c\SCCS Information: @(#) -c FILE: seupd.F SID: 2.7 DATE OF SID: 8/27/96 RELEASE: 2 +c\SCCS Information: @(#) +c FILE: seupd.F SID: 2.11 DATE OF SID: 04/10/01 RELEASE: 2 c c\EndLib c c----------------------------------------------------------------------- - subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, - & sigma, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam, - & ipntr, workd, workl, lworkl, info ) + subroutine igraphdseupd (rvec , howmny, select, d , + & z , ldz , sigma , bmat , + & n , which , nev , tol , + & resid , ncv , v , ldv , + & iparam, ipntr , workd , workl, + & lworkl, info ) c c %----------------------------------------------------% c | Include files for debugging and timing information | @@ -225,9 +234,9 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, c %------------------% c character bmat, howmny, which*2 - logical rvec, select(ncv) + logical rvec integer info, ldz, ldv, lworkl, n, ncv, nev - Double precision + Double precision & sigma, tol c c %-----------------% @@ -235,9 +244,10 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, c %-----------------% c integer iparam(7), ipntr(11) + logical select(ncv) Double precision - & d(nev), resid(n), v(ldv,ncv), z(ldz, nev), - & workd(2*n), workl(lworkl) + & d(nev) , resid(n) , v(ldv,ncv), + & z(ldz, nev), workd(2*n), workl(lworkl) c c %------------% c | Parameters | @@ -245,42 +255,37 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, c Double precision & one, zero - parameter (one = 1.0D+0, zero = 0.0D+0) + parameter (one = 1.0D+0 , zero = 0.0D+0 ) c c %---------------% c | Local Scalars | c %---------------% c character type*6 - integer bounds, ierr, ih, ihb, ihd, iq, iw, j, k, - & ldh, ldq, mode, msglvl, nconv, next, ritz, - & irz, ibd, ktrord, leftptr, rghtptr, ism, ilg + integer bounds , ierr , ih , ihb , ihd , + & iq , iw , j , k , ldh , + & ldq , mode , msglvl, nconv , next , + & ritz , irz , ibd , np , ishift, + & leftptr, rghtptr, numcnv, jj Double precision - & bnorm2, rnorm, temp, thres1, thres2, tempbnd, eps23 + & bnorm2 , rnorm, temp, temp1, eps23 logical reord c -c %--------------% -c | Local Arrays | -c %--------------% -c - Double precision - & kv(2) -c c %----------------------% c | External Subroutines | c %----------------------% c - external dcopy, dger, dgeqr2, dlacpy, dorm2r, dscal, - & igraphdsesrt, dsteqr, dswap, igraphdvout, - & igraphivout, igraphdsortr + external dcopy, dger, dgeqr2, dlacpy, dorm2r, dscal, + & igraphdsesrt, dsteqr, dswap, igraphdvout, + & igraphivout, igraphdsortr c c %--------------------% c | External Functions | c %--------------------% c Double precision - & dnrm2, dlamch - external dnrm2, dlamch + & dnrm2 , dlamch + external dnrm2 , dlamch c c %---------------------% c | Intrinsic Functions | @@ -291,7 +296,7 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, c %-----------------------% c | Executable Statements | c %-----------------------% -c +c c %------------------------% c | Set default parameters | c %------------------------% @@ -308,7 +313,7 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, if (nconv .eq. 0) go to 9000 ierr = 0 c - if (nconv .le. 0) ierr = -14 + if (nconv .le. 0) ierr = -14 if (n .le. 0) ierr = -1 if (nev .le. 0) ierr = -2 if (ncv .le. nev .or. ncv .gt. n) ierr = -3 @@ -320,12 +325,12 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6 if ( (howmny .ne. 'A' .and. & howmny .ne. 'P' .and. - & howmny .ne. 'S') .and. rvec ) + & howmny .ne. 'S') .and. rvec ) & ierr = -15 if (rvec .and. howmny .eq. 'S') ierr = -16 c if (rvec .and. lworkl .lt. ncv**2+8*ncv) ierr = -7 -c +c if (mode .eq. 1 .or. mode .eq. 2) then type = 'REGULR' else if (mode .eq. 3 ) then @@ -334,7 +339,7 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, type = 'BUCKLE' else if (mode .eq. 5 ) then type = 'CAYLEY' - else + else ierr = -10 end if if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11 @@ -348,7 +353,7 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, info = ierr go to 9000 end if -c +c c %-------------------------------------------------------% c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | c | etc... and the remaining workspace. | @@ -357,18 +362,18 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, c | workl(1:2*ncv) := generated tridiagonal matrix H | c | The subdiagonal is stored in workl(2:ncv). | c | The dead spot is workl(1) but upon exiting | -c | igraphdsaupd stores the B-norm of the last residual | +c | igraphdsaupd stores the B-norm of the last residual | c | vector in workl(1). We use this !!! | c | workl(2*ncv+1:2*ncv+ncv) := ritz values | c | The wanted values are in the first NCONV spots. | c | workl(3*ncv+1:3*ncv+ncv) := computed Ritz estimates | c | The wanted values are in the first NCONV spots. | -c | NOTE: workl(1:4*ncv) is set by igraphdsaupd and is not | -c | modified by igraphdseupd. | +c | NOTE: workl(1:4*ncv) is set by igraphdsaupd and is not | +c | modified by igraphdseupd . | c %-------------------------------------------------------% c c %-------------------------------------------------------% -c | The following is used and set by igraphdseupd. | +c | The following is used and set by igraphdseupd . | c | workl(4*ncv+1:4*ncv+ncv) := used as workspace during | c | computation of the eigenvectors of H. Stores | c | the diagonal of H. Upon EXIT contains the NCV | @@ -384,10 +389,10 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, c | workl(3*ncv+1:4*ncv). | c | workl(6*ncv+1:6*ncv+ncv*ncv) := orthogonal Q that is | c | the eigenvector matrix for H as returned by | -c | dsteqr. Not referenced if RVEC = .False. | +c | dsteqr . Not referenced if RVEC = .False. | c | Ordering follows that of workl(4*ncv+1:5*ncv) | c | workl(6*ncv+ncv*ncv+1:6*ncv+ncv*ncv+2*ncv) := | -c | Workspace. Needed by dsteqr and by igraphdseupd. | +c | Workspace. Needed by dsteqr and by igraphdseupd . | c | GRAND total of NCV*(NCV+8) locations. | c %-------------------------------------------------------% c @@ -423,13 +428,13 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, c | Set machine dependent constant. | c %---------------------------------% c - eps23 = dlamch('Epsilon-Machine') - eps23 = eps23**(2.0D+0 / 3.0D+0) + eps23 = dlamch ('Epsilon-Machine') + eps23 = eps23**(2.0D+0 / 3.0D+0 ) c c %---------------------------------------% c | RNORM is B-norm of the RESID(1:N). | c | BNORM2 is the 2 norm of B*RESID(1:N). | -c | Upon exit of igraphdsaupd WORKD(1:N) has | +c | Upon exit of igraphdsaupd WORKD(1:N) has | c | B*RESID(1:N). | c %---------------------------------------% c @@ -437,145 +442,88 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, if (bmat .eq. 'I') then bnorm2 = rnorm else if (bmat .eq. 'G') then - bnorm2 = dnrm2(n, workd, 1) + bnorm2 = dnrm2 (n, workd, 1) + end if +c + if (msglvl .gt. 2) then + call igraphdvout (logfil, ncv, workl(irz), ndigit, + & '_seupd: Ritz values passed in from _SAUPD.') + call igraphdvout (logfil, ncv, workl(ibd), ndigit, + & '_seupd: Ritz estimates passed in from _SAUPD.') end if c if (rvec) then c -c %------------------------------------------------% -c | Get the converged Ritz value on the boundary. | -c | This value will be used to dermine whether we | -c | need to reorder the eigenvalues and | -c | eigenvectors comupted by _steqr, and is | -c | referred to as the "threshold" value. | -c | | -c | A Ritz value gamma is said to be a wanted | -c | one, if | -c | abs(gamma) .ge. threshold, when WHICH = 'LM'; | -c | abs(gamma) .le. threshold, when WHICH = 'SM'; | -c | gamma .ge. threshold, when WHICH = 'LA'; | -c | gamma .le. threshold, when WHICH = 'SA'; | -c | gamma .le. thres1 .or. gamma .ge. thres2 | -c | when WHICH = 'BE'; | -c | | -c | Note: converged Ritz values and associated | -c | Ritz estimates have been placed in the first | -c | NCONV locations in workl(ritz) and | -c | workl(bounds) respectively. They have been | -c | sorted (in _saup2) according to the WHICH | -c | selection criterion. (Except in the case | -c | WHICH = 'BE', they are sorted in an increasing | -c | order.) | -c %------------------------------------------------% -c - if (which .eq. 'LM' .or. which .eq. 'SM' - & .or. which .eq. 'LA' .or. which .eq. 'SA' ) then -c - thres1 = workl(ritz) -c - if (msglvl .gt. 2) then - call igraphdvout(logfil, 1, [thres1], ndigit, - & '_seupd: Threshold eigenvalue used for re-ordering') - end if -c - else if (which .eq. 'BE') then -c -c %------------------------------------------------% -c | Ritz values returned from _saup2 have been | -c | sorted in increasing order. Thus two | -c | "threshold" values (one for the small end, one | -c | for the large end) are in the middle. | -c %------------------------------------------------% -c - ism = max(nev,nconv) / 2 - ilg = ism + 1 - thres1 = workl(ism) - thres2 = workl(ilg) -c - if (msglvl .gt. 2) then - kv(1) = thres1 - kv(2) = thres2 - call igraphdvout(logfil, 2, kv, ndigit, - & '_seupd: Threshold eigenvalues used for re-ordering') - end if + reord = .false. +c +c %---------------------------------------------------% +c | Use the temporary bounds array to store indices | +c | These will be used to mark the select array later | +c %---------------------------------------------------% +c + do 10 j = 1,ncv + workl(bounds+j-1) = j + select(j) = .false. + 10 continue +c +c %-------------------------------------% +c | Select the wanted Ritz values. | +c | Sort the Ritz values so that the | +c | wanted ones appear at the tailing | +c | NEV positions of workl(irr) and | +c | workl(iri). Move the corresponding | +c | error estimates in workl(bound) | +c | accordingly. | +c %-------------------------------------% +c + np = ncv - nev + ishift = 0 + call igraphdsgets (ishift, which , nev , + & np , workl(irz) , workl(bounds), + & workl) c + if (msglvl .gt. 2) then + call igraphdvout (logfil, ncv, workl(irz), ndigit, + & '_seupd: Ritz values after calling _SGETS.') + call igraphdvout (logfil, ncv, workl(bounds), ndigit, + & '_seupd: Ritz value indices after calling _SGETS.') end if c -c %----------------------------------------------------------% -c | Check to see if all converged Ritz values appear within | -c | the first NCONV diagonal elements returned from _seigt. | -c | This is done in the following way: | -c | | -c | 1) For each Ritz value obtained from _seigt, compare it | -c | with the threshold Ritz value computed above to | -c | determine whether it is a wanted one. | -c | | -c | 2) If it is wanted, then check the corresponding Ritz | -c | estimate to see if it has converged. If it has, set | -c | correponding entry in the logical array SELECT to | -c | .TRUE.. | -c | | -c | If SELECT(j) = .TRUE. and j > NCONV, then there is a | -c | converged Ritz value that does not appear at the top of | -c | the diagonal matrix computed by _seigt in _saup2. | -c | Reordering is needed. | -c %----------------------------------------------------------% +c %-----------------------------------------------------% +c | Record indices of the converged wanted Ritz values | +c | Mark the select array for possible reordering | +c %-----------------------------------------------------% c - reord = .false. - ktrord = 0 - do 10 j = 0, ncv-1 - select(j+1) = .false. - if (which .eq. 'LM') then - if (abs(workl(irz+j)) .ge. abs(thres1)) then - tempbnd = max( eps23, abs(workl(irz+j)) ) - if (workl(ibd+j) .le. tol*tempbnd) then - select(j+1) = .true. - end if - end if - else if (which .eq. 'SM') then - if (abs(workl(irz+j)) .le. abs(thres1)) then - tempbnd = max( eps23, abs(workl(irz+j)) ) - if (workl(ibd+j) .le. tol*tempbnd) then - select(j+1) = .true. - end if - end if - else if (which .eq. 'LA') then - if (workl(irz+j) .ge. thres1) then - tempbnd = max( eps23, abs(workl(irz+j)) ) - if (workl(ibd+j) .le. tol*tempbnd) then - select(j+1) = .true. - end if - end if - else if (which .eq. 'SA') then - if (workl(irz+j) .le. thres1) then - tempbnd = max( eps23, abs(workl(irz+j)) ) - if (workl(ibd+j) .le. tol*tempbnd) then - select(j+1) = .true. - end if - end if - else if (which .eq. 'BE') then - if ( workl(irz+j) .le. thres1 .or. - & workl(irz+j) .ge. thres2 ) then - tempbnd = max( eps23, abs(workl(irz+j)) ) - if (workl(ibd+j) .le. tol*tempbnd) then - select(j+1) = .true. - end if - end if - end if - if (j+1 .gt. nconv ) reord = select(j+1) .or. reord - if (select(j+1)) ktrord = ktrord + 1 - 10 continue - -c %-------------------------------------------% -c | If KTRORD .ne. NCONV, something is wrong. | -c %-------------------------------------------% + numcnv = 0 + do 11 j = 1,ncv + temp1 = max(eps23, abs(workl(irz+ncv-j)) ) + jj = workl(bounds + ncv - j) + if (numcnv .lt. nconv .and. + & workl(ibd+jj-1) .le. tol*temp1) then + select(jj) = .true. + numcnv = numcnv + 1 + if (jj .gt. nconv) reord = .true. + endif + 11 continue +c +c %-----------------------------------------------------------% +c | Check the count (numcnv) of converged Ritz values with | +c | the number (nconv) reported by _saupd. If these two | +c | are different then there has probably been an error | +c | caused by incorrect passing of the _saupd data. | +c %-----------------------------------------------------------% c if (msglvl .gt. 2) then - call igraphivout(logfil, 1, [ktrord], ndigit, + call igraphivout(logfil, 1, [numcnv], ndigit, & '_seupd: Number of specified eigenvalues') call igraphivout(logfil, 1, [nconv], ndigit, & '_seupd: Number of "converged" eigenvalues') end if +c + if (numcnv .ne. nconv) then + info = -17 + go to 9000 + end if c c %-----------------------------------------------------------% c | Call LAPACK routine _steqr to compute the eigenvalues and | @@ -587,7 +535,7 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, call dcopy (ncv, workl(ih+ldh), 1, workl(ihd), 1) c call dsteqr ('Identity', ncv, workl(ihd), workl(ihb), - & workl(iq), ldq, workl(iw), ierr) + & workl(iq) , ldq, workl(iw), ierr) c if (ierr .ne. 0) then info = -8 @@ -649,11 +597,11 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, temp = workl(ihd+leftptr-1) workl(ihd+leftptr-1) = workl(ihd+rghtptr-1) workl(ihd+rghtptr-1) = temp - call dcopy(ncv, workl(iq+ncv*(leftptr-1)), 1, + call dcopy (ncv, workl(iq+ncv*(leftptr-1)), 1, & workl(iw), 1) - call dcopy(ncv, workl(iq+ncv*(rghtptr-1)), 1, + call dcopy (ncv, workl(iq+ncv*(rghtptr-1)), 1, & workl(iq+ncv*(leftptr-1)), 1) - call dcopy(ncv, workl(iw), 1, + call dcopy (ncv, workl(iw), 1, & workl(iq+ncv*(rghtptr-1)), 1) leftptr = leftptr + 1 rghtptr = rghtptr - 1 @@ -662,10 +610,10 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, c if (leftptr .lt. rghtptr) go to 20 c - 30 end if + end if c - if (msglvl .gt. 2) then - call igraphdvout (logfil, ncv, workl(ihd), ndigit, + 30 if (msglvl .gt. 2) then + call igraphdvout (logfil, ncv, workl(ihd), ndigit, & '_seupd: The eigenvalues of H--reordered') end if c @@ -673,7 +621,7 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, c | Load the converged Ritz values into D. | c %----------------------------------------% c - call dcopy(nconv, workl(ihd), 1, d, 1) + call dcopy (nconv, workl(ihd), 1, d, 1) c else c @@ -701,13 +649,13 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, c if (rvec) then call igraphdsesrt ('LA', rvec , nconv, d, ncv, workl(iq), - & ldq) + & ldq) else call dcopy (ncv, workl(bounds), 1, workl(ihb), 1) end if c - else -c + else +c c %-------------------------------------------------------------% c | * Make a copy of all the Ritz values. | c | * Transform the Ritz values back to the original system. | @@ -717,20 +665,20 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, c | lambda = sigma * theta / ( theta - 1 ) | c | For TYPE = 'CAYLEY' the transformation is | c | lambda = sigma * (theta + 1) / (theta - 1 ) | -c | where the theta are the Ritz values returned by igraphdsaupd. | +c | where the theta are the Ritz values returned by igraphdsaupd . | c | NOTES: | c | *The Ritz vectors are not affected by the transformation. | c | They are only reordered. | c %-------------------------------------------------------------% c - call dcopy (ncv, workl(ihd), 1, workl(iw), 1) - if (type .eq. 'SHIFTI') then + call dcopy (ncv, workl(ihd), 1, workl(iw), 1) + if (type .eq. 'SHIFTI') then do 40 k=1, ncv workl(ihd+k-1) = one / workl(ihd+k-1) + sigma 40 continue else if (type .eq. 'BUCKLE') then do 50 k=1, ncv - workl(ihd+k-1) = sigma * workl(ihd+k-1) / + workl(ihd+k-1) = sigma * workl(ihd+k-1) / & (workl(ihd+k-1) - one) 50 continue else if (type .eq. 'CAYLEY') then @@ -739,35 +687,35 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, & (workl(ihd+k-1) - one) 60 continue end if -c +c c %-------------------------------------------------------------% c | * Store the wanted NCONV lambda values into D. | c | * Sort the NCONV wanted lambda in WORKL(IHD:IHD+NCONV-1) | c | into ascending order and apply sort to the NCONV theta | -c | values in the transformed system. We'll need this to | +c | values in the transformed system. We will need this to | c | compute Ritz estimates in the original system. | -c | * Finally sort the lambda's into ascending order and apply | -c | to Ritz vectors if wanted. Else just sort lambda's into | +c | * Finally sort the lambda`s into ascending order and apply | +c | to Ritz vectors if wanted. Else just sort lambda`s into | c | ascending order. | c | NOTES: | c | *workl(iw:iw+ncv-1) contain the theta ordered so that they | -c | match the ordering of the lambda. We'll use them again for | +c | match the ordering of the lambda. We`ll use them again for | c | Ritz vector purification. | c %-------------------------------------------------------------% c call dcopy (nconv, workl(ihd), 1, d, 1) call igraphdsortr ('LA', .true., nconv, workl(ihd), workl(iw)) if (rvec) then - call igraphdsesrt ('LA', rvec , nconv, d, ncv, workl(iq), - & ldq) + call igraphdsesrt ('LA', rvec , nconv, d, ncv, workl(iq), + & ldq) else call dcopy (ncv, workl(bounds), 1, workl(ihb), 1) call dscal (ncv, bnorm2/rnorm, workl(ihb), 1) call igraphdsortr ('LA', .true., nconv, d, workl(ihb)) end if c - end if -c + end if +c c %------------------------------------------------% c | Compute the Ritz vectors. Transform the wanted | c | eigenvectors of the symmetric tridiagonal H by | @@ -775,42 +723,56 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, c %------------------------------------------------% c if (rvec .and. howmny .eq. 'A') then -c +c c %----------------------------------------------------------% c | Compute the QR factorization of the matrix representing | c | the wanted invariant subspace located in the first NCONV | c | columns of workl(iq,ldq). | c %----------------------------------------------------------% -c - call dgeqr2 (ncv, nconv, workl(iq), ldq, workl(iw+ncv), - & workl(ihb), ierr) c -c + call dgeqr2 (ncv, nconv , workl(iq) , + & ldq, workl(iw+ncv), workl(ihb), + & ierr) +c c %--------------------------------------------------------% -c | * Postmultiply V by Q. | +c | * Postmultiply V by Q. | c | * Copy the first NCONV columns of VQ into Z. | c | The N by NCONV matrix Z is now a matrix representation | c | of the approximate invariant subspace associated with | c | the Ritz values in workl(ihd). | c %--------------------------------------------------------% -c - call dorm2r ('Right', 'Notranspose', n, ncv, nconv, workl(iq), - & ldq, workl(iw+ncv), v, ldv, workd(n+1), ierr) +c + call dorm2r ('Right', 'Notranspose', n , + & ncv , nconv , workl(iq), + & ldq , workl(iw+ncv), v , + & ldv , workd(n+1) , ierr) call dlacpy ('All', n, nconv, v, ldv, z, ldz) c c %-----------------------------------------------------% c | In order to compute the Ritz estimates for the Ritz | c | values in both systems, need the last row of the | -c | eigenvector matrix. Remember, it's in factored form | +c | eigenvector matrix. Remember, it`s in factored form | c %-----------------------------------------------------% c do 65 j = 1, ncv-1 - workl(ihb+j-1) = zero + workl(ihb+j-1) = zero 65 continue workl(ihb+ncv-1) = one - call dorm2r ('Left', 'Transpose', ncv, 1, nconv, workl(iq), - & ldq, workl(iw+ncv), workl(ihb), ncv, temp, ierr) + call dorm2r ('Left', 'Transpose' , ncv , + & 1 , nconv , workl(iq) , + & ldq , workl(iw+ncv), workl(ihb), + & ncv , temp , ierr) c +c %-----------------------------------------------------% +c | Make a copy of the last row into | +c | workl(iw+ncv:iw+2*ncv), as it is needed again in | +c | the Ritz vector purification step below | +c %-----------------------------------------------------% +c + do 67 j = 1, nconv + workl(iw+ncv+j-1) = workl(ihb+j-1) + 67 continue + else if (rvec .and. howmny .eq. 'S') then c c Not yet implemented. See remark 2 above. @@ -830,29 +792,30 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, c | If RVEC = .true. then compute Ritz estimates | c | of the theta. | c | If RVEC = .false. then copy Ritz estimates | -c | as computed by igraphdsaupd. | +c | as computed by igraphdsaupd . | c | * Determine Ritz estimates of the lambda. | c %-------------------------------------------------% c - call dscal (ncv, bnorm2, workl(ihb), 1) - if (type .eq. 'SHIFTI') then + call dscal (ncv, bnorm2, workl(ihb), 1) + if (type .eq. 'SHIFTI') then c do 80 k=1, ncv - workl(ihb+k-1) = abs( workl(ihb+k-1) ) / workl(iw+k-1)**2 + workl(ihb+k-1) = abs( workl(ihb+k-1) ) + & / workl(iw+k-1)**2 80 continue c else if (type .eq. 'BUCKLE') then c do 90 k=1, ncv - workl(ihb+k-1) = sigma * abs( workl(ihb+k-1) ) / - & ( workl(iw+k-1)-one )**2 + workl(ihb+k-1) = sigma * abs( workl(ihb+k-1) ) + & / (workl(iw+k-1)-one )**2 90 continue c else if (type .eq. 'CAYLEY') then c do 100 k=1, ncv - workl(ihb+k-1) = abs( workl(ihb+k-1) / - & workl(iw+k-1)*(workl(iw+k-1)-one) ) + workl(ihb+k-1) = abs( workl(ihb+k-1) + & / workl(iw+k-1)*(workl(iw+k-1)-one) ) 100 continue c end if @@ -862,15 +825,15 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, if (type .ne. 'REGULR' .and. msglvl .gt. 1) then call igraphdvout (logfil, nconv, d, ndigit, & '_seupd: Untransformed converged Ritz values') - call igraphdvout (logfil, nconv, workl(ihb), ndigit, + call igraphdvout (logfil, nconv, workl(ihb), ndigit, & '_seupd: Ritz estimates of the untransformed Ritz values') else if (msglvl .gt. 1) then call igraphdvout (logfil, nconv, d, ndigit, & '_seupd: Converged Ritz values') - call igraphdvout (logfil, nconv, workl(ihb), ndigit, + call igraphdvout (logfil, nconv, workl(ihb), ndigit, & '_seupd: Associated Ritz estimates') end if -c +c c %-------------------------------------------------% c | Ritz vector purification step. Formally perform | c | one of inverse subspace iteration. Only used | @@ -880,19 +843,21 @@ subroutine igraphdseupd (rvec, howmny, select, d, z, ldz, if (rvec .and. (type .eq. 'SHIFTI' .or. type .eq. 'CAYLEY')) then c do 110 k=0, nconv-1 - workl(iw+k) = workl(iq+k*ldq+ncv-1) / workl(iw+k) + workl(iw+k) = workl(iw+ncv+k) + & / workl(iw+k) 110 continue c else if (rvec .and. type .eq. 'BUCKLE') then c do 120 k=0, nconv-1 - workl(iw+k) = workl(iq+k*ldq+ncv-1) / (workl(iw+k)-one) + workl(iw+k) = workl(iw+ncv+k) + & / (workl(iw+k)-one) 120 continue c - end if + end if c - if (type .ne. 'REGULR') - & call dger (n, nconv, one, resid, 1, workl(iw), 1, z, ldz) + if (rvec .and. type .ne. 'REGULR') + & call dger (n, nconv, one, resid, 1, workl(iw), 1, z, ldz) c 9000 continue c diff --git a/src/vendor/arpack/dsgets.f b/src/vendor/arpack/dsgets.f index d7539e47da..6d5e641149 100644 --- a/src/vendor/arpack/dsgets.f +++ b/src/vendor/arpack/dsgets.f @@ -3,13 +3,13 @@ c c\Name: igraphdsgets c -c\Description: +c\Description: c Given the eigenvalues of the symmetric tridiagonal matrix H, -c computes the NP shifts AMU that are zeros of the polynomial of -c degree NP which filters out components of the unwanted eigenvectors +c computes the NP shifts AMU that are zeros of the polynomial of +c degree NP which filters out components of the unwanted eigenvectors c corresponding to the AMU's based on some given criteria. c -c NOTE: This is called even in the case of user specified shifts in +c NOTE: This is called even in the case of user specified shifts in c order to sort the eigenvalues, and error bounds of H for later use. c c\Usage: @@ -39,8 +39,8 @@ c c RITZ Double precision array of length KEV+NP. (INPUT/OUTPUT) c On INPUT, RITZ contains the eigenvalues of H. -c On OUTPUT, RITZ are sorted so that the unwanted eigenvalues -c are in the first NP locations and the wanted part is in +c On OUTPUT, RITZ are sorted so that the unwanted eigenvalues +c are in the first NP locations and the wanted part is in c the last KEV locations. When exact shifts are selected, the c unwanted part corresponds to the shifts to be applied. c @@ -49,7 +49,7 @@ c c SHIFTS Double precision array of length NP. (INPUT/OUTPUT) c On INPUT: contains the user specified shifts if ISHIFT = 0. -c On OUTPUT: contains the shifts sorted into decreasing order +c On OUTPUT: contains the shifts sorted into decreasing order c of magnitude with respect to the Ritz estimates contained in c BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit. c @@ -65,7 +65,7 @@ c\Routines called: c igraphdsortr ARPACK utility sorting routine. c igraphivout ARPACK utility routine that prints integers. -c igraphsecond ARPACK utility routine for timing. +c igrapharscnd ARPACK utility routine for timing. c igraphdvout ARPACK utility routine that prints vectors. c dcopy Level 1 BLAS that copies one vector to another. c dswap Level 1 BLAS that swaps the contents of two vectors. @@ -75,13 +75,13 @@ c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas +c Rice University +c Houston, Texas c c\Revision history: c xx/xx/93: Version ' 2.1' c -c\SCCS Information: @(#) +c\SCCS Information: @(#) c FILE: sgets.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2 c c\Remarks @@ -91,7 +91,7 @@ c----------------------------------------------------------------------- c subroutine igraphdsgets ( ishift, which, kev, np, ritz, bounds, - & shifts ) + & shifts ) c c %----------------------------------------------------% c | Include files for debugging and timing information | @@ -104,7 +104,7 @@ subroutine igraphdsgets ( ishift, which, kev, np, ritz, bounds, c | Scalar Arguments | c %------------------% c - character which*2 + character*2 which integer ishift, kev, np c c %-----------------% @@ -132,7 +132,7 @@ subroutine igraphdsgets ( ishift, which, kev, np, ritz, bounds, c | External Subroutines | c %----------------------% c - external dswap, dcopy, igraphdsortr, igraphsecond + external dswap, dcopy, igraphdsortr, igrapharscnd c c %---------------------% c | Intrinsic Functions | @@ -143,15 +143,15 @@ subroutine igraphdsgets ( ishift, which, kev, np, ritz, bounds, c %-----------------------% c | Executable Statements | c %-----------------------% -c +c c %-------------------------------% c | Initialize timing statistics | c | & message level for debugging | c %-------------------------------% c - call igraphsecond (t0) + call igrapharscnd (t0) msglvl = msgets -c +c if (which .eq. 'BE') then c c %-----------------------------------------------------% @@ -164,11 +164,11 @@ subroutine igraphdsgets ( ishift, which, kev, np, ritz, bounds, c %-----------------------------------------------------% c call igraphdsortr ('LA', .true., kev+np, ritz, bounds) - kevd2 = kev / 2 + kevd2 = kev / 2 if ( kev .gt. 1 ) then - call dswap ( min(kevd2,np), ritz, 1, + call dswap ( min(kevd2,np), ritz, 1, & ritz( max(kevd2,np)+1 ), 1) - call dswap ( min(kevd2,np), bounds, 1, + call dswap ( min(kevd2,np), bounds, 1, & bounds( max(kevd2,np)+1 ), 1) end if c @@ -186,7 +186,7 @@ subroutine igraphdsgets ( ishift, which, kev, np, ritz, bounds, end if c if (ishift .eq. 1 .and. np .gt. 0) then -c +c c %-------------------------------------------------------% c | Sort the unwanted Ritz values used as shifts so that | c | the ones with largest Ritz estimates are first. | @@ -194,23 +194,23 @@ subroutine igraphdsgets ( ishift, which, kev, np, ritz, bounds, c | forward instability of the iteration when the shifts | c | are applied in subroutine igraphdsapps. | c %-------------------------------------------------------% -c +c call igraphdsortr ('SM', .true., np, bounds, ritz) call dcopy (np, ritz, 1, shifts, 1) end if -c - call igraphsecond (t1) +c + call igrapharscnd (t1) tsgets = tsgets + (t1 - t0) c if (msglvl .gt. 0) then - call igraphivout (logfil, 1, kev, ndigit, '_sgets: KEV is') - call igraphivout (logfil, 1, np, ndigit, '_sgets: NP is') + call igraphivout (logfil, 1, [kev], ndigit, '_sgets: KEV is') + call igraphivout (logfil, 1, [np], ndigit, '_sgets: NP is') call igraphdvout (logfil, kev+np, ritz, ndigit, & '_sgets: Eigenvalues of current H matrix') - call igraphdvout (logfil, kev+np, bounds, ndigit, + call igraphdvout (logfil, kev+np, bounds, ndigit, & '_sgets: Associated Ritz estimates') end if -c +c return c c %---------------% diff --git a/src/vendor/arpack/dsortc.f b/src/vendor/arpack/dsortc.f index ac4a645be0..c36f5c6fa7 100644 --- a/src/vendor/arpack/dsortc.f +++ b/src/vendor/arpack/dsortc.f @@ -4,7 +4,7 @@ c\Name: igraphdsortc c c\Description: -c Sorts the complex array in XREAL and XIMAG into the order +c Sorts the complex array in XREAL and XIMAG into the order c specified by WHICH and optionally applies the permutation to the c real array Y. It is assumed that if an element of XIMAG is c nonzero, then its negative is also an element. In other words, @@ -49,14 +49,14 @@ c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas +c Rice University +c Houston, Texas c c\Revision history: c xx/xx/92: Version ' 2.1' c Adapted from the sort routine in LANSO. c -c\SCCS Information: @(#) +c\SCCS Information: @(#) c FILE: sortc.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2 c c\EndLib @@ -69,7 +69,7 @@ subroutine igraphdsortc (which, apply, n, xreal, ximag, y) c | Scalar Arguments | c %------------------% c - character which*2 + character*2 which logical apply integer n c @@ -77,7 +77,7 @@ subroutine igraphdsortc (which, apply, n, xreal, ximag, y) c | Array Arguments | c %-----------------% c - Double precision + Double precision & xreal(0:n-1), ximag(0:n-1), y(0:n-1) c c %---------------% @@ -85,14 +85,14 @@ subroutine igraphdsortc (which, apply, n, xreal, ximag, y) c %---------------% c integer i, igap, j - Double precision + Double precision & temp, temp1, temp2 c c %--------------------% c | External Functions | c %--------------------% c - Double precision + Double precision & dlapy2 external dlapy2 c @@ -101,7 +101,7 @@ subroutine igraphdsortc (which, apply, n, xreal, ximag, y) c %-----------------------% c igap = n / 2 -c +c if (which .eq. 'LM') then c c %------------------------------------------------------% @@ -169,7 +169,7 @@ subroutine igraphdsortc (which, apply, n, xreal, ximag, y) temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp -c +c if (apply) then temp = y(j) y(j) = y(j+igap) @@ -183,7 +183,7 @@ subroutine igraphdsortc (which, apply, n, xreal, ximag, y) 60 continue igap = igap / 2 go to 40 -c +c else if (which .eq. 'LR') then c c %------------------------------------------------% @@ -207,7 +207,7 @@ subroutine igraphdsortc (which, apply, n, xreal, ximag, y) temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp -c +c if (apply) then temp = y(j) y(j) = y(j+igap) @@ -221,7 +221,7 @@ subroutine igraphdsortc (which, apply, n, xreal, ximag, y) 90 continue igap = igap / 2 go to 70 -c +c else if (which .eq. 'SR') then c c %------------------------------------------------% @@ -244,7 +244,7 @@ subroutine igraphdsortc (which, apply, n, xreal, ximag, y) temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp -c +c if (apply) then temp = y(j) y(j) = y(j+igap) @@ -258,7 +258,7 @@ subroutine igraphdsortc (which, apply, n, xreal, ximag, y) 120 continue igap = igap / 2 go to 100 -c +c else if (which .eq. 'LI') then c c %------------------------------------------------% @@ -281,7 +281,7 @@ subroutine igraphdsortc (which, apply, n, xreal, ximag, y) temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp -c +c if (apply) then temp = y(j) y(j) = y(j+igap) @@ -295,7 +295,7 @@ subroutine igraphdsortc (which, apply, n, xreal, ximag, y) 150 continue igap = igap / 2 go to 130 -c +c else if (which .eq. 'SI') then c c %------------------------------------------------% @@ -318,7 +318,7 @@ subroutine igraphdsortc (which, apply, n, xreal, ximag, y) temp = ximag(j) ximag(j) = ximag(j+igap) ximag(j+igap) = temp -c +c if (apply) then temp = y(j) y(j) = y(j+igap) @@ -333,7 +333,7 @@ subroutine igraphdsortc (which, apply, n, xreal, ximag, y) igap = igap / 2 go to 160 end if -c +c 9000 continue return c diff --git a/src/vendor/arpack/dsortr.f b/src/vendor/arpack/dsortr.f index 11b02716b8..381678741e 100644 --- a/src/vendor/arpack/dsortr.f +++ b/src/vendor/arpack/dsortr.f @@ -4,7 +4,7 @@ c\Name: igraphdsortr c c\Description: -c Sort the array X1 in the order specified by WHICH and optionally +c Sort the array X1 in the order specified by WHICH and optionally c applies the permutation to the array X2. c c\Usage: @@ -39,17 +39,17 @@ c c\Author c Danny Sorensen Phuong Vu -c Richard Lehoucq CRPC / Rice University -c Dept. of Computational & Houston, Texas +c Richard Lehoucq CRPC / Rice University +c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas +c Rice University +c Houston, Texas c c\Revision history: c 12/16/93: Version ' 2.1'. c Adapted from the sort routine in LANSO. c -c\SCCS Information: @(#) +c\SCCS Information: @(#) c FILE: sortr.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2 c c\EndLib @@ -62,7 +62,7 @@ subroutine igraphdsortr (which, apply, n, x1, x2) c | Scalar Arguments | c %------------------% c - character which*2 + character*2 which logical apply integer n c @@ -86,7 +86,7 @@ subroutine igraphdsortr (which, apply, n, x1, x2) c %-----------------------% c igap = n / 2 -c +c if (which .eq. 'SA') then c c X1 is sorted into decreasing order of algebraic. @@ -158,7 +158,7 @@ subroutine igraphdsortr (which, apply, n, x1, x2) 80 continue c if (j.lt.0) go to 90 -c +c if (x1(j).gt.x1(j+igap)) then temp = x1(j) x1(j) = x1(j+igap) @@ -176,7 +176,7 @@ subroutine igraphdsortr (which, apply, n, x1, x2) 90 continue igap = igap / 2 go to 70 -c +c else if (which .eq. 'LM') then c c X1 is sorted into increasing order of magnitude. diff --git a/src/vendor/arpack/dstatn.f b/src/vendor/arpack/dstatn.f index afd0a57256..89e26c8359 100644 --- a/src/vendor/arpack/dstatn.f +++ b/src/vendor/arpack/dstatn.f @@ -9,10 +9,10 @@ c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas +c Rice University +c Houston, Texas c -c\SCCS Information: @(#) +c\SCCS Information: @(#) c FILE: statn.F SID: 2.4 DATE OF SID: 4/20/96 RELEASE: 2 c subroutine igraphdstatn @@ -22,7 +22,7 @@ subroutine igraphdstatn c %--------------------------------% c include 'stat.h' -c +c c %-----------------------% c | Executable Statements | c %-----------------------% @@ -32,7 +32,7 @@ subroutine igraphdstatn nrorth = 0 nitref = 0 nrstrt = 0 -c +c tnaupd = 0.0D+0 tnaup2 = 0.0D+0 tnaitr = 0.0D+0 @@ -43,14 +43,14 @@ subroutine igraphdstatn titref = 0.0D+0 tgetv0 = 0.0D+0 trvec = 0.0D+0 -c +c c %----------------------------------------------------% c | User time including reverse communication overhead | c %----------------------------------------------------% c tmvopx = 0.0D+0 tmvbx = 0.0D+0 -c +c return c c diff --git a/src/vendor/arpack/dstats.f b/src/vendor/arpack/dstats.f index 545ed1960a..a93855428b 100644 --- a/src/vendor/arpack/dstats.f +++ b/src/vendor/arpack/dstats.f @@ -1,18 +1,18 @@ c -c\SCCS Information: @(#) +c\SCCS Information: @(#) c FILE: stats.F SID: 2.1 DATE OF SID: 4/19/96 RELEASE: 2 c %---------------------------------------------% c | Initialize statistic and timing information | c | for symmetric Arnoldi code. | c %---------------------------------------------% - + subroutine igraphdstats c %--------------------------------% c | See stat.doc for documentation | c %--------------------------------% include 'stat.h' - + c %-----------------------% c | Executable Statements | c %-----------------------% @@ -22,7 +22,7 @@ subroutine igraphdstats nrorth = 0 nitref = 0 nrstrt = 0 - + tsaupd = 0.0D+0 tsaup2 = 0.0D+0 tsaitr = 0.0D+0 @@ -33,13 +33,13 @@ subroutine igraphdstats titref = 0.0D+0 tgetv0 = 0.0D+0 trvec = 0.0D+0 - + c %----------------------------------------------------% c | User time including reverse communication overhead | c %----------------------------------------------------% tmvopx = 0.0D+0 tmvbx = 0.0D+0 - + return c c End of igraphdstats diff --git a/src/vendor/arpack/dstqrb.f b/src/vendor/arpack/dstqrb.f index eff13698ab..cb8c8a8638 100644 --- a/src/vendor/arpack/dstqrb.f +++ b/src/vendor/arpack/dstqrb.f @@ -32,13 +32,13 @@ c On exit, E has been destroyed. c c Z Double precision array, dimension (N). (OUTPUT) -c On exit, Z contains the last row of the orthonormal -c eigenvector matrix of the symmetric tridiagonal matrix. +c On exit, Z contains the last row of the orthonormal +c eigenvector matrix of the symmetric tridiagonal matrix. c If an error exit is made, Z contains the last row of the c eigenvector matrix associated with the stored eigenvalues. c c WORK Double precision array, dimension (max(1,2*N-2)). (WORKSPACE) -c Workspace used in accumulating the transformation for +c Workspace used in accumulating the transformation for c computing the last components of the eigenvectors. c c INFO Integer. (OUTPUT) @@ -62,9 +62,9 @@ c dcopy Level 1 BLAS that copies one vector to another. c dswap Level 1 BLAS that swaps the contents of two vectors. c lsame LAPACK character comparison routine. -c dlae2 LAPACK routine that computes the eigenvalues of a 2-by-2 +c dlae2 LAPACK routine that computes the eigenvalues of a 2-by-2 c symmetric matrix. -c dlaev2 LAPACK routine that eigendecomposition of a 2-by-2 symmetric +c dlaev2 LAPACK routine that eigendecomposition of a 2-by-2 symmetric c matrix. c dlamch LAPACK routine that determines machine constants. c dlanst LAPACK routine that computes the norm of a matrix. @@ -72,7 +72,7 @@ c dlartg LAPACK Givens rotation construction routine. c dlascl LAPACK routine for careful scaling of a matrix. c dlaset LAPACK matrix initialization routine. -c dlasr LAPACK routine that applies an orthogonal transformation to +c dlasr LAPACK routine that applies an orthogonal transformation to c a matrix. c dlasrt LAPACK sorting routine. c dsteqr LAPACK routine that computes eigenvalues and eigenvectors @@ -84,19 +84,19 @@ c Richard Lehoucq CRPC / Rice University c Dept. of Computational & Houston, Texas c Applied Mathematics -c Rice University -c Houston, Texas +c Rice University +c Houston, Texas c -c\SCCS Information: @(#) +c\SCCS Information: @(#) c FILE: stqrb.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2 c c\Remarks c 1. Starting with version 2.5, this routine is a modified version c of LAPACK version 2.0 subroutine SSTEQR. No lines are deleted, -c only commeted out and new lines inserted. +c only commented out and new lines inserted. c All lines commented out have "c$$$" at the beginning. c Note that the LAPACK version 1.0 subroutine SSTEQR contained -c bugs. +c bugs. c c\EndLib c @@ -118,9 +118,9 @@ subroutine igraphdstqrb ( n, d, e, z, work, info ) & d( n ), e( n-1 ), z( n ), work( 2*n-2 ) c c .. parameters .. - Double precision + Double precision & zero, one, two, three - parameter ( zero = 0.0D+0, one = 1.0D+0, + parameter ( zero = 0.0D+0, one = 1.0D+0, & two = 2.0D+0, three = 3.0D+0 ) integer maxit parameter ( maxit = 30 ) @@ -129,7 +129,7 @@ subroutine igraphdstqrb ( n, d, e, z, work, info ) integer i, icompz, ii, iscale, j, jtot, k, l, l1, lend, & lendm1, lendp1, lendsv, lm1, lsv, m, mm, mm1, & nm1, nmaxit - Double precision + Double precision & anorm, b, c, eps, eps2, f, g, p, r, rt1, rt2, & s, safmax, safmin, ssfmax, ssfmin, tst c .. @@ -380,9 +380,9 @@ subroutine igraphdstqrb ( n, d, e, z, work, info ) c c *** New starting with version 2.5 *** c - call dlasr( 'r', 'v', 'b', 1, mm, work( l ), + call dlasr( 'r', 'v', 'b', 1, mm, work( l ), & work( n-1+l ), z( l ), 1 ) -c ************************************* +c ************************************* end if c d( l ) = d( l ) - p @@ -440,7 +440,7 @@ subroutine igraphdstqrb ( n, d, e, z, work, info ) tst = z(l) z(l) = c*tst - s*z(l-1) z(l-1) = s*tst + c*z(l-1) -c ************************************* +c ************************************* else call dlae2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2 ) end if @@ -502,7 +502,7 @@ subroutine igraphdstqrb ( n, d, e, z, work, info ) c call dlasr( 'r', 'v', 'f', 1, mm, work( m ), work( n-1+m ), & z( m ), 1 ) -c ************************************* +c ************************************* end if c d( l ) = d( l ) - p diff --git a/src/vendor/arpack/dvout.f b/src/vendor/arpack/dvout.f index 3e855dd365..3c209970e6 100644 --- a/src/vendor/arpack/dvout.f +++ b/src/vendor/arpack/dvout.f @@ -1,9 +1,9 @@ *----------------------------------------------------------------------- -* Routine: DVOUT +* Routine: IGRAPHDVOUT * * Purpose: Real vector output routine. * -* Usage: CALL DVOUT (LOUT, N, SX, IDIGIT, IFMT) +* Usage: CALL IGRAPHDVOUT (LOUT, N, SX, IDIGIT, IFMT) * * Arguments * N - Length of array SX. (Input) @@ -28,7 +28,7 @@ SUBROUTINE IGRAPHDVOUT( LOUT, N, SX, IDIGIT, IFMT ) DOUBLE PRECISION SX( * ) * .. * .. Local Scalars .. - CHARACTER LINE*80 + CHARACTER*80 LINE INTEGER I, K1, K2, LLL, NDIGIT * .. * .. Intrinsic Functions .. @@ -39,84 +39,84 @@ SUBROUTINE IGRAPHDVOUT( LOUT, N, SX, IDIGIT, IFMT ) * ... FIRST EXECUTABLE STATEMENT * * -c$$$ LLL = MIN( LEN( IFMT ), 80 ) -c$$$ DO 10 I = 1, LLL -c$$$ LINE( I: I ) = '-' -c$$$ 10 CONTINUE -c$$$* -c$$$ DO 20 I = LLL + 1, 80 -c$$$ LINE( I: I ) = ' ' -c$$$ 20 CONTINUE -c$$$* -c$$$ WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL ) -c$$$ 9999 FORMAT( / 1X, A, / 1X, A ) -c$$$* -c$$$ IF( N.LE.0 ) -c$$$ $ RETURN -c$$$ NDIGIT = IDIGIT -c$$$ IF( IDIGIT.EQ.0 ) -c$$$ $ NDIGIT = 4 -c$$$* -c$$$*======================================================================= -c$$$* CODE FOR OUTPUT USING 72 COLUMNS FORMAT -c$$$*======================================================================= -c$$$* -c$$$ IF( IDIGIT.LT.0 ) THEN -c$$$ NDIGIT = -IDIGIT -c$$$ IF( NDIGIT.LE.4 ) THEN -c$$$ DO 30 K1 = 1, N, 5 -c$$$ K2 = MIN0( N, K1+4 ) -c$$$ WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 ) -c$$$ 30 CONTINUE -c$$$ ELSE IF( NDIGIT.LE.6 ) THEN -c$$$ DO 40 K1 = 1, N, 4 -c$$$ K2 = MIN0( N, K1+3 ) -c$$$ WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 ) -c$$$ 40 CONTINUE -c$$$ ELSE IF( NDIGIT.LE.10 ) THEN -c$$$ DO 50 K1 = 1, N, 3 -c$$$ K2 = MIN0( N, K1+2 ) -c$$$ WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 ) -c$$$ 50 CONTINUE -c$$$ ELSE -c$$$ DO 60 K1 = 1, N, 2 -c$$$ K2 = MIN0( N, K1+1 ) -c$$$ WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 ) -c$$$ 60 CONTINUE -c$$$ END IF -c$$$* -c$$$*======================================================================= -c$$$* CODE FOR OUTPUT USING 132 COLUMNS FORMAT -c$$$*======================================================================= -c$$$* -c$$$ ELSE -c$$$ IF( NDIGIT.LE.4 ) THEN -c$$$ DO 70 K1 = 1, N, 10 -c$$$ K2 = MIN0( N, K1+9 ) -c$$$ WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 ) -c$$$ 70 CONTINUE -c$$$ ELSE IF( NDIGIT.LE.6 ) THEN -c$$$ DO 80 K1 = 1, N, 8 -c$$$ K2 = MIN0( N, K1+7 ) -c$$$ WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 ) -c$$$ 80 CONTINUE -c$$$ ELSE IF( NDIGIT.LE.10 ) THEN -c$$$ DO 90 K1 = 1, N, 6 -c$$$ K2 = MIN0( N, K1+5 ) -c$$$ WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 ) -c$$$ 90 CONTINUE -c$$$ ELSE -c$$$ DO 100 K1 = 1, N, 5 -c$$$ K2 = MIN0( N, K1+4 ) -c$$$ WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 ) -c$$$ 100 CONTINUE -c$$$ END IF -c$$$ END IF -c$$$ WRITE( LOUT, FMT = 9994 ) -c$$$ RETURN -c$$$ 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P, 10D12.3 ) -c$$$ 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 8D14.5 ) -c$$$ 9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 6D18.9 ) -c$$$ 9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 5D24.13 ) -c$$$ 9994 FORMAT( 1X, ' ' ) + LLL = MIN( LEN( IFMT ), 80 ) + DO 10 I = 1, LLL + LINE( I: I ) = '-' + 10 CONTINUE +* + DO 20 I = LLL + 1, 80 + LINE( I: I ) = ' ' + 20 CONTINUE +* + WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL ) + 9999 FORMAT( / 1X, A, / 1X, A ) +* + IF( N.LE.0 ) + $ RETURN + NDIGIT = IDIGIT + IF( IDIGIT.EQ.0 ) + $ NDIGIT = 4 +* +*======================================================================= +* CODE FOR OUTPUT USING 72 COLUMNS FORMAT +*======================================================================= +* + IF( IDIGIT.LT.0 ) THEN + NDIGIT = -IDIGIT + IF( NDIGIT.LE.4 ) THEN + DO 30 K1 = 1, N, 5 + K2 = MIN0( N, K1+4 ) + WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 ) + 30 CONTINUE + ELSE IF( NDIGIT.LE.6 ) THEN + DO 40 K1 = 1, N, 4 + K2 = MIN0( N, K1+3 ) + WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 ) + 40 CONTINUE + ELSE IF( NDIGIT.LE.10 ) THEN + DO 50 K1 = 1, N, 3 + K2 = MIN0( N, K1+2 ) + WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 ) + 50 CONTINUE + ELSE + DO 60 K1 = 1, N, 2 + K2 = MIN0( N, K1+1 ) + WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 ) + 60 CONTINUE + END IF +* +*======================================================================= +* CODE FOR OUTPUT USING 132 COLUMNS FORMAT +*======================================================================= +* + ELSE + IF( NDIGIT.LE.4 ) THEN + DO 70 K1 = 1, N, 10 + K2 = MIN0( N, K1+9 ) + WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 ) + 70 CONTINUE + ELSE IF( NDIGIT.LE.6 ) THEN + DO 80 K1 = 1, N, 8 + K2 = MIN0( N, K1+7 ) + WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 ) + 80 CONTINUE + ELSE IF( NDIGIT.LE.10 ) THEN + DO 90 K1 = 1, N, 6 + K2 = MIN0( N, K1+5 ) + WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 ) + 90 CONTINUE + ELSE + DO 100 K1 = 1, N, 5 + K2 = MIN0( N, K1+4 ) + WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 ) + 100 CONTINUE + END IF + END IF + WRITE( LOUT, FMT = 9994 ) + RETURN + 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P, 10D12.3 ) + 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 8D14.5 ) + 9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 6D18.9 ) + 9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 5D24.13 ) + 9994 FORMAT( 1X, ' ' ) END diff --git a/src/vendor/arpack/ivout.f b/src/vendor/arpack/ivout.f index abbc489e00..63618bf491 100644 --- a/src/vendor/arpack/ivout.f +++ b/src/vendor/arpack/ivout.f @@ -1,9 +1,9 @@ C----------------------------------------------------------------------- -C Routine: IVOUT +C Routine: IGRAPHIVOUT C C Purpose: Integer vector output routine. C -C Usage: CALL IVOUT (LOUT, N, IX, IDIGIT, IFMT) +C Usage: CALL IGRAPHIVOUT (LOUT, N, IX, IDIGIT, IFMT) C C Arguments C N - Length of array IX. (Input) @@ -23,98 +23,98 @@ SUBROUTINE IGRAPHIVOUT (LOUT, N, IX, IDIGIT, IFMT) C ... C ... SPECIFICATIONS FOR LOCAL VARIABLES INTEGER I, NDIGIT, K1, K2, LLL - CHARACTER LINE*80 + CHARACTER*80 LINE * ... * ... SPECIFICATIONS INTRINSICS INTRINSIC MIN * C -c$$$ LLL = MIN ( LEN ( IFMT ), 80 ) -c$$$ DO 1 I = 1, LLL -c$$$ LINE(I:I) = '-' -c$$$ 1 CONTINUE -c$$$C -c$$$ DO 2 I = LLL+1, 80 -c$$$ LINE(I:I) = ' ' -c$$$ 2 CONTINUE -c$$$C -c$$$ WRITE ( LOUT, 2000 ) IFMT, LINE(1:LLL) -c$$$ 2000 FORMAT ( /1X, A /1X, A ) -c$$$C -c$$$ IF (N .LE. 0) RETURN -c$$$ NDIGIT = IDIGIT -c$$$ IF (IDIGIT .EQ. 0) NDIGIT = 4 -c$$$C -c$$$C======================================================================= -c$$$C CODE FOR OUTPUT USING 72 COLUMNS FORMAT -c$$$C======================================================================= -c$$$C -c$$$ IF (IDIGIT .LT. 0) THEN -c$$$C -c$$$ NDIGIT = -IDIGIT -c$$$ IF (NDIGIT .LE. 4) THEN -c$$$ DO 10 K1 = 1, N, 10 -c$$$ K2 = MIN0(N,K1+9) -c$$$ WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2) -c$$$ 10 CONTINUE -c$$$C -c$$$ ELSE IF (NDIGIT .LE. 6) THEN -c$$$ DO 30 K1 = 1, N, 7 -c$$$ K2 = MIN0(N,K1+6) -c$$$ WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2) -c$$$ 30 CONTINUE -c$$$C -c$$$ ELSE IF (NDIGIT .LE. 10) THEN -c$$$ DO 50 K1 = 1, N, 5 -c$$$ K2 = MIN0(N,K1+4) -c$$$ WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2) -c$$$ 50 CONTINUE -c$$$C -c$$$ ELSE -c$$$ DO 70 K1 = 1, N, 3 -c$$$ K2 = MIN0(N,K1+2) -c$$$ WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2) -c$$$ 70 CONTINUE -c$$$ END IF -c$$$C -c$$$C======================================================================= -c$$$C CODE FOR OUTPUT USING 132 COLUMNS FORMAT -c$$$C======================================================================= -c$$$C -c$$$ ELSE -c$$$C -c$$$ IF (NDIGIT .LE. 4) THEN -c$$$ DO 90 K1 = 1, N, 20 -c$$$ K2 = MIN0(N,K1+19) -c$$$ WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2) -c$$$ 90 CONTINUE -c$$$C -c$$$ ELSE IF (NDIGIT .LE. 6) THEN -c$$$ DO 110 K1 = 1, N, 15 -c$$$ K2 = MIN0(N,K1+14) -c$$$ WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2) -c$$$ 110 CONTINUE -c$$$C -c$$$ ELSE IF (NDIGIT .LE. 10) THEN -c$$$ DO 130 K1 = 1, N, 10 -c$$$ K2 = MIN0(N,K1+9) -c$$$ WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2) -c$$$ 130 CONTINUE -c$$$C -c$$$ ELSE -c$$$ DO 150 K1 = 1, N, 7 -c$$$ K2 = MIN0(N,K1+6) -c$$$ WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2) -c$$$ 150 CONTINUE -c$$$ END IF -c$$$ END IF -c$$$ WRITE (LOUT,1004) -c$$$C -c$$$ 1000 FORMAT(1X,I4,' - ',I4,':',20(1X,I5)) -c$$$ 1001 FORMAT(1X,I4,' - ',I4,':',15(1X,I7)) -c$$$ 1002 FORMAT(1X,I4,' - ',I4,':',10(1X,I11)) -c$$$ 1003 FORMAT(1X,I4,' - ',I4,':',7(1X,I15)) -c$$$ 1004 FORMAT(1X,' ') -c$$$C + LLL = MIN ( LEN ( IFMT ), 80 ) + DO 1 I = 1, LLL + LINE(I:I) = '-' + 1 CONTINUE +C + DO 2 I = LLL+1, 80 + LINE(I:I) = ' ' + 2 CONTINUE +C + WRITE ( LOUT, 2000 ) IFMT, LINE(1:LLL) + 2000 FORMAT ( /1X, A /1X, A ) +C + IF (N .LE. 0) RETURN + NDIGIT = IDIGIT + IF (IDIGIT .EQ. 0) NDIGIT = 4 +C +C======================================================================= +C CODE FOR OUTPUT USING 72 COLUMNS FORMAT +C======================================================================= +C + IF (IDIGIT .LT. 0) THEN +C + NDIGIT = -IDIGIT + IF (NDIGIT .LE. 4) THEN + DO 10 K1 = 1, N, 10 + K2 = MIN0(N,K1+9) + WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2) + 10 CONTINUE +C + ELSE IF (NDIGIT .LE. 6) THEN + DO 30 K1 = 1, N, 7 + K2 = MIN0(N,K1+6) + WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2) + 30 CONTINUE +C + ELSE IF (NDIGIT .LE. 10) THEN + DO 50 K1 = 1, N, 5 + K2 = MIN0(N,K1+4) + WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2) + 50 CONTINUE +C + ELSE + DO 70 K1 = 1, N, 3 + K2 = MIN0(N,K1+2) + WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2) + 70 CONTINUE + END IF +C +C======================================================================= +C CODE FOR OUTPUT USING 132 COLUMNS FORMAT +C======================================================================= +C + ELSE +C + IF (NDIGIT .LE. 4) THEN + DO 90 K1 = 1, N, 20 + K2 = MIN0(N,K1+19) + WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2) + 90 CONTINUE +C + ELSE IF (NDIGIT .LE. 6) THEN + DO 110 K1 = 1, N, 15 + K2 = MIN0(N,K1+14) + WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2) + 110 CONTINUE +C + ELSE IF (NDIGIT .LE. 10) THEN + DO 130 K1 = 1, N, 10 + K2 = MIN0(N,K1+9) + WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2) + 130 CONTINUE +C + ELSE + DO 150 K1 = 1, N, 7 + K2 = MIN0(N,K1+6) + WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2) + 150 CONTINUE + END IF + END IF + WRITE (LOUT,1004) +C + 1000 FORMAT(1X,I4,' - ',I4,':',20(1X,I5)) + 1001 FORMAT(1X,I4,' - ',I4,':',15(1X,I7)) + 1002 FORMAT(1X,I4,' - ',I4,':',10(1X,I11)) + 1003 FORMAT(1X,I4,' - ',I4,':',7(1X,I15)) + 1004 FORMAT(1X,' ') +C RETURN END diff --git a/src/vendor/arpack/second.f b/src/vendor/arpack/second.f index f9f06471f8..b5b9a9ae48 100644 --- a/src/vendor/arpack/second.f +++ b/src/vendor/arpack/second.f @@ -1,4 +1,4 @@ - SUBROUTINE IGRAPHSECOND( T ) + SUBROUTINE IGRAPHARSCND( T ) * REAL T * @@ -10,34 +10,14 @@ SUBROUTINE IGRAPHSECOND( T ) * Purpose * ======= * -* SECOND returns the user time for a process in igraphseconds. -* This version gets the time from the system function ETIME. -* -* .. Local Scalars .. - REAL T1 -* .. -* .. Local Arrays .. - REAL TARRAY( 2 ) -* .. -* .. External Functions .. - REAL ETIME -* .. -* .. Executable Statements .. -* -* ====================================== -* This has been changed by the CRAN team. -* Needs to be back-ported to igrapch/C -* ====================================== +* IGRAPHARSCND returns the user time for a process in seconds. +* This version was modified by the igraph team to always return 0, +* since igraph does not require ARPACK's timing functionality. * T = 0.0 RETURN * -* ====================================== -* This has been changed by the CRAN team -* Needs to be back-ported to igrapch/C -* ====================================== * -* -* End of SECOND +* End of IGRAPHARSCND * END diff --git a/src/vendor/arpack/stat.h b/src/vendor/arpack/stat.h index ae407cb768..017400d5ce 100644 --- a/src/vendor/arpack/stat.h +++ b/src/vendor/arpack/stat.h @@ -1,20 +1,20 @@ -c %--------------------------------% -c | See stat.doc for documentation | -c %--------------------------------% -c -c\SCCS Information: @(#) -c FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2 -c +! %--------------------------------% +! | See stat.doc for documentation | +! %--------------------------------% +! +!\SCCS Information: @(#) +! FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2 +! real t0, t1, t2, t3, t4, t5 -c save t0, t1, t2, t3, t4, t5 -c + save t0, t1, t2, t3, t4, t5 +! integer nopx, nbx, nrorth, nitref, nrstrt real tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv, & tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv, & tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv, & tmvopx, tmvbx, tgetv0, titref, trvec - common /timing/ - & nopx, nbx, nrorth, nitref, nrstrt, + common /timing/ + & nopx, nbx, nrorth, nitref, nrstrt, & tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv, & tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv, & tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv, diff --git a/tests/testthat/_snaps/centrality.md b/tests/testthat/_snaps/centrality.md index 56fcb4fcc8..64311236e3 100644 --- a/tests/testthat/_snaps/centrality.md +++ b/tests/testthat/_snaps/centrality.md @@ -92,13 +92,13 @@ [1] 1 $options$numop - [1] 7 + [1] 8 $options$numopb [1] 0 $options$numreo - [1] 5 + [1] 6