From a7b6dc7b5954077cd3da19a3c77798eca683739b Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Sat, 30 Apr 2022 19:03:28 -0400 Subject: [PATCH 001/262] initial implementation of minimizer support in fix shake/rattle --- doc/src/fix_shake.rst | 27 ++-- src/KOKKOS/fix_shake_kokkos.cpp | 15 +- src/RIGID/fix_rattle.cpp | 104 ++++++-------- src/RIGID/fix_shake.cpp | 233 ++++++++++++++++++++++---------- src/RIGID/fix_shake.h | 15 +- src/fix_restrain.cpp | 21 ++- 6 files changed, 249 insertions(+), 166 deletions(-) diff --git a/doc/src/fix_shake.rst b/doc/src/fix_shake.rst index f0c847cb5e..d723f28fc0 100644 --- a/doc/src/fix_shake.rst +++ b/doc/src/fix_shake.rst @@ -33,12 +33,14 @@ Syntax *m* value = one or more mass values * zero or more keyword/value pairs may be appended -* keyword = *mol* +* keyword = *mol* or *kbond* .. parsed-literal:: *mol* value = template-ID template-ID = ID of molecule template specified in a separate :doc:`molecule ` command + *kbond* value = force constant + force constant = force constant used to apply a restraint force when used during minimization Examples """""""" @@ -152,17 +154,23 @@ for. ---------- -The *mol* keyword should be used when other commands, such as :doc:`fix deposit ` or :doc:`fix pour `, add molecules +The *mol* keyword should be used when other commands, such as :doc:`fix +deposit ` or :doc:`fix pour `, add molecules on-the-fly during a simulation, and you wish to constrain the new molecules via SHAKE. You specify a *template-ID* previously defined using the :doc:`molecule ` command, which reads a file that defines the molecule. You must use the same *template-ID* that the command adding molecules uses. The coordinates, atom types, special -bond restrictions, and SHAKE info can be specified in the molecule -file. See the :doc:`molecule ` command for details. The only +bond restrictions, and SHAKE info can be specified in the molecule file. +See the :doc:`molecule ` command for details. The only settings required to be in this file (by this command) are the SHAKE info of atoms in the molecule. +The *kbond* keyword allows to set the restraint force constant when +fix shake or fix rattle are used during minimization. In that case +the constraint algorithms are **not** applied and restraint +forces are used instead to help maintaining the geometries. + ---------- .. include:: accel_styles.rst @@ -205,8 +213,10 @@ setting for this fix is :doc:`fix_modify virial yes `. No global or per-atom quantities are stored by these fixes for access by various :doc:`output commands `. No parameter of these fixes can be used with the *start/stop* keywords of the -:doc:`run ` command. These fixes are not invoked during -:doc:`energy minimization `. +:doc:`run ` command. + +When used during minimization, the SHAKE or RATTLE algorithms are **not** +applied. Strong restraint forces are applied instead. Restrictions """""""""""" @@ -232,13 +242,14 @@ make a linear molecule rigid. Related commands """""""""""""""" -none +`fix rigid `, `fix ehex `, +`fix nve/manifold/rattle ` Default """"""" -none +kbond = 1.0e6 ---------- diff --git a/src/KOKKOS/fix_shake_kokkos.cpp b/src/KOKKOS/fix_shake_kokkos.cpp index a24c47c1e2..5ed8cfccb3 100644 --- a/src/KOKKOS/fix_shake_kokkos.cpp +++ b/src/KOKKOS/fix_shake_kokkos.cpp @@ -12,12 +12,8 @@ See the README file in the top-level LAMMPS directory. ------------------------------------------------------------------------- */ -#include -#include -#include -#include -#include #include "fix_shake_kokkos.h" + #include "fix_rattle.h" #include "atom_kokkos.h" #include "atom_vec.h" @@ -38,6 +34,9 @@ #include "kokkos.h" #include "atom_masks.h" +#include +#include + using namespace LAMMPS_NS; using namespace FixConst; using namespace MathConst; @@ -292,7 +291,7 @@ void FixShakeKokkos::pre_neighbor() if (h_error_flag() == 1) { error->one(FLERR,"Shake atoms missing on proc " - "{} at step {}",me,update->ntimestep); + "{} at step {}",comm->me,update->ntimestep); } } @@ -341,7 +340,7 @@ void FixShakeKokkos::post_force(int vflag) // communicate results if necessary unconstrained_update(); - if (nprocs > 1) comm->forward_comm(this); + if (comm->nprocs > 1) comm->forward_comm(this); k_xshake.sync(); // virial setup @@ -1702,7 +1701,7 @@ void FixShakeKokkos::correct_coordinates(int vflag) { double **xtmp = xshake; xshake = x; - if (nprocs > 1) { + if (comm->nprocs > 1) { forward_comm_device = 0; comm->forward_comm(this); forward_comm_device = 1; diff --git a/src/RIGID/fix_rattle.cpp b/src/RIGID/fix_rattle.cpp index afe08415c3..1d6336712b 100644 --- a/src/RIGID/fix_rattle.cpp +++ b/src/RIGID/fix_rattle.cpp @@ -81,7 +81,7 @@ FixRattle::~FixRattle() { memory->destroy(vp); - if (RATTLE_DEBUG) { +#if RATTLE_DEBUG // communicate maximum distance error @@ -91,13 +91,11 @@ FixRattle::~FixRattle() MPI_Reduce(&derr_max, &global_derr_max, 1 , MPI_DOUBLE, MPI_MAX, 0, world); MPI_Reduce(&verr_max, &global_verr_max, 1 , MPI_DOUBLE, MPI_MAX, 0, world); - MPI_Comm_rank (world, &npid); // Find out process rank - - if (npid == 0 && screen) { + if (comm->me == 0 && screen) { fprintf(screen, "RATTLE: Maximum overall relative position error ( (r_ij-d_ij)/d_ij ): %.10g\n", global_derr_max); fprintf(screen, "RATTLE: Maximum overall absolute velocity error (r_ij * v_ij): %.10g\n", global_verr_max); } - } +#endif } /* ---------------------------------------------------------------------- */ @@ -110,7 +108,10 @@ int FixRattle::setmask() mask |= POST_FORCE_RESPA; mask |= FINAL_INTEGRATE; mask |= FINAL_INTEGRATE_RESPA; - if (RATTLE_DEBUG) mask |= END_OF_STEP; + mask |= MIN_POST_FORCE; +#if RATTLE_DEBUG + mask |= END_OF_STEP; +#endif return mask; } @@ -156,7 +157,7 @@ void FixRattle::post_force(int vflag) // communicate the unconstrained velocities - if (nprocs > 1) { + if (comm->nprocs > 1) { comm_mode = VP; comm->forward_comm(this); } @@ -188,7 +189,7 @@ void FixRattle::post_force_respa(int vflag, int ilevel, int /*iloop*/) // communicate the unconstrained velocities - if (nprocs > 1) { + if (comm->nprocs > 1) { comm_mode = VP; comm->forward_comm(this); } @@ -718,7 +719,7 @@ void FixRattle::unpack_forward_comm(int n, int first, double *buf) void FixRattle::shake_end_of_step(int vflag) { - if (nprocs > 1) { + if (comm->nprocs > 1) { comm_mode = V; comm->forward_comm(this); } @@ -738,7 +739,6 @@ void FixRattle::correct_coordinates(int vflag) { FixShake::correct_coordinates(vflag); } - /* ---------------------------------------------------------------------- Remove the velocity component along any bond. ------------------------------------------------------------------------- */ @@ -759,7 +759,7 @@ void FixRattle::correct_velocities() { // communicate the unconstrained velocities - if (nprocs > 1) { + if (comm->nprocs > 1) { comm_mode = VP; comm->forward_comm(this); } @@ -769,14 +769,13 @@ void FixRattle::correct_velocities() { int m; for (int i = 0; i < nlist; i++) { m = list[i]; - if (shake_flag[m] == 2) vrattle2(m); - else if (shake_flag[m] == 3) vrattle3(m); - else if (shake_flag[m] == 4) vrattle4(m); - else vrattle3angle(m); + if (shake_flag[m] == 2) vrattle2(m); + else if (shake_flag[m] == 3) vrattle3(m); + else if (shake_flag[m] == 4) vrattle4(m); + else vrattle3angle(m); } } - /* ---------------------------------------------------------------------- DEBUGGING methods The functions below allow you to check whether the @@ -788,16 +787,16 @@ void FixRattle::correct_velocities() { void FixRattle::end_of_step() { - if (nprocs > 1) { - comm_mode = V; - comm->forward_comm(this); + if (comm->nprocs > 1) { + comm_mode = V; + comm->forward_comm(this); } - if (!check_constraints(v, RATTLE_TEST_POS, RATTLE_TEST_VEL) && RATTLE_RAISE_ERROR) { +#if RATTLE_RAISE_ERROR + if (!check_constraints(v, RATTLE_TEST_POS, RATTLE_TEST_VEL)) error->one(FLERR, "Rattle failed "); - } +#endif } - /* ---------------------------------------------------------------------- */ bool FixRattle::check_constraints(double **v, bool checkr, bool checkv) @@ -807,12 +806,11 @@ bool FixRattle::check_constraints(double **v, bool checkr, bool checkv) int i=0; while (i < nlist && ret) { m = list[i]; - if (shake_flag[m] == 2) ret = check2(v,m,checkr,checkv); - else if (shake_flag[m] == 3) ret = check3(v,m,checkr,checkv); - else if (shake_flag[m] == 4) ret = check4(v,m,checkr,checkv); - else ret = check3angle(v,m,checkr,checkv); + if (shake_flag[m] == 2) ret = check2(v,m,checkr,checkv); + else if (shake_flag[m] == 3) ret = check3(v,m,checkr,checkv); + else if (shake_flag[m] == 4) ret = check4(v,m,checkr,checkv); + else ret = check3angle(v,m,checkr,checkv); i++; - if (!RATTLE_RAISE_ERROR) ret = true; } return ret; } @@ -834,14 +832,10 @@ bool FixRattle::check2(double **v, int m, bool checkr, bool checkv) MathExtra::sub3(v[i1],v[i0],v01); stat = !(checkr && (fabs(sqrt(MathExtra::dot3(r01,r01)) - bond1) > tol)); - if (!stat) - error->one(FLERR,"Coordinate constraints are not satisfied " - "up to desired tolerance "); + if (!stat) error->one(FLERR,"Coordinate constraints are not satisfied up to desired tolerance "); stat = !(checkv && (fabs(MathExtra::dot3(r01,v01)) > tol)); - if (!stat) - error->one(FLERR,"Velocity constraints are not satisfied " - "up to desired tolerance "); + if (!stat) error->one(FLERR,"Velocity constraints are not satisfied up to desired tolerance "); return stat; } @@ -871,15 +865,11 @@ bool FixRattle::check3(double **v, int m, bool checkr, bool checkv) stat = !(checkr && (fabs(sqrt(MathExtra::dot3(r01,r01)) - bond1) > tol || fabs(sqrt(MathExtra::dot3(r02,r02))-bond2) > tol)); - if (!stat) - error->one(FLERR,"Coordinate constraints are not satisfied " - "up to desired tolerance "); + if (!stat) error->one(FLERR,"Coordinate constraints are not satisfied up to desired tolerance "); stat = !(checkv && (fabs(MathExtra::dot3(r01,v01)) > tol || fabs(MathExtra::dot3(r02,v02)) > tol)); - if (!stat) - error->one(FLERR,"Velocity constraints are not satisfied " - "up to desired tolerance "); + if (!stat) error->one(FLERR,"Velocity constraints are not satisfied up to desired tolerance "); return stat; } @@ -914,16 +904,12 @@ bool FixRattle::check4(double **v, int m, bool checkr, bool checkv) stat = !(checkr && (fabs(sqrt(MathExtra::dot3(r01,r01)) - bond1) > tol || fabs(sqrt(MathExtra::dot3(r02,r02))-bond2) > tol || fabs(sqrt(MathExtra::dot3(r03,r03))-bond3) > tol)); - if (!stat) - error->one(FLERR,"Coordinate constraints are not satisfied " - "up to desired tolerance "); + if (!stat) error->one(FLERR,"Coordinate constraints are not satisfied up to desired tolerance "); stat = !(checkv && (fabs(MathExtra::dot3(r01,v01)) > tol || fabs(MathExtra::dot3(r02,v02)) > tol || fabs(MathExtra::dot3(r03,v03)) > tol)); - if (!stat) - error->one(FLERR,"Velocity constraints are not satisfied " - "up to desired tolerance "); + if (!stat) error->one(FLERR,"Velocity constraints are not satisfied up to desired tolerance "); return stat; } @@ -954,25 +940,19 @@ bool FixRattle::check3angle(double **v, int m, bool checkr, bool checkv) MathExtra::sub3(v[i2],v[i0],v02); MathExtra::sub3(v[i2],v[i1],v12); - - double db1 = fabs(sqrt(MathExtra::dot3(r01,r01)) - bond1); double db2 = fabs(sqrt(MathExtra::dot3(r02,r02))-bond2); double db12 = fabs(sqrt(MathExtra::dot3(r12,r12))-bond12); - - stat = !(checkr && (db1 > tol || - db2 > tol || - db12 > tol)); + stat = !(checkr && (db1 > tol || db2 > tol || db12 > tol)); if (derr_max < db1/bond1) derr_max = db1/bond1; if (derr_max < db2/bond2) derr_max = db2/bond2; if (derr_max < db12/bond12) derr_max = db12/bond12; - - if (!stat && RATTLE_RAISE_ERROR) - error->one(FLERR,"Coordinate constraints are not satisfied " - "up to desired tolerance "); +#if RATTLE_RAISE_ERROR + if (!stat) error->one(FLERR,"Coordinate constraints are not satisfied up to desired tolerance "); +#endif double dv1 = fabs(MathExtra::dot3(r01,v01)); double dv2 = fabs(MathExtra::dot3(r02,v02)); @@ -982,16 +962,10 @@ bool FixRattle::check3angle(double **v, int m, bool checkr, bool checkv) if (verr_max < dv2) verr_max = dv2; if (verr_max < dv12) verr_max = dv12; + stat = !(checkv && (dv1 > tol || dv2 > tol || dv12> tol)); - stat = !(checkv && (dv1 > tol || - dv2 > tol || - dv12> tol)); - - - if (!stat && RATTLE_RAISE_ERROR) - error->one(FLERR,"Velocity constraints are not satisfied " - "up to desired tolerance!"); - - +#if RATTLE_RAISE_ERROR + if (!stat) error->one(FLERR,"Velocity constraints are not satisfied up to desired tolerance!"); +#endif return stat; } diff --git a/src/RIGID/fix_shake.cpp b/src/RIGID/fix_shake.cpp index d74f72fb69..41d8c1599c 100644 --- a/src/RIGID/fix_shake.cpp +++ b/src/RIGID/fix_shake.cpp @@ -41,8 +41,8 @@ using namespace MathConst; #define RVOUS 1 // 0 for irregular, 1 for all2all -#define BIG 1.0e20 -#define MASSDELTA 0.1 +static constexpr double BIG = 1.0e20; +static constexpr double MASSDELTA = 0.1; /* ---------------------------------------------------------------------- */ @@ -57,21 +57,20 @@ FixShake::FixShake(LAMMPS *lmp, int narg, char **arg) : a_count_all(nullptr), a_ave(nullptr), a_max(nullptr), a_min(nullptr), a_ave_all(nullptr), a_max_all(nullptr), a_min_all(nullptr), atommols(nullptr), onemols(nullptr) { - MPI_Comm_rank(world,&me); - MPI_Comm_size(world,&nprocs); - + energy_global_flag = energy_peratom_flag = 1; virial_global_flag = virial_peratom_flag = 1; - thermo_virial = 1; + thermo_energy = thermo_virial = 1; create_attribute = 1; dof_flag = 1; stores_ids = 1; centroidstressflag = CENTROID_AVAIL; + next_output = -1; // error check molecular = atom->molecular; if (molecular == Atom::ATOMIC) - error->all(FLERR,"Cannot use fix shake with non-molecular system"); + error->all(FLERR,"Cannot use fix {} with non-molecular system", style); // perform initial allocation of atom-based arrays // register with Atom class @@ -92,8 +91,9 @@ FixShake::FixShake(LAMMPS *lmp, int narg, char **arg) : comm_forward = 3; // parse SHAKE args + auto mystyle = fmt::format("fix {}",style); - if (narg < 8) error->all(FLERR,"Illegal fix shake command"); + if (narg < 8) utils::missing_cmd_args(FLERR,mystyle, error); tolerance = utils::numeric(FLERR,arg[3],false,lmp); max_iter = utils::inumeric(FLERR,arg[4],false,lmp); @@ -133,49 +133,55 @@ FixShake::FixShake(LAMMPS *lmp, int narg, char **arg) : else if (mode == 'b') { int i = utils::inumeric(FLERR,arg[next],false,lmp); if (i < 1 || i > atom->nbondtypes) - error->all(FLERR,"Invalid bond type index for fix shake"); + error->all(FLERR,"Invalid bond type index for {}", mystyle); bond_flag[i] = 1; } else if (mode == 'a') { int i = utils::inumeric(FLERR,arg[next],false,lmp); if (i < 1 || i > atom->nangletypes) - error->all(FLERR,"Invalid angle type index for fix shake"); + error->all(FLERR,"Invalid angle type index for {}", mystyle); angle_flag[i] = 1; } else if (mode == 't') { int i = utils::inumeric(FLERR,arg[next],false,lmp); if (i < 1 || i > atom->ntypes) - error->all(FLERR,"Invalid atom type index for fix shake"); + error->all(FLERR,"Invalid atom type index for {}", mystyle); type_flag[i] = 1; } else if (mode == 'm') { double massone = utils::numeric(FLERR,arg[next],false,lmp); - if (massone == 0.0) error->all(FLERR,"Invalid atom mass for fix shake"); + if (massone == 0.0) error->all(FLERR,"Invalid atom mass for {}", mystyle); if (nmass == atom->ntypes) - error->all(FLERR,"Too many masses for fix shake"); + error->all(FLERR,"Too many masses for {}", mystyle); mass_list[nmass++] = massone; - } else error->all(FLERR,"Illegal fix shake command"); + } else error->all(FLERR,"Unknown {} command option: {}", mystyle, arg[next]); next++; } // parse optional args onemols = nullptr; + kbond = 1.0e6; int iarg = next; while (iarg < narg) { - if (strcmp(arg[next],"mol") == 0) { - if (iarg+2 > narg) error->all(FLERR,"Illegal fix shake command"); + if (strcmp(arg[iarg],"mol") == 0) { + if (iarg+2 > narg) utils::missing_cmd_args(FLERR,mystyle+" mol",error); int imol = atom->find_molecule(arg[iarg+1]); if (imol == -1) - error->all(FLERR,"Molecule template ID for fix shake does not exist"); - if (atom->molecules[imol]->nset > 1 && comm->me == 0) - error->warning(FLERR,"Molecule template for fix shake has multiple molecules"); + error->all(FLERR,"Molecule template ID {} for {} does not exist", mystyle, arg[iarg+1]); + if ((atom->molecules[imol]->nset > 1) && (comm->me == 0)) + error->warning(FLERR,"Molecule template for {} has multiple molecules", mystyle); onemols = &atom->molecules[imol]; nmol = onemols[0]->nset; iarg += 2; - } else error->all(FLERR,"Illegal fix shake command"); + } else if (strcmp(arg[iarg],"kbond") == 0) { + if (iarg+2 > narg) utils::missing_cmd_args(FLERR,mystyle+" kbond",error); + kbond = utils::numeric(FLERR, arg[iarg+1], false, lmp); + if (kbond < 0) error->all(FLERR,"Illegal {} kbond value {}. Must be >= 0.0", mystyle, kbond); + iarg += 2; + } else error->all(FLERR,"Unknown {} command option: {}", mystyle, arg[iarg]); } // error check for Molecule template @@ -183,7 +189,7 @@ FixShake::FixShake(LAMMPS *lmp, int narg, char **arg) : if (onemols) { for (int i = 0; i < nmol; i++) if (onemols[i]->shakeflag == 0) - error->all(FLERR,"Fix shake molecule template must have shake info"); + error->all(FLERR,"Fix {} molecule template must have shake info", style); } // allocate bond and angle distance arrays, indexed from 1 to n @@ -321,6 +327,7 @@ int FixShake::setmask() mask |= PRE_NEIGHBOR; mask |= POST_FORCE; mask |= POST_FORCE_RESPA; + mask |= MIN_POST_FORCE; return mask; } @@ -335,28 +342,24 @@ void FixShake::init() double rsq,angle; // error if more than one shake fix + auto pattern = fmt::format("^{}",style); - int count = 0; - for (i = 0; i < modify->nfix; i++) - if (strcmp(modify->fix[i]->style,"shake") == 0) count++; - if (count > 1) error->all(FLERR,"More than one fix shake"); + if (modify->get_fix_by_style(pattern).size() > 1) + error->all(FLERR,"More than one fix {} instance",style); // cannot use with minimization since SHAKE turns off bonds // that should contribute to potential energy - if (update->whichflag == 2) - error->all(FLERR,"Fix shake cannot be used with minimization"); + if ((comm->me == 0) && (update->whichflag == 2)) + error->warning(FLERR,"Using fix {} with minimization. Substituting constraints with " + "restraint forces using k={:.4g}", style, kbond); - // error if npt,nph fix comes before shake fix - - for (i = 0; i < modify->nfix; i++) { - if (strcmp(modify->fix[i]->style,"npt") == 0) break; - if (strcmp(modify->fix[i]->style,"nph") == 0) break; - } - if (i < modify->nfix) { - for (int j = i; j < modify->nfix; j++) - if (strcmp(modify->fix[j]->style,"shake") == 0) - error->all(FLERR,"Shake fix must come before NPT/NPH fix"); + // error if a fix changing the box comes before shake fix + bool boxflag = false; + for (auto ifix : modify->get_fix_list()) { + if (boxflag && utils::strmatch(ifix->style,pattern)) + error->all(FLERR,"Fix {} must come before any box changing fix", style); + if (ifix->box_change) boxflag = true; } // if rRESPA, find associated fix that must exist @@ -379,7 +382,7 @@ void FixShake::init() // set equilibrium bond distances if (force->bond == nullptr) - error->all(FLERR,"Bond potential must be defined for SHAKE"); + error->all(FLERR,"Bond style must be defined for fix {}",style); for (i = 1; i <= atom->nbondtypes; i++) bond_distance[i] = force->bond->equilibrium_distance(i); @@ -390,7 +393,7 @@ void FixShake::init() for (i = 1; i <= atom->nangletypes; i++) { if (angle_flag[i] == 0) continue; if (force->angle == nullptr) - error->all(FLERR,"Angle potential must be defined for SHAKE"); + error->all(FLERR,"Angle style must be defined for fix {}",style); // scan all atoms for a SHAKE angle cluster // extract bond types for the 2 bonds in the cluster @@ -417,7 +420,7 @@ void FixShake::init() // error check for any bond types that are not the same MPI_Allreduce(&flag,&flag_all,1,MPI_INT,MPI_MAX,world); - if (flag_all) error->all(FLERR,"Shake angles have different bond types"); + if (flag_all) error->all(FLERR,"Fix {} angles have different bond types", style); // insure all procs have bond types @@ -494,6 +497,16 @@ void FixShake::setup(int vflag) shake_end_of_step(vflag); } +/* ---------------------------------------------------------------------- + during minimization fix SHAKE adds strong bond forces +------------------------------------------------------------------------- */ + +void FixShake::min_setup(int vflag) +{ + pre_neighbor(); + min_post_force(vflag); +} + /* ---------------------------------------------------------------------- build list of SHAKE clusters to constrain if one or more atoms in cluster are on this proc, @@ -533,19 +546,17 @@ void FixShake::pre_neighbor() atom1 = atom->map(shake_atom[i][0]); atom2 = atom->map(shake_atom[i][1]); if (atom1 == -1 || atom2 == -1) - error->one(FLERR,"Shake atoms {} {} missing on proc " - "{} at step {}",shake_atom[i][0], - shake_atom[i][1],me,update->ntimestep); + error->one(FLERR,"Shake atoms {} {} missing on proc {} at step {}",shake_atom[i][0], + shake_atom[i][1],comm->me,update->ntimestep); if (i <= atom1 && i <= atom2) list[nlist++] = i; } else if (shake_flag[i] % 2 == 1) { atom1 = atom->map(shake_atom[i][0]); atom2 = atom->map(shake_atom[i][1]); atom3 = atom->map(shake_atom[i][2]); if (atom1 == -1 || atom2 == -1 || atom3 == -1) - error->one(FLERR,"Shake atoms {} {} {} missing on proc " - "{} at step {}",shake_atom[i][0], + error->one(FLERR,"Shake atoms {} {} {} missing on proc {} at step {}",shake_atom[i][0], shake_atom[i][1],shake_atom[i][2], - me,update->ntimestep); + comm->me,update->ntimestep); if (i <= atom1 && i <= atom2 && i <= atom3) list[nlist++] = i; } else { atom1 = atom->map(shake_atom[i][0]); @@ -553,10 +564,9 @@ void FixShake::pre_neighbor() atom3 = atom->map(shake_atom[i][2]); atom4 = atom->map(shake_atom[i][3]); if (atom1 == -1 || atom2 == -1 || atom3 == -1 || atom4 == -1) - error->one(FLERR,"Shake atoms {} {} {} {} missing on " - "proc {} at step {}",shake_atom[i][0], + error->one(FLERR,"Shake atoms {} {} {} {} missing on proc {} at step {}",shake_atom[i][0], shake_atom[i][1],shake_atom[i][2], - shake_atom[i][3],me,update->ntimestep); + shake_atom[i][3],comm->me,update->ntimestep); if (i <= atom1 && i <= atom2 && i <= atom3 && i <= atom4) list[nlist++] = i; } @@ -575,7 +585,7 @@ void FixShake::post_force(int vflag) // communicate results if necessary unconstrained_update(); - if (nprocs > 1) comm->forward_comm(this); + if (comm->nprocs > 1) comm->forward_comm(this); // virial setup @@ -619,7 +629,7 @@ void FixShake::post_force_respa(int vflag, int ilevel, int iloop) // communicate results if necessary unconstrained_update_respa(ilevel); - if (nprocs > 1) comm->forward_comm(this); + if (comm->nprocs > 1) comm->forward_comm(this); // virial setup only needed on last iteration of innermost level // and if pressure is requested @@ -644,6 +654,48 @@ void FixShake::post_force_respa(int vflag, int ilevel, int iloop) vflag_post_force = vflag; } +/* ---------------------------------------------------------------------- + substitute shake constraints with very strong bonds +------------------------------------------------------------------------- */ + +void FixShake::min_post_force(int vflag) +{ + if (output_every) { + bigint ntimestep = update->ntimestep; + if (next_output == ntimestep) stats(); + + next_output = ntimestep + output_every; + if (ntimestep % output_every != 0) + next_output = (ntimestep/output_every)*output_every + output_every; + } else next_output = -1; + + v_init(vflag); + + x = atom->x; + f = atom->f; + nlocal = atom->nlocal; + + // loop over clusters to add strong restraint forces + + for (int i = 0; i < nlist; i++) { + int m = list[i]; + if (shake_flag[m] == 2) { + bond_force(shake_atom[m][0], shake_atom[m][1], bond_distance[shake_type[m][0]]); + } else if (shake_flag[m] == 3) { + bond_force(shake_atom[m][0], shake_atom[m][1], bond_distance[shake_type[m][0]]); + bond_force(shake_atom[m][0], shake_atom[m][2], bond_distance[shake_type[m][1]]); + } else if (shake_flag[m] == 4) { + bond_force(shake_atom[m][0], shake_atom[m][1], bond_distance[shake_type[m][0]]); + bond_force(shake_atom[m][0], shake_atom[m][2], bond_distance[shake_type[m][1]]); + bond_force(shake_atom[m][0], shake_atom[m][3], bond_distance[shake_type[m][2]]); + } else { + bond_force(shake_atom[m][0], shake_atom[m][1], bond_distance[shake_type[m][0]]); + bond_force(shake_atom[m][0], shake_atom[m][2], bond_distance[shake_type[m][1]]); + bond_force(shake_atom[m][1], shake_atom[m][2], angle_distance[shake_type[m][2]]); + } + } +} + /* ---------------------------------------------------------------------- count # of degrees-of-freedom removed by SHAKE for atoms in igroup ------------------------------------------------------------------------- */ @@ -690,10 +742,7 @@ void FixShake::find_clusters() tagint tagprev; double massone; - if ((me == 0) && screen) { - if (!rattle) fputs("Finding SHAKE clusters ...\n",screen); - else fputs("Finding RATTLE clusters ...\n",screen); - } + if (comm->me == 0) utils::logmesg(lmp, "Finding {} clusters ...\n",utils::uppercase(style)); atommols = atom->avec->onemols; tagint *tag = atom->tag; @@ -805,7 +854,7 @@ void FixShake::find_clusters() } MPI_Allreduce(&flag,&flag_all,1,MPI_INT,MPI_SUM,world); - if (flag_all) error->all(FLERR,"Did not find fix shake partner info"); + if (flag_all) error->all(FLERR,"Did not find fix {} partner info", style); // ----------------------------------------------------- // identify SHAKEable bonds @@ -1015,7 +1064,7 @@ void FixShake::find_clusters() tmp = count4; MPI_Allreduce(&tmp,&count4,1,MPI_INT,MPI_SUM,world); - if (me == 0) { + if (comm->me == 0) { utils::logmesg(lmp,"{:>8} = # of size 2 clusters\n" "{:>8} = # of size 3 clusters\n" "{:>8} = # of size 4 clusters\n" @@ -1043,8 +1092,8 @@ void FixShake::atom_owners() // one datum for each owned atom: datum = owning proc, atomID for (int i = 0; i < nlocal; i++) { - proclist[i] = tag[i] % nprocs; - idbuf[i].me = me; + proclist[i] = tag[i] % comm->nprocs; + idbuf[i].me = comm->me; idbuf[i].atomID = tag[i]; } @@ -1089,7 +1138,7 @@ void FixShake::partner_info(int *npartner, tagint **partner_tag, // set values in 4 partner arrays for all partner atoms I own // also setup input buf to rendezvous comm // input datums = pair of bonded atoms where I do not own partner - // owning proc for each datum = partner_tag % nprocs + // owning proc for each datum = partner_tag % comm->nprocs // datum: atomID = partner_tag (off-proc), partnerID = tag (on-proc) // 4 values for my owned atom @@ -1127,7 +1176,7 @@ void FixShake::partner_info(int *npartner, tagint **partner_tag, } } else { - proclist[nsend] = partner_tag[i][j] % nprocs; + proclist[nsend] = partner_tag[i][j] % comm->nprocs; inbuf[nsend].atomID = partner_tag[i][j]; inbuf[nsend].partnerID = tag[i]; inbuf[nsend].mask = mask[i]; @@ -1217,7 +1266,7 @@ void FixShake::nshake_info(int *npartner, tagint **partner_tag, // set partner_nshake for all partner atoms I own // also setup input buf to rendezvous comm // input datums = pair of bonded atoms where I do not own partner - // owning proc for each datum = partner_tag % nprocs + // owning proc for each datum = partner_tag % comm->nprocs // datum: atomID = partner_tag (off-proc), partnerID = tag (on-proc) // nshake value for my owned atom @@ -1231,7 +1280,7 @@ void FixShake::nshake_info(int *npartner, tagint **partner_tag, if (m >= 0 && m < nlocal) { partner_nshake[i][j] = nshake[m]; } else { - proclist[nsend] = partner_tag[i][j] % nprocs; + proclist[nsend] = partner_tag[i][j] % comm->nprocs; inbuf[nsend].atomID = partner_tag[i][j]; inbuf[nsend].partnerID = tag[i]; inbuf[nsend].nshake = nshake[i]; @@ -1295,7 +1344,7 @@ void FixShake::shake_info(int *npartner, tagint **partner_tag, // set 3 shake arrays for all partner atoms I own // also setup input buf to rendezvous comm // input datums = partner atom where I do not own partner - // owning proc for each datum = partner_tag % nprocs + // owning proc for each datum = partner_tag % comm->nprocs // datum: atomID = partner_tag (off-proc) // values in 3 shake arrays @@ -1317,7 +1366,7 @@ void FixShake::shake_info(int *npartner, tagint **partner_tag, shake_type[m][2] = shake_type[i][2]; } else { - proclist[nsend] = partner_tag[i][j] % nprocs; + proclist[nsend] = partner_tag[i][j] % comm->nprocs; inbuf[nsend].atomID = partner_tag[i][j]; inbuf[nsend].shake_flag = shake_flag[i]; inbuf[nsend].shake_atom[0] = shake_atom[i][0]; @@ -2451,6 +2500,53 @@ void FixShake::shake3angle(int m) } } +/* ---------------------------------------------------------------------- + apply bond force for minimization +------------------------------------------------------------------------- */ + +void FixShake::bond_force(tagint id1, tagint id2, double length) +{ + + int i1 = atom->map(id1); + int i2 = atom->map(id2); + + if ((i1 < 0) || (i2 < 0)) return; + + // distance vec between atoms, with PBC + + double delx = x[i1][0] - x[i2][0]; + double dely = x[i1][1] - x[i2][1]; + double delz = x[i1][2] - x[i2][2]; + domain->minimum_image(delx, dely, delz); + + // compute and apply force + + const double r = sqrt(delx * delx + dely * dely + delz * delz); + const double dr = r - length; + const double rk = kbond * dr; + const double fbond = (r > 0.0) ? -2.0 * rk / r : 0.0; + double v[6]; + v[0] = 0.5 * delx * delx * fbond; + v[1] = 0.5 * dely * dely * fbond; + v[2] = 0.5 * delz * delz * fbond; + v[3] = 0.5 * delx * dely * fbond; + v[4] = 0.5 * delx * delz * fbond; + v[5] = 0.5 * dely * delz * fbond; + + if (i1 < nlocal) { + f[i1][0] += delx * fbond; + f[i1][1] += dely * fbond; + f[i1][2] += delz * fbond; + if (evflag) v_tally(i1, v); + } + if (i2 < nlocal) { + f[i2][0] -= delx * fbond; + f[i2][1] -= dely * fbond; + f[i2][2] -= delz * fbond; + if (evflag) v_tally(i2, v); + } +} + /* ---------------------------------------------------------------------- print-out bond & angle statistics ------------------------------------------------------------------------- */ @@ -2558,9 +2654,10 @@ void FixShake::stats() // print stats only for non-zero counts - if (me == 0) { + if (comm->me == 0) { const int width = log10((MAX(MAX(1,nb),na)))+2; - auto mesg = fmt::format("SHAKE stats (type/ave/delta/count) on step {}\n", update->ntimestep); + auto mesg = fmt::format("{} stats (type/ave/delta/count) on step {}\n", + utils::uppercase(style), update->ntimestep); for (i = 1; i < nb; i++) { const auto bcnt = b_count_all[i]; if (bcnt) @@ -3109,7 +3206,7 @@ void FixShake::correct_coordinates(int vflag) { double **xtmp = xshake; xshake = x; - if (nprocs > 1) { + if (comm->nprocs > 1) { comm->forward_comm(this); } xshake = xtmp; diff --git a/src/RIGID/fix_shake.h b/src/RIGID/fix_shake.h index 12e24fb350..a0f743d7d2 100644 --- a/src/RIGID/fix_shake.h +++ b/src/RIGID/fix_shake.h @@ -34,9 +34,11 @@ class FixShake : public Fix { int setmask() override; void init() override; void setup(int) override; + void min_setup(int) override; void pre_neighbor() override; void post_force(int) override; void post_force_respa(int, int, int) override; + void min_post_force(int) override; double memory_usage() override; void grow_arrays(int) override; @@ -61,12 +63,11 @@ class FixShake : public Fix { protected: int vflag_post_force; // store the vflag of last post_force call int respa; // 0 = vel. Verlet, 1 = respa - int me, nprocs; - int rattle; // 0 = SHAKE, 1 = RATTLE - double tolerance; // SHAKE tolerance - int max_iter; // max # of SHAKE iterations - int output_every; // SHAKE stat output every so often - bigint next_output; // timestep for next output + int rattle; // 0 = SHAKE, 1 = RATTLE + double tolerance; // SHAKE tolerance + int max_iter; // max # of SHAKE iterations + int output_every; // SHAKE stat output every so often + bigint next_output; // timestep for next output // settings from input command int *bond_flag, *angle_flag; // bond/angle types to constrain @@ -76,6 +77,7 @@ class FixShake : public Fix { int molecular; // copy of atom->molecular double *bond_distance, *angle_distance; // constraint distances + double kbond; // force constant for restraint class FixRespa *fix_respa; // rRESPA fix needed by SHAKE int nlevels_respa; // copies of needed rRESPA variables @@ -133,6 +135,7 @@ class FixShake : public Fix { void shake3(int); void shake4(int); void shake3angle(int); + void bond_force(tagint, tagint, double); void stats(); int bondtype_findset(int, tagint, tagint, int); int angletype_findset(int, tagint, tagint, int); diff --git a/src/fix_restrain.cpp b/src/fix_restrain.cpp index 8b97715ff6..e5440830f5 100644 --- a/src/fix_restrain.cpp +++ b/src/fix_restrain.cpp @@ -19,17 +19,18 @@ #include "fix_restrain.h" -#include -#include #include "atom.h" -#include "force.h" -#include "update.h" -#include "domain.h" #include "comm.h" -#include "respa.h" +#include "domain.h" +#include "error.h" +#include "force.h" #include "math_const.h" #include "memory.h" -#include "error.h" +#include "respa.h" +#include "update.h" + +#include +#include using namespace LAMMPS_NS; using namespace FixConst; @@ -271,14 +272,12 @@ void FixRestrain::restrain_bond(int m) if (newton_bond) { if (i2 == -1 || i2 >= nlocal) return; if (i1 == -1) - error->one(FLERR,"Restrain atoms {} {} missing on " - "proc {} at step {}", ids[m][0],ids[m][1], + error->one(FLERR,"Restrain atoms {} {} missing on proc {} at step {}", ids[m][0],ids[m][1], comm->me,update->ntimestep); } else { if ((i1 == -1 || i1 >= nlocal) && (i2 == -1 || i2 >= nlocal)) return; if (i1 == -1 || i2 == -1) - error->one(FLERR,"Restrain atoms {} {} missing on " - "proc {} at step {}", ids[m][0],ids[m][1], + error->one(FLERR,"Restrain atoms {} {} missing on proc {} at step {}", ids[m][0],ids[m][1], comm->me,update->ntimestep); } From d8f8a3a36ab2fafdb63447fb2ffb841175fcc4b6 Mon Sep 17 00:00:00 2001 From: Vsevak Date: Sat, 28 May 2022 00:24:24 +0300 Subject: [PATCH 002/262] Handle inconsistent J molecules in tip4p/gpu --- lib/gpu/geryon/hip_device.h | 2 +- lib/gpu/lal_lj_tip4p_long.cu | 42 ++++++++++++++++++++------ src/GPU/pair_lj_cut_tip4p_long_gpu.cpp | 7 +++-- 3 files changed, 38 insertions(+), 13 deletions(-) diff --git a/lib/gpu/geryon/hip_device.h b/lib/gpu/geryon/hip_device.h index fadeec8711..f809323ee7 100644 --- a/lib/gpu/geryon/hip_device.h +++ b/lib/gpu/geryon/hip_device.h @@ -394,7 +394,7 @@ UCL_Device::~UCL_Device() { clear(); } -int UCL_Device::set_platform(const int) { +int UCL_Device::set_platform(const int pid) { clear(); #ifdef UCL_DEBUG assert(pid=0 && iH2>=0) { + compute_newsite(iO,iH1,iH2, &m[iO], qO, alpha, x_); + } else { + m[iO] = ix; + m[iO].w = qO; + hneigh[i*4] = iO; + hneigh[i*4+1] = iO; + } } } } diff --git a/src/GPU/pair_lj_cut_tip4p_long_gpu.cpp b/src/GPU/pair_lj_cut_tip4p_long_gpu.cpp index 5c2c391136..f6e528676d 100644 --- a/src/GPU/pair_lj_cut_tip4p_long_gpu.cpp +++ b/src/GPU/pair_lj_cut_tip4p_long_gpu.cpp @@ -186,8 +186,9 @@ void PairLJCutTIP4PLongGPU::init_style() alpha = qdist / (cos(0.5 * theta) * blen); cut_coulsq = cut_coul * cut_coul; - double cut_coulsqplus = (cut_coul + qdist + blen) * (cut_coul + qdist + blen); - if (maxcut < cut_coulsqplus) { cell_size = (cut_coul + qdist + blen) + neighbor->skin; } + double cut_coulplus = cut_coul + qdist + blen; + double cut_coulsqplus = cut_coulplus*cut_coulplus; + if (sqrt(maxcut) < cut_coulplus+blen) { cell_size = (cut_coulplus + blen) + neighbor->skin; } if (comm->cutghostuser < cell_size) { if (comm->me == 0) error->warning(FLERR, @@ -205,7 +206,7 @@ void PairLJCutTIP4PLongGPU::init_style() GPU_EXTRA::check_flag(success, error, world); if (gpu_mode == GPU_FORCE) { auto req = neighbor->add_request(this, NeighConst::REQ_FULL); - req->set_cutoff(cut_coul + qdist + blen + neighbor->skin); + req->set_cutoff(cut_coulplus + neighbor->skin); } } From e9051620a510a69bd2eddaa76903f801b7a79de1 Mon Sep 17 00:00:00 2001 From: Vsevak Date: Sat, 28 May 2022 00:39:07 +0300 Subject: [PATCH 003/262] Cleanup --- lib/gpu/lal_lj_tip4p_long.cu | 26 ++------------------------ 1 file changed, 2 insertions(+), 24 deletions(-) diff --git a/lib/gpu/lal_lj_tip4p_long.cu b/lib/gpu/lal_lj_tip4p_long.cu index 21fb1a91c8..74ee7a9036 100644 --- a/lib/gpu/lal_lj_tip4p_long.cu +++ b/lib/gpu/lal_lj_tip4p_long.cu @@ -218,15 +218,6 @@ __kernel void k_lj_tip4p_reneigh(const __global numtyp4 *restrict x_, iH1 = closest_image(i, iH1, sametag, x_); iH2 = closest_image(i, iH2, sametag, x_); - //printf("%d %f %f %f\n", (iH1 < 0 || iH2 < 0) ? 0:1, ix.x, ix.y, ix.z ); - /* - if (iH1 < 0) { - printf("i=%d\ttag[i]=%d\tmap[tag[i]-1]=%d\tmap[tag[i]-2]=%d\n", i, tag[i], map[tag[i]+1], map[tag[i]+2]); - } - if (iH2 < 0) { - printf("i=%d\ttag[i]=%d\tmap[tag[i]-1]=%d\tmap[tag[i]-2]=%d\n", i, tag[i], map[tag[i]+1], map[tag[i]+2]); - }*/ - hneigh[i*4 ] = iH1; hneigh[i*4+1] = iH2; hneigh[i*4+2] = -1; @@ -237,25 +228,12 @@ __kernel void k_lj_tip4p_reneigh(const __global numtyp4 *restrict x_, int iI, iH; iI = atom_mapping(map,tag[i] - 1); iO = closest_image(i,iI,sametag, x_); - //printf("%d %f %f %f\n", (iI < 0) ? 2:3, ix.x, ix.y, ix.z ); - /* - // printf("iI = %d iO closest = %d\n",iI, iO); - if (iI < 0) { - printf("i=%d\ttag[i]=%d\tmap[tag[i]-1]=%d\tmap[tag[i]-2]=%d\n", i, tag[i], map[tag[i]-1],map[tag[i]-2]); - }*/ numtyp4 iIx; fetch4(iIx,iO,pos_tex); //x_[iI]; if ((int)iIx.w == typeH) { iO = atom_mapping(map,tag[i] - 2); iO = closest_image(i, iO, sametag, x_); - //iH1 = closest_image(i, iI, sametag, x_); - //iH2 = i; - } else { //if ((int)iIx.w == typeO) - //iH = atom_mapping(map, tag[i] + 1); - //iO = closest_image(i,iI,sametag, x_); - //iH1 = i; - //iH2 = closest_image(i,iH,sametag, x_); - } - hneigh[i*4+0] = iO; + } + hneigh[i*4+0] = iO; hneigh[i*4+1] += -1; hneigh[i*4+2] = -1; } From 9b73c66ec6c2b4a3d76b69fad544e7929f45a9e9 Mon Sep 17 00:00:00 2001 From: Vsevak Date: Mon, 30 May 2022 18:44:53 +0300 Subject: [PATCH 004/262] Reduce increased comm cutoff --- src/GPU/pair_lj_cut_tip4p_long_gpu.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GPU/pair_lj_cut_tip4p_long_gpu.cpp b/src/GPU/pair_lj_cut_tip4p_long_gpu.cpp index f6e528676d..cad8f2c07c 100644 --- a/src/GPU/pair_lj_cut_tip4p_long_gpu.cpp +++ b/src/GPU/pair_lj_cut_tip4p_long_gpu.cpp @@ -188,7 +188,7 @@ void PairLJCutTIP4PLongGPU::init_style() cut_coulsq = cut_coul * cut_coul; double cut_coulplus = cut_coul + qdist + blen; double cut_coulsqplus = cut_coulplus*cut_coulplus; - if (sqrt(maxcut) < cut_coulplus+blen) { cell_size = (cut_coulplus + blen) + neighbor->skin; } + if (sqrt(maxcut) < cut_coulplus) { cell_size = cut_coulplus + neighbor->skin; } if (comm->cutghostuser < cell_size) { if (comm->me == 0) error->warning(FLERR, From 59dc63d003d3a12b4983e8b8d735ee759c086987 Mon Sep 17 00:00:00 2001 From: Vsevak Date: Wed, 1 Jun 2022 01:29:18 +0300 Subject: [PATCH 005/262] Add typecasting for consts in tip4p GPU kernels --- lib/gpu/lal_lj_tip4p_long.cu | 46 ++++++++++++++++++------------------ 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/lib/gpu/lal_lj_tip4p_long.cu b/lib/gpu/lal_lj_tip4p_long.cu index 74ee7a9036..e6c0022ca0 100644 --- a/lib/gpu/lal_lj_tip4p_long.cu +++ b/lib/gpu/lal_lj_tip4p_long.cu @@ -417,12 +417,12 @@ __kernel void k_lj_tip4p_long(const __global numtyp4 *restrict x_, fO.x += delx * force_coul; fO.y += dely * force_coul; fO.z += delz * force_coul; - fO.w += 0; + //fO.w += 0; } else { f.x += delx * force_coul; f.y += dely * force_coul; f.z += delz * force_coul; - f.w += 0; + //f.w += 0; } if (EVFLAG && eflag) { e_coul += prefactor*(_erfc-factor_coul); @@ -433,7 +433,7 @@ __kernel void k_lj_tip4p_long(const __global numtyp4 *restrict x_, fd.y = dely*force_coul; fd.z = delz*force_coul; if (itype == typeO) { - numtyp cO = 1 - alpha, cH = 0.5*alpha; + numtyp cO = (numtyp)1.0 - alpha, cH = (numtyp)0.5*alpha; numtyp4 vdi, vdj; numtyp4 xH1; fetch4(xH1,iH1,pos_tex); numtyp4 xH2; fetch4(xH2,iH2,pos_tex); @@ -451,15 +451,15 @@ __kernel void k_lj_tip4p_long(const __global numtyp4 *restrict x_, vdj.z = xjO.z*cO + xjH1.z*cH + xjH2.z*cH; //vdj.w = vdj.w; } else vdj = jx; - vO[0] += 0.5*(vdi.x - vdj.x)*fd.x; - vO[1] += 0.5*(vdi.y - vdj.y)*fd.y; - vO[2] += 0.5*(vdi.z - vdj.z)*fd.z; - vO[3] += 0.5*(vdi.x - vdj.x)*fd.y; - vO[4] += 0.5*(vdi.x - vdj.x)*fd.z; - vO[5] += 0.5*(vdi.y - vdj.y)*fd.z; + vO[0] += (numtyp)0.5*(vdi.x - vdj.x)*fd.x; + vO[1] += (numtyp)0.5*(vdi.y - vdj.y)*fd.y; + vO[2] += (numtyp)0.5*(vdi.z - vdj.z)*fd.z; + vO[3] += (numtyp)0.5*(vdi.x - vdj.x)*fd.y; + vO[4] += (numtyp)0.5*(vdi.x - vdj.x)*fd.z; + vO[5] += (numtyp)0.5*(vdi.y - vdj.y)*fd.z; } else { if (jtype == typeO) { - numtyp cO = 1 - alpha, cH = 0.5*alpha; + numtyp cO = (numtyp)1.0 - alpha, cH = (numtyp)0.5*alpha; numtyp4 vdj; numtyp4 xjH1; fetch4(xjH1,jH1,pos_tex); numtyp4 xjH2; fetch4(xjH2,jH2,pos_tex); @@ -507,7 +507,7 @@ __kernel void k_lj_tip4p_long(const __global numtyp4 *restrict x_, prefactor *= qqrd2e*x1m.w/r; numtyp force_coul = r2inv*prefactor * (_erfc + EWALD_F*grij*expm2 - factor_coul); - numtyp cO = 1 - alpha, cH = 0.5*alpha; + numtyp cO = (numtyp)1 - alpha, cH = (numtyp)0.5*alpha; numtyp4 fd; fd.x = delx * force_coul * cH; fd.y = dely * force_coul * cH; @@ -518,7 +518,7 @@ __kernel void k_lj_tip4p_long(const __global numtyp4 *restrict x_, f.z += fd.z; if (EVFLAG && eflag) { - e_coul += prefactor*(_erfc-factor_coul) * (acctyp)0.5 * alpha; + e_coul += prefactor*(_erfc-factor_coul) * (numtyp)0.5 * alpha; } if (EVFLAG && vflag) { numtyp4 xH1; fetch4(xH1,iH1,pos_tex); @@ -748,12 +748,12 @@ __kernel void k_lj_tip4p_long_fast(const __global numtyp4 *restrict x_, fO.x += delx * force_coul; fO.y += dely * force_coul; fO.z += delz * force_coul; - fO.w += 0; + //fO.w += 0; } else { f.x += delx * force_coul; f.y += dely * force_coul; f.z += delz * force_coul; - f.w += 0; + //f.w += 0; } if (EVFLAG && eflag) { e_coul += prefactor*(_erfc-factor_coul); @@ -764,7 +764,7 @@ __kernel void k_lj_tip4p_long_fast(const __global numtyp4 *restrict x_, fd.y = dely*force_coul; fd.z = delz*force_coul; if (itype == typeO) { - numtyp cO = 1 - alpha, cH = 0.5*alpha; + numtyp cO = (numtyp)1.0 - alpha, cH = (numtyp)0.5*alpha; numtyp4 vdi, vdj; numtyp4 xH1; fetch4(xH1,iH1,pos_tex); numtyp4 xH2; fetch4(xH2,iH2,pos_tex); @@ -782,15 +782,15 @@ __kernel void k_lj_tip4p_long_fast(const __global numtyp4 *restrict x_, vdj.z = xjO.z*cO + xjH1.z*cH + xjH2.z*cH; //vdj.w = vdj.w; } else vdj = jx; - vO[0] += 0.5*(vdi.x - vdj.x)*fd.x; - vO[1] += 0.5*(vdi.y - vdj.y)*fd.y; - vO[2] += 0.5*(vdi.z - vdj.z)*fd.z; - vO[3] += 0.5*(vdi.x - vdj.x)*fd.y; - vO[4] += 0.5*(vdi.x - vdj.x)*fd.z; - vO[5] += 0.5*(vdi.y - vdj.y)*fd.z; + vO[0] += (numtyp)0.5*(vdi.x - vdj.x)*fd.x; + vO[1] += (numtyp)0.5*(vdi.y - vdj.y)*fd.y; + vO[2] += (numtyp)0.5*(vdi.z - vdj.z)*fd.z; + vO[3] += (numtyp)0.5*(vdi.x - vdj.x)*fd.y; + vO[4] += (numtyp)0.5*(vdi.x - vdj.x)*fd.z; + vO[5] += (numtyp)0.5*(vdi.y - vdj.y)*fd.z; } else { if (jtype == typeO) { - numtyp cO = 1 - alpha, cH = 0.5*alpha; + numtyp cO = (numtyp)1.0 - alpha, cH = (numtyp)0.5*alpha; numtyp4 vdj; numtyp4 xjH1; fetch4(xjH1,jH1,pos_tex); numtyp4 xjH2; fetch4(xjH2,jH2,pos_tex); @@ -838,7 +838,7 @@ __kernel void k_lj_tip4p_long_fast(const __global numtyp4 *restrict x_, prefactor *= qqrd2e*x1m.w/r; numtyp force_coul = r2inv*prefactor * (_erfc + EWALD_F*grij*expm2 - factor_coul); - numtyp cO = 1 - alpha, cH = 0.5*alpha; + numtyp cO = (numtyp)1.0 - alpha, cH = (numtyp)0.5*alpha; numtyp4 fd; fd.x = delx * force_coul * cH; fd.y = dely * force_coul * cH; From 322bf1ef477e928a49796eacdfe686e897a3a4c1 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Thu, 9 Jun 2022 22:34:35 -0400 Subject: [PATCH 006/262] compute energy due to restraint forces during minimization. output stats. --- doc/src/fix_shake.rst | 31 ++++++++++++++--------- src/RIGID/fix_shake.cpp | 54 ++++++++++++++++++++++++++--------------- src/RIGID/fix_shake.h | 3 +++ 3 files changed, 57 insertions(+), 31 deletions(-) diff --git a/doc/src/fix_shake.rst b/doc/src/fix_shake.rst index d723f28fc0..137cb1aedb 100644 --- a/doc/src/fix_shake.rst +++ b/doc/src/fix_shake.rst @@ -58,7 +58,9 @@ Description Apply bond and angle constraints to specified bonds and angles in the simulation by either the SHAKE or RATTLE algorithms. This typically -enables a longer timestep. +enables a longer timestep. This SHAKE or RATTLE algorithms can *only* +be applied during molecular dynamics runs. When this fix is used during +a minimization, the constraints are replaced by strong harmonic restraints. **SHAKE vs RATTLE:** @@ -166,10 +168,13 @@ See the :doc:`molecule ` command for details. The only settings required to be in this file (by this command) are the SHAKE info of atoms in the molecule. -The *kbond* keyword allows to set the restraint force constant when -fix shake or fix rattle are used during minimization. In that case -the constraint algorithms are **not** applied and restraint -forces are used instead to help maintaining the geometries. +The *kbond* keyword allows to set the restraint force constant when fix +shake or fix rattle are used during minimization. In that case the +constraint algorithms are *not* applied and restraint forces are used +instead to help maintaining the geometries. How well the geometries +are maintained and how quickly a minimization will converge depends on +the magnitude of the force constant (kbond). If it is chosen too large +the minimization may converge slowly. The default is 1.0e6*k_B. ---------- @@ -202,6 +207,9 @@ Restart, fix_modify, output, run start/stop, minimize info No information about these fixes is written to :doc:`binary restart files `. +When used during minimization, the SHAKE or RATTLE algorithms are **not** +applied. Strong restraint forces are applied instead. + The :doc:`fix_modify ` *virial* option is supported by these fixes to add the contribution due to the added forces on atoms to both the global pressure and per-atom stress of the system via the @@ -209,14 +217,15 @@ to both the global pressure and per-atom stress of the system via the stress/atom ` commands. The former can be accessed by :doc:`thermodynamic output `. The default setting for this fix is :doc:`fix_modify virial yes `. +During minimization, the virial contribution is *NOT* available. -No global or per-atom quantities are stored by these fixes for access -by various :doc:`output commands `. No parameter of -these fixes can be used with the *start/stop* keywords of the +No global or per-atom quantities are stored by these fixes for access by +various :doc:`output commands ` during a run. During +minimization, this fix computes a global scalar which is the energy of +the restraint forces applied insteat of the constraints. No parameter +of these fixes can be used with the *start/stop* keywords of the :doc:`run ` command. -When used during minimization, the SHAKE or RATTLE algorithms are **not** -applied. Strong restraint forces are applied instead. Restrictions """""""""""" @@ -249,7 +258,7 @@ Related commands Default """"""" -kbond = 1.0e6 +kbond = 1.0e9*k_B ---------- diff --git a/src/RIGID/fix_shake.cpp b/src/RIGID/fix_shake.cpp index 41d8c1599c..99836483dd 100644 --- a/src/RIGID/fix_shake.cpp +++ b/src/RIGID/fix_shake.cpp @@ -52,16 +52,17 @@ FixShake::FixShake(LAMMPS *lmp, int narg, char **arg) : loop_respa(nullptr), step_respa(nullptr), x(nullptr), v(nullptr), f(nullptr), ftmp(nullptr), vtmp(nullptr), mass(nullptr), rmass(nullptr), type(nullptr), shake_flag(nullptr), shake_atom(nullptr), shake_type(nullptr), xshake(nullptr), nshake(nullptr), list(nullptr), - b_count(nullptr), b_count_all(nullptr), b_atom(nullptr), b_atom_all(nullptr), b_ave(nullptr), b_max(nullptr), - b_min(nullptr), b_ave_all(nullptr), b_max_all(nullptr), b_min_all(nullptr), a_count(nullptr), - a_count_all(nullptr), a_ave(nullptr), a_max(nullptr), a_min(nullptr), a_ave_all(nullptr), - a_max_all(nullptr), a_min_all(nullptr), atommols(nullptr), onemols(nullptr) + b_count(nullptr), b_count_all(nullptr), b_atom(nullptr), b_atom_all(nullptr), b_ave(nullptr), + b_max(nullptr), b_min(nullptr), b_ave_all(nullptr), b_max_all(nullptr), b_min_all(nullptr), + a_count(nullptr), a_count_all(nullptr), a_ave(nullptr), a_max(nullptr), a_min(nullptr), + a_ave_all(nullptr), a_max_all(nullptr), a_min_all(nullptr), atommols(nullptr), onemols(nullptr) { energy_global_flag = energy_peratom_flag = 1; virial_global_flag = virial_peratom_flag = 1; thermo_energy = thermo_virial = 1; create_attribute = 1; dof_flag = 1; + scalar_flag = 1; stores_ids = 1; centroidstressflag = CENTROID_AVAIL; next_output = -1; @@ -162,7 +163,7 @@ FixShake::FixShake(LAMMPS *lmp, int narg, char **arg) : // parse optional args onemols = nullptr; - kbond = 1.0e6; + kbond = 1.0e6*force->boltz; int iarg = next; while (iarg < narg) { @@ -328,6 +329,7 @@ int FixShake::setmask() mask |= POST_FORCE; mask |= POST_FORCE_RESPA; mask |= MIN_POST_FORCE; + mask |= POST_RUN; return mask; } @@ -351,8 +353,8 @@ void FixShake::init() // that should contribute to potential energy if ((comm->me == 0) && (update->whichflag == 2)) - error->warning(FLERR,"Using fix {} with minimization. Substituting constraints with " - "restraint forces using k={:.4g}", style, kbond); + error->warning(FLERR,"Using fix {} with minimization.\n Substituting constraints with " + "harmonic restraint forces using kbond={:.4g}", style, kbond); // error if a fix changing the box comes before shake fix bool boxflag = false; @@ -590,6 +592,7 @@ void FixShake::post_force(int vflag) // virial setup v_init(vflag); + ebond = 0.0; // loop over clusters to add constraint forces @@ -669,13 +672,12 @@ void FixShake::min_post_force(int vflag) next_output = (ntimestep/output_every)*output_every + output_every; } else next_output = -1; - v_init(vflag); - x = atom->x; f = atom->f; nlocal = atom->nlocal; + ebond = 0.0; - // loop over clusters to add strong restraint forces + // loop over shake clusters to add restraint forces for (int i = 0; i < nlist; i++) { int m = list[i]; @@ -2506,7 +2508,6 @@ void FixShake::shake3angle(int m) void FixShake::bond_force(tagint id1, tagint id2, double length) { - int i1 = atom->map(id1); int i2 = atom->map(id2); @@ -2525,25 +2526,18 @@ void FixShake::bond_force(tagint id1, tagint id2, double length) const double dr = r - length; const double rk = kbond * dr; const double fbond = (r > 0.0) ? -2.0 * rk / r : 0.0; - double v[6]; - v[0] = 0.5 * delx * delx * fbond; - v[1] = 0.5 * dely * dely * fbond; - v[2] = 0.5 * delz * delz * fbond; - v[3] = 0.5 * delx * dely * fbond; - v[4] = 0.5 * delx * delz * fbond; - v[5] = 0.5 * dely * delz * fbond; if (i1 < nlocal) { f[i1][0] += delx * fbond; f[i1][1] += dely * fbond; f[i1][2] += delz * fbond; - if (evflag) v_tally(i1, v); + ebond += 0.5*rk*dr; } if (i2 < nlocal) { f[i2][0] -= delx * fbond; f[i2][1] -= dely * fbond; f[i2][2] -= delz * fbond; - if (evflag) v_tally(i2, v); + ebond += 0.5*rk*dr; } } @@ -3102,6 +3096,26 @@ void *FixShake::extract(const char *str, int &dim) return nullptr; } +/* ---------------------------------------------------------------------- + energy due to restraint forces +------------------------------------------------------------------------- */ + +double FixShake::compute_scalar() +{ + double all; + MPI_Allreduce(&ebond, &all, 1, MPI_DOUBLE, MPI_SUM, world); + return all; +} + +/* ---------------------------------------------------------------------- + print shake stats at the end of a minimization +------------------------------------------------------------------------- */ +void FixShake::post_run() +{ + if ((update->whichflag == 2) && (output_every > 0)) stats(); +} + + /* ---------------------------------------------------------------------- add coordinate constraining forces this method is called at the end of a timestep diff --git a/src/RIGID/fix_shake.h b/src/RIGID/fix_shake.h index a0f743d7d2..d6f9a8f5d6 100644 --- a/src/RIGID/fix_shake.h +++ b/src/RIGID/fix_shake.h @@ -39,6 +39,7 @@ class FixShake : public Fix { void post_force(int) override; void post_force_respa(int, int, int) override; void min_post_force(int) override; + void post_run() override; double memory_usage() override; void grow_arrays(int) override; @@ -59,6 +60,7 @@ class FixShake : public Fix { int dof(int) override; void reset_dt() override; void *extract(const char *, int &) override; + double compute_scalar() override; protected: int vflag_post_force; // store the vflag of last post_force call @@ -78,6 +80,7 @@ class FixShake : public Fix { int molecular; // copy of atom->molecular double *bond_distance, *angle_distance; // constraint distances double kbond; // force constant for restraint + double ebond; // energy of bond restraints class FixRespa *fix_respa; // rRESPA fix needed by SHAKE int nlevels_respa; // copies of needed rRESPA variables From 1ee35bea6117c0df955326d4857a7a4475ff696e Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 10 Jun 2022 01:41:14 -0400 Subject: [PATCH 007/262] fix shake stats (again) --- src/RIGID/fix_shake.cpp | 60 ++++++++++++++++++++--------------------- src/RIGID/fix_shake.h | 3 +-- 2 files changed, 30 insertions(+), 33 deletions(-) diff --git a/src/RIGID/fix_shake.cpp b/src/RIGID/fix_shake.cpp index 99836483dd..c284d99011 100644 --- a/src/RIGID/fix_shake.cpp +++ b/src/RIGID/fix_shake.cpp @@ -52,10 +52,10 @@ FixShake::FixShake(LAMMPS *lmp, int narg, char **arg) : loop_respa(nullptr), step_respa(nullptr), x(nullptr), v(nullptr), f(nullptr), ftmp(nullptr), vtmp(nullptr), mass(nullptr), rmass(nullptr), type(nullptr), shake_flag(nullptr), shake_atom(nullptr), shake_type(nullptr), xshake(nullptr), nshake(nullptr), list(nullptr), - b_count(nullptr), b_count_all(nullptr), b_atom(nullptr), b_atom_all(nullptr), b_ave(nullptr), - b_max(nullptr), b_min(nullptr), b_ave_all(nullptr), b_max_all(nullptr), b_min_all(nullptr), - a_count(nullptr), a_count_all(nullptr), a_ave(nullptr), a_max(nullptr), a_min(nullptr), - a_ave_all(nullptr), a_max_all(nullptr), a_min_all(nullptr), atommols(nullptr), onemols(nullptr) + b_count(nullptr), b_count_all(nullptr), b_ave(nullptr), b_max(nullptr), b_min(nullptr), + b_ave_all(nullptr), b_max_all(nullptr), b_min_all(nullptr), a_count(nullptr), + a_count_all(nullptr), a_ave(nullptr), a_max(nullptr), a_min(nullptr), a_ave_all(nullptr), + a_max_all(nullptr), a_min_all(nullptr), atommols(nullptr), onemols(nullptr) { energy_global_flag = energy_peratom_flag = 1; virial_global_flag = virial_peratom_flag = 1; @@ -204,8 +204,6 @@ FixShake::FixShake(LAMMPS *lmp, int narg, char **arg) : int nb = atom->nbondtypes + 1; b_count = new int[nb]; b_count_all = new int[nb]; - b_atom = new int[nb]; - b_atom_all = new int[nb]; b_ave = new double[nb]; b_ave_all = new double[nb]; b_max = new double[nb]; @@ -298,8 +296,6 @@ FixShake::~FixShake() if (output_every) { delete[] b_count; delete[] b_count_all; - delete[] b_atom; - delete[] b_atom_all; delete[] b_ave; delete[] b_ave_all; delete[] b_max; @@ -2547,7 +2543,6 @@ void FixShake::bond_force(tagint id1, tagint id2, double length) void FixShake::stats() { - int i,j,m,n,iatom,jatom,katom; double delx,dely,delz; double r,r1,r2,r3,angle; @@ -2556,13 +2551,12 @@ void FixShake::stats() int nb = atom->nbondtypes + 1; int na = atom->nangletypes + 1; - for (i = 0; i < nb; i++) { + for (int i = 0; i < nb; i++) { b_count[i] = 0; b_ave[i] = b_max[i] = 0.0; b_min[i] = BIG; - b_atom[i] = -1; } - for (i = 0; i < na; i++) { + for (int i = 0; i < na; i++) { a_count[i] = 0; a_ave[i] = a_max[i] = 0.0; a_min[i] = BIG; @@ -2574,25 +2568,26 @@ void FixShake::stats() double **x = atom->x; int nlocal = atom->nlocal; - for (i = 0; i < nlocal; i++) { - if (shake_flag[i] == 0) continue; + for (int ii = 0; ii < nlist; ++ii) { + int i = list[ii]; + int n = shake_flag[i]; + if (n == 0) continue; // bond stats - n = shake_flag[i]; if (n == 1) n = 3; - iatom = atom->map(shake_atom[i][0]); - for (j = 1; j < n; j++) { - jatom = atom->map(shake_atom[i][j]); + int iatom = atom->map(shake_atom[i][0]); + for (int j = 1; j < n; j++) { + int jatom = atom->map(shake_atom[i][j]); + if (jatom >= nlocal) continue; delx = x[iatom][0] - x[jatom][0]; dely = x[iatom][1] - x[jatom][1]; delz = x[iatom][2] - x[jatom][2]; domain->minimum_image(delx,dely,delz); - r = sqrt(delx*delx + dely*dely + delz*delz); - m = shake_type[i][j-1]; + r = sqrt(delx*delx + dely*dely + delz*delz); + int m = shake_type[i][j-1]; b_count[m]++; - b_atom[m] = n; b_ave[m] += r; b_max[m] = MAX(b_max[m],r); b_min[m] = MIN(b_min[m],r); @@ -2601,9 +2596,13 @@ void FixShake::stats() // angle stats if (shake_flag[i] == 1) { - iatom = atom->map(shake_atom[i][0]); - jatom = atom->map(shake_atom[i][1]); - katom = atom->map(shake_atom[i][2]); + int iatom = atom->map(shake_atom[i][0]); + int jatom = atom->map(shake_atom[i][1]); + int katom = atom->map(shake_atom[i][2]); + int n = 0; + if (iatom < nlocal) ++n; + if (jatom < nlocal) ++n; + if (katom < nlocal) ++n; delx = x[iatom][0] - x[jatom][0]; dely = x[iatom][1] - x[jatom][1]; @@ -2625,9 +2624,9 @@ void FixShake::stats() angle = acos((r1*r1 + r2*r2 - r3*r3) / (2.0*r1*r2)); angle *= 180.0/MY_PI; - m = shake_type[i][2]; - a_count[m]++; - a_ave[m] += angle; + int m = shake_type[i][2]; + a_count[m] += n; + a_ave[m] += n*angle; a_max[m] = MAX(a_max[m],angle); a_min[m] = MIN(a_min[m],angle); } @@ -2636,7 +2635,6 @@ void FixShake::stats() // sum across all procs MPI_Allreduce(b_count,b_count_all,nb,MPI_INT,MPI_SUM,world); - MPI_Allreduce(b_atom,b_atom_all,nb,MPI_INT,MPI_MAX,world); MPI_Allreduce(b_ave,b_ave_all,nb,MPI_DOUBLE,MPI_SUM,world); MPI_Allreduce(b_max,b_max_all,nb,MPI_DOUBLE,MPI_MAX,world); MPI_Allreduce(b_min,b_min_all,nb,MPI_DOUBLE,MPI_MIN,world); @@ -2652,13 +2650,13 @@ void FixShake::stats() const int width = log10((MAX(MAX(1,nb),na)))+2; auto mesg = fmt::format("{} stats (type/ave/delta/count) on step {}\n", utils::uppercase(style), update->ntimestep); - for (i = 1; i < nb; i++) { + for (int i = 1; i < nb; i++) { const auto bcnt = b_count_all[i]; if (bcnt) mesg += fmt::format("Bond: {:>{}d} {:<9.6} {:<11.6} {:>8d}\n",i,width, - b_ave_all[i]/bcnt,b_max_all[i]-b_min_all[i],bcnt/b_atom_all[i]); + b_ave_all[i]/bcnt,b_max_all[i]-b_min_all[i],bcnt); } - for (i = 1; i < na; i++) { + for (int i = 1; i < na; i++) { const auto acnt = a_count_all[i]; if (acnt) mesg += fmt::format("Angle: {:>{}d} {:<9.6} {:<11.6} {:>8d}\n",i,width, diff --git a/src/RIGID/fix_shake.h b/src/RIGID/fix_shake.h index d6f9a8f5d6..820d68ebe7 100644 --- a/src/RIGID/fix_shake.h +++ b/src/RIGID/fix_shake.h @@ -113,8 +113,7 @@ class FixShake : public Fix { int nlist, maxlist; // size and max-size of list // stat quantities - int *b_count, *b_count_all, *b_atom, - *b_atom_all; // counts for each bond type, atoms in bond cluster + int *b_count, *b_count_all; // counts for each bond type, atoms in bond cluster double *b_ave, *b_max, *b_min; // ave/max/min dist for each bond type double *b_ave_all, *b_max_all, *b_min_all; // MPI summing arrays int *a_count, *a_count_all; // ditto for angle types From c4a76103667823d30ce4ce1b4d89ff90889270a0 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 10 Jun 2022 11:07:50 -0400 Subject: [PATCH 008/262] update docs and include suggestions --- doc/src/fix_shake.rst | 56 ++++++++++++--------- doc/utils/sphinx-config/false_positives.txt | 1 + 2 files changed, 33 insertions(+), 24 deletions(-) diff --git a/doc/src/fix_shake.rst b/doc/src/fix_shake.rst index 137cb1aedb..4ba2eb7f4d 100644 --- a/doc/src/fix_shake.rst +++ b/doc/src/fix_shake.rst @@ -168,13 +168,17 @@ See the :doc:`molecule ` command for details. The only settings required to be in this file (by this command) are the SHAKE info of atoms in the molecule. -The *kbond* keyword allows to set the restraint force constant when fix -shake or fix rattle are used during minimization. In that case the -constraint algorithms are *not* applied and restraint forces are used -instead to help maintaining the geometries. How well the geometries -are maintained and how quickly a minimization will converge depends on -the magnitude of the force constant (kbond). If it is chosen too large -the minimization may converge slowly. The default is 1.0e6*k_B. +The *kbond* keyword sets the restraint force constant when fix shake or +fix rattle are used during minimization. In that case the constraint +algorithms are *not* applied and restraint forces are used instead to +maintain the geometries similar to the constraints. How well the +geometries are maintained and how quickly a minimization converges, +depends on the force constant *kbond*: larger values will reduce the +deviation from the desired geometry, but can also lead to slower +convergence of the minimization or lead to instabilities depending on +the minimization algorithm requiring to reduce the value of +:doc:`timestep `. The default value for *kbond* depends on +the :doc:`units ` setting and is 1.0e6*k_B. ---------- @@ -190,7 +194,7 @@ LAMMPS closely follows (:ref:`Andersen (1983) `). .. note:: - The fix rattle command modifies forces and velocities and thus + The *fix rattle* command modifies forces and velocities and thus should be defined after all other integration fixes in your input script. If you define other fixes that modify velocities or forces after fix rattle operates, then fix rattle will not take them into @@ -207,24 +211,28 @@ Restart, fix_modify, output, run start/stop, minimize info No information about these fixes is written to :doc:`binary restart files `. -When used during minimization, the SHAKE or RATTLE algorithms are **not** -applied. Strong restraint forces are applied instead. +Fix *shake* and *rattle* behave differently during minimization and +during a molecular dynamics run. -The :doc:`fix_modify ` *virial* option is supported by -these fixes to add the contribution due to the added forces on atoms -to both the global pressure and per-atom stress of the system via the -:doc:`compute pressure ` and :doc:`compute -stress/atom ` commands. The former can be -accessed by :doc:`thermodynamic output `. The default -setting for this fix is :doc:`fix_modify virial yes `. -During minimization, the virial contribution is *NOT* available. +When used during minimization, the SHAKE or RATTLE algorithms are +**not** applied. The constraints are replaced by restraint forces +instead. The energy due to restraint forces is included in the global +potential energy, but virial contributions from them are not included in +the global pressure. The restraint energy is also accessible as a +global scalar property of the fix. -No global or per-atom quantities are stored by these fixes for access by -various :doc:`output commands ` during a run. During -minimization, this fix computes a global scalar which is the energy of -the restraint forces applied insteat of the constraints. No parameter -of these fixes can be used with the *start/stop* keywords of the -:doc:`run ` command. +During molecular dynamics runs, the fixes apply the requested +constraints. The :doc:`fix_modify ` *virial* option is in +this case supported by these fixes to add the contribution due to the +added constraint forces on atoms to both the global pressure and +per-atom stress of the system via the :doc:`compute pressure +` and :doc:`compute stress/atom ` +commands. The former can be accessed by :doc:`thermodynamic output +`. The default setting for this fix is :doc:`fix_modify +virial yes `. No global or per-atom quantities are stored by +these fixes for access by various :doc:`output commands ` +during a run. No parameter of these fixes can be used with the +*start/stop* keywords of the :doc:`run ` command. Restrictions diff --git a/doc/utils/sphinx-config/false_positives.txt b/doc/utils/sphinx-config/false_positives.txt index b42cff262a..ff1d17ee07 100644 --- a/doc/utils/sphinx-config/false_positives.txt +++ b/doc/utils/sphinx-config/false_positives.txt @@ -1609,6 +1609,7 @@ kb kB kbit kbits +kbond kcal kcl Kd From f05fcaf0d5f8b086a0deaf07839bd8c1686ba68e Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 17 Jun 2022 05:31:42 -0400 Subject: [PATCH 009/262] change energy tally during minimize --- src/RIGID/fix_shake.cpp | 45 ++++++++++++++++++++++++++-- src/RIGID/fix_shake.h | 3 ++ src/compute_pe_atom.cpp | 66 ++++++++++++++++++++++------------------- 3 files changed, 82 insertions(+), 32 deletions(-) diff --git a/src/RIGID/fix_shake.cpp b/src/RIGID/fix_shake.cpp index c284d99011..5b2cc7a33a 100644 --- a/src/RIGID/fix_shake.cpp +++ b/src/RIGID/fix_shake.cpp @@ -67,6 +67,11 @@ FixShake::FixShake(LAMMPS *lmp, int narg, char **arg) : centroidstressflag = CENTROID_AVAIL; next_output = -1; + // to avoid uninitialized access + vflag_post_force = 0; + eflag_pre_reverse = 0; + ebond = 0.0; + // error check molecular = atom->molecular; @@ -324,6 +329,7 @@ int FixShake::setmask() mask |= PRE_NEIGHBOR; mask |= POST_FORCE; mask |= POST_FORCE_RESPA; + mask |= MIN_PRE_REVERSE; mask |= MIN_POST_FORCE; mask |= POST_RUN; return mask; @@ -505,6 +511,13 @@ void FixShake::min_setup(int vflag) min_post_force(vflag); } +/* --------------------------------------------------------------------- */ + +void FixShake::setup_pre_reverse(int eflag, int vflag) +{ + min_pre_reverse(eflag,vflag); +} + /* ---------------------------------------------------------------------- build list of SHAKE clusters to constrain if one or more atoms in cluster are on this proc, @@ -513,6 +526,7 @@ void FixShake::min_setup(int vflag) void FixShake::pre_neighbor() { + ebond = 0.0; int atom1,atom2,atom3,atom4; // local copies of atom quantities @@ -653,6 +667,15 @@ void FixShake::post_force_respa(int vflag, int ilevel, int iloop) vflag_post_force = vflag; } +/* ---------------------------------------------------------------------- + store eflag so it can be used in min_post_force +------------------------------------------------------------------------- */ + +void FixShake::min_pre_reverse(int eflag, int /*vflag*/) +{ + eflag_pre_reverse = eflag; +} + /* ---------------------------------------------------------------------- substitute shake constraints with very strong bonds ------------------------------------------------------------------------- */ @@ -668,6 +691,9 @@ void FixShake::min_post_force(int vflag) next_output = (ntimestep/output_every)*output_every + output_every; } else next_output = -1; + int eflag = eflag_pre_reverse; + ev_init(eflag, vflag); + x = atom->x; f = atom->f; nlocal = atom->nlocal; @@ -2522,18 +2548,33 @@ void FixShake::bond_force(tagint id1, tagint id2, double length) const double dr = r - length; const double rk = kbond * dr; const double fbond = (r > 0.0) ? -2.0 * rk / r : 0.0; + const double eb = rk*dr; + int list[2]; + int nlist = 0; if (i1 < nlocal) { f[i1][0] += delx * fbond; f[i1][1] += dely * fbond; f[i1][2] += delz * fbond; - ebond += 0.5*rk*dr; + list[nlist++] = i1; + ebond += 0.5*eb; } if (i2 < nlocal) { f[i2][0] -= delx * fbond; f[i2][1] -= dely * fbond; f[i2][2] -= delz * fbond; - ebond += 0.5*rk*dr; + list[nlist++] = i2; + ebond += 0.5*eb; + } + if (evflag) { + double v[6]; + v[0] = 0.5 * delx * delx * fbond; + v[1] = 0.5 * dely * dely * fbond; + v[2] = 0.5 * delz * delz * fbond; + v[3] = 0.5 * delx * dely * fbond; + v[4] = 0.5 * delx * delz * fbond; + v[5] = 0.5 * dely * delz * fbond; + ev_tally(nlist, list, 2.0, eb, v); } } diff --git a/src/RIGID/fix_shake.h b/src/RIGID/fix_shake.h index 820d68ebe7..914b73ea34 100644 --- a/src/RIGID/fix_shake.h +++ b/src/RIGID/fix_shake.h @@ -34,10 +34,12 @@ class FixShake : public Fix { int setmask() override; void init() override; void setup(int) override; + void setup_pre_reverse(int, int) override; void min_setup(int) override; void pre_neighbor() override; void post_force(int) override; void post_force_respa(int, int, int) override; + void min_pre_reverse(int, int) override; void min_post_force(int) override; void post_run() override; @@ -64,6 +66,7 @@ class FixShake : public Fix { protected: int vflag_post_force; // store the vflag of last post_force call + int eflag_pre_reverse; // store the eflag of last pre_reverse call int respa; // 0 = vel. Verlet, 1 = respa int rattle; // 0 = SHAKE, 1 = RATTLE double tolerance; // SHAKE tolerance diff --git a/src/compute_pe_atom.cpp b/src/compute_pe_atom.cpp index a627e133e5..b1b62ec16d 100644 --- a/src/compute_pe_atom.cpp +++ b/src/compute_pe_atom.cpp @@ -1,4 +1,3 @@ -// clang-format off /* ---------------------------------------------------------------------- LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator https://www.lammps.org/, Sandia National Laboratories @@ -13,30 +12,31 @@ ------------------------------------------------------------------------- */ #include "compute_pe_atom.h" -#include -#include "atom.h" -#include "update.h" -#include "comm.h" -#include "force.h" -#include "pair.h" -#include "bond.h" + #include "angle.h" +#include "atom.h" +#include "bond.h" +#include "comm.h" #include "dihedral.h" +#include "error.h" +#include "force.h" #include "improper.h" #include "kspace.h" -#include "modify.h" #include "memory.h" -#include "error.h" +#include "modify.h" +#include "pair.h" +#include "update.h" + +#include using namespace LAMMPS_NS; /* ---------------------------------------------------------------------- */ ComputePEAtom::ComputePEAtom(LAMMPS *lmp, int narg, char **arg) : - Compute(lmp, narg, arg), - energy(nullptr) + Compute(lmp, narg, arg), energy(nullptr) { - if (narg < 3) error->all(FLERR,"Illegal compute pe/atom command"); + if (narg < 3) error->all(FLERR, "Illegal compute pe/atom command"); peratom_flag = 1; size_peratom_cols = 0; @@ -56,14 +56,22 @@ ComputePEAtom::ComputePEAtom(LAMMPS *lmp, int narg, char **arg) : fixflag = 0; int iarg = 3; while (iarg < narg) { - if (strcmp(arg[iarg],"pair") == 0) pairflag = 1; - else if (strcmp(arg[iarg],"bond") == 0) bondflag = 1; - else if (strcmp(arg[iarg],"angle") == 0) angleflag = 1; - else if (strcmp(arg[iarg],"dihedral") == 0) dihedralflag = 1; - else if (strcmp(arg[iarg],"improper") == 0) improperflag = 1; - else if (strcmp(arg[iarg],"kspace") == 0) kspaceflag = 1; - else if (strcmp(arg[iarg],"fix") == 0) fixflag = 1; - else error->all(FLERR,"Illegal compute pe/atom command"); + if (strcmp(arg[iarg], "pair") == 0) + pairflag = 1; + else if (strcmp(arg[iarg], "bond") == 0) + bondflag = 1; + else if (strcmp(arg[iarg], "angle") == 0) + angleflag = 1; + else if (strcmp(arg[iarg], "dihedral") == 0) + dihedralflag = 1; + else if (strcmp(arg[iarg], "improper") == 0) + improperflag = 1; + else if (strcmp(arg[iarg], "kspace") == 0) + kspaceflag = 1; + else if (strcmp(arg[iarg], "fix") == 0) + fixflag = 1; + else + error->all(FLERR, "Illegal compute pe/atom command"); iarg++; } } @@ -86,7 +94,7 @@ void ComputePEAtom::compute_peratom() invoked_peratom = update->ntimestep; if (update->eflag_atom != invoked_peratom) - error->all(FLERR,"Per-atom energy was not tallied on needed timestep"); + error->all(FLERR, "Per-atom energy was not tallied on needed timestep"); // grow local energy array if necessary // needs to be atom->nmax in length @@ -94,7 +102,7 @@ void ComputePEAtom::compute_peratom() if (atom->nmax > nmax) { memory->destroy(energy); nmax = atom->nmax; - memory->create(energy,nmax,"pe/atom:energy"); + memory->create(energy, nmax, "pe/atom:energy"); vector_atom = energy; } @@ -153,13 +161,11 @@ void ComputePEAtom::compute_peratom() // add in per-atom contributions from relevant fixes // always only for owned atoms, not ghost - if (fixflag && modify->n_energy_atom) - modify->energy_atom(nlocal,energy); + if (fixflag && modify->n_energy_atom) modify->energy_atom(nlocal, energy); // communicate ghost energy between neighbor procs - if (force->newton || (force->kspace && force->kspace->tip4pflag)) - comm->reverse_comm(this); + if (force->newton || (force->kspace && force->kspace->tip4pflag)) comm->reverse_comm(this); // zero energy of atoms not in group // only do this after comm since ghost contributions must be included @@ -174,7 +180,7 @@ void ComputePEAtom::compute_peratom() int ComputePEAtom::pack_reverse_comm(int n, int first, double *buf) { - int i,m,last; + int i, m, last; m = 0; last = first + n; @@ -186,7 +192,7 @@ int ComputePEAtom::pack_reverse_comm(int n, int first, double *buf) void ComputePEAtom::unpack_reverse_comm(int n, int *list, double *buf) { - int i,j,m; + int i, j, m; m = 0; for (i = 0; i < n; i++) { @@ -201,6 +207,6 @@ void ComputePEAtom::unpack_reverse_comm(int n, int *list, double *buf) double ComputePEAtom::memory_usage() { - double bytes = (double)nmax * sizeof(double); + double bytes = (double) nmax * sizeof(double); return bytes; } From 0ad45a02249d6c60e2c80a34330fb76f08f6f620 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 17 Jun 2022 05:53:34 -0400 Subject: [PATCH 010/262] correctly produce eatom (=0) for MD runs --- src/RIGID/fix_shake.cpp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/RIGID/fix_shake.cpp b/src/RIGID/fix_shake.cpp index 5b2cc7a33a..6673472458 100644 --- a/src/RIGID/fix_shake.cpp +++ b/src/RIGID/fix_shake.cpp @@ -601,7 +601,8 @@ void FixShake::post_force(int vflag) // virial setup - v_init(vflag); + int eflag = eflag_pre_reverse; + ev_init(eflag, vflag); ebond = 0.0; // loop over clusters to add constraint forces From e66229dadb61f60c784c7f1863331a6afefcf4de Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 17 Jun 2022 06:19:57 -0400 Subject: [PATCH 011/262] update docs --- doc/src/fix_shake.rst | 37 ++++++++++++++++++++++--------------- 1 file changed, 22 insertions(+), 15 deletions(-) diff --git a/doc/src/fix_shake.rst b/doc/src/fix_shake.rst index 4ba2eb7f4d..b53f8602ec 100644 --- a/doc/src/fix_shake.rst +++ b/doc/src/fix_shake.rst @@ -216,23 +216,25 @@ during a molecular dynamics run. When used during minimization, the SHAKE or RATTLE algorithms are **not** applied. The constraints are replaced by restraint forces -instead. The energy due to restraint forces is included in the global -potential energy, but virial contributions from them are not included in -the global pressure. The restraint energy is also accessible as a -global scalar property of the fix. +instead. The energy and virial contributions due to the restraint +forces are tallied into global and per-atom accumulators. The total +restraint energy is also accessible as a global scalar property of the +fix. During molecular dynamics runs, the fixes apply the requested -constraints. The :doc:`fix_modify ` *virial* option is in -this case supported by these fixes to add the contribution due to the -added constraint forces on atoms to both the global pressure and -per-atom stress of the system via the :doc:`compute pressure -` and :doc:`compute stress/atom ` -commands. The former can be accessed by :doc:`thermodynamic output -`. The default setting for this fix is :doc:`fix_modify -virial yes `. No global or per-atom quantities are stored by -these fixes for access by various :doc:`output commands ` -during a run. No parameter of these fixes can be used with the -*start/stop* keywords of the :doc:`run ` command. +constraints. + +The :doc:`fix_modify ` *virial* option is supported by these +fixes to add the contribution due to the added constraint forces on +atoms to both the global pressure and per-atom stress of the system via +the :doc:`compute pressure ` and :doc:`compute +stress/atom ` commands. The former can be accessed +by :doc:`thermodynamic output `. The default setting for +this fix is :doc:`fix_modify virial yes `. No global or +per-atom quantities are stored by these fixes for access by various +:doc:`output commands ` during an MD run. No parameter of +these fixes can be used with the *start/stop* keywords of the :doc:`run +` command. Restrictions @@ -256,6 +258,11 @@ degrees (e.g. linear CO2 molecule). This causes numeric difficulties. You can use :doc:`fix rigid or fix rigid/small ` instead to make a linear molecule rigid. +When used during minimization choosing a too large value of the *kbond* +can make minimization very inefficent and also cause stability problems +with some minimization algorithms. Sometimes those can be avoided by +reducing the :doc:`timestep `. + Related commands """""""""""""""" From 114b19f620b3d7904cfe9bb5cbf1a1621767bd40 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Thu, 23 Jun 2022 06:51:13 -0400 Subject: [PATCH 012/262] make certain that the fix energy is properly reset to zero --- src/KOKKOS/fix_shake_kokkos.cpp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/KOKKOS/fix_shake_kokkos.cpp b/src/KOKKOS/fix_shake_kokkos.cpp index 5ed8cfccb3..40f641780a 100644 --- a/src/KOKKOS/fix_shake_kokkos.cpp +++ b/src/KOKKOS/fix_shake_kokkos.cpp @@ -192,6 +192,7 @@ void FixShakeKokkos::pre_neighbor() // local copies of atom quantities // used by SHAKE until next re-neighboring + ebond = 0.0; x = atom->x; v = atom->v; f = atom->f; @@ -302,6 +303,7 @@ void FixShakeKokkos::pre_neighbor() template void FixShakeKokkos::post_force(int vflag) { + ebond = 0.0; copymode = 1; d_x = atomKK->k_x.view(); From ed73c21a2104dfbfe02719422e924ab8f22c5633 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Tue, 19 Jul 2022 13:25:05 -0400 Subject: [PATCH 013/262] Set path to python interpreter when running in a virtual environment --- cmake/CMakeLists.txt | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/cmake/CMakeLists.txt b/cmake/CMakeLists.txt index 669bff1533..cf8e54b995 100644 --- a/cmake/CMakeLists.txt +++ b/cmake/CMakeLists.txt @@ -154,6 +154,19 @@ endif() ######################################################################## # User input options # ######################################################################## +# set path to python interpreter and thus enforcing python version if +# when in a virtual environment and PYTHON_EXECUTABLE is not set on command line +if(DEFINED ENV{VIRTUAL_ENV} AND NOT PYTHON_EXECUTABLE) + if(CMAKE_HOST_SYSTEM_NAME STREQUAL "Windows") + set(PYTHON_EXECUTABLE "$ENV{VIRTUAL_ENV}/Scripts/python.exe") + else() + set(PYTHON_EXECUTABLE "$ENV{VIRTUAL_ENV}/bin/python") + endif() + set(Python_EXECUTABLE "${PYTHON_EXECUTABLE}") + message(STATUS "Running in virtual environment: $ENV{VIRTUAL_ENV}\n" + " Setting Python interpreter to: ${PYTHON_EXECUTABLE}") +endif() + set(LAMMPS_MACHINE "" CACHE STRING "Suffix to append to lmp binary (WON'T enable any features automatically") mark_as_advanced(LAMMPS_MACHINE) if(LAMMPS_MACHINE) From b6550886577dedce2b6cde74526f3b81655dbd57 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Tue, 19 Jul 2022 13:26:50 -0400 Subject: [PATCH 014/262] adjust search for python interpreter so it is consistent with manual --- cmake/CMakeLists.txt | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/cmake/CMakeLists.txt b/cmake/CMakeLists.txt index cf8e54b995..a9b46671d8 100644 --- a/cmake/CMakeLists.txt +++ b/cmake/CMakeLists.txt @@ -795,9 +795,13 @@ if(BUILD_SHARED_LIBS) set(Python_ADDITIONAL_VERSIONS 3.12 3.11 3.10 3.9 3.8 3.7 3.6) find_package(PythonInterp) # Deprecated since version 3.12 if(PYTHONINTERP_FOUND) - set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) + set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) endif() else() + # backward compatibility + if(PYTHON_EXECUTABLE) + set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) + endif() find_package(Python COMPONENTS Interpreter) endif() if(BUILD_IS_MULTI_CONFIG) @@ -830,11 +834,17 @@ endif() ############################################################################### if(BUILD_SHARED_LIBS OR PKG_PYTHON) if(CMAKE_VERSION VERSION_LESS 3.12) + # adjust so we find Python 3 versions before Python 2 on old systems with old CMake + set(Python_ADDITIONAL_VERSIONS 3.12 3.11 3.10 3.9 3.8 3.7 3.6) find_package(PythonInterp) # Deprecated since version 3.12 if(PYTHONINTERP_FOUND) - set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) + set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) endif() else() + # backward compatibility + if(PYTHON_EXECUTABLE) + set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) + endif() find_package(Python COMPONENTS Interpreter) endif() if(Python_EXECUTABLE) From 5eec9da8fe4386c4ae027dc4e9340e105ebb5391 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Tue, 19 Jul 2022 13:28:43 -0400 Subject: [PATCH 015/262] make search for python libraries consistent with search for python interpreter - apply same semantics of selecting the interpreter than the main cmake script - make certain that we search for the interpreter first - when searching for the library find the version matching the interpreter - error out when library version and interpreter version does not match --- cmake/Modules/Packages/MDI.cmake | 13 +++++++++++++ cmake/Modules/Packages/PYTHON.cmake | 20 ++++++++++++++++++++ 2 files changed, 33 insertions(+) diff --git a/cmake/Modules/Packages/MDI.cmake b/cmake/Modules/Packages/MDI.cmake index 1a14d5273a..d873c8f6d1 100644 --- a/cmake/Modules/Packages/MDI.cmake +++ b/cmake/Modules/Packages/MDI.cmake @@ -26,8 +26,21 @@ if(DOWNLOAD_MDI) # detect if we have python development support and thus can enable python plugins set(MDI_USE_PYTHON_PLUGINS OFF) if(CMAKE_VERSION VERSION_LESS 3.12) + if(NOT PYTHON_VERSION_STRING) + set(Python_ADDITIONAL_VERSIONS 3.12 3.11 3.10 3.9 3.8 3.7 3.6) + # search for interpreter first, so we have a consistent library + find_package(PythonInterp) # Deprecated since version 3.12 + if(PYTHONINTERP_FOUND) + set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) + endif() + endif() + # search for the library matching the selected interpreter + set(Python_ADDITIONAL_VERSIONS ${PYTHON_VERSION_MAJOR}.${PYTHON_VERSION_MINOR}) find_package(PythonLibs QUIET) # Deprecated since version 3.12 if(PYTHONLIBS_FOUND) + if(NOT (PYTHON_VERSION_STRING STREQUAL PYTHONLIBS_VERSION_STRING)) + message(FATAL_ERROR "Python Library version ${PYTHONLIBS_VERSION_STRING} does not match Interpreter version ${PYTHON_VERSION_STRING}") + endif() set(MDI_USE_PYTHON_PLUGINS ON) endif() else() diff --git a/cmake/Modules/Packages/PYTHON.cmake b/cmake/Modules/Packages/PYTHON.cmake index c94db88073..4a2925fe31 100644 --- a/cmake/Modules/Packages/PYTHON.cmake +++ b/cmake/Modules/Packages/PYTHON.cmake @@ -1,8 +1,28 @@ if(CMAKE_VERSION VERSION_LESS 3.12) + if(NOT PYTHON_VERSION_STRING) + set(Python_ADDITIONAL_VERSIONS 3.12 3.11 3.10 3.9 3.8 3.7 3.6) + # search for interpreter first, so we have a consistent library + find_package(PythonInterp) # Deprecated since version 3.12 + if(PYTHONINTERP_FOUND) + set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) + endif() + endif() + # search for the library matching the selected interpreter + set(Python_ADDITIONAL_VERSIONS ${PYTHON_VERSION_MAJOR}.${PYTHON_VERSION_MINOR}) find_package(PythonLibs REQUIRED) # Deprecated since version 3.12 + if(NOT (PYTHON_VERSION_STRING STREQUAL PYTHONLIBS_VERSION_STRING)) + message(FATAL_ERROR "Python Library version ${PYTHONLIBS_VERSION_STRING} does not match Interpreter version ${PYTHON_VERSION_STRING}") + endif() target_include_directories(lammps PRIVATE ${PYTHON_INCLUDE_DIRS}) target_link_libraries(lammps PRIVATE ${PYTHON_LIBRARIES}) else() + if(NOT Python_INTERPRETER) + # backward compatibility + if(PYTHON_EXECUTABLE) + set(Python_EXECUTABLE ${PYTHON_EXECUTABLE}) + endif() + find_package(Python COMPONENTS Interpreter) + endif() find_package(Python REQUIRED COMPONENTS Interpreter Development) target_link_libraries(lammps PRIVATE Python::Python) endif() From 3c99a6b5c41af1f35ff790198f49b68b828d09f2 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Wed, 20 Jul 2022 17:01:44 -0400 Subject: [PATCH 016/262] Correctly handle the dependency of pair style (and fix) srp/react on the MC package --- cmake/CMakeLists.txt | 2 +- cmake/Modules/Packages/MISC.cmake | 13 ++++++++ src/Depend.sh | 4 +++ src/MISC/Install.sh | 55 +++++++++++++++++++++++++++++++ 4 files changed, 73 insertions(+), 1 deletion(-) create mode 100644 cmake/Modules/Packages/MISC.cmake create mode 100644 src/MISC/Install.sh diff --git a/cmake/CMakeLists.txt b/cmake/CMakeLists.txt index a9b46671d8..ac7f88f939 100644 --- a/cmake/CMakeLists.txt +++ b/cmake/CMakeLists.txt @@ -648,7 +648,7 @@ endif() # packages which selectively include variants based on enabled styles # e.g. accelerator packages ###################################################################### -foreach(PKG_WITH_INCL CORESHELL DPD-SMOOTH PHONON QEQ OPENMP KOKKOS OPT INTEL GPU) +foreach(PKG_WITH_INCL CORESHELL DPD-SMOOTH MISC PHONON QEQ OPENMP KOKKOS OPT INTEL GPU) if(PKG_${PKG_WITH_INCL}) include(Packages/${PKG_WITH_INCL}) endif() diff --git a/cmake/Modules/Packages/MISC.cmake b/cmake/Modules/Packages/MISC.cmake new file mode 100644 index 0000000000..38207835a0 --- /dev/null +++ b/cmake/Modules/Packages/MISC.cmake @@ -0,0 +1,13 @@ +# pair style and fix srp/react depend on the fixes bond/break and bond/create from the MC package +if(NOT PKG_MC) + get_property(LAMMPS_FIX_HEADERS GLOBAL PROPERTY FIX) + list(REMOVE_ITEM LAMMPS_FIX_HEADERS ${LAMMPS_SOURCE_DIR}/MISC/fix_srp_react.h) + set_property(GLOBAL PROPERTY FIX "${LAMMPS_FIX_HEADERS}") + get_property(LAMMPS_PAIR_HEADERS GLOBAL PROPERTY PAIR) + list(REMOVE_ITEM LAMMPS_PAIR_HEADERS ${LAMMPS_SOURCE_DIR}/MISC/pair_srp_react.h) + set_property(GLOBAL PROPERTY PAIR "${LAMMPS_PAIR_HEADERS}") + get_target_property(LAMMPS_SOURCES lammps SOURCES) + list(REMOVE_ITEM LAMMPS_SOURCES ${LAMMPS_SOURCE_DIR}/MISC/fix_srp_react.cpp) + list(REMOVE_ITEM LAMMPS_SOURCES ${LAMMPS_SOURCE_DIR}/MISC/pair_srp_react.cpp) + set_property(TARGET lammps PROPERTY SOURCES "${LAMMPS_SOURCES}") +endif() diff --git a/src/Depend.sh b/src/Depend.sh index 5dd903f0bc..90dfdbba7a 100755 --- a/src/Depend.sh +++ b/src/Depend.sh @@ -128,6 +128,10 @@ if (test $1 = "MANYBODY") then depend OPENMP fi +if (test $1 = "MC") then + depend MISC +fi + if (test $1 = "MEAM") then depend KOKKOS fi diff --git a/src/MISC/Install.sh b/src/MISC/Install.sh new file mode 100644 index 0000000000..b6ba8a13fe --- /dev/null +++ b/src/MISC/Install.sh @@ -0,0 +1,55 @@ +# Install/Uninstall package files in LAMMPS +# mode = 0/1/2 for uninstall/install/update + +mode=$1 + +# enforce using portable C locale +LC_ALL=C +export LC_ALL + +# arg1 = file, arg2 = file it depends on + +action () { + if (test $mode = 0) then + rm -f ../$1 + elif (! cmp -s $1 ../$1) then + if (test -z "$2" || test -e ../$2) then + cp $1 .. + if (test $mode = 2) then + echo " updating src/$1" + fi + fi + elif (test -n "$2") then + if (test ! -e ../$2) then + rm -f ../$1 + fi + fi +} + +# package files without dependencies +action bond_special.cpp +action bond_special.h +action compute_viscosity_cos.cpp +action compute_viscosity_cos.h +action fix_accelerate_cos.cpp +action fix_accelerate_cos.h +action fix_imd.cpp +action fix_imd.h +action fix_ipi.cpp +action fix_ipi.h +action fix_srp.cpp +action fix_srp.h +action pair_agni.cpp +action pair_agni.h +action pair_list.cpp +action pair_list.h +action pair_srp.cpp +action pair_srp.h +action pair_tracker.cpp +action pair_tracker.h + +# package files with dependencies +action pair_srp_react.cpp fix_bond_break.h +action pair_srp_react.h fix_bond_break.h +action fix_srp_react.cpp fix_bond_break.h +action fix_srp_react.h fix_bond_break.h From 00cecceab77989e57445a089b722c018302f4d69 Mon Sep 17 00:00:00 2001 From: Paulius Velesko Date: Thu, 21 Jul 2022 03:55:53 +0000 Subject: [PATCH 017/262] gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index bd2d0ea705..0cc211ab09 100644 --- a/.gitignore +++ b/.gitignore @@ -55,3 +55,4 @@ out/RelWithDebInfo out/Release out/x86 out/x64 +benchmark/* From bf65b4720f26d5b2dc90d1076a3ff7379784774d Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Thu, 21 Jul 2022 05:20:11 -0400 Subject: [PATCH 018/262] add more BLAS/LAPACK functions to support LATTE package --- lib/linalg/zdrot.f | 153 ++++++++++++++ lib/linalg/zheevd.f | 395 ++++++++++++++++++++++++++++++++++++ lib/linalg/zlacpy.f | 156 ++++++++++++++ lib/linalg/zlacrm.f | 182 +++++++++++++++++ lib/linalg/zlaed0.f | 368 +++++++++++++++++++++++++++++++++ lib/linalg/zlaed7.f | 382 +++++++++++++++++++++++++++++++++++ lib/linalg/zlaed8.f | 483 ++++++++++++++++++++++++++++++++++++++++++++ lib/linalg/zstedc.f | 483 ++++++++++++++++++++++++++++++++++++++++++++ lib/linalg/zunm2l.f | 278 +++++++++++++++++++++++++ lib/linalg/zunm2r.f | 283 ++++++++++++++++++++++++++ lib/linalg/zunmql.f | 336 ++++++++++++++++++++++++++++++ lib/linalg/zunmqr.f | 337 +++++++++++++++++++++++++++++++ lib/linalg/zunmtr.f | 307 ++++++++++++++++++++++++++++ 13 files changed, 4143 insertions(+) create mode 100644 lib/linalg/zdrot.f create mode 100644 lib/linalg/zheevd.f create mode 100644 lib/linalg/zlacpy.f create mode 100644 lib/linalg/zlacrm.f create mode 100644 lib/linalg/zlaed0.f create mode 100644 lib/linalg/zlaed7.f create mode 100644 lib/linalg/zlaed8.f create mode 100644 lib/linalg/zstedc.f create mode 100644 lib/linalg/zunm2l.f create mode 100644 lib/linalg/zunm2r.f create mode 100644 lib/linalg/zunmql.f create mode 100644 lib/linalg/zunmqr.f create mode 100644 lib/linalg/zunmtr.f diff --git a/lib/linalg/zdrot.f b/lib/linalg/zdrot.f new file mode 100644 index 0000000000..3145561d67 --- /dev/null +++ b/lib/linalg/zdrot.f @@ -0,0 +1,153 @@ +*> \brief \b ZDROT +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE ZDROT( N, ZX, INCX, ZY, INCY, C, S ) +* +* .. Scalar Arguments .. +* INTEGER INCX, INCY, N +* DOUBLE PRECISION C, S +* .. +* .. Array Arguments .. +* COMPLEX*16 ZX( * ), ZY( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> Applies a plane rotation, where the cos and sin (c and s) are real +*> and the vectors cx and cy are complex. +*> jack dongarra, linpack, 3/11/78. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the order of the vectors cx and cy. +*> N must be at least zero. +*> \endverbatim +*> +*> \param[in,out] ZX +*> \verbatim +*> ZX is COMPLEX*16 array, dimension at least +*> ( 1 + ( N - 1 )*abs( INCX ) ). +*> Before entry, the incremented array ZX must contain the n +*> element vector cx. On exit, ZX is overwritten by the updated +*> vector cx. +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> On entry, INCX specifies the increment for the elements of +*> ZX. INCX must not be zero. +*> \endverbatim +*> +*> \param[in,out] ZY +*> \verbatim +*> ZY is COMPLEX*16 array, dimension at least +*> ( 1 + ( N - 1 )*abs( INCY ) ). +*> Before entry, the incremented array ZY must contain the n +*> element vector cy. On exit, ZY is overwritten by the updated +*> vector cy. +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> On entry, INCY specifies the increment for the elements of +*> ZY. INCY must not be zero. +*> \endverbatim +*> +*> \param[in] C +*> \verbatim +*> C is DOUBLE PRECISION +*> On entry, C specifies the cosine, cos. +*> \endverbatim +*> +*> \param[in] S +*> \verbatim +*> S is DOUBLE PRECISION +*> On entry, S specifies the sine, sin. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16_blas_level1 +* +* ===================================================================== + SUBROUTINE ZDROT( N, ZX, INCX, ZY, INCY, C, S ) +* +* -- Reference BLAS level1 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + INTEGER INCX, INCY, N + DOUBLE PRECISION C, S +* .. +* .. Array Arguments .. + COMPLEX*16 ZX( * ), ZY( * ) +* .. +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I, IX, IY + COMPLEX*16 CTEMP +* .. +* .. Executable Statements .. +* + IF( N.LE.0 ) + $ RETURN + IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN +* +* code for both increments equal to 1 +* + DO I = 1, N + CTEMP = C*ZX( I ) + S*ZY( I ) + ZY( I ) = C*ZY( I ) - S*ZX( I ) + ZX( I ) = CTEMP + END DO + ELSE +* +* code for unequal increments or equal increments not equal +* to 1 +* + IX = 1 + IY = 1 + IF( INCX.LT.0 ) + $ IX = ( -N+1 )*INCX + 1 + IF( INCY.LT.0 ) + $ IY = ( -N+1 )*INCY + 1 + DO I = 1, N + CTEMP = C*ZX( IX ) + S*ZY( IY ) + ZY( IY ) = C*ZY( IY ) - S*ZX( IX ) + ZX( IX ) = CTEMP + IX = IX + INCX + IY = IY + INCY + END DO + END IF + RETURN +* +* End of ZDROT +* + END diff --git a/lib/linalg/zheevd.f b/lib/linalg/zheevd.f new file mode 100644 index 0000000000..7f58c7f726 --- /dev/null +++ b/lib/linalg/zheevd.f @@ -0,0 +1,395 @@ +*> \brief ZHEEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZHEEVD + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, +* LRWORK, IWORK, LIWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER JOBZ, UPLO +* INTEGER INFO, LDA, LIWORK, LRWORK, LWORK, N +* .. +* .. Array Arguments .. +* INTEGER IWORK( * ) +* DOUBLE PRECISION RWORK( * ), W( * ) +* COMPLEX*16 A( LDA, * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZHEEVD computes all eigenvalues and, optionally, eigenvectors of a +*> complex Hermitian matrix A. If eigenvectors are desired, it uses a +*> divide and conquer algorithm. +*> +*> The divide and conquer algorithm makes very mild assumptions about +*> floating point arithmetic. It will work on machines with a guard +*> digit in add/subtract, or on those binary machines without guard +*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or +*> Cray-2. It could conceivably fail on hexadecimal or decimal machines +*> without guard digits, but we know of none. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] JOBZ +*> \verbatim +*> JOBZ is CHARACTER*1 +*> = 'N': Compute eigenvalues only; +*> = 'V': Compute eigenvalues and eigenvectors. +*> \endverbatim +*> +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> = 'U': Upper triangle of A is stored; +*> = 'L': Lower triangle of A is stored. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The order of the matrix A. N >= 0. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA, N) +*> On entry, the Hermitian matrix A. If UPLO = 'U', the +*> leading N-by-N upper triangular part of A contains the +*> upper triangular part of the matrix A. If UPLO = 'L', +*> the leading N-by-N lower triangular part of A contains +*> the lower triangular part of the matrix A. +*> On exit, if JOBZ = 'V', then if INFO = 0, A contains the +*> orthonormal eigenvectors of the matrix A. +*> If JOBZ = 'N', then on exit the lower triangle (if UPLO='L') +*> or the upper triangle (if UPLO='U') of A, including the +*> diagonal, is destroyed. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,N). +*> \endverbatim +*> +*> \param[out] W +*> \verbatim +*> W is DOUBLE PRECISION array, dimension (N) +*> If INFO = 0, the eigenvalues in ascending order. +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The length of the array WORK. +*> If N <= 1, LWORK must be at least 1. +*> If JOBZ = 'N' and N > 1, LWORK must be at least N + 1. +*> If JOBZ = 'V' and N > 1, LWORK must be at least 2*N + N**2. +*> +*> If LWORK = -1, then a workspace query is assumed; the routine +*> only calculates the optimal sizes of the WORK, RWORK and +*> IWORK arrays, returns these values as the first entries of +*> the WORK, RWORK and IWORK arrays, and no error message +*> related to LWORK or LRWORK or LIWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] RWORK +*> \verbatim +*> RWORK is DOUBLE PRECISION array, +*> dimension (LRWORK) +*> On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK. +*> \endverbatim +*> +*> \param[in] LRWORK +*> \verbatim +*> LRWORK is INTEGER +*> The dimension of the array RWORK. +*> If N <= 1, LRWORK must be at least 1. +*> If JOBZ = 'N' and N > 1, LRWORK must be at least N. +*> If JOBZ = 'V' and N > 1, LRWORK must be at least +*> 1 + 5*N + 2*N**2. +*> +*> If LRWORK = -1, then a workspace query is assumed; the +*> routine only calculates the optimal sizes of the WORK, RWORK +*> and IWORK arrays, returns these values as the first entries +*> of the WORK, RWORK and IWORK arrays, and no error message +*> related to LWORK or LRWORK or LIWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] IWORK +*> \verbatim +*> IWORK is INTEGER array, dimension (MAX(1,LIWORK)) +*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK. +*> \endverbatim +*> +*> \param[in] LIWORK +*> \verbatim +*> LIWORK is INTEGER +*> The dimension of the array IWORK. +*> If N <= 1, LIWORK must be at least 1. +*> If JOBZ = 'N' and N > 1, LIWORK must be at least 1. +*> If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N. +*> +*> If LIWORK = -1, then a workspace query is assumed; the +*> routine only calculates the optimal sizes of the WORK, RWORK +*> and IWORK arrays, returns these values as the first entries +*> of the WORK, RWORK and IWORK arrays, and no error message +*> related to LWORK or LRWORK or LIWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> > 0: if INFO = i and JOBZ = 'N', then the algorithm failed +*> to converge; i off-diagonal elements of an intermediate +*> tridiagonal form did not converge to zero; +*> if INFO = i and JOBZ = 'V', then the algorithm failed +*> to compute an eigenvalue while working on the submatrix +*> lying in rows and columns INFO/(N+1) through +*> mod(INFO,N+1). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16HEeigen +* +*> \par Further Details: +* ===================== +*> +*> Modified description of INFO. Sven, 16 Feb 05. +* +*> \par Contributors: +* ================== +*> +*> Jeff Rutter, Computer Science Division, University of California +*> at Berkeley, USA +*> +* ===================================================================== + SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, + $ LRWORK, IWORK, LIWORK, INFO ) +* +* -- LAPACK driver routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER JOBZ, UPLO + INTEGER INFO, LDA, LIWORK, LRWORK, LWORK, N +* .. +* .. Array Arguments .. + INTEGER IWORK( * ) + DOUBLE PRECISION RWORK( * ), W( * ) + COMPLEX*16 A( LDA, * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) + COMPLEX*16 CONE + PARAMETER ( CONE = ( 1.0D0, 0.0D0 ) ) +* .. +* .. Local Scalars .. + LOGICAL LOWER, LQUERY, WANTZ + INTEGER IINFO, IMAX, INDE, INDRWK, INDTAU, INDWK2, + $ INDWRK, ISCALE, LIOPT, LIWMIN, LLRWK, LLWORK, + $ LLWRK2, LOPT, LROPT, LRWMIN, LWMIN + DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, + $ SMLNUM +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAENV + DOUBLE PRECISION DLAMCH, ZLANHE + EXTERNAL LSAME, ILAENV, DLAMCH, ZLANHE +* .. +* .. External Subroutines .. + EXTERNAL DSCAL, DSTERF, XERBLA, ZHETRD, ZLACPY, ZLASCL, + $ ZSTEDC, ZUNMTR +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, SQRT +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + WANTZ = LSAME( JOBZ, 'V' ) + LOWER = LSAME( UPLO, 'L' ) + LQUERY = ( LWORK.EQ.-1 .OR. LRWORK.EQ.-1 .OR. LIWORK.EQ.-1 ) +* + INFO = 0 + IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN + INFO = -1 + ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -5 + END IF +* + IF( INFO.EQ.0 ) THEN + IF( N.LE.1 ) THEN + LWMIN = 1 + LRWMIN = 1 + LIWMIN = 1 + LOPT = LWMIN + LROPT = LRWMIN + LIOPT = LIWMIN + ELSE + IF( WANTZ ) THEN + LWMIN = 2*N + N*N + LRWMIN = 1 + 5*N + 2*N**2 + LIWMIN = 3 + 5*N + ELSE + LWMIN = N + 1 + LRWMIN = N + LIWMIN = 1 + END IF + LOPT = MAX( LWMIN, N + + $ N*ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) ) + LROPT = LRWMIN + LIOPT = LIWMIN + END IF + WORK( 1 ) = LOPT + RWORK( 1 ) = LROPT + IWORK( 1 ) = LIOPT +* + IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN + INFO = -8 + ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN + INFO = -10 + ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN + INFO = -12 + END IF + END IF +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZHEEVD', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* + IF( N.EQ.1 ) THEN + W( 1 ) = DBLE( A( 1, 1 ) ) + IF( WANTZ ) + $ A( 1, 1 ) = CONE + RETURN + END IF +* +* Get machine constants. +* + SAFMIN = DLAMCH( 'Safe minimum' ) + EPS = DLAMCH( 'Precision' ) + SMLNUM = SAFMIN / EPS + BIGNUM = ONE / SMLNUM + RMIN = SQRT( SMLNUM ) + RMAX = SQRT( BIGNUM ) +* +* Scale matrix to allowable range, if necessary. +* + ANRM = ZLANHE( 'M', UPLO, N, A, LDA, RWORK ) + ISCALE = 0 + IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN + ISCALE = 1 + SIGMA = RMIN / ANRM + ELSE IF( ANRM.GT.RMAX ) THEN + ISCALE = 1 + SIGMA = RMAX / ANRM + END IF + IF( ISCALE.EQ.1 ) + $ CALL ZLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO ) +* +* Call ZHETRD to reduce Hermitian matrix to tridiagonal form. +* + INDE = 1 + INDTAU = 1 + INDWRK = INDTAU + N + INDRWK = INDE + N + INDWK2 = INDWRK + N*N + LLWORK = LWORK - INDWRK + 1 + LLWRK2 = LWORK - INDWK2 + 1 + LLRWK = LRWORK - INDRWK + 1 + CALL ZHETRD( UPLO, N, A, LDA, W, RWORK( INDE ), WORK( INDTAU ), + $ WORK( INDWRK ), LLWORK, IINFO ) +* +* For eigenvalues only, call DSTERF. For eigenvectors, first call +* ZSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the +* tridiagonal matrix, then call ZUNMTR to multiply it to the +* Householder transformations represented as Householder vectors in +* A. +* + IF( .NOT.WANTZ ) THEN + CALL DSTERF( N, W, RWORK( INDE ), INFO ) + ELSE + CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK( INDWRK ), N, + $ WORK( INDWK2 ), LLWRK2, RWORK( INDRWK ), LLRWK, + $ IWORK, LIWORK, INFO ) + CALL ZUNMTR( 'L', UPLO, 'N', N, N, A, LDA, WORK( INDTAU ), + $ WORK( INDWRK ), N, WORK( INDWK2 ), LLWRK2, IINFO ) + CALL ZLACPY( 'A', N, N, WORK( INDWRK ), N, A, LDA ) + END IF +* +* If matrix was scaled, then rescale eigenvalues appropriately. +* + IF( ISCALE.EQ.1 ) THEN + IF( INFO.EQ.0 ) THEN + IMAX = N + ELSE + IMAX = INFO - 1 + END IF + CALL DSCAL( IMAX, ONE / SIGMA, W, 1 ) + END IF +* + WORK( 1 ) = LOPT + RWORK( 1 ) = LROPT + IWORK( 1 ) = LIOPT +* + RETURN +* +* End of ZHEEVD +* + END diff --git a/lib/linalg/zlacpy.f b/lib/linalg/zlacpy.f new file mode 100644 index 0000000000..06017509e0 --- /dev/null +++ b/lib/linalg/zlacpy.f @@ -0,0 +1,156 @@ +*> \brief \b ZLACPY copies all or part of one two-dimensional array to another. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLACPY + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLACPY( UPLO, M, N, A, LDA, B, LDB ) +* +* .. Scalar Arguments .. +* CHARACTER UPLO +* INTEGER LDA, LDB, M, N +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), B( LDB, * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZLACPY copies all or part of a two-dimensional matrix A to another +*> matrix B. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> Specifies the part of the matrix A to be copied to B. +*> = 'U': Upper triangular part +*> = 'L': Lower triangular part +*> Otherwise: All of the matrix A +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. N >= 0. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA,N) +*> The m by n matrix A. If UPLO = 'U', only the upper trapezium +*> is accessed; if UPLO = 'L', only the lower trapezium is +*> accessed. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] B +*> \verbatim +*> B is COMPLEX*16 array, dimension (LDB,N) +*> On exit, B = A in the locations specified by UPLO. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> The leading dimension of the array B. LDB >= max(1,M). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERauxiliary +* +* ===================================================================== + SUBROUTINE ZLACPY( UPLO, M, N, A, LDA, B, LDB ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER UPLO + INTEGER LDA, LDB, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), B( LDB, * ) +* .. +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I, J +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. Intrinsic Functions .. + INTRINSIC MIN +* .. +* .. Executable Statements .. +* + IF( LSAME( UPLO, 'U' ) ) THEN + DO 20 J = 1, N + DO 10 I = 1, MIN( J, M ) + B( I, J ) = A( I, J ) + 10 CONTINUE + 20 CONTINUE +* + ELSE IF( LSAME( UPLO, 'L' ) ) THEN + DO 40 J = 1, N + DO 30 I = J, M + B( I, J ) = A( I, J ) + 30 CONTINUE + 40 CONTINUE +* + ELSE + DO 60 J = 1, N + DO 50 I = 1, M + B( I, J ) = A( I, J ) + 50 CONTINUE + 60 CONTINUE + END IF +* + RETURN +* +* End of ZLACPY +* + END diff --git a/lib/linalg/zlacrm.f b/lib/linalg/zlacrm.f new file mode 100644 index 0000000000..ce8b9b02c5 --- /dev/null +++ b/lib/linalg/zlacrm.f @@ -0,0 +1,182 @@ +*> \brief \b ZLACRM multiplies a complex matrix by a square real matrix. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLACRM + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLACRM( M, N, A, LDA, B, LDB, C, LDC, RWORK ) +* +* .. Scalar Arguments .. +* INTEGER LDA, LDB, LDC, M, N +* .. +* .. Array Arguments .. +* DOUBLE PRECISION B( LDB, * ), RWORK( * ) +* COMPLEX*16 A( LDA, * ), C( LDC, * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZLACRM performs a very simple matrix-matrix multiplication: +*> C := A * B, +*> where A is M by N and complex; B is N by N and real; +*> C is M by N and complex. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A and of the matrix C. +*> M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns and rows of the matrix B and +*> the number of columns of the matrix C. +*> N >= 0. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA, N) +*> On entry, A contains the M by N matrix A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >=max(1,M). +*> \endverbatim +*> +*> \param[in] B +*> \verbatim +*> B is DOUBLE PRECISION array, dimension (LDB, N) +*> On entry, B contains the N by N matrix B. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> The leading dimension of the array B. LDB >=max(1,N). +*> \endverbatim +*> +*> \param[out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension (LDC, N) +*> On exit, C contains the M by N matrix C. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >=max(1,N). +*> \endverbatim +*> +*> \param[out] RWORK +*> \verbatim +*> RWORK is DOUBLE PRECISION array, dimension (2*M*N) +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERauxiliary +* +* ===================================================================== + SUBROUTINE ZLACRM( M, N, A, LDA, B, LDB, C, LDC, RWORK ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + INTEGER LDA, LDB, LDC, M, N +* .. +* .. Array Arguments .. + DOUBLE PRECISION B( LDB, * ), RWORK( * ) + COMPLEX*16 A( LDA, * ), C( LDC, * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE, ZERO + PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 ) +* .. +* .. Local Scalars .. + INTEGER I, J, L +* .. +* .. Intrinsic Functions .. + INTRINSIC DBLE, DCMPLX, DIMAG +* .. +* .. External Subroutines .. + EXTERNAL DGEMM +* .. +* .. Executable Statements .. +* +* Quick return if possible. +* + IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) ) + $ RETURN +* + DO 20 J = 1, N + DO 10 I = 1, M + RWORK( ( J-1 )*M+I ) = DBLE( A( I, J ) ) + 10 CONTINUE + 20 CONTINUE +* + L = M*N + 1 + CALL DGEMM( 'N', 'N', M, N, N, ONE, RWORK, M, B, LDB, ZERO, + $ RWORK( L ), M ) + DO 40 J = 1, N + DO 30 I = 1, M + C( I, J ) = RWORK( L+( J-1 )*M+I-1 ) + 30 CONTINUE + 40 CONTINUE +* + DO 60 J = 1, N + DO 50 I = 1, M + RWORK( ( J-1 )*M+I ) = DIMAG( A( I, J ) ) + 50 CONTINUE + 60 CONTINUE + CALL DGEMM( 'N', 'N', M, N, N, ONE, RWORK, M, B, LDB, ZERO, + $ RWORK( L ), M ) + DO 80 J = 1, N + DO 70 I = 1, M + C( I, J ) = DCMPLX( DBLE( C( I, J ) ), + $ RWORK( L+( J-1 )*M+I-1 ) ) + 70 CONTINUE + 80 CONTINUE +* + RETURN +* +* End of ZLACRM +* + END diff --git a/lib/linalg/zlaed0.f b/lib/linalg/zlaed0.f new file mode 100644 index 0000000000..c4deac037a --- /dev/null +++ b/lib/linalg/zlaed0.f @@ -0,0 +1,368 @@ +*> \brief \b ZLAED0 used by ZSTEDC. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLAED0 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLAED0( QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, RWORK, +* IWORK, INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDQ, LDQS, N, QSIZ +* .. +* .. Array Arguments .. +* INTEGER IWORK( * ) +* DOUBLE PRECISION D( * ), E( * ), RWORK( * ) +* COMPLEX*16 Q( LDQ, * ), QSTORE( LDQS, * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> Using the divide and conquer method, ZLAED0 computes all eigenvalues +*> of a symmetric tridiagonal matrix which is one diagonal block of +*> those from reducing a dense or band Hermitian matrix and +*> corresponding eigenvectors of the dense or band matrix. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] QSIZ +*> \verbatim +*> QSIZ is INTEGER +*> The dimension of the unitary matrix used to reduce +*> the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The dimension of the symmetric tridiagonal matrix. N >= 0. +*> \endverbatim +*> +*> \param[in,out] D +*> \verbatim +*> D is DOUBLE PRECISION array, dimension (N) +*> On entry, the diagonal elements of the tridiagonal matrix. +*> On exit, the eigenvalues in ascending order. +*> \endverbatim +*> +*> \param[in,out] E +*> \verbatim +*> E is DOUBLE PRECISION array, dimension (N-1) +*> On entry, the off-diagonal elements of the tridiagonal matrix. +*> On exit, E has been destroyed. +*> \endverbatim +*> +*> \param[in,out] Q +*> \verbatim +*> Q is COMPLEX*16 array, dimension (LDQ,N) +*> On entry, Q must contain an QSIZ x N matrix whose columns +*> unitarily orthonormal. It is a part of the unitary matrix +*> that reduces the full dense Hermitian matrix to a +*> (reducible) symmetric tridiagonal matrix. +*> \endverbatim +*> +*> \param[in] LDQ +*> \verbatim +*> LDQ is INTEGER +*> The leading dimension of the array Q. LDQ >= max(1,N). +*> \endverbatim +*> +*> \param[out] IWORK +*> \verbatim +*> IWORK is INTEGER array, +*> the dimension of IWORK must be at least +*> 6 + 6*N + 5*N*lg N +*> ( lg( N ) = smallest integer k +*> such that 2^k >= N ) +*> \endverbatim +*> +*> \param[out] RWORK +*> \verbatim +*> RWORK is DOUBLE PRECISION array, +*> dimension (1 + 3*N + 2*N*lg N + 3*N**2) +*> ( lg( N ) = smallest integer k +*> such that 2^k >= N ) +*> \endverbatim +*> +*> \param[out] QSTORE +*> \verbatim +*> QSTORE is COMPLEX*16 array, dimension (LDQS, N) +*> Used to store parts of +*> the eigenvector matrix when the updating matrix multiplies +*> take place. +*> \endverbatim +*> +*> \param[in] LDQS +*> \verbatim +*> LDQS is INTEGER +*> The leading dimension of the array QSTORE. +*> LDQS >= max(1,N). +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit. +*> < 0: if INFO = -i, the i-th argument had an illegal value. +*> > 0: The algorithm failed to compute an eigenvalue while +*> working on the submatrix lying in rows and columns +*> INFO/(N+1) through mod(INFO,N+1). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZLAED0( QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, RWORK, + $ IWORK, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + INTEGER INFO, LDQ, LDQS, N, QSIZ +* .. +* .. Array Arguments .. + INTEGER IWORK( * ) + DOUBLE PRECISION D( * ), E( * ), RWORK( * ) + COMPLEX*16 Q( LDQ, * ), QSTORE( LDQS, * ) +* .. +* +* ===================================================================== +* +* Warning: N could be as big as QSIZ! +* +* .. Parameters .. + DOUBLE PRECISION TWO + PARAMETER ( TWO = 2.D+0 ) +* .. +* .. Local Scalars .. + INTEGER CURLVL, CURPRB, CURR, I, IGIVCL, IGIVNM, + $ IGIVPT, INDXQ, IPERM, IPRMPT, IQ, IQPTR, IWREM, + $ J, K, LGN, LL, MATSIZ, MSD2, SMLSIZ, SMM1, + $ SPM1, SPM2, SUBMAT, SUBPBS, TLVLS + DOUBLE PRECISION TEMP +* .. +* .. External Subroutines .. + EXTERNAL DCOPY, DSTEQR, XERBLA, ZCOPY, ZLACRM, ZLAED7 +* .. +* .. External Functions .. + INTEGER ILAENV + EXTERNAL ILAENV +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, DBLE, INT, LOG, MAX +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 +* +* IF( ICOMPQ .LT. 0 .OR. ICOMPQ .GT. 2 ) THEN +* INFO = -1 +* ELSE IF( ( ICOMPQ .EQ. 1 ) .AND. ( QSIZ .LT. MAX( 0, N ) ) ) +* $ THEN + IF( QSIZ.LT.MAX( 0, N ) ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN + INFO = -6 + ELSE IF( LDQS.LT.MAX( 1, N ) ) THEN + INFO = -8 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZLAED0', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* + SMLSIZ = ILAENV( 9, 'ZLAED0', ' ', 0, 0, 0, 0 ) +* +* Determine the size and placement of the submatrices, and save in +* the leading elements of IWORK. +* + IWORK( 1 ) = N + SUBPBS = 1 + TLVLS = 0 + 10 CONTINUE + IF( IWORK( SUBPBS ).GT.SMLSIZ ) THEN + DO 20 J = SUBPBS, 1, -1 + IWORK( 2*J ) = ( IWORK( J )+1 ) / 2 + IWORK( 2*J-1 ) = IWORK( J ) / 2 + 20 CONTINUE + TLVLS = TLVLS + 1 + SUBPBS = 2*SUBPBS + GO TO 10 + END IF + DO 30 J = 2, SUBPBS + IWORK( J ) = IWORK( J ) + IWORK( J-1 ) + 30 CONTINUE +* +* Divide the matrix into SUBPBS submatrices of size at most SMLSIZ+1 +* using rank-1 modifications (cuts). +* + SPM1 = SUBPBS - 1 + DO 40 I = 1, SPM1 + SUBMAT = IWORK( I ) + 1 + SMM1 = SUBMAT - 1 + D( SMM1 ) = D( SMM1 ) - ABS( E( SMM1 ) ) + D( SUBMAT ) = D( SUBMAT ) - ABS( E( SMM1 ) ) + 40 CONTINUE +* + INDXQ = 4*N + 3 +* +* Set up workspaces for eigenvalues only/accumulate new vectors +* routine +* + TEMP = LOG( DBLE( N ) ) / LOG( TWO ) + LGN = INT( TEMP ) + IF( 2**LGN.LT.N ) + $ LGN = LGN + 1 + IF( 2**LGN.LT.N ) + $ LGN = LGN + 1 + IPRMPT = INDXQ + N + 1 + IPERM = IPRMPT + N*LGN + IQPTR = IPERM + N*LGN + IGIVPT = IQPTR + N + 2 + IGIVCL = IGIVPT + N*LGN +* + IGIVNM = 1 + IQ = IGIVNM + 2*N*LGN + IWREM = IQ + N**2 + 1 +* Initialize pointers + DO 50 I = 0, SUBPBS + IWORK( IPRMPT+I ) = 1 + IWORK( IGIVPT+I ) = 1 + 50 CONTINUE + IWORK( IQPTR ) = 1 +* +* Solve each submatrix eigenproblem at the bottom of the divide and +* conquer tree. +* + CURR = 0 + DO 70 I = 0, SPM1 + IF( I.EQ.0 ) THEN + SUBMAT = 1 + MATSIZ = IWORK( 1 ) + ELSE + SUBMAT = IWORK( I ) + 1 + MATSIZ = IWORK( I+1 ) - IWORK( I ) + END IF + LL = IQ - 1 + IWORK( IQPTR+CURR ) + CALL DSTEQR( 'I', MATSIZ, D( SUBMAT ), E( SUBMAT ), + $ RWORK( LL ), MATSIZ, RWORK, INFO ) + CALL ZLACRM( QSIZ, MATSIZ, Q( 1, SUBMAT ), LDQ, RWORK( LL ), + $ MATSIZ, QSTORE( 1, SUBMAT ), LDQS, + $ RWORK( IWREM ) ) + IWORK( IQPTR+CURR+1 ) = IWORK( IQPTR+CURR ) + MATSIZ**2 + CURR = CURR + 1 + IF( INFO.GT.0 ) THEN + INFO = SUBMAT*( N+1 ) + SUBMAT + MATSIZ - 1 + RETURN + END IF + K = 1 + DO 60 J = SUBMAT, IWORK( I+1 ) + IWORK( INDXQ+J ) = K + K = K + 1 + 60 CONTINUE + 70 CONTINUE +* +* Successively merge eigensystems of adjacent submatrices +* into eigensystem for the corresponding larger matrix. +* +* while ( SUBPBS > 1 ) +* + CURLVL = 1 + 80 CONTINUE + IF( SUBPBS.GT.1 ) THEN + SPM2 = SUBPBS - 2 + DO 90 I = 0, SPM2, 2 + IF( I.EQ.0 ) THEN + SUBMAT = 1 + MATSIZ = IWORK( 2 ) + MSD2 = IWORK( 1 ) + CURPRB = 0 + ELSE + SUBMAT = IWORK( I ) + 1 + MATSIZ = IWORK( I+2 ) - IWORK( I ) + MSD2 = MATSIZ / 2 + CURPRB = CURPRB + 1 + END IF +* +* Merge lower order eigensystems (of size MSD2 and MATSIZ - MSD2) +* into an eigensystem of size MATSIZ. ZLAED7 handles the case +* when the eigenvectors of a full or band Hermitian matrix (which +* was reduced to tridiagonal form) are desired. +* +* I am free to use Q as a valuable working space until Loop 150. +* + CALL ZLAED7( MATSIZ, MSD2, QSIZ, TLVLS, CURLVL, CURPRB, + $ D( SUBMAT ), QSTORE( 1, SUBMAT ), LDQS, + $ E( SUBMAT+MSD2-1 ), IWORK( INDXQ+SUBMAT ), + $ RWORK( IQ ), IWORK( IQPTR ), IWORK( IPRMPT ), + $ IWORK( IPERM ), IWORK( IGIVPT ), + $ IWORK( IGIVCL ), RWORK( IGIVNM ), + $ Q( 1, SUBMAT ), RWORK( IWREM ), + $ IWORK( SUBPBS+1 ), INFO ) + IF( INFO.GT.0 ) THEN + INFO = SUBMAT*( N+1 ) + SUBMAT + MATSIZ - 1 + RETURN + END IF + IWORK( I / 2+1 ) = IWORK( I+2 ) + 90 CONTINUE + SUBPBS = SUBPBS / 2 + CURLVL = CURLVL + 1 + GO TO 80 + END IF +* +* end while +* +* Re-merge the eigenvalues/vectors which were deflated at the final +* merge step. +* + DO 100 I = 1, N + J = IWORK( INDXQ+I ) + RWORK( I ) = D( J ) + CALL ZCOPY( QSIZ, QSTORE( 1, J ), 1, Q( 1, I ), 1 ) + 100 CONTINUE + CALL DCOPY( N, RWORK, 1, D, 1 ) +* + RETURN +* +* End of ZLAED0 +* + END diff --git a/lib/linalg/zlaed7.f b/lib/linalg/zlaed7.f new file mode 100644 index 0000000000..83f32d8b81 --- /dev/null +++ b/lib/linalg/zlaed7.f @@ -0,0 +1,382 @@ +*> \brief \b ZLAED7 used by ZSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLAED7 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLAED7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, +* LDQ, RHO, INDXQ, QSTORE, QPTR, PRMPTR, PERM, +* GIVPTR, GIVCOL, GIVNUM, WORK, RWORK, IWORK, +* INFO ) +* +* .. Scalar Arguments .. +* INTEGER CURLVL, CURPBM, CUTPNT, INFO, LDQ, N, QSIZ, +* $ TLVLS +* DOUBLE PRECISION RHO +* .. +* .. Array Arguments .. +* INTEGER GIVCOL( 2, * ), GIVPTR( * ), INDXQ( * ), +* $ IWORK( * ), PERM( * ), PRMPTR( * ), QPTR( * ) +* DOUBLE PRECISION D( * ), GIVNUM( 2, * ), QSTORE( * ), RWORK( * ) +* COMPLEX*16 Q( LDQ, * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZLAED7 computes the updated eigensystem of a diagonal +*> matrix after modification by a rank-one symmetric matrix. This +*> routine is used only for the eigenproblem which requires all +*> eigenvalues and optionally eigenvectors of a dense or banded +*> Hermitian matrix that has been reduced to tridiagonal form. +*> +*> T = Q(in) ( D(in) + RHO * Z*Z**H ) Q**H(in) = Q(out) * D(out) * Q**H(out) +*> +*> where Z = Q**Hu, u is a vector of length N with ones in the +*> CUTPNT and CUTPNT + 1 th elements and zeros elsewhere. +*> +*> The eigenvectors of the original matrix are stored in Q, and the +*> eigenvalues are in D. The algorithm consists of three stages: +*> +*> The first stage consists of deflating the size of the problem +*> when there are multiple eigenvalues or if there is a zero in +*> the Z vector. For each such occurrence the dimension of the +*> secular equation problem is reduced by one. This stage is +*> performed by the routine DLAED2. +*> +*> The second stage consists of calculating the updated +*> eigenvalues. This is done by finding the roots of the secular +*> equation via the routine DLAED4 (as called by SLAED3). +*> This routine also calculates the eigenvectors of the current +*> problem. +*> +*> The final stage consists of computing the updated eigenvectors +*> directly using the updated eigenvalues. The eigenvectors for +*> the current problem are multiplied with the eigenvectors from +*> the overall problem. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The dimension of the symmetric tridiagonal matrix. N >= 0. +*> \endverbatim +*> +*> \param[in] CUTPNT +*> \verbatim +*> CUTPNT is INTEGER +*> Contains the location of the last eigenvalue in the leading +*> sub-matrix. min(1,N) <= CUTPNT <= N. +*> \endverbatim +*> +*> \param[in] QSIZ +*> \verbatim +*> QSIZ is INTEGER +*> The dimension of the unitary matrix used to reduce +*> the full matrix to tridiagonal form. QSIZ >= N. +*> \endverbatim +*> +*> \param[in] TLVLS +*> \verbatim +*> TLVLS is INTEGER +*> The total number of merging levels in the overall divide and +*> conquer tree. +*> \endverbatim +*> +*> \param[in] CURLVL +*> \verbatim +*> CURLVL is INTEGER +*> The current level in the overall merge routine, +*> 0 <= curlvl <= tlvls. +*> \endverbatim +*> +*> \param[in] CURPBM +*> \verbatim +*> CURPBM is INTEGER +*> The current problem in the current level in the overall +*> merge routine (counting from upper left to lower right). +*> \endverbatim +*> +*> \param[in,out] D +*> \verbatim +*> D is DOUBLE PRECISION array, dimension (N) +*> On entry, the eigenvalues of the rank-1-perturbed matrix. +*> On exit, the eigenvalues of the repaired matrix. +*> \endverbatim +*> +*> \param[in,out] Q +*> \verbatim +*> Q is COMPLEX*16 array, dimension (LDQ,N) +*> On entry, the eigenvectors of the rank-1-perturbed matrix. +*> On exit, the eigenvectors of the repaired tridiagonal matrix. +*> \endverbatim +*> +*> \param[in] LDQ +*> \verbatim +*> LDQ is INTEGER +*> The leading dimension of the array Q. LDQ >= max(1,N). +*> \endverbatim +*> +*> \param[in] RHO +*> \verbatim +*> RHO is DOUBLE PRECISION +*> Contains the subdiagonal element used to create the rank-1 +*> modification. +*> \endverbatim +*> +*> \param[out] INDXQ +*> \verbatim +*> INDXQ is INTEGER array, dimension (N) +*> This contains the permutation which will reintegrate the +*> subproblem just solved back into sorted order, +*> ie. D( INDXQ( I = 1, N ) ) will be in ascending order. +*> \endverbatim +*> +*> \param[out] IWORK +*> \verbatim +*> IWORK is INTEGER array, dimension (4*N) +*> \endverbatim +*> +*> \param[out] RWORK +*> \verbatim +*> RWORK is DOUBLE PRECISION array, +*> dimension (3*N+2*QSIZ*N) +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension (QSIZ*N) +*> \endverbatim +*> +*> \param[in,out] QSTORE +*> \verbatim +*> QSTORE is DOUBLE PRECISION array, dimension (N**2+1) +*> Stores eigenvectors of submatrices encountered during +*> divide and conquer, packed together. QPTR points to +*> beginning of the submatrices. +*> \endverbatim +*> +*> \param[in,out] QPTR +*> \verbatim +*> QPTR is INTEGER array, dimension (N+2) +*> List of indices pointing to beginning of submatrices stored +*> in QSTORE. The submatrices are numbered starting at the +*> bottom left of the divide and conquer tree, from left to +*> right and bottom to top. +*> \endverbatim +*> +*> \param[in] PRMPTR +*> \verbatim +*> PRMPTR is INTEGER array, dimension (N lg N) +*> Contains a list of pointers which indicate where in PERM a +*> level's permutation is stored. PRMPTR(i+1) - PRMPTR(i) +*> indicates the size of the permutation and also the size of +*> the full, non-deflated problem. +*> \endverbatim +*> +*> \param[in] PERM +*> \verbatim +*> PERM is INTEGER array, dimension (N lg N) +*> Contains the permutations (from deflation and sorting) to be +*> applied to each eigenblock. +*> \endverbatim +*> +*> \param[in] GIVPTR +*> \verbatim +*> GIVPTR is INTEGER array, dimension (N lg N) +*> Contains a list of pointers which indicate where in GIVCOL a +*> level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i) +*> indicates the number of Givens rotations. +*> \endverbatim +*> +*> \param[in] GIVCOL +*> \verbatim +*> GIVCOL is INTEGER array, dimension (2, N lg N) +*> Each pair of numbers indicates a pair of columns to take place +*> in a Givens rotation. +*> \endverbatim +*> +*> \param[in] GIVNUM +*> \verbatim +*> GIVNUM is DOUBLE PRECISION array, dimension (2, N lg N) +*> Each number indicates the S value to be used in the +*> corresponding Givens rotation. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit. +*> < 0: if INFO = -i, the i-th argument had an illegal value. +*> > 0: if INFO = 1, an eigenvalue did not converge +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZLAED7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, + $ LDQ, RHO, INDXQ, QSTORE, QPTR, PRMPTR, PERM, + $ GIVPTR, GIVCOL, GIVNUM, WORK, RWORK, IWORK, + $ INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + INTEGER CURLVL, CURPBM, CUTPNT, INFO, LDQ, N, QSIZ, + $ TLVLS + DOUBLE PRECISION RHO +* .. +* .. Array Arguments .. + INTEGER GIVCOL( 2, * ), GIVPTR( * ), INDXQ( * ), + $ IWORK( * ), PERM( * ), PRMPTR( * ), QPTR( * ) + DOUBLE PRECISION D( * ), GIVNUM( 2, * ), QSTORE( * ), RWORK( * ) + COMPLEX*16 Q( LDQ, * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER COLTYP, CURR, I, IDLMDA, INDX, + $ INDXC, INDXP, IQ, IW, IZ, K, N1, N2, PTR +* .. +* .. External Subroutines .. + EXTERNAL DLAED9, DLAEDA, DLAMRG, XERBLA, ZLACRM, ZLAED8 +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 +* +* IF( ICOMPQ.LT.0 .OR. ICOMPQ.GT.1 ) THEN +* INFO = -1 +* ELSE IF( N.LT.0 ) THEN + IF( N.LT.0 ) THEN + INFO = -1 + ELSE IF( MIN( 1, N ).GT.CUTPNT .OR. N.LT.CUTPNT ) THEN + INFO = -2 + ELSE IF( QSIZ.LT.N ) THEN + INFO = -3 + ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN + INFO = -9 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZLAED7', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* +* The following values are for bookkeeping purposes only. They are +* integer pointers which indicate the portion of the workspace +* used by a particular array in DLAED2 and SLAED3. +* + IZ = 1 + IDLMDA = IZ + N + IW = IDLMDA + N + IQ = IW + N +* + INDX = 1 + INDXC = INDX + N + COLTYP = INDXC + N + INDXP = COLTYP + N +* +* Form the z-vector which consists of the last row of Q_1 and the +* first row of Q_2. +* + PTR = 1 + 2**TLVLS + DO 10 I = 1, CURLVL - 1 + PTR = PTR + 2**( TLVLS-I ) + 10 CONTINUE + CURR = PTR + CURPBM + CALL DLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR, + $ GIVCOL, GIVNUM, QSTORE, QPTR, RWORK( IZ ), + $ RWORK( IZ+N ), INFO ) +* +* When solving the final problem, we no longer need the stored data, +* so we will overwrite the data from this level onto the previously +* used storage space. +* + IF( CURLVL.EQ.TLVLS ) THEN + QPTR( CURR ) = 1 + PRMPTR( CURR ) = 1 + GIVPTR( CURR ) = 1 + END IF +* +* Sort and Deflate eigenvalues. +* + CALL ZLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, RWORK( IZ ), + $ RWORK( IDLMDA ), WORK, QSIZ, RWORK( IW ), + $ IWORK( INDXP ), IWORK( INDX ), INDXQ, + $ PERM( PRMPTR( CURR ) ), GIVPTR( CURR+1 ), + $ GIVCOL( 1, GIVPTR( CURR ) ), + $ GIVNUM( 1, GIVPTR( CURR ) ), INFO ) + PRMPTR( CURR+1 ) = PRMPTR( CURR ) + N + GIVPTR( CURR+1 ) = GIVPTR( CURR+1 ) + GIVPTR( CURR ) +* +* Solve Secular Equation. +* + IF( K.NE.0 ) THEN + CALL DLAED9( K, 1, K, N, D, RWORK( IQ ), K, RHO, + $ RWORK( IDLMDA ), RWORK( IW ), + $ QSTORE( QPTR( CURR ) ), K, INFO ) + CALL ZLACRM( QSIZ, K, WORK, QSIZ, QSTORE( QPTR( CURR ) ), K, Q, + $ LDQ, RWORK( IQ ) ) + QPTR( CURR+1 ) = QPTR( CURR ) + K**2 + IF( INFO.NE.0 ) THEN + RETURN + END IF +* +* Prepare the INDXQ sorting premutation. +* + N1 = K + N2 = N - K + CALL DLAMRG( N1, N2, D, 1, -1, INDXQ ) + ELSE + QPTR( CURR+1 ) = QPTR( CURR ) + DO 20 I = 1, N + INDXQ( I ) = I + 20 CONTINUE + END IF +* + RETURN +* +* End of ZLAED7 +* + END diff --git a/lib/linalg/zlaed8.f b/lib/linalg/zlaed8.f new file mode 100644 index 0000000000..995a673de9 --- /dev/null +++ b/lib/linalg/zlaed8.f @@ -0,0 +1,483 @@ +*> \brief \b ZLAED8 used by ZSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLAED8 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMDA, +* Q2, LDQ2, W, INDXP, INDX, INDXQ, PERM, GIVPTR, +* GIVCOL, GIVNUM, INFO ) +* +* .. Scalar Arguments .. +* INTEGER CUTPNT, GIVPTR, INFO, K, LDQ, LDQ2, N, QSIZ +* DOUBLE PRECISION RHO +* .. +* .. Array Arguments .. +* INTEGER GIVCOL( 2, * ), INDX( * ), INDXP( * ), +* $ INDXQ( * ), PERM( * ) +* DOUBLE PRECISION D( * ), DLAMDA( * ), GIVNUM( 2, * ), W( * ), +* $ Z( * ) +* COMPLEX*16 Q( LDQ, * ), Q2( LDQ2, * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZLAED8 merges the two sets of eigenvalues together into a single +*> sorted set. Then it tries to deflate the size of the problem. +*> There are two ways in which deflation can occur: when two or more +*> eigenvalues are close together or if there is a tiny element in the +*> Z vector. For each such occurrence the order of the related secular +*> equation problem is reduced by one. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[out] K +*> \verbatim +*> K is INTEGER +*> Contains the number of non-deflated eigenvalues. +*> This is the order of the related secular equation. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The dimension of the symmetric tridiagonal matrix. N >= 0. +*> \endverbatim +*> +*> \param[in] QSIZ +*> \verbatim +*> QSIZ is INTEGER +*> The dimension of the unitary matrix used to reduce +*> the dense or band matrix to tridiagonal form. +*> QSIZ >= N if ICOMPQ = 1. +*> \endverbatim +*> +*> \param[in,out] Q +*> \verbatim +*> Q is COMPLEX*16 array, dimension (LDQ,N) +*> On entry, Q contains the eigenvectors of the partially solved +*> system which has been previously updated in matrix +*> multiplies with other partially solved eigensystems. +*> On exit, Q contains the trailing (N-K) updated eigenvectors +*> (those which were deflated) in its last N-K columns. +*> \endverbatim +*> +*> \param[in] LDQ +*> \verbatim +*> LDQ is INTEGER +*> The leading dimension of the array Q. LDQ >= max( 1, N ). +*> \endverbatim +*> +*> \param[in,out] D +*> \verbatim +*> D is DOUBLE PRECISION array, dimension (N) +*> On entry, D contains the eigenvalues of the two submatrices to +*> be combined. On exit, D contains the trailing (N-K) updated +*> eigenvalues (those which were deflated) sorted into increasing +*> order. +*> \endverbatim +*> +*> \param[in,out] RHO +*> \verbatim +*> RHO is DOUBLE PRECISION +*> Contains the off diagonal element associated with the rank-1 +*> cut which originally split the two submatrices which are now +*> being recombined. RHO is modified during the computation to +*> the value required by DLAED3. +*> \endverbatim +*> +*> \param[in] CUTPNT +*> \verbatim +*> CUTPNT is INTEGER +*> Contains the location of the last eigenvalue in the leading +*> sub-matrix. MIN(1,N) <= CUTPNT <= N. +*> \endverbatim +*> +*> \param[in] Z +*> \verbatim +*> Z is DOUBLE PRECISION array, dimension (N) +*> On input this vector contains the updating vector (the last +*> row of the first sub-eigenvector matrix and the first row of +*> the second sub-eigenvector matrix). The contents of Z are +*> destroyed during the updating process. +*> \endverbatim +*> +*> \param[out] DLAMDA +*> \verbatim +*> DLAMDA is DOUBLE PRECISION array, dimension (N) +*> Contains a copy of the first K eigenvalues which will be used +*> by DLAED3 to form the secular equation. +*> \endverbatim +*> +*> \param[out] Q2 +*> \verbatim +*> Q2 is COMPLEX*16 array, dimension (LDQ2,N) +*> If ICOMPQ = 0, Q2 is not referenced. Otherwise, +*> Contains a copy of the first K eigenvectors which will be used +*> by DLAED7 in a matrix multiply (DGEMM) to update the new +*> eigenvectors. +*> \endverbatim +*> +*> \param[in] LDQ2 +*> \verbatim +*> LDQ2 is INTEGER +*> The leading dimension of the array Q2. LDQ2 >= max( 1, N ). +*> \endverbatim +*> +*> \param[out] W +*> \verbatim +*> W is DOUBLE PRECISION array, dimension (N) +*> This will hold the first k values of the final +*> deflation-altered z-vector and will be passed to DLAED3. +*> \endverbatim +*> +*> \param[out] INDXP +*> \verbatim +*> INDXP is INTEGER array, dimension (N) +*> This will contain the permutation used to place deflated +*> values of D at the end of the array. On output INDXP(1:K) +*> points to the nondeflated D-values and INDXP(K+1:N) +*> points to the deflated eigenvalues. +*> \endverbatim +*> +*> \param[out] INDX +*> \verbatim +*> INDX is INTEGER array, dimension (N) +*> This will contain the permutation used to sort the contents of +*> D into ascending order. +*> \endverbatim +*> +*> \param[in] INDXQ +*> \verbatim +*> INDXQ is INTEGER array, dimension (N) +*> This contains the permutation which separately sorts the two +*> sub-problems in D into ascending order. Note that elements in +*> the second half of this permutation must first have CUTPNT +*> added to their values in order to be accurate. +*> \endverbatim +*> +*> \param[out] PERM +*> \verbatim +*> PERM is INTEGER array, dimension (N) +*> Contains the permutations (from deflation and sorting) to be +*> applied to each eigenblock. +*> \endverbatim +*> +*> \param[out] GIVPTR +*> \verbatim +*> GIVPTR is INTEGER +*> Contains the number of Givens rotations which took place in +*> this subproblem. +*> \endverbatim +*> +*> \param[out] GIVCOL +*> \verbatim +*> GIVCOL is INTEGER array, dimension (2, N) +*> Each pair of numbers indicates a pair of columns to take place +*> in a Givens rotation. +*> \endverbatim +*> +*> \param[out] GIVNUM +*> \verbatim +*> GIVNUM is DOUBLE PRECISION array, dimension (2, N) +*> Each number indicates the S value to be used in the +*> corresponding Givens rotation. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit. +*> < 0: if INFO = -i, the i-th argument had an illegal value. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMDA, + $ Q2, LDQ2, W, INDXP, INDX, INDXQ, PERM, GIVPTR, + $ GIVCOL, GIVNUM, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + INTEGER CUTPNT, GIVPTR, INFO, K, LDQ, LDQ2, N, QSIZ + DOUBLE PRECISION RHO +* .. +* .. Array Arguments .. + INTEGER GIVCOL( 2, * ), INDX( * ), INDXP( * ), + $ INDXQ( * ), PERM( * ) + DOUBLE PRECISION D( * ), DLAMDA( * ), GIVNUM( 2, * ), W( * ), + $ Z( * ) + COMPLEX*16 Q( LDQ, * ), Q2( LDQ2, * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION MONE, ZERO, ONE, TWO, EIGHT + PARAMETER ( MONE = -1.0D0, ZERO = 0.0D0, ONE = 1.0D0, + $ TWO = 2.0D0, EIGHT = 8.0D0 ) +* .. +* .. Local Scalars .. + INTEGER I, IMAX, J, JLAM, JMAX, JP, K2, N1, N1P1, N2 + DOUBLE PRECISION C, EPS, S, T, TAU, TOL +* .. +* .. External Functions .. + INTEGER IDAMAX + DOUBLE PRECISION DLAMCH, DLAPY2 + EXTERNAL IDAMAX, DLAMCH, DLAPY2 +* .. +* .. External Subroutines .. + EXTERNAL DCOPY, DLAMRG, DSCAL, XERBLA, ZCOPY, ZDROT, + $ ZLACPY +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, MIN, SQRT +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 +* + IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( QSIZ.LT.N ) THEN + INFO = -3 + ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN + INFO = -5 + ELSE IF( CUTPNT.LT.MIN( 1, N ) .OR. CUTPNT.GT.N ) THEN + INFO = -8 + ELSE IF( LDQ2.LT.MAX( 1, N ) ) THEN + INFO = -12 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZLAED8', -INFO ) + RETURN + END IF +* +* Need to initialize GIVPTR to O here in case of quick exit +* to prevent an unspecified code behavior (usually sigfault) +* when IWORK array on entry to *stedc is not zeroed +* (or at least some IWORK entries which used in *laed7 for GIVPTR). +* + GIVPTR = 0 +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* + N1 = CUTPNT + N2 = N - N1 + N1P1 = N1 + 1 +* + IF( RHO.LT.ZERO ) THEN + CALL DSCAL( N2, MONE, Z( N1P1 ), 1 ) + END IF +* +* Normalize z so that norm(z) = 1 +* + T = ONE / SQRT( TWO ) + DO 10 J = 1, N + INDX( J ) = J + 10 CONTINUE + CALL DSCAL( N, T, Z, 1 ) + RHO = ABS( TWO*RHO ) +* +* Sort the eigenvalues into increasing order +* + DO 20 I = CUTPNT + 1, N + INDXQ( I ) = INDXQ( I ) + CUTPNT + 20 CONTINUE + DO 30 I = 1, N + DLAMDA( I ) = D( INDXQ( I ) ) + W( I ) = Z( INDXQ( I ) ) + 30 CONTINUE + I = 1 + J = CUTPNT + 1 + CALL DLAMRG( N1, N2, DLAMDA, 1, 1, INDX ) + DO 40 I = 1, N + D( I ) = DLAMDA( INDX( I ) ) + Z( I ) = W( INDX( I ) ) + 40 CONTINUE +* +* Calculate the allowable deflation tolerance +* + IMAX = IDAMAX( N, Z, 1 ) + JMAX = IDAMAX( N, D, 1 ) + EPS = DLAMCH( 'Epsilon' ) + TOL = EIGHT*EPS*ABS( D( JMAX ) ) +* +* If the rank-1 modifier is small enough, no more needs to be done +* -- except to reorganize Q so that its columns correspond with the +* elements in D. +* + IF( RHO*ABS( Z( IMAX ) ).LE.TOL ) THEN + K = 0 + DO 50 J = 1, N + PERM( J ) = INDXQ( INDX( J ) ) + CALL ZCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), 1 ) + 50 CONTINUE + CALL ZLACPY( 'A', QSIZ, N, Q2( 1, 1 ), LDQ2, Q( 1, 1 ), LDQ ) + RETURN + END IF +* +* If there are multiple eigenvalues then the problem deflates. Here +* the number of equal eigenvalues are found. As each equal +* eigenvalue is found, an elementary reflector is computed to rotate +* the corresponding eigensubspace so that the corresponding +* components of Z are zero in this new basis. +* + K = 0 + K2 = N + 1 + DO 60 J = 1, N + IF( RHO*ABS( Z( J ) ).LE.TOL ) THEN +* +* Deflate due to small z component. +* + K2 = K2 - 1 + INDXP( K2 ) = J + IF( J.EQ.N ) + $ GO TO 100 + ELSE + JLAM = J + GO TO 70 + END IF + 60 CONTINUE + 70 CONTINUE + J = J + 1 + IF( J.GT.N ) + $ GO TO 90 + IF( RHO*ABS( Z( J ) ).LE.TOL ) THEN +* +* Deflate due to small z component. +* + K2 = K2 - 1 + INDXP( K2 ) = J + ELSE +* +* Check if eigenvalues are close enough to allow deflation. +* + S = Z( JLAM ) + C = Z( J ) +* +* Find sqrt(a**2+b**2) without overflow or +* destructive underflow. +* + TAU = DLAPY2( C, S ) + T = D( J ) - D( JLAM ) + C = C / TAU + S = -S / TAU + IF( ABS( T*C*S ).LE.TOL ) THEN +* +* Deflation is possible. +* + Z( J ) = TAU + Z( JLAM ) = ZERO +* +* Record the appropriate Givens rotation +* + GIVPTR = GIVPTR + 1 + GIVCOL( 1, GIVPTR ) = INDXQ( INDX( JLAM ) ) + GIVCOL( 2, GIVPTR ) = INDXQ( INDX( J ) ) + GIVNUM( 1, GIVPTR ) = C + GIVNUM( 2, GIVPTR ) = S + CALL ZDROT( QSIZ, Q( 1, INDXQ( INDX( JLAM ) ) ), 1, + $ Q( 1, INDXQ( INDX( J ) ) ), 1, C, S ) + T = D( JLAM )*C*C + D( J )*S*S + D( J ) = D( JLAM )*S*S + D( J )*C*C + D( JLAM ) = T + K2 = K2 - 1 + I = 1 + 80 CONTINUE + IF( K2+I.LE.N ) THEN + IF( D( JLAM ).LT.D( INDXP( K2+I ) ) ) THEN + INDXP( K2+I-1 ) = INDXP( K2+I ) + INDXP( K2+I ) = JLAM + I = I + 1 + GO TO 80 + ELSE + INDXP( K2+I-1 ) = JLAM + END IF + ELSE + INDXP( K2+I-1 ) = JLAM + END IF + JLAM = J + ELSE + K = K + 1 + W( K ) = Z( JLAM ) + DLAMDA( K ) = D( JLAM ) + INDXP( K ) = JLAM + JLAM = J + END IF + END IF + GO TO 70 + 90 CONTINUE +* +* Record the last eigenvalue. +* + K = K + 1 + W( K ) = Z( JLAM ) + DLAMDA( K ) = D( JLAM ) + INDXP( K ) = JLAM +* + 100 CONTINUE +* +* Sort the eigenvalues and corresponding eigenvectors into DLAMDA +* and Q2 respectively. The eigenvalues/vectors which were not +* deflated go into the first K slots of DLAMDA and Q2 respectively, +* while those which were deflated go into the last N - K slots. +* + DO 110 J = 1, N + JP = INDXP( J ) + DLAMDA( J ) = D( JP ) + PERM( J ) = INDXQ( INDX( JP ) ) + CALL ZCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), 1 ) + 110 CONTINUE +* +* The deflated eigenvalues and their corresponding vectors go back +* into the last N - K slots of D and Q respectively. +* + IF( K.LT.N ) THEN + CALL DCOPY( N-K, DLAMDA( K+1 ), 1, D( K+1 ), 1 ) + CALL ZLACPY( 'A', QSIZ, N-K, Q2( 1, K+1 ), LDQ2, Q( 1, K+1 ), + $ LDQ ) + END IF +* + RETURN +* +* End of ZLAED8 +* + END diff --git a/lib/linalg/zstedc.f b/lib/linalg/zstedc.f new file mode 100644 index 0000000000..74d390af7e --- /dev/null +++ b/lib/linalg/zstedc.f @@ -0,0 +1,483 @@ +*> \brief \b ZSTEDC +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZSTEDC + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, +* LRWORK, IWORK, LIWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER COMPZ +* INTEGER INFO, LDZ, LIWORK, LRWORK, LWORK, N +* .. +* .. Array Arguments .. +* INTEGER IWORK( * ) +* DOUBLE PRECISION D( * ), E( * ), RWORK( * ) +* COMPLEX*16 WORK( * ), Z( LDZ, * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZSTEDC computes all eigenvalues and, optionally, eigenvectors of a +*> symmetric tridiagonal matrix using the divide and conquer method. +*> The eigenvectors of a full or band complex Hermitian matrix can also +*> be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this +*> matrix to tridiagonal form. +*> +*> This code makes very mild assumptions about floating point +*> arithmetic. It will work on machines with a guard digit in +*> add/subtract, or on those binary machines without guard digits +*> which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2. +*> It could conceivably fail on hexadecimal or decimal machines +*> without guard digits, but we know of none. See DLAED3 for details. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] COMPZ +*> \verbatim +*> COMPZ is CHARACTER*1 +*> = 'N': Compute eigenvalues only. +*> = 'I': Compute eigenvectors of tridiagonal matrix also. +*> = 'V': Compute eigenvectors of original Hermitian matrix +*> also. On entry, Z contains the unitary matrix used +*> to reduce the original matrix to tridiagonal form. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The dimension of the symmetric tridiagonal matrix. N >= 0. +*> \endverbatim +*> +*> \param[in,out] D +*> \verbatim +*> D is DOUBLE PRECISION array, dimension (N) +*> On entry, the diagonal elements of the tridiagonal matrix. +*> On exit, if INFO = 0, the eigenvalues in ascending order. +*> \endverbatim +*> +*> \param[in,out] E +*> \verbatim +*> E is DOUBLE PRECISION array, dimension (N-1) +*> On entry, the subdiagonal elements of the tridiagonal matrix. +*> On exit, E has been destroyed. +*> \endverbatim +*> +*> \param[in,out] Z +*> \verbatim +*> Z is COMPLEX*16 array, dimension (LDZ,N) +*> On entry, if COMPZ = 'V', then Z contains the unitary +*> matrix used in the reduction to tridiagonal form. +*> On exit, if INFO = 0, then if COMPZ = 'V', Z contains the +*> orthonormal eigenvectors of the original Hermitian matrix, +*> and if COMPZ = 'I', Z contains the orthonormal eigenvectors +*> of the symmetric tridiagonal matrix. +*> If COMPZ = 'N', then Z is not referenced. +*> \endverbatim +*> +*> \param[in] LDZ +*> \verbatim +*> LDZ is INTEGER +*> The leading dimension of the array Z. LDZ >= 1. +*> If eigenvectors are desired, then LDZ >= max(1,N). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of the array WORK. +*> If COMPZ = 'N' or 'I', or N <= 1, LWORK must be at least 1. +*> If COMPZ = 'V' and N > 1, LWORK must be at least N*N. +*> Note that for COMPZ = 'V', then if N is less than or +*> equal to the minimum divide size, usually 25, then LWORK need +*> only be 1. +*> +*> If LWORK = -1, then a workspace query is assumed; the routine +*> only calculates the optimal sizes of the WORK, RWORK and +*> IWORK arrays, returns these values as the first entries of +*> the WORK, RWORK and IWORK arrays, and no error message +*> related to LWORK or LRWORK or LIWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] RWORK +*> \verbatim +*> RWORK is DOUBLE PRECISION array, dimension (MAX(1,LRWORK)) +*> On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK. +*> \endverbatim +*> +*> \param[in] LRWORK +*> \verbatim +*> LRWORK is INTEGER +*> The dimension of the array RWORK. +*> If COMPZ = 'N' or N <= 1, LRWORK must be at least 1. +*> If COMPZ = 'V' and N > 1, LRWORK must be at least +*> 1 + 3*N + 2*N*lg N + 4*N**2 , +*> where lg( N ) = smallest integer k such +*> that 2**k >= N. +*> If COMPZ = 'I' and N > 1, LRWORK must be at least +*> 1 + 4*N + 2*N**2 . +*> Note that for COMPZ = 'I' or 'V', then if N is less than or +*> equal to the minimum divide size, usually 25, then LRWORK +*> need only be max(1,2*(N-1)). +*> +*> If LRWORK = -1, then a workspace query is assumed; the +*> routine only calculates the optimal sizes of the WORK, RWORK +*> and IWORK arrays, returns these values as the first entries +*> of the WORK, RWORK and IWORK arrays, and no error message +*> related to LWORK or LRWORK or LIWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] IWORK +*> \verbatim +*> IWORK is INTEGER array, dimension (MAX(1,LIWORK)) +*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK. +*> \endverbatim +*> +*> \param[in] LIWORK +*> \verbatim +*> LIWORK is INTEGER +*> The dimension of the array IWORK. +*> If COMPZ = 'N' or N <= 1, LIWORK must be at least 1. +*> If COMPZ = 'V' or N > 1, LIWORK must be at least +*> 6 + 6*N + 5*N*lg N. +*> If COMPZ = 'I' or N > 1, LIWORK must be at least +*> 3 + 5*N . +*> Note that for COMPZ = 'I' or 'V', then if N is less than or +*> equal to the minimum divide size, usually 25, then LIWORK +*> need only be 1. +*> +*> If LIWORK = -1, then a workspace query is assumed; the +*> routine only calculates the optimal sizes of the WORK, RWORK +*> and IWORK arrays, returns these values as the first entries +*> of the WORK, RWORK and IWORK arrays, and no error message +*> related to LWORK or LRWORK or LIWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit. +*> < 0: if INFO = -i, the i-th argument had an illegal value. +*> > 0: The algorithm failed to compute an eigenvalue while +*> working on the submatrix lying in rows and columns +*> INFO/(N+1) through mod(INFO,N+1). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +*> \par Contributors: +* ================== +*> +*> Jeff Rutter, Computer Science Division, University of California +*> at Berkeley, USA +* +* ===================================================================== + SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, + $ LRWORK, IWORK, LIWORK, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER COMPZ + INTEGER INFO, LDZ, LIWORK, LRWORK, LWORK, N +* .. +* .. Array Arguments .. + INTEGER IWORK( * ) + DOUBLE PRECISION D( * ), E( * ), RWORK( * ) + COMPLEX*16 WORK( * ), Z( LDZ, * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE, TWO + PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 ) +* .. +* .. Local Scalars .. + LOGICAL LQUERY + INTEGER FINISH, I, ICOMPZ, II, J, K, LGN, LIWMIN, LL, + $ LRWMIN, LWMIN, M, SMLSIZ, START + DOUBLE PRECISION EPS, ORGNRM, P, TINY +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAENV + DOUBLE PRECISION DLAMCH, DLANST + EXTERNAL LSAME, ILAENV, DLAMCH, DLANST +* .. +* .. External Subroutines .. + EXTERNAL DLASCL, DLASET, DSTEDC, DSTEQR, DSTERF, XERBLA, + $ ZLACPY, ZLACRM, ZLAED0, ZSTEQR, ZSWAP +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, DBLE, INT, LOG, MAX, MOD, SQRT +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + LQUERY = ( LWORK.EQ.-1 .OR. LRWORK.EQ.-1 .OR. LIWORK.EQ.-1 ) +* + IF( LSAME( COMPZ, 'N' ) ) THEN + ICOMPZ = 0 + ELSE IF( LSAME( COMPZ, 'V' ) ) THEN + ICOMPZ = 1 + ELSE IF( LSAME( COMPZ, 'I' ) ) THEN + ICOMPZ = 2 + ELSE + ICOMPZ = -1 + END IF + IF( ICOMPZ.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( ( LDZ.LT.1 ) .OR. + $ ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1, N ) ) ) THEN + INFO = -6 + END IF +* + IF( INFO.EQ.0 ) THEN +* +* Compute the workspace requirements +* + SMLSIZ = ILAENV( 9, 'ZSTEDC', ' ', 0, 0, 0, 0 ) + IF( N.LE.1 .OR. ICOMPZ.EQ.0 ) THEN + LWMIN = 1 + LIWMIN = 1 + LRWMIN = 1 + ELSE IF( N.LE.SMLSIZ ) THEN + LWMIN = 1 + LIWMIN = 1 + LRWMIN = 2*( N - 1 ) + ELSE IF( ICOMPZ.EQ.1 ) THEN + LGN = INT( LOG( DBLE( N ) ) / LOG( TWO ) ) + IF( 2**LGN.LT.N ) + $ LGN = LGN + 1 + IF( 2**LGN.LT.N ) + $ LGN = LGN + 1 + LWMIN = N*N + LRWMIN = 1 + 3*N + 2*N*LGN + 4*N**2 + LIWMIN = 6 + 6*N + 5*N*LGN + ELSE IF( ICOMPZ.EQ.2 ) THEN + LWMIN = 1 + LRWMIN = 1 + 4*N + 2*N**2 + LIWMIN = 3 + 5*N + END IF + WORK( 1 ) = LWMIN + RWORK( 1 ) = LRWMIN + IWORK( 1 ) = LIWMIN +* + IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN + INFO = -8 + ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN + INFO = -10 + ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN + INFO = -12 + END IF + END IF +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZSTEDC', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN + IF( N.EQ.1 ) THEN + IF( ICOMPZ.NE.0 ) + $ Z( 1, 1 ) = ONE + RETURN + END IF +* +* If the following conditional clause is removed, then the routine +* will use the Divide and Conquer routine to compute only the +* eigenvalues, which requires (3N + 3N**2) real workspace and +* (2 + 5N + 2N lg(N)) integer workspace. +* Since on many architectures DSTERF is much faster than any other +* algorithm for finding eigenvalues only, it is used here +* as the default. If the conditional clause is removed, then +* information on the size of workspace needs to be changed. +* +* If COMPZ = 'N', use DSTERF to compute the eigenvalues. +* + IF( ICOMPZ.EQ.0 ) THEN + CALL DSTERF( N, D, E, INFO ) + GO TO 70 + END IF +* +* If N is smaller than the minimum divide size (SMLSIZ+1), then +* solve the problem with another solver. +* + IF( N.LE.SMLSIZ ) THEN +* + CALL ZSTEQR( COMPZ, N, D, E, Z, LDZ, RWORK, INFO ) +* + ELSE +* +* If COMPZ = 'I', we simply call DSTEDC instead. +* + IF( ICOMPZ.EQ.2 ) THEN + CALL DLASET( 'Full', N, N, ZERO, ONE, RWORK, N ) + LL = N*N + 1 + CALL DSTEDC( 'I', N, D, E, RWORK, N, + $ RWORK( LL ), LRWORK-LL+1, IWORK, LIWORK, INFO ) + DO 20 J = 1, N + DO 10 I = 1, N + Z( I, J ) = RWORK( ( J-1 )*N+I ) + 10 CONTINUE + 20 CONTINUE + GO TO 70 + END IF +* +* From now on, only option left to be handled is COMPZ = 'V', +* i.e. ICOMPZ = 1. +* +* Scale. +* + ORGNRM = DLANST( 'M', N, D, E ) + IF( ORGNRM.EQ.ZERO ) + $ GO TO 70 +* + EPS = DLAMCH( 'Epsilon' ) +* + START = 1 +* +* while ( START <= N ) +* + 30 CONTINUE + IF( START.LE.N ) THEN +* +* Let FINISH be the position of the next subdiagonal entry +* such that E( FINISH ) <= TINY or FINISH = N if no such +* subdiagonal exists. The matrix identified by the elements +* between START and FINISH constitutes an independent +* sub-problem. +* + FINISH = START + 40 CONTINUE + IF( FINISH.LT.N ) THEN + TINY = EPS*SQRT( ABS( D( FINISH ) ) )* + $ SQRT( ABS( D( FINISH+1 ) ) ) + IF( ABS( E( FINISH ) ).GT.TINY ) THEN + FINISH = FINISH + 1 + GO TO 40 + END IF + END IF +* +* (Sub) Problem determined. Compute its size and solve it. +* + M = FINISH - START + 1 + IF( M.GT.SMLSIZ ) THEN +* +* Scale. +* + ORGNRM = DLANST( 'M', M, D( START ), E( START ) ) + CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), M, + $ INFO ) + CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, E( START ), + $ M-1, INFO ) +* + CALL ZLAED0( N, M, D( START ), E( START ), Z( 1, START ), + $ LDZ, WORK, N, RWORK, IWORK, INFO ) + IF( INFO.GT.0 ) THEN + INFO = ( INFO / ( M+1 )+START-1 )*( N+1 ) + + $ MOD( INFO, ( M+1 ) ) + START - 1 + GO TO 70 + END IF +* +* Scale back. +* + CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), M, + $ INFO ) +* + ELSE + CALL DSTEQR( 'I', M, D( START ), E( START ), RWORK, M, + $ RWORK( M*M+1 ), INFO ) + CALL ZLACRM( N, M, Z( 1, START ), LDZ, RWORK, M, WORK, N, + $ RWORK( M*M+1 ) ) + CALL ZLACPY( 'A', N, M, WORK, N, Z( 1, START ), LDZ ) + IF( INFO.GT.0 ) THEN + INFO = START*( N+1 ) + FINISH + GO TO 70 + END IF + END IF +* + START = FINISH + 1 + GO TO 30 + END IF +* +* endwhile +* +* +* Use Selection Sort to minimize swaps of eigenvectors +* + DO 60 II = 2, N + I = II - 1 + K = I + P = D( I ) + DO 50 J = II, N + IF( D( J ).LT.P ) THEN + K = J + P = D( J ) + END IF + 50 CONTINUE + IF( K.NE.I ) THEN + D( K ) = D( I ) + D( I ) = P + CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 ) + END IF + 60 CONTINUE + END IF +* + 70 CONTINUE + WORK( 1 ) = LWMIN + RWORK( 1 ) = LRWMIN + IWORK( 1 ) = LIWMIN +* + RETURN +* +* End of ZSTEDC +* + END diff --git a/lib/linalg/zunm2l.f b/lib/linalg/zunm2l.f new file mode 100644 index 0000000000..48c2dbfc0c --- /dev/null +++ b/lib/linalg/zunm2l.f @@ -0,0 +1,278 @@ +*> \brief \b ZUNM2L multiplies a general matrix by the unitary matrix from a QL factorization determined by cgeqlf (unblocked algorithm). +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZUNM2L + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, +* WORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE, TRANS +* INTEGER INFO, K, LDA, LDC, M, N +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZUNM2L overwrites the general complex m-by-n matrix C with +*> +*> Q * C if SIDE = 'L' and TRANS = 'N', or +*> +*> Q**H* C if SIDE = 'L' and TRANS = 'C', or +*> +*> C * Q if SIDE = 'R' and TRANS = 'N', or +*> +*> C * Q**H if SIDE = 'R' and TRANS = 'C', +*> +*> where Q is a complex unitary matrix defined as the product of k +*> elementary reflectors +*> +*> Q = H(k) . . . H(2) H(1) +*> +*> as returned by ZGEQLF. Q is of order m if SIDE = 'L' and of order n +*> if SIDE = 'R'. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': apply Q or Q**H from the Left +*> = 'R': apply Q or Q**H from the Right +*> \endverbatim +*> +*> \param[in] TRANS +*> \verbatim +*> TRANS is CHARACTER*1 +*> = 'N': apply Q (No transpose) +*> = 'C': apply Q**H (Conjugate transpose) +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. N >= 0. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> The number of elementary reflectors whose product defines +*> the matrix Q. +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA,K) +*> The i-th column must contain the vector which defines the +*> elementary reflector H(i), for i = 1,2,...,k, as returned by +*> ZGEQLF in the last k columns of its array argument A. +*> A is modified by the routine but restored on exit. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. +*> If SIDE = 'L', LDA >= max(1,M); +*> if SIDE = 'R', LDA >= max(1,N). +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX*16 array, dimension (K) +*> TAU(i) must contain the scalar factor of the elementary +*> reflector H(i), as returned by ZGEQLF. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension (LDC,N) +*> On entry, the m-by-n matrix C. +*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension +*> (N) if SIDE = 'L', +*> (M) if SIDE = 'R' +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE, TRANS + INTEGER INFO, K, LDA, LDC, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX*16 ONE + PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) +* .. +* .. Local Scalars .. + LOGICAL LEFT, NOTRAN + INTEGER I, I1, I2, I3, MI, NI, NQ + COMPLEX*16 AII, TAUI +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZLARF +* .. +* .. Intrinsic Functions .. + INTRINSIC DCONJG, MAX +* .. +* .. Executable Statements .. +* +* Test the input arguments +* + INFO = 0 + LEFT = LSAME( SIDE, 'L' ) + NOTRAN = LSAME( TRANS, 'N' ) +* +* NQ is the order of Q +* + IF( LEFT ) THEN + NQ = M + ELSE + NQ = N + END IF + IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN + INFO = -1 + ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + INFO = -2 + ELSE IF( M.LT.0 ) THEN + INFO = -3 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN + INFO = -5 + ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN + INFO = -7 + ELSE IF( LDC.LT.MAX( 1, M ) ) THEN + INFO = -10 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZUNM2L', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) + $ RETURN +* + IF( ( LEFT .AND. NOTRAN .OR. .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN + I1 = 1 + I2 = K + I3 = 1 + ELSE + I1 = K + I2 = 1 + I3 = -1 + END IF +* + IF( LEFT ) THEN + NI = N + ELSE + MI = M + END IF +* + DO 10 I = I1, I2, I3 + IF( LEFT ) THEN +* +* H(i) or H(i)**H is applied to C(1:m-k+i,1:n) +* + MI = M - K + I + ELSE +* +* H(i) or H(i)**H is applied to C(1:m,1:n-k+i) +* + NI = N - K + I + END IF +* +* Apply H(i) or H(i)**H +* + IF( NOTRAN ) THEN + TAUI = TAU( I ) + ELSE + TAUI = DCONJG( TAU( I ) ) + END IF + AII = A( NQ-K+I, I ) + A( NQ-K+I, I ) = ONE + CALL ZLARF( SIDE, MI, NI, A( 1, I ), 1, TAUI, C, LDC, WORK ) + A( NQ-K+I, I ) = AII + 10 CONTINUE + RETURN +* +* End of ZUNM2L +* + END diff --git a/lib/linalg/zunm2r.f b/lib/linalg/zunm2r.f new file mode 100644 index 0000000000..aec5a8bcae --- /dev/null +++ b/lib/linalg/zunm2r.f @@ -0,0 +1,283 @@ +*> \brief \b ZUNM2R multiplies a general matrix by the unitary matrix from a QR factorization determined by cgeqrf (unblocked algorithm). +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZUNM2R + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, +* WORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE, TRANS +* INTEGER INFO, K, LDA, LDC, M, N +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZUNM2R overwrites the general complex m-by-n matrix C with +*> +*> Q * C if SIDE = 'L' and TRANS = 'N', or +*> +*> Q**H* C if SIDE = 'L' and TRANS = 'C', or +*> +*> C * Q if SIDE = 'R' and TRANS = 'N', or +*> +*> C * Q**H if SIDE = 'R' and TRANS = 'C', +*> +*> where Q is a complex unitary matrix defined as the product of k +*> elementary reflectors +*> +*> Q = H(1) H(2) . . . H(k) +*> +*> as returned by ZGEQRF. Q is of order m if SIDE = 'L' and of order n +*> if SIDE = 'R'. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': apply Q or Q**H from the Left +*> = 'R': apply Q or Q**H from the Right +*> \endverbatim +*> +*> \param[in] TRANS +*> \verbatim +*> TRANS is CHARACTER*1 +*> = 'N': apply Q (No transpose) +*> = 'C': apply Q**H (Conjugate transpose) +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. N >= 0. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> The number of elementary reflectors whose product defines +*> the matrix Q. +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA,K) +*> The i-th column must contain the vector which defines the +*> elementary reflector H(i), for i = 1,2,...,k, as returned by +*> ZGEQRF in the first k columns of its array argument A. +*> A is modified by the routine but restored on exit. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. +*> If SIDE = 'L', LDA >= max(1,M); +*> if SIDE = 'R', LDA >= max(1,N). +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX*16 array, dimension (K) +*> TAU(i) must contain the scalar factor of the elementary +*> reflector H(i), as returned by ZGEQRF. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension (LDC,N) +*> On entry, the m-by-n matrix C. +*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension +*> (N) if SIDE = 'L', +*> (M) if SIDE = 'R' +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE, TRANS + INTEGER INFO, K, LDA, LDC, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX*16 ONE + PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) +* .. +* .. Local Scalars .. + LOGICAL LEFT, NOTRAN + INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ + COMPLEX*16 AII, TAUI +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZLARF +* .. +* .. Intrinsic Functions .. + INTRINSIC DCONJG, MAX +* .. +* .. Executable Statements .. +* +* Test the input arguments +* + INFO = 0 + LEFT = LSAME( SIDE, 'L' ) + NOTRAN = LSAME( TRANS, 'N' ) +* +* NQ is the order of Q +* + IF( LEFT ) THEN + NQ = M + ELSE + NQ = N + END IF + IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN + INFO = -1 + ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + INFO = -2 + ELSE IF( M.LT.0 ) THEN + INFO = -3 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN + INFO = -5 + ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN + INFO = -7 + ELSE IF( LDC.LT.MAX( 1, M ) ) THEN + INFO = -10 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZUNM2R', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) + $ RETURN +* + IF( ( LEFT .AND. .NOT.NOTRAN .OR. .NOT.LEFT .AND. NOTRAN ) ) THEN + I1 = 1 + I2 = K + I3 = 1 + ELSE + I1 = K + I2 = 1 + I3 = -1 + END IF +* + IF( LEFT ) THEN + NI = N + JC = 1 + ELSE + MI = M + IC = 1 + END IF +* + DO 10 I = I1, I2, I3 + IF( LEFT ) THEN +* +* H(i) or H(i)**H is applied to C(i:m,1:n) +* + MI = M - I + 1 + IC = I + ELSE +* +* H(i) or H(i)**H is applied to C(1:m,i:n) +* + NI = N - I + 1 + JC = I + END IF +* +* Apply H(i) or H(i)**H +* + IF( NOTRAN ) THEN + TAUI = TAU( I ) + ELSE + TAUI = DCONJG( TAU( I ) ) + END IF + AII = A( I, I ) + A( I, I ) = ONE + CALL ZLARF( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ), LDC, + $ WORK ) + A( I, I ) = AII + 10 CONTINUE + RETURN +* +* End of ZUNM2R +* + END diff --git a/lib/linalg/zunmql.f b/lib/linalg/zunmql.f new file mode 100644 index 0000000000..06353a0c75 --- /dev/null +++ b/lib/linalg/zunmql.f @@ -0,0 +1,336 @@ +*> \brief \b ZUNMQL +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZUNMQL + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZUNMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, +* WORK, LWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE, TRANS +* INTEGER INFO, K, LDA, LDC, LWORK, M, N +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZUNMQL overwrites the general complex M-by-N matrix C with +*> +*> SIDE = 'L' SIDE = 'R' +*> TRANS = 'N': Q * C C * Q +*> TRANS = 'C': Q**H * C C * Q**H +*> +*> where Q is a complex unitary matrix defined as the product of k +*> elementary reflectors +*> +*> Q = H(k) . . . H(2) H(1) +*> +*> as returned by ZGEQLF. Q is of order M if SIDE = 'L' and of order N +*> if SIDE = 'R'. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': apply Q or Q**H from the Left; +*> = 'R': apply Q or Q**H from the Right. +*> \endverbatim +*> +*> \param[in] TRANS +*> \verbatim +*> TRANS is CHARACTER*1 +*> = 'N': No transpose, apply Q; +*> = 'C': Conjugate transpose, apply Q**H. +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. N >= 0. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> The number of elementary reflectors whose product defines +*> the matrix Q. +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA,K) +*> The i-th column must contain the vector which defines the +*> elementary reflector H(i), for i = 1,2,...,k, as returned by +*> ZGEQLF in the last k columns of its array argument A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. +*> If SIDE = 'L', LDA >= max(1,M); +*> if SIDE = 'R', LDA >= max(1,N). +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX*16 array, dimension (K) +*> TAU(i) must contain the scalar factor of the elementary +*> reflector H(i), as returned by ZGEQLF. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension (LDC,N) +*> On entry, the M-by-N matrix C. +*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of the array WORK. +*> If SIDE = 'L', LWORK >= max(1,N); +*> if SIDE = 'R', LWORK >= max(1,M). +*> For good performance, LWORK should generally be larger. +*> +*> If LWORK = -1, then a workspace query is assumed; the routine +*> only calculates the optimal size of the WORK array, returns +*> this value as the first entry of the WORK array, and no error +*> message related to LWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZUNMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, LWORK, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE, TRANS + INTEGER INFO, K, LDA, LDC, LWORK, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + INTEGER NBMAX, LDT, TSIZE + PARAMETER ( NBMAX = 64, LDT = NBMAX+1, + $ TSIZE = LDT*NBMAX ) +* .. +* .. Local Scalars .. + LOGICAL LEFT, LQUERY, NOTRAN + INTEGER I, I1, I2, I3, IB, IINFO, IWT, LDWORK, LWKOPT, + $ MI, NB, NBMIN, NI, NQ, NW +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAENV + EXTERNAL LSAME, ILAENV +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZLARFB, ZLARFT, ZUNM2L +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input arguments +* + INFO = 0 + LEFT = LSAME( SIDE, 'L' ) + NOTRAN = LSAME( TRANS, 'N' ) + LQUERY = ( LWORK.EQ.-1 ) +* +* NQ is the order of Q and NW is the minimum dimension of WORK +* + IF( LEFT ) THEN + NQ = M + NW = MAX( 1, N ) + ELSE + NQ = N + NW = MAX( 1, M ) + END IF + IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN + INFO = -1 + ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + INFO = -2 + ELSE IF( M.LT.0 ) THEN + INFO = -3 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN + INFO = -5 + ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN + INFO = -7 + ELSE IF( LDC.LT.MAX( 1, M ) ) THEN + INFO = -10 + ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN + INFO = -12 + END IF +* + IF( INFO.EQ.0 ) THEN +* +* Compute the workspace requirements +* + IF( M.EQ.0 .OR. N.EQ.0 ) THEN + LWKOPT = 1 + ELSE + NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQL', SIDE // TRANS, M, N, + $ K, -1 ) ) + LWKOPT = NW*NB + TSIZE + END IF + WORK( 1 ) = LWKOPT + END IF +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZUNMQL', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible +* + IF( M.EQ.0 .OR. N.EQ.0 ) THEN + RETURN + END IF +* + NBMIN = 2 + LDWORK = NW + IF( NB.GT.1 .AND. NB.LT.K ) THEN + IF( LWORK.LT.LWKOPT ) THEN + NB = (LWORK-TSIZE) / LDWORK + NBMIN = MAX( 2, ILAENV( 2, 'ZUNMQL', SIDE // TRANS, M, N, K, + $ -1 ) ) + END IF + END IF +* + IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN +* +* Use unblocked code +* + CALL ZUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + $ IINFO ) + ELSE +* +* Use blocked code +* + IWT = 1 + NW*NB + IF( ( LEFT .AND. NOTRAN ) .OR. + $ ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN + I1 = 1 + I2 = K + I3 = NB + ELSE + I1 = ( ( K-1 ) / NB )*NB + 1 + I2 = 1 + I3 = -NB + END IF +* + IF( LEFT ) THEN + NI = N + ELSE + MI = M + END IF +* + DO 10 I = I1, I2, I3 + IB = MIN( NB, K-I+1 ) +* +* Form the triangular factor of the block reflector +* H = H(i+ib-1) . . . H(i+1) H(i) +* + CALL ZLARFT( 'Backward', 'Columnwise', NQ-K+I+IB-1, IB, + $ A( 1, I ), LDA, TAU( I ), WORK( IWT ), LDT ) + IF( LEFT ) THEN +* +* H or H**H is applied to C(1:m-k+i+ib-1,1:n) +* + MI = M - K + I + IB - 1 + ELSE +* +* H or H**H is applied to C(1:m,1:n-k+i+ib-1) +* + NI = N - K + I + IB - 1 + END IF +* +* Apply H or H**H +* + CALL ZLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, NI, + $ IB, A( 1, I ), LDA, WORK( IWT ), LDT, C, LDC, + $ WORK, LDWORK ) + 10 CONTINUE + END IF + WORK( 1 ) = LWKOPT + RETURN +* +* End of ZUNMQL +* + END diff --git a/lib/linalg/zunmqr.f b/lib/linalg/zunmqr.f new file mode 100644 index 0000000000..2ae205f4fd --- /dev/null +++ b/lib/linalg/zunmqr.f @@ -0,0 +1,337 @@ +*> \brief \b ZUNMQR +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZUNMQR + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, +* WORK, LWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE, TRANS +* INTEGER INFO, K, LDA, LDC, LWORK, M, N +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZUNMQR overwrites the general complex M-by-N matrix C with +*> +*> SIDE = 'L' SIDE = 'R' +*> TRANS = 'N': Q * C C * Q +*> TRANS = 'C': Q**H * C C * Q**H +*> +*> where Q is a complex unitary matrix defined as the product of k +*> elementary reflectors +*> +*> Q = H(1) H(2) . . . H(k) +*> +*> as returned by ZGEQRF. Q is of order M if SIDE = 'L' and of order N +*> if SIDE = 'R'. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': apply Q or Q**H from the Left; +*> = 'R': apply Q or Q**H from the Right. +*> \endverbatim +*> +*> \param[in] TRANS +*> \verbatim +*> TRANS is CHARACTER*1 +*> = 'N': No transpose, apply Q; +*> = 'C': Conjugate transpose, apply Q**H. +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. N >= 0. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> The number of elementary reflectors whose product defines +*> the matrix Q. +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA,K) +*> The i-th column must contain the vector which defines the +*> elementary reflector H(i), for i = 1,2,...,k, as returned by +*> ZGEQRF in the first k columns of its array argument A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. +*> If SIDE = 'L', LDA >= max(1,M); +*> if SIDE = 'R', LDA >= max(1,N). +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX*16 array, dimension (K) +*> TAU(i) must contain the scalar factor of the elementary +*> reflector H(i), as returned by ZGEQRF. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension (LDC,N) +*> On entry, the M-by-N matrix C. +*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of the array WORK. +*> If SIDE = 'L', LWORK >= max(1,N); +*> if SIDE = 'R', LWORK >= max(1,M). +*> For good performance, LWORK should generally be larger. +*> +*> If LWORK = -1, then a workspace query is assumed; the routine +*> only calculates the optimal size of the WORK array, returns +*> this value as the first entry of the WORK array, and no error +*> message related to LWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, LWORK, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE, TRANS + INTEGER INFO, K, LDA, LDC, LWORK, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + INTEGER NBMAX, LDT, TSIZE + PARAMETER ( NBMAX = 64, LDT = NBMAX+1, + $ TSIZE = LDT*NBMAX ) +* .. +* .. Local Scalars .. + LOGICAL LEFT, LQUERY, NOTRAN + INTEGER I, I1, I2, I3, IB, IC, IINFO, IWT, JC, LDWORK, + $ LWKOPT, MI, NB, NBMIN, NI, NQ, NW +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAENV + EXTERNAL LSAME, ILAENV +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZLARFB, ZLARFT, ZUNM2R +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input arguments +* + INFO = 0 + LEFT = LSAME( SIDE, 'L' ) + NOTRAN = LSAME( TRANS, 'N' ) + LQUERY = ( LWORK.EQ.-1 ) +* +* NQ is the order of Q and NW is the minimum dimension of WORK +* + IF( LEFT ) THEN + NQ = M + NW = MAX( 1, N ) + ELSE + NQ = N + NW = MAX( 1, M ) + END IF + IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN + INFO = -1 + ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + INFO = -2 + ELSE IF( M.LT.0 ) THEN + INFO = -3 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN + INFO = -5 + ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN + INFO = -7 + ELSE IF( LDC.LT.MAX( 1, M ) ) THEN + INFO = -10 + ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN + INFO = -12 + END IF +* + IF( INFO.EQ.0 ) THEN +* +* Compute the workspace requirements +* + NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N, K, + $ -1 ) ) + LWKOPT = NW*NB + TSIZE + WORK( 1 ) = LWKOPT + END IF +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZUNMQR', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible +* + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN + WORK( 1 ) = 1 + RETURN + END IF +* + NBMIN = 2 + LDWORK = NW + IF( NB.GT.1 .AND. NB.LT.K ) THEN + IF( LWORK.LT.LWKOPT ) THEN + NB = (LWORK-TSIZE) / LDWORK + NBMIN = MAX( 2, ILAENV( 2, 'ZUNMQR', SIDE // TRANS, M, N, K, + $ -1 ) ) + END IF + END IF +* + IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN +* +* Use unblocked code +* + CALL ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + $ IINFO ) + ELSE +* +* Use blocked code +* + IWT = 1 + NW*NB + IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. + $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN + I1 = 1 + I2 = K + I3 = NB + ELSE + I1 = ( ( K-1 ) / NB )*NB + 1 + I2 = 1 + I3 = -NB + END IF +* + IF( LEFT ) THEN + NI = N + JC = 1 + ELSE + MI = M + IC = 1 + END IF +* + DO 10 I = I1, I2, I3 + IB = MIN( NB, K-I+1 ) +* +* Form the triangular factor of the block reflector +* H = H(i) H(i+1) . . . H(i+ib-1) +* + CALL ZLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ), + $ LDA, TAU( I ), WORK( IWT ), LDT ) + IF( LEFT ) THEN +* +* H or H**H is applied to C(i:m,1:n) +* + MI = M - I + 1 + IC = I + ELSE +* +* H or H**H is applied to C(1:m,i:n) +* + NI = N - I + 1 + JC = I + END IF +* +* Apply H or H**H +* + CALL ZLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI, + $ IB, A( I, I ), LDA, WORK( IWT ), LDT, + $ C( IC, JC ), LDC, WORK, LDWORK ) + 10 CONTINUE + END IF + WORK( 1 ) = LWKOPT + RETURN +* +* End of ZUNMQR +* + END diff --git a/lib/linalg/zunmtr.f b/lib/linalg/zunmtr.f new file mode 100644 index 0000000000..441a7c2bcc --- /dev/null +++ b/lib/linalg/zunmtr.f @@ -0,0 +1,307 @@ +*> \brief \b ZUNMTR +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZUNMTR + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, +* WORK, LWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE, TRANS, UPLO +* INTEGER INFO, LDA, LDC, LWORK, M, N +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZUNMTR overwrites the general complex M-by-N matrix C with +*> +*> SIDE = 'L' SIDE = 'R' +*> TRANS = 'N': Q * C C * Q +*> TRANS = 'C': Q**H * C C * Q**H +*> +*> where Q is a complex unitary matrix of order nq, with nq = m if +*> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of +*> nq-1 elementary reflectors, as returned by ZHETRD: +*> +*> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); +*> +*> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': apply Q or Q**H from the Left; +*> = 'R': apply Q or Q**H from the Right. +*> \endverbatim +*> +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> = 'U': Upper triangle of A contains elementary reflectors +*> from ZHETRD; +*> = 'L': Lower triangle of A contains elementary reflectors +*> from ZHETRD. +*> \endverbatim +*> +*> \param[in] TRANS +*> \verbatim +*> TRANS is CHARACTER*1 +*> = 'N': No transpose, apply Q; +*> = 'C': Conjugate transpose, apply Q**H. +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. N >= 0. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension +*> (LDA,M) if SIDE = 'L' +*> (LDA,N) if SIDE = 'R' +*> The vectors which define the elementary reflectors, as +*> returned by ZHETRD. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. +*> LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX*16 array, dimension +*> (M-1) if SIDE = 'L' +*> (N-1) if SIDE = 'R' +*> TAU(i) must contain the scalar factor of the elementary +*> reflector H(i), as returned by ZHETRD. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension (LDC,N) +*> On entry, the M-by-N matrix C. +*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of the array WORK. +*> If SIDE = 'L', LWORK >= max(1,N); +*> if SIDE = 'R', LWORK >= max(1,M). +*> For optimum performance LWORK >= N*NB if SIDE = 'L', and +*> LWORK >=M*NB if SIDE = 'R', where NB is the optimal +*> blocksize. +*> +*> If LWORK = -1, then a workspace query is assumed; the routine +*> only calculates the optimal size of the WORK array, returns +*> this value as the first entry of the WORK array, and no error +*> message related to LWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup complex16OTHERcomputational +* +* ===================================================================== + SUBROUTINE ZUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, + $ WORK, LWORK, INFO ) +* +* -- LAPACK computational routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE, TRANS, UPLO + INTEGER INFO, LDA, LDC, LWORK, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Local Scalars .. + LOGICAL LEFT, LQUERY, UPPER + INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAENV + EXTERNAL LSAME, ILAENV +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZUNMQL, ZUNMQR +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Executable Statements .. +* +* Test the input arguments +* + INFO = 0 + LEFT = LSAME( SIDE, 'L' ) + UPPER = LSAME( UPLO, 'U' ) + LQUERY = ( LWORK.EQ.-1 ) +* +* NQ is the order of Q and NW is the minimum dimension of WORK +* + IF( LEFT ) THEN + NQ = M + NW = MAX( 1, N ) + ELSE + NQ = N + NW = MAX( 1, M ) + END IF + IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN + INFO = -1 + ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + INFO = -2 + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) + $ THEN + INFO = -3 + ELSE IF( M.LT.0 ) THEN + INFO = -4 + ELSE IF( N.LT.0 ) THEN + INFO = -5 + ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN + INFO = -7 + ELSE IF( LDC.LT.MAX( 1, M ) ) THEN + INFO = -10 + ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN + INFO = -12 + END IF +* + IF( INFO.EQ.0 ) THEN + IF( UPPER ) THEN + IF( LEFT ) THEN + NB = ILAENV( 1, 'ZUNMQL', SIDE // TRANS, M-1, N, M-1, + $ -1 ) + ELSE + NB = ILAENV( 1, 'ZUNMQL', SIDE // TRANS, M, N-1, N-1, + $ -1 ) + END IF + ELSE + IF( LEFT ) THEN + NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M-1, N, M-1, + $ -1 ) + ELSE + NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N-1, N-1, + $ -1 ) + END IF + END IF + LWKOPT = NW*NB + WORK( 1 ) = LWKOPT + END IF +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZUNMTR', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible +* + IF( M.EQ.0 .OR. N.EQ.0 .OR. NQ.EQ.1 ) THEN + WORK( 1 ) = 1 + RETURN + END IF +* + IF( LEFT ) THEN + MI = M - 1 + NI = N + ELSE + MI = M + NI = N - 1 + END IF +* + IF( UPPER ) THEN +* +* Q was determined by a call to ZHETRD with UPLO = 'U' +* + CALL ZUNMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU, C, + $ LDC, WORK, LWORK, IINFO ) + ELSE +* +* Q was determined by a call to ZHETRD with UPLO = 'L' +* + IF( LEFT ) THEN + I1 = 2 + I2 = 1 + ELSE + I1 = 1 + I2 = 2 + END IF + CALL ZUNMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU, + $ C( I1, I2 ), LDC, WORK, LWORK, IINFO ) + END IF + WORK( 1 ) = LWKOPT + RETURN +* +* End of ZUNMTR +* + END From 1f4447d1cd4fa1db02f5e21036e37176c79029d4 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Thu, 21 Jul 2022 05:32:53 -0400 Subject: [PATCH 019/262] add USE_INTERNAL_LINALG to workaround passing BLAS/LAPACK settings to external projects --- cmake/CMakeLists.txt | 8 ++++--- cmake/Modules/Packages/LATTE.cmake | 5 ++-- doc/src/Build_extras.rst | 38 +++++++++++++++++++++++------- 3 files changed, 37 insertions(+), 14 deletions(-) diff --git a/cmake/CMakeLists.txt b/cmake/CMakeLists.txt index 669bff1533..d599a500c7 100644 --- a/cmake/CMakeLists.txt +++ b/cmake/CMakeLists.txt @@ -404,9 +404,11 @@ endif() if(PKG_MSCG OR PKG_ATC OR PKG_AWPMD OR PKG_ML-QUIP OR PKG_LATTE OR PKG_ELECTRODE) enable_language(C) - find_package(LAPACK) - find_package(BLAS) - if(NOT LAPACK_FOUND OR NOT BLAS_FOUND) + if (NOT USE_INTERNAL_LINALG) + find_package(LAPACK) + find_package(BLAS) + endif() + if(NOT LAPACK_FOUND OR NOT BLAS_FOUND OR USE_INTERNAL_LINALG) include(CheckGeneratorSupport) if(NOT CMAKE_GENERATOR_SUPPORT_FORTRAN) status(FATAL_ERROR "Cannot build internal linear algebra library as CMake build tool lacks Fortran support") diff --git a/cmake/Modules/Packages/LATTE.cmake b/cmake/Modules/Packages/LATTE.cmake index a96e850f7e..d7793fa257 100644 --- a/cmake/Modules/Packages/LATTE.cmake +++ b/cmake/Modules/Packages/LATTE.cmake @@ -23,8 +23,9 @@ if(DOWNLOAD_LATTE) # CMake cannot pass BLAS or LAPACK library variable to external project if they are a list list(LENGTH BLAS_LIBRARIES} NUM_BLAS) list(LENGTH LAPACK_LIBRARIES NUM_LAPACK) - if((NUM_BLAS GREATER 1) OR (NUM_LAPACK GREATER 1)) - message(FATAL_ERROR "Cannot compile downloaded LATTE library due to a technical limitation") + if((NUM_BLAS GREATER 1) OR (NUM_LAPACK GREATER 1) AND NOT USE_INTERNAL_LINALG) + message(FATAL_ERROR "Cannot compile downloaded LATTE library due to a technical limitation. " + "Try to configure LAMMPS with '-D USE_INTERNAL_LINALG=on' added as a workaround.") endif() include(ExternalProject) diff --git a/doc/src/Build_extras.rst b/doc/src/Build_extras.rst index 14d0e290aa..3dad393a52 100644 --- a/doc/src/Build_extras.rst +++ b/doc/src/Build_extras.rst @@ -788,8 +788,10 @@ library. .. code-block:: bash - -D DOWNLOAD_LATTE=value # download LATTE for build, value = no (default) or yes - -D LATTE_LIBRARY=path # LATTE library file (only needed if a custom location) + -D DOWNLOAD_LATTE=value # download LATTE for build, value = no (default) or yes + -D LATTE_LIBRARY=path # LATTE library file (only needed if a custom location) + -D USE_INTERNAL_LINALG=value # Use the internal linear algebra library instead of LAPACK + # value = no (default) or yes If ``DOWNLOAD_LATTE`` is set, the LATTE library will be downloaded and built inside the CMake build directory. If the LATTE library @@ -797,6 +799,13 @@ library. ``LATTE_LIBRARY`` is the filename (plus path) of the LATTE library file, not the directory the library file is in. + The LATTE library requires LAPACK (and BLAS) and CMake can identify + their locations and pass that info to the LATTE build script. But + on some systems this triggers a (current) limitation of CMake and + the configuration will fail. Try enabling ``USE_INTERNAL_LINALG`` in + those cases to use the bundled linear algebra library and work around + the limitation. + .. tab:: Traditional make You can download and build the LATTE library manually if you @@ -1913,14 +1922,25 @@ within CMake will download the non-commercial use version. .. code-block:: bash - -D DOWNLOAD_QUIP=value # download OpenKIM API v2 for build, value = no (default) or yes - -D QUIP_LIBRARY=path # path to libquip.a (only needed if a custom location) + -D DOWNLOAD_QUIP=value # download QUIP library for build, value = no (default) or yes + -D QUIP_LIBRARY=path # path to libquip.a (only needed if a custom location) + -D USE_INTERNAL_LINALG=value # Use the internal linear algebra library instead of LAPACK + # value = no (default) or yes - CMake will try to download and build the QUIP library from GitHub, if it is not - found on the local machine. This requires to have git installed. It will use the same compilers - and flags as used for compiling LAMMPS. Currently this is only supported for the GNU and the - Intel compilers. Set the ``QUIP_LIBRARY`` variable if you want to use a previously compiled - and installed QUIP library and CMake cannot find it. + CMake will try to download and build the QUIP library from GitHub, + if it is not found on the local machine. This requires to have git + installed. It will use the same compilers and flags as used for + compiling LAMMPS. Currently this is only supported for the GNU + and the Intel compilers. Set the ``QUIP_LIBRARY`` variable if you + want to use a previously compiled and installed QUIP library and + CMake cannot find it. + + The QUIP library requires LAPACK (and BLAS) and CMake can identify + their locations and pass that info to the QUIP build script. But + on some systems this triggers a (current) limitation of CMake and + the configuration will fail. Try enabling ``USE_INTERNAL_LINALG`` in + those cases to use the bundled linear algebra library and work around + the limitation. .. tab:: Traditional make From 11c46a6e9055a6c6b659b22a242e2ae102c92005 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Thu, 21 Jul 2022 08:19:39 -0400 Subject: [PATCH 020/262] correct dangling and inconsistent links to sphinx homepage and rst docs --- doc/src/Build_manual.rst | 24 ++++++++++-------------- doc/src/Modify_style.rst | 15 ++++++++------- 2 files changed, 18 insertions(+), 21 deletions(-) diff --git a/doc/src/Build_manual.rst b/doc/src/Build_manual.rst index 90633d0811..d91ac94be5 100644 --- a/doc/src/Build_manual.rst +++ b/doc/src/Build_manual.rst @@ -48,18 +48,15 @@ Build using GNU make The LAMMPS manual is written in `reStructuredText `_ format which can be translated to different output format using the `Sphinx -`_ document generator tool. It also incorporates programmer -documentation extracted from the LAMMPS C++ sources through the `Doxygen -`_ program. Currently the translation to HTML, PDF -(via LaTeX), ePUB (for many e-book readers) and MOBI (for Amazon Kindle -readers) are supported. For that to work a Python 3 interpreter, the -``doxygen`` tools and internet access to download additional files and -tools are required. This download is usually only required once or -after the documentation folder is returned to a pristine state with -``make clean-all``. - -.. _rst: https://docutils.readthedocs.io/en/sphinx-docs/user/rst/quickstart.html -.. _sphinx: https://www.sphinx-doc.org +`_ document generator tool. It also +incorporates programmer documentation extracted from the LAMMPS C++ +sources through the `Doxygen `_ program. Currently +the translation to HTML, PDF (via LaTeX), ePUB (for many e-book readers) +and MOBI (for Amazon Kindle readers) are supported. For that to work a +Python 3 interpreter, the ``doxygen`` tools and internet access to +download additional files and tools are required. This download is +usually only required once or after the documentation folder is returned +to a pristine state with ``make clean-all``. For the documentation build a python virtual environment is set up in the folder ``doc/docenv`` and various python packages are installed into @@ -252,6 +249,5 @@ manual with ``make spelling``. This requires `a library called enchant positives* (e.g. keywords, names, abbreviations) those can be added to the file ``lammps/doc/utils/sphinx-config/false_positives.txt``. -.. _rst: https://docutils.readthedocs.io/en/sphinx-docs/user/rst/quickstart.html - .. _lws: https://www.lammps.org +.. _rst: https://www.sphinx-doc.org/en/master/usage/restructuredtext/index.html diff --git a/doc/src/Modify_style.rst b/doc/src/Modify_style.rst index 2ed83ed7c6..9b394f23a9 100644 --- a/doc/src/Modify_style.rst +++ b/doc/src/Modify_style.rst @@ -100,13 +100,14 @@ Documentation (strict) Contributions that add new styles or commands or augment existing ones must include the corresponding new or modified documentation in -`ReStructuredText format `_ (.rst files in the ``doc/src/`` folder). The -documentation shall be written in American English and the .rst file -must use only ASCII characters so it can be cleanly translated to PDF -files (via `sphinx `_ and PDFLaTeX). Special characters may be included via -embedded math expression typeset in a LaTeX subset. +`ReStructuredText format `_ (.rst files in the ``doc/src/`` +folder). The documentation shall be written in American English and the +.rst file must use only ASCII characters so it can be cleanly translated +to PDF files (via `sphinx `_ and PDFLaTeX). +Special characters may be included via embedded math expression typeset +in a LaTeX subset. -.. _rst: https://docutils.readthedocs.io/en/sphinx-docs/user/rst/quickstart.html +.. _rst: https://www.sphinx-doc.org/en/master/usage/restructuredtext/index.html When adding new commands, they need to be integrated into the sphinx documentation system, and the corresponding command tables and lists @@ -133,7 +134,7 @@ error free completion of the HTML and PDF build will be performed and also a spell check, a check for correct anchors and labels, and a check for completeness of references all styles in their corresponding tables and lists is run. In case the spell check reports false positives they -can be added to the file doc/utils/sphinx-config/false_positives.txt +can be added to the file ``doc/utils/sphinx-config/false_positives.txt`` Contributions that add or modify the library interface or "public" APIs from the C++ code or the Fortran module must include suitable doxygen From c8cc2b1b24467a18482a07bf90962c3341316622 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Thu, 21 Jul 2022 08:41:44 -0400 Subject: [PATCH 021/262] update to LAPACK version 3.10.1 --- lib/linalg/dasum.f | 8 +++--- lib/linalg/daxpy.f | 8 +++--- lib/linalg/dbdsqr.f | 7 ++--- lib/linalg/dcabs1.f | 8 +++--- lib/linalg/dcopy.f | 8 +++--- lib/linalg/ddot.f | 8 +++--- lib/linalg/dgebd2.f | 5 +--- lib/linalg/dgebrd.f | 8 ++---- lib/linalg/dgecon.f | 5 +--- lib/linalg/dgelq2.f | 17 +++++++----- lib/linalg/dgelqf.f | 15 +++++++---- lib/linalg/dgelsd.f | 5 +--- lib/linalg/dgelss.f | 5 +--- lib/linalg/dgemm.f | 15 ++++------- lib/linalg/dgemv.f | 7 ++--- lib/linalg/dgeqr2.f | 18 ++++++++----- lib/linalg/dgeqrf.f | 34 ++++++++++++++++-------- lib/linalg/dger.f | 7 ++--- lib/linalg/dgesv.f | 5 +--- lib/linalg/dgesvd.f | 5 +--- lib/linalg/dgetf2.f | 5 +--- lib/linalg/dgetrf.f | 5 +--- lib/linalg/dgetrf2.f | 5 +--- lib/linalg/dgetri.f | 5 +--- lib/linalg/dgetrs.f | 5 +--- lib/linalg/disnan.f | 5 +--- lib/linalg/dlabad.f | 5 +--- lib/linalg/dlabrd.f | 5 +--- lib/linalg/dlacn2.f | 28 +++++++++++++------- lib/linalg/dlacpy.f | 5 +--- lib/linalg/dladiv.f | 13 +++------- lib/linalg/dlae2.f | 5 +--- lib/linalg/dlaed0.f | 7 ++--- lib/linalg/dlaed1.f | 7 ++--- lib/linalg/dlaed2.f | 7 ++--- lib/linalg/dlaed3.f | 7 ++--- lib/linalg/dlaed4.f | 9 +++---- lib/linalg/dlaed5.f | 9 +++---- lib/linalg/dlaed6.f | 7 ++--- lib/linalg/dlaed7.f | 7 ++--- lib/linalg/dlaed8.f | 7 ++--- lib/linalg/dlaed9.f | 7 ++--- lib/linalg/dlaeda.f | 7 ++--- lib/linalg/dlaev2.f | 5 +--- lib/linalg/dlaisnan.f | 5 +--- lib/linalg/dlals0.f | 5 +--- lib/linalg/dlalsa.f | 7 ++--- lib/linalg/dlalsd.f | 5 +--- lib/linalg/dlamrg.f | 5 +--- lib/linalg/dlange.f | 5 +--- lib/linalg/dlanst.f | 5 +--- lib/linalg/dlansy.f | 5 +--- lib/linalg/dlapy2.f | 15 ++++++----- lib/linalg/dlapy3.f | 15 ++++++----- lib/linalg/dlarf.f | 5 +--- lib/linalg/dlarfb.f | 7 +++-- lib/linalg/dlarfg.f | 7 ++--- lib/linalg/dlarft.f | 5 +--- lib/linalg/dlas2.f | 5 +--- lib/linalg/dlascl.f | 5 +--- lib/linalg/dlasd4.f | 5 +--- lib/linalg/dlasd5.f | 5 +--- lib/linalg/dlasd6.f | 5 +--- lib/linalg/dlasd7.f | 5 +--- lib/linalg/dlasd8.f | 5 +--- lib/linalg/dlasda.f | 5 +--- lib/linalg/dlasdq.f | 5 +--- lib/linalg/dlasdt.f | 5 +--- lib/linalg/dlaset.f | 5 +--- lib/linalg/dlasq1.f | 5 +--- lib/linalg/dlasq2.f | 20 +++++++++------ lib/linalg/dlasq3.f | 5 +--- lib/linalg/dlasq4.f | 5 +--- lib/linalg/dlasq5.f | 5 +--- lib/linalg/dlasq6.f | 5 +--- lib/linalg/dlasr.f | 7 ++--- lib/linalg/dlasrt.f | 5 +--- lib/linalg/dlasv2.f | 5 +--- lib/linalg/dlaswp.f | 5 +--- lib/linalg/dlatrd.f | 5 +--- lib/linalg/dlatrs.f | 5 +--- lib/linalg/dorg2l.f | 5 +--- lib/linalg/dorg2r.f | 5 +--- lib/linalg/dorgbr.f | 13 ++++------ lib/linalg/dorgl2.f | 5 +--- lib/linalg/dorglq.f | 5 +--- lib/linalg/dorgql.f | 5 +--- lib/linalg/dorgqr.f | 5 +--- lib/linalg/dorgtr.f | 5 +--- lib/linalg/dorm2l.f | 5 +--- lib/linalg/dorm2r.f | 5 +--- lib/linalg/dormbr.f | 13 ++++------ lib/linalg/dorml2.f | 5 +--- lib/linalg/dormlq.f | 15 +++++------ lib/linalg/dormql.f | 7 ++--- lib/linalg/dormqr.f | 15 +++++------ lib/linalg/dormtr.f | 13 ++++------ lib/linalg/dpotf2.f | 5 +--- lib/linalg/dpotrf.f | 5 +--- lib/linalg/dpotrf2.f | 5 +--- lib/linalg/drot.f | 8 +++--- lib/linalg/drscl.f | 7 ++--- lib/linalg/dscal.f | 8 +++--- lib/linalg/dstedc.f | 5 +--- lib/linalg/dsteqr.f | 5 +--- lib/linalg/dsterf.f | 5 +--- lib/linalg/dswap.f | 8 +++--- lib/linalg/dsyev.f | 5 +--- lib/linalg/dsyevd.f | 5 +--- lib/linalg/dsygs2.f | 5 +--- lib/linalg/dsygst.f | 5 +--- lib/linalg/dsygv.f | 5 +--- lib/linalg/dsygvd.f | 5 +--- lib/linalg/dsymm.f | 7 ++--- lib/linalg/dsymv.f | 7 ++--- lib/linalg/dsyr2.f | 7 ++--- lib/linalg/dsyr2k.f | 7 ++--- lib/linalg/dsyrk.f | 7 ++--- lib/linalg/dsytd2.f | 5 +--- lib/linalg/dsytrd.f | 5 +--- lib/linalg/dtrmm.f | 7 ++--- lib/linalg/dtrmv.f | 7 ++--- lib/linalg/dtrsm.f | 7 ++--- lib/linalg/dtrsv.f | 7 ++--- lib/linalg/dtrti2.f | 5 +--- lib/linalg/dtrtri.f | 5 +--- lib/linalg/idamax.f | 10 ++++---- lib/linalg/ieeeck.f | 5 +--- lib/linalg/iladlc.f | 5 +--- lib/linalg/iladlr.f | 5 +--- lib/linalg/ilaenv.f | 60 ++++++++++++++++++++++++++----------------- lib/linalg/ilazlc.f | 5 +--- lib/linalg/ilazlr.f | 5 +--- lib/linalg/iparmq.f | 37 ++++++++++++++++---------- lib/linalg/lsame.f | 5 +--- lib/linalg/xerbla.f | 5 +--- lib/linalg/zaxpy.f | 8 +++--- lib/linalg/zcopy.f | 8 +++--- lib/linalg/zdotc.f | 12 ++++----- lib/linalg/zdscal.f | 8 +++--- lib/linalg/zgemm.f | 14 +++------- lib/linalg/zgemv.f | 7 ++--- lib/linalg/zgerc.f | 7 ++--- lib/linalg/zheev.f | 7 ++--- lib/linalg/zheevd.f | 2 +- lib/linalg/zhemv.f | 7 ++--- lib/linalg/zher2.f | 7 ++--- lib/linalg/zher2k.f | 7 ++--- lib/linalg/zhetd2.f | 17 +++++------- lib/linalg/zhetrd.f | 9 +++---- lib/linalg/zhpr.f | 7 ++--- lib/linalg/zlacgv.f | 5 +--- lib/linalg/zladiv.f | 5 +--- lib/linalg/zlanhe.f | 5 +--- lib/linalg/zlarf.f | 5 +--- lib/linalg/zlarfb.f | 7 +++-- lib/linalg/zlarfg.f | 7 ++--- lib/linalg/zlarft.f | 5 +--- lib/linalg/zlascl.f | 5 +--- lib/linalg/zlaset.f | 5 +--- lib/linalg/zlasr.f | 5 +--- lib/linalg/zlatrd.f | 9 +++---- lib/linalg/zpptrf.f | 9 +++---- lib/linalg/zpptri.f | 7 ++--- lib/linalg/zscal.f | 8 +++--- lib/linalg/zsteqr.f | 5 +--- lib/linalg/zswap.f | 8 +++--- lib/linalg/ztpmv.f | 7 ++--- lib/linalg/ztpsv.f | 7 ++--- lib/linalg/ztptri.f | 5 +--- lib/linalg/ztrmm.f | 7 ++--- lib/linalg/ztrmv.f | 7 ++--- lib/linalg/zung2l.f | 5 +--- lib/linalg/zung2r.f | 5 +--- lib/linalg/zungl2.f | 5 +--- lib/linalg/zungql.f | 5 +--- lib/linalg/zungqr.f | 5 +--- lib/linalg/zungtr.f | 5 +--- 178 files changed, 471 insertions(+), 864 deletions(-) diff --git a/lib/linalg/dasum.f b/lib/linalg/dasum.f index cc5977f770..9a360b5acd 100644 --- a/lib/linalg/dasum.f +++ b/lib/linalg/dasum.f @@ -54,8 +54,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * *> \par Further Details: @@ -71,10 +69,9 @@ * ===================================================================== DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -128,4 +125,7 @@ END IF DASUM = DTEMP RETURN +* +* End of DASUM +* END diff --git a/lib/linalg/daxpy.f b/lib/linalg/daxpy.f index cb94fc1e0a..421f7c630b 100644 --- a/lib/linalg/daxpy.f +++ b/lib/linalg/daxpy.f @@ -73,8 +73,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * *> \par Further Details: @@ -89,10 +87,9 @@ * ===================================================================== SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION DA @@ -149,4 +146,7 @@ END DO END IF RETURN +* +* End of DAXPY +* END diff --git a/lib/linalg/dbdsqr.f b/lib/linalg/dbdsqr.f index 93db95e7a8..c220a5875d 100644 --- a/lib/linalg/dbdsqr.f +++ b/lib/linalg/dbdsqr.f @@ -166,7 +166,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (4*N) +*> WORK is DOUBLE PRECISION array, dimension (4*(N-1)) *> \endverbatim *> *> \param[out] INFO @@ -233,18 +233,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, $ LDU, C, LDC, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/dcabs1.f b/lib/linalg/dcabs1.f index d6d850ed0f..f6212a8595 100644 --- a/lib/linalg/dcabs1.f +++ b/lib/linalg/dcabs1.f @@ -40,17 +40,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * * ===================================================================== DOUBLE PRECISION FUNCTION DCABS1(Z) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 Z @@ -63,4 +60,7 @@ * DCABS1 = ABS(DBLE(Z)) + ABS(DIMAG(Z)) RETURN +* +* End of DCABS1 +* END diff --git a/lib/linalg/dcopy.f b/lib/linalg/dcopy.f index 27bc08582b..ded46c5ecf 100644 --- a/lib/linalg/dcopy.f +++ b/lib/linalg/dcopy.f @@ -66,8 +66,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * *> \par Further Details: @@ -82,10 +80,9 @@ * ===================================================================== SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -143,4 +140,7 @@ END DO END IF RETURN +* +* End of DCOPY +* END diff --git a/lib/linalg/ddot.f b/lib/linalg/ddot.f index 3d18695aab..683a04bd46 100644 --- a/lib/linalg/ddot.f +++ b/lib/linalg/ddot.f @@ -66,8 +66,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * *> \par Further Details: @@ -82,10 +80,9 @@ * ===================================================================== DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -145,4 +142,7 @@ END IF DDOT = DTEMP RETURN +* +* End of DDOT +* END diff --git a/lib/linalg/dgebd2.f b/lib/linalg/dgebd2.f index 2bec4e29c7..daaa187aff 100644 --- a/lib/linalg/dgebd2.f +++ b/lib/linalg/dgebd2.f @@ -132,8 +132,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup doubleGEcomputational * *> \par Further Details: @@ -189,10 +187,9 @@ * ===================================================================== SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lib/linalg/dgebrd.f b/lib/linalg/dgebrd.f index 957cf2e539..0f0d1651a7 100644 --- a/lib/linalg/dgebrd.f +++ b/lib/linalg/dgebrd.f @@ -147,8 +147,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup doubleGEcomputational * *> \par Further Details: @@ -205,10 +203,9 @@ SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N @@ -227,8 +224,7 @@ * .. Local Scalars .. LOGICAL LQUERY INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB, - $ NBMIN, NX - DOUBLE PRECISION WS + $ NBMIN, NX, WS * .. * .. External Subroutines .. EXTERNAL DGEBD2, DGEMM, DLABRD, XERBLA diff --git a/lib/linalg/dgecon.f b/lib/linalg/dgecon.f index be20bbcd2a..aa10dee9a2 100644 --- a/lib/linalg/dgecon.f +++ b/lib/linalg/dgecon.f @@ -116,18 +116,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * * ===================================================================== SUBROUTINE DGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER NORM diff --git a/lib/linalg/dgelq2.f b/lib/linalg/dgelq2.f index 04aa57fc19..9915c57d47 100644 --- a/lib/linalg/dgelq2.f +++ b/lib/linalg/dgelq2.f @@ -33,8 +33,16 @@ *> *> \verbatim *> -*> DGELQ2 computes an LQ factorization of a real m by n matrix A: -*> A = L * Q. +*> DGELQ2 computes an LQ factorization of a real m-by-n matrix A: +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a n-by-n orthogonal matrix; +*> L is a lower-triangular m-by-m matrix; +*> 0 is a m-by-(n-m) zero matrix, if m < n. +*> *> \endverbatim * * Arguments: @@ -96,8 +104,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * *> \par Further Details: @@ -121,10 +127,9 @@ * ===================================================================== SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lib/linalg/dgelqf.f b/lib/linalg/dgelqf.f index 834c47168f..ed3372f965 100644 --- a/lib/linalg/dgelqf.f +++ b/lib/linalg/dgelqf.f @@ -34,7 +34,15 @@ *> \verbatim *> *> DGELQF computes an LQ factorization of a real M-by-N matrix A: -*> A = L * Q. +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a N-by-N orthogonal matrix; +*> L is a lower-triangular M-by-M matrix; +*> 0 is a M-by-(N-M) zero matrix, if M < N. +*> *> \endverbatim * * Arguments: @@ -110,8 +118,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * *> \par Further Details: @@ -135,10 +141,9 @@ * ===================================================================== SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N diff --git a/lib/linalg/dgelsd.f b/lib/linalg/dgelsd.f index f2cfd63376..b3b3d8b2d3 100644 --- a/lib/linalg/dgelsd.f +++ b/lib/linalg/dgelsd.f @@ -194,8 +194,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup doubleGEsolve * *> \par Contributors: @@ -209,10 +207,9 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ WORK, LWORK, IWORK, INFO ) * -* -- LAPACK driver routine (version 3.7.1) -- +* -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK diff --git a/lib/linalg/dgelss.f b/lib/linalg/dgelss.f index 674a7ba784..8ed703fcf2 100644 --- a/lib/linalg/dgelss.f +++ b/lib/linalg/dgelss.f @@ -164,18 +164,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEsolve * * ===================================================================== SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ WORK, LWORK, INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK diff --git a/lib/linalg/dgemm.f b/lib/linalg/dgemm.f index 3a60ca4e73..8c1b4f2066 100644 --- a/lib/linalg/dgemm.f +++ b/lib/linalg/dgemm.f @@ -166,8 +166,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level3 * *> \par Further Details: @@ -187,10 +185,9 @@ * ===================================================================== SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -215,7 +212,7 @@ * .. * .. Local Scalars .. DOUBLE PRECISION TEMP - INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB + INTEGER I,INFO,J,L,NROWA,NROWB LOGICAL NOTA,NOTB * .. * .. Parameters .. @@ -224,17 +221,15 @@ * .. * * Set NOTA and NOTB as true if A and B respectively are not -* transposed and set NROWA, NCOLA and NROWB as the number of rows -* and columns of A and the number of rows of B respectively. +* transposed and set NROWA and NROWB as the number of rows of A +* and B respectively. * NOTA = LSAME(TRANSA,'N') NOTB = LSAME(TRANSB,'N') IF (NOTA) THEN NROWA = M - NCOLA = K ELSE NROWA = K - NCOLA = M END IF IF (NOTB) THEN NROWB = K @@ -379,6 +374,6 @@ * RETURN * -* End of DGEMM . +* End of DGEMM * END diff --git a/lib/linalg/dgemv.f b/lib/linalg/dgemv.f index 08e395b1cd..6625509b3a 100644 --- a/lib/linalg/dgemv.f +++ b/lib/linalg/dgemv.f @@ -134,8 +134,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level2 * *> \par Further Details: @@ -156,10 +154,9 @@ * ===================================================================== SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -325,6 +322,6 @@ * RETURN * -* End of DGEMV . +* End of DGEMV * END diff --git a/lib/linalg/dgeqr2.f b/lib/linalg/dgeqr2.f index c1e91e9bde..5791b3a915 100644 --- a/lib/linalg/dgeqr2.f +++ b/lib/linalg/dgeqr2.f @@ -33,8 +33,17 @@ *> *> \verbatim *> -*> DGEQR2 computes a QR factorization of a real m by n matrix A: -*> A = Q * R. +*> DGEQR2 computes a QR factorization of a real m-by-n matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a m-by-m orthogonal matrix; +*> R is an upper-triangular n-by-n matrix; +*> 0 is a (m-n)-by-n zero matrix, if m > n. +*> *> \endverbatim * * Arguments: @@ -96,8 +105,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * *> \par Further Details: @@ -121,10 +128,9 @@ * ===================================================================== SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lib/linalg/dgeqrf.f b/lib/linalg/dgeqrf.f index 83d7d8dd71..705e939286 100644 --- a/lib/linalg/dgeqrf.f +++ b/lib/linalg/dgeqrf.f @@ -34,7 +34,16 @@ *> \verbatim *> *> DGEQRF computes a QR factorization of a real M-by-N matrix A: -*> A = Q * R. +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix; +*> R is an upper-triangular N-by-N matrix; +*> 0 is a (M-N)-by-N zero matrix, if M > N. +*> *> \endverbatim * * Arguments: @@ -86,7 +95,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,N). +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise. *> For optimum performance LWORK >= N*NB, where NB is *> the optimal blocksize. *> @@ -111,8 +121,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * *> \par Further Details: @@ -136,10 +144,9 @@ * ===================================================================== SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N @@ -169,10 +176,9 @@ * * Test the input arguments * + K = MIN( M, N ) INFO = 0 NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 ) - LWKOPT = N*NB - WORK( 1 ) = LWKOPT LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -180,19 +186,25 @@ INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN - INFO = -7 + ELSE IF( .NOT.LQUERY ) THEN + IF( LWORK.LE.0 .OR. ( M.GT.0 .AND. LWORK.LT.MAX( 1, N ) ) ) + $ INFO = -7 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'DGEQRF', -INFO ) RETURN ELSE IF( LQUERY ) THEN + IF( K.EQ.0 ) THEN + LWKOPT = 1 + ELSE + LWKOPT = N*NB + END IF + WORK( 1 ) = LWKOPT RETURN END IF * * Quick return if possible * - K = MIN( M, N ) IF( K.EQ.0 ) THEN WORK( 1 ) = 1 RETURN diff --git a/lib/linalg/dger.f b/lib/linalg/dger.f index bdc8ef4349..8c19cb4e41 100644 --- a/lib/linalg/dger.f +++ b/lib/linalg/dger.f @@ -109,8 +109,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level2 * *> \par Further Details: @@ -130,10 +128,9 @@ * ===================================================================== SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -222,6 +219,6 @@ * RETURN * -* End of DGER . +* End of DGER * END diff --git a/lib/linalg/dgesv.f b/lib/linalg/dgesv.f index 23999e167f..3609c52f47 100644 --- a/lib/linalg/dgesv.f +++ b/lib/linalg/dgesv.f @@ -115,17 +115,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEsolve * * ===================================================================== SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDB, N, NRHS diff --git a/lib/linalg/dgesvd.f b/lib/linalg/dgesvd.f index ddf0bd5c2d..7cc8b35129 100644 --- a/lib/linalg/dgesvd.f +++ b/lib/linalg/dgesvd.f @@ -203,18 +203,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup doubleGEsing * * ===================================================================== SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, $ VT, LDVT, WORK, LWORK, INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * .. Scalar Arguments .. CHARACTER JOBU, JOBVT diff --git a/lib/linalg/dgetf2.f b/lib/linalg/dgetf2.f index 5458a5f3eb..fc1587842e 100644 --- a/lib/linalg/dgetf2.f +++ b/lib/linalg/dgetf2.f @@ -101,17 +101,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * * ===================================================================== SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lib/linalg/dgetrf.f b/lib/linalg/dgetrf.f index 9a340b60f3..73d0f3601a 100644 --- a/lib/linalg/dgetrf.f +++ b/lib/linalg/dgetrf.f @@ -101,17 +101,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * * ===================================================================== SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lib/linalg/dgetrf2.f b/lib/linalg/dgetrf2.f index 77948d2305..40af0793dd 100644 --- a/lib/linalg/dgetrf2.f +++ b/lib/linalg/dgetrf2.f @@ -106,17 +106,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup doubleGEcomputational * * ===================================================================== RECURSIVE SUBROUTINE DGETRF2( M, N, A, LDA, IPIV, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lib/linalg/dgetri.f b/lib/linalg/dgetri.f index 9d8cf2ad3e..92ef90c186 100644 --- a/lib/linalg/dgetri.f +++ b/lib/linalg/dgetri.f @@ -107,17 +107,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * * ===================================================================== SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, N diff --git a/lib/linalg/dgetrs.f b/lib/linalg/dgetrs.f index 7ac727776e..d3464f685a 100644 --- a/lib/linalg/dgetrs.f +++ b/lib/linalg/dgetrs.f @@ -114,17 +114,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEcomputational * * ===================================================================== SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER TRANS diff --git a/lib/linalg/disnan.f b/lib/linalg/disnan.f index a565ed36d4..e621b2589c 100644 --- a/lib/linalg/disnan.f +++ b/lib/linalg/disnan.f @@ -52,17 +52,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup OTHERauxiliary * * ===================================================================== LOGICAL FUNCTION DISNAN( DIN ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. DOUBLE PRECISION, INTENT(IN) :: DIN diff --git a/lib/linalg/dlabad.f b/lib/linalg/dlabad.f index 01b8158f66..95b35e53b8 100644 --- a/lib/linalg/dlabad.f +++ b/lib/linalg/dlabad.f @@ -67,17 +67,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== SUBROUTINE DLABAD( SMALL, LARGE ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION LARGE, SMALL diff --git a/lib/linalg/dlabrd.f b/lib/linalg/dlabrd.f index b5e734dc7c..86dfc10c7c 100644 --- a/lib/linalg/dlabrd.f +++ b/lib/linalg/dlabrd.f @@ -156,8 +156,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup doubleOTHERauxiliary * *> \par Further Details: @@ -210,10 +208,9 @@ SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, $ LDY ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER LDA, LDX, LDY, M, N, NB diff --git a/lib/linalg/dlacn2.f b/lib/linalg/dlacn2.f index 952854043a..ee2e7ca266 100644 --- a/lib/linalg/dlacn2.f +++ b/lib/linalg/dlacn2.f @@ -101,8 +101,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERauxiliary * *> \par Further Details: @@ -136,10 +134,9 @@ * ===================================================================== SUBROUTINE DLACN2( N, V, X, ISGN, EST, KASE, ISAVE ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER KASE, N @@ -160,7 +157,7 @@ * .. * .. Local Scalars .. INTEGER I, JLAST - DOUBLE PRECISION ALTSGN, ESTOLD, TEMP + DOUBLE PRECISION ALTSGN, ESTOLD, TEMP, XS * .. * .. External Functions .. INTEGER IDAMAX @@ -171,7 +168,7 @@ EXTERNAL DCOPY * .. * .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, NINT, SIGN + INTRINSIC ABS, DBLE, NINT * .. * .. Executable Statements .. * @@ -199,7 +196,11 @@ EST = DASUM( N, X, 1 ) * DO 30 I = 1, N - X( I ) = SIGN( ONE, X( I ) ) + IF( X(I).GE.ZERO ) THEN + X(I) = ONE + ELSE + X(I) = -ONE + END IF ISGN( I ) = NINT( X( I ) ) 30 CONTINUE KASE = 2 @@ -232,7 +233,12 @@ ESTOLD = EST EST = DASUM( N, V, 1 ) DO 80 I = 1, N - IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) ) + IF( X(I).GE.ZERO ) THEN + XS = ONE + ELSE + XS = -ONE + END IF + IF( NINT( XS ).NE.ISGN( I ) ) $ GO TO 90 80 CONTINUE * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED. @@ -244,7 +250,11 @@ $ GO TO 120 * DO 100 I = 1, N - X( I ) = SIGN( ONE, X( I ) ) + IF( X(I).GE.ZERO ) THEN + X(I) = ONE + ELSE + X(I) = -ONE + END IF ISGN( I ) = NINT( X( I ) ) 100 CONTINUE KASE = 2 diff --git a/lib/linalg/dlacpy.f b/lib/linalg/dlacpy.f index d1c396724a..917aa1e2a2 100644 --- a/lib/linalg/dlacpy.f +++ b/lib/linalg/dlacpy.f @@ -96,17 +96,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/dladiv.f b/lib/linalg/dladiv.f index dd8110adf2..4265618fed 100644 --- a/lib/linalg/dladiv.f +++ b/lib/linalg/dladiv.f @@ -84,17 +84,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date January 2013 -* *> \ingroup doubleOTHERauxiliary * * ===================================================================== SUBROUTINE DLADIV( A, B, C, D, P, Q ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* January 2013 * * .. Scalar Arguments .. DOUBLE PRECISION A, B, C, D, P, Q @@ -178,10 +175,9 @@ SUBROUTINE DLADIV1( A, B, C, D, P, Q ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* January 2013 * * .. Scalar Arguments .. DOUBLE PRECISION A, B, C, D, P, Q @@ -218,10 +214,9 @@ DOUBLE PRECISION FUNCTION DLADIV2( A, B, C, D, R, T ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* January 2013 * * .. Scalar Arguments .. DOUBLE PRECISION A, B, C, D, R, T @@ -251,6 +246,6 @@ * RETURN * -* End of DLADIV12 +* End of DLADIV2 * END diff --git a/lib/linalg/dlae2.f b/lib/linalg/dlae2.f index ed77ff6dfe..a0e3971b41 100644 --- a/lib/linalg/dlae2.f +++ b/lib/linalg/dlae2.f @@ -78,8 +78,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Further Details: @@ -102,10 +100,9 @@ * ===================================================================== SUBROUTINE DLAE2( A, B, C, RT1, RT2 ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION A, B, C, RT1, RT2 diff --git a/lib/linalg/dlaed0.f b/lib/linalg/dlaed0.f index 4e92da98ea..fe3b6249e9 100644 --- a/lib/linalg/dlaed0.f +++ b/lib/linalg/dlaed0.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED0 used by sstedc. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method. +*> \brief \b DLAED0 used by DSTEDC. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method. * * =========== DOCUMENTATION =========== * @@ -158,8 +158,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -172,10 +170,9 @@ SUBROUTINE DLAED0( ICOMPQ, QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, $ WORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER ICOMPQ, INFO, LDQ, LDQS, N, QSIZ diff --git a/lib/linalg/dlaed1.f b/lib/linalg/dlaed1.f index 30e71fa241..3718139c14 100644 --- a/lib/linalg/dlaed1.f +++ b/lib/linalg/dlaed1.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED1 used by sstedc. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is tridiagonal. +*> \brief \b DLAED1 used by DSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== * @@ -148,8 +148,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -163,10 +161,9 @@ SUBROUTINE DLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2016 * * .. Scalar Arguments .. INTEGER CUTPNT, INFO, LDQ, N diff --git a/lib/linalg/dlaed2.f b/lib/linalg/dlaed2.f index fbcc87a880..9b1f1e0930 100644 --- a/lib/linalg/dlaed2.f +++ b/lib/linalg/dlaed2.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED2 used by sstedc. Merges eigenvalues and deflates secular equation. Used when the original matrix is tridiagonal. +*> \brief \b DLAED2 used by DSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== * @@ -197,8 +197,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -212,10 +210,9 @@ SUBROUTINE DLAED2( K, N, N1, D, Q, LDQ, INDXQ, RHO, Z, DLAMDA, W, $ Q2, INDX, INDXC, INDXP, COLTYP, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, K, LDQ, N, N1 diff --git a/lib/linalg/dlaed3.f b/lib/linalg/dlaed3.f index d200fc0a22..c58944e604 100644 --- a/lib/linalg/dlaed3.f +++ b/lib/linalg/dlaed3.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED3 used by sstedc. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is tridiagonal. +*> \brief \b DLAED3 used by DSTEDC. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== * @@ -170,8 +170,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -185,10 +183,9 @@ SUBROUTINE DLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX, $ CTOT, W, S, INFO ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER INFO, K, LDQ, N, N1 diff --git a/lib/linalg/dlaed4.f b/lib/linalg/dlaed4.f index e7dc839df5..3ee3ef920f 100644 --- a/lib/linalg/dlaed4.f +++ b/lib/linalg/dlaed4.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED4 used by sstedc. Finds a single root of the secular equation. +*> \brief \b DLAED4 used by DSTEDC. Finds a single root of the secular equation. * * =========== DOCUMENTATION =========== * @@ -82,7 +82,7 @@ *> \param[out] DELTA *> \verbatim *> DELTA is DOUBLE PRECISION array, dimension (N) -*> If N .GT. 2, DELTA contains (D(j) - lambda_I) in its j-th +*> If N > 2, DELTA contains (D(j) - lambda_I) in its j-th *> component. If N = 1, then DELTA(1) = 1. If N = 2, see DLAED5 *> for detail. The vector DELTA contains the information necessary *> to construct the eigenvectors by DLAED3 and DLAED9. @@ -132,8 +132,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -145,10 +143,9 @@ * ===================================================================== SUBROUTINE DLAED4( N, I, D, Z, DELTA, RHO, DLAM, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER I, INFO, N diff --git a/lib/linalg/dlaed5.f b/lib/linalg/dlaed5.f index 3ea9e401cf..d9e977e6b7 100644 --- a/lib/linalg/dlaed5.f +++ b/lib/linalg/dlaed5.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED5 used by sstedc. Solves the 2-by-2 secular equation. +*> \brief \b DLAED5 used by DSTEDC. Solves the 2-by-2 secular equation. * * =========== DOCUMENTATION =========== * @@ -95,8 +95,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -108,10 +106,9 @@ * ===================================================================== SUBROUTINE DLAED5( I, D, Z, DELTA, RHO, DLAM ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER I @@ -184,6 +181,6 @@ END IF RETURN * -* End OF DLAED5 +* End of DLAED5 * END diff --git a/lib/linalg/dlaed6.f b/lib/linalg/dlaed6.f index daa8db39e4..a0c0364e56 100644 --- a/lib/linalg/dlaed6.f +++ b/lib/linalg/dlaed6.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED6 used by sstedc. Computes one Newton step in solution of the secular equation. +*> \brief \b DLAED6 used by DSTEDC. Computes one Newton step in solution of the secular equation. * * =========== DOCUMENTATION =========== * @@ -115,8 +115,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Further Details: @@ -140,10 +138,9 @@ * ===================================================================== SUBROUTINE DLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. LOGICAL ORGATI diff --git a/lib/linalg/dlaed7.f b/lib/linalg/dlaed7.f index 9c528added..d968c56752 100644 --- a/lib/linalg/dlaed7.f +++ b/lib/linalg/dlaed7.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED7 used by sstedc. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense. +*> \brief \b DLAED7 used by DSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== * @@ -244,8 +244,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -260,10 +258,9 @@ $ PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2016 * * .. Scalar Arguments .. INTEGER CURLVL, CURPBM, CUTPNT, ICOMPQ, INFO, LDQ, N, diff --git a/lib/linalg/dlaed8.f b/lib/linalg/dlaed8.f index f64679dc05..3631fb4566 100644 --- a/lib/linalg/dlaed8.f +++ b/lib/linalg/dlaed8.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED8 used by sstedc. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense. +*> \brief \b DLAED8 used by DSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== * @@ -228,8 +228,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -243,10 +241,9 @@ $ CUTPNT, Z, DLAMDA, Q2, LDQ2, W, PERM, GIVPTR, $ GIVCOL, GIVNUM, INDXP, INDX, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER CUTPNT, GIVPTR, ICOMPQ, INFO, K, LDQ, LDQ2, N, diff --git a/lib/linalg/dlaed9.f b/lib/linalg/dlaed9.f index d3be22502a..b88cdd9077 100644 --- a/lib/linalg/dlaed9.f +++ b/lib/linalg/dlaed9.f @@ -1,4 +1,4 @@ -*> \brief \b DLAED9 used by sstedc. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is dense. +*> \brief \b DLAED9 used by DSTEDC. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== * @@ -142,8 +142,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -156,10 +154,9 @@ SUBROUTINE DLAED9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W, $ S, LDS, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, K, KSTART, KSTOP, LDQ, LDS, N diff --git a/lib/linalg/dlaeda.f b/lib/linalg/dlaeda.f index 4ca08a0879..8864fd7f2a 100644 --- a/lib/linalg/dlaeda.f +++ b/lib/linalg/dlaeda.f @@ -1,4 +1,4 @@ -*> \brief \b DLAEDA used by sstedc. Computes the Z vector determining the rank-one modification of the diagonal matrix. Used when the original matrix is dense. +*> \brief \b DLAEDA used by DSTEDC. Computes the Z vector determining the rank-one modification of the diagonal matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== * @@ -152,8 +152,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -166,10 +164,9 @@ SUBROUTINE DLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR, $ GIVCOL, GIVNUM, Q, QPTR, Z, ZTEMP, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER CURLVL, CURPBM, INFO, N, TLVLS diff --git a/lib/linalg/dlaev2.f b/lib/linalg/dlaev2.f index 4906f1a20c..9e29991a6d 100644 --- a/lib/linalg/dlaev2.f +++ b/lib/linalg/dlaev2.f @@ -94,8 +94,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Further Details: @@ -120,10 +118,9 @@ * ===================================================================== SUBROUTINE DLAEV2( A, B, C, RT1, RT2, CS1, SN1 ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION A, B, C, CS1, RT1, RT2, SN1 diff --git a/lib/linalg/dlaisnan.f b/lib/linalg/dlaisnan.f index c2e87d88a0..2caf5fb1d0 100644 --- a/lib/linalg/dlaisnan.f +++ b/lib/linalg/dlaisnan.f @@ -67,17 +67,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup OTHERauxiliary * * ===================================================================== LOGICAL FUNCTION DLAISNAN( DIN1, DIN2 ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. DOUBLE PRECISION, INTENT(IN) :: DIN1, DIN2 diff --git a/lib/linalg/dlals0.f b/lib/linalg/dlals0.f index d4cff166d6..cfca222806 100644 --- a/lib/linalg/dlals0.f +++ b/lib/linalg/dlals0.f @@ -252,8 +252,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * *> \par Contributors: @@ -268,10 +266,9 @@ $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, $ POLES, DIFL, DIFR, Z, K, C, S, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER GIVPTR, ICOMPQ, INFO, K, LDB, LDBX, LDGCOL, diff --git a/lib/linalg/dlalsa.f b/lib/linalg/dlalsa.f index 478ee24b0e..da8e0fa175 100644 --- a/lib/linalg/dlalsa.f +++ b/lib/linalg/dlalsa.f @@ -43,7 +43,7 @@ *> *> \verbatim *> -*> DLALSA is an intermediate step in solving the least squares problem +*> DLALSA is an itermediate step in solving the least squares problem *> by computing the SVD of the coefficient matrix in compact form (The *> singular vectors are computed as products of simple orthorgonal *> matrices.). @@ -250,8 +250,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup doubleOTHERcomputational * *> \par Contributors: @@ -267,10 +265,9 @@ $ GIVCOL, LDGCOL, PERM, GIVNUM, C, S, WORK, $ IWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER ICOMPQ, INFO, LDB, LDBX, LDGCOL, LDU, N, NRHS, diff --git a/lib/linalg/dlalsd.f b/lib/linalg/dlalsd.f index 510e0455a6..d22c45dc6e 100644 --- a/lib/linalg/dlalsd.f +++ b/lib/linalg/dlalsd.f @@ -164,8 +164,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * *> \par Contributors: @@ -179,10 +177,9 @@ SUBROUTINE DLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, $ RANK, WORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/dlamrg.f b/lib/linalg/dlamrg.f index de19508e45..80bd354b97 100644 --- a/lib/linalg/dlamrg.f +++ b/lib/linalg/dlamrg.f @@ -92,17 +92,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DLAMRG( N1, N2, A, DTRD1, DTRD2, INDEX ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2016 * * .. Scalar Arguments .. INTEGER DTRD1, DTRD2, N1, N2 diff --git a/lib/linalg/dlange.f b/lib/linalg/dlange.f index 9dbf45e818..9d214cb542 100644 --- a/lib/linalg/dlange.f +++ b/lib/linalg/dlange.f @@ -107,17 +107,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleGEauxiliary * * ===================================================================== DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, WORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER NORM diff --git a/lib/linalg/dlanst.f b/lib/linalg/dlanst.f index e952e2dd21..c5bc7ea038 100644 --- a/lib/linalg/dlanst.f +++ b/lib/linalg/dlanst.f @@ -93,17 +93,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== DOUBLE PRECISION FUNCTION DLANST( NORM, N, D, E ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER NORM diff --git a/lib/linalg/dlansy.f b/lib/linalg/dlansy.f index 2372fce0a8..949c5535a2 100644 --- a/lib/linalg/dlansy.f +++ b/lib/linalg/dlansy.f @@ -115,17 +115,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYauxiliary * * ===================================================================== DOUBLE PRECISION FUNCTION DLANSY( NORM, UPLO, N, A, LDA, WORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER NORM, UPLO diff --git a/lib/linalg/dlapy2.f b/lib/linalg/dlapy2.f index bc01829a24..1f63193bb7 100644 --- a/lib/linalg/dlapy2.f +++ b/lib/linalg/dlapy2.f @@ -31,7 +31,7 @@ *> \verbatim *> *> DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary -*> overflow. +*> overflow and unnecessary underflow. *> \endverbatim * * Arguments: @@ -56,17 +56,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup OTHERauxiliary * * ===================================================================== DOUBLE PRECISION FUNCTION DLAPY2( X, Y ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. DOUBLE PRECISION X, Y @@ -81,13 +78,16 @@ PARAMETER ( ONE = 1.0D0 ) * .. * .. Local Scalars .. - DOUBLE PRECISION W, XABS, YABS, Z + DOUBLE PRECISION W, XABS, YABS, Z, HUGEVAL LOGICAL X_IS_NAN, Y_IS_NAN * .. * .. External Functions .. LOGICAL DISNAN EXTERNAL DISNAN * .. +* .. External Subroutines .. + DOUBLE PRECISION DLAMCH +* .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT * .. @@ -97,13 +97,14 @@ Y_IS_NAN = DISNAN( Y ) IF ( X_IS_NAN ) DLAPY2 = X IF ( Y_IS_NAN ) DLAPY2 = Y + HUGEVAL = DLAMCH( 'Overflow' ) * IF ( .NOT.( X_IS_NAN.OR.Y_IS_NAN ) ) THEN XABS = ABS( X ) YABS = ABS( Y ) W = MAX( XABS, YABS ) Z = MIN( XABS, YABS ) - IF( Z.EQ.ZERO ) THEN + IF( Z.EQ.ZERO .OR. W.GT.HUGEVAL ) THEN DLAPY2 = W ELSE DLAPY2 = W*SQRT( ONE+( Z / W )**2 ) diff --git a/lib/linalg/dlapy3.f b/lib/linalg/dlapy3.f index 3bbba88875..230a65cdb2 100644 --- a/lib/linalg/dlapy3.f +++ b/lib/linalg/dlapy3.f @@ -31,7 +31,7 @@ *> \verbatim *> *> DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause -*> unnecessary overflow. +*> unnecessary overflow and unnecessary underflow. *> \endverbatim * * Arguments: @@ -61,17 +61,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION X, Y, Z @@ -84,18 +81,22 @@ PARAMETER ( ZERO = 0.0D0 ) * .. * .. Local Scalars .. - DOUBLE PRECISION W, XABS, YABS, ZABS + DOUBLE PRECISION W, XABS, YABS, ZABS, HUGEVAL +* .. +* .. External Subroutines .. + DOUBLE PRECISION DLAMCH * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT * .. * .. Executable Statements .. * + HUGEVAL = DLAMCH( 'Overflow' ) XABS = ABS( X ) YABS = ABS( Y ) ZABS = ABS( Z ) W = MAX( XABS, YABS, ZABS ) - IF( W.EQ.ZERO ) THEN + IF( W.EQ.ZERO .OR. W.GT.HUGEVAL ) THEN * W can be zero for max(0,nan,0) * adding all three entries together will make sure * NaN will not disappear. diff --git a/lib/linalg/dlarf.f b/lib/linalg/dlarf.f index e99d0bb2a9..ed21638645 100644 --- a/lib/linalg/dlarf.f +++ b/lib/linalg/dlarf.f @@ -117,17 +117,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERauxiliary * * ===================================================================== SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER SIDE diff --git a/lib/linalg/dlarfb.f b/lib/linalg/dlarfb.f index 5b2cc2ba80..a3fa083b43 100644 --- a/lib/linalg/dlarfb.f +++ b/lib/linalg/dlarfb.f @@ -92,6 +92,8 @@ *> K is INTEGER *> The order of the matrix T (= the number of elementary *> reflectors whose product defines the block reflector). +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. *> \endverbatim *> *> \param[in] V @@ -159,8 +161,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2013 -* *> \ingroup doubleOTHERauxiliary * *> \par Further Details: @@ -195,10 +195,9 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, $ T, LDT, C, LDC, WORK, LDWORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2013 * * .. Scalar Arguments .. CHARACTER DIRECT, SIDE, STOREV, TRANS diff --git a/lib/linalg/dlarfg.f b/lib/linalg/dlarfg.f index cb177a5703..9bfb45a6b0 100644 --- a/lib/linalg/dlarfg.f +++ b/lib/linalg/dlarfg.f @@ -99,17 +99,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERauxiliary * * ===================================================================== SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX, N @@ -170,7 +167,7 @@ CALL DSCAL( N-1, RSAFMN, X, INCX ) BETA = BETA*RSAFMN ALPHA = ALPHA*RSAFMN - IF( ABS( BETA ).LT.SAFMIN ) + IF( (ABS( BETA ).LT.SAFMIN) .AND. (KNT .LT. 20) ) $ GO TO 10 * * New BETA is at most 1, at least SAFMIN diff --git a/lib/linalg/dlarft.f b/lib/linalg/dlarft.f index e69a6b792e..a8d9de61f1 100644 --- a/lib/linalg/dlarft.f +++ b/lib/linalg/dlarft.f @@ -130,8 +130,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERauxiliary * *> \par Further Details: @@ -163,10 +161,9 @@ * ===================================================================== SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER DIRECT, STOREV diff --git a/lib/linalg/dlas2.f b/lib/linalg/dlas2.f index 83873bc612..ea929e86f7 100644 --- a/lib/linalg/dlas2.f +++ b/lib/linalg/dlas2.f @@ -78,8 +78,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Further Details: @@ -107,10 +105,9 @@ * ===================================================================== SUBROUTINE DLAS2( F, G, H, SSMIN, SSMAX ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION F, G, H, SSMAX, SSMIN diff --git a/lib/linalg/dlascl.f b/lib/linalg/dlascl.f index 03e1000a87..05ad1c4f3c 100644 --- a/lib/linalg/dlascl.f +++ b/lib/linalg/dlascl.f @@ -136,17 +136,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2016 * * .. Scalar Arguments .. CHARACTER TYPE diff --git a/lib/linalg/dlasd4.f b/lib/linalg/dlasd4.f index 8b4a8762c8..acfd896b3b 100644 --- a/lib/linalg/dlasd4.f +++ b/lib/linalg/dlasd4.f @@ -140,8 +140,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -153,10 +151,9 @@ * ===================================================================== SUBROUTINE DLASD4( N, I, D, Z, DELTA, RHO, SIGMA, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER I, INFO, N diff --git a/lib/linalg/dlasd5.f b/lib/linalg/dlasd5.f index 4896ba6b97..645c2fdc3e 100644 --- a/lib/linalg/dlasd5.f +++ b/lib/linalg/dlasd5.f @@ -103,8 +103,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -116,10 +114,9 @@ * ===================================================================== SUBROUTINE DLASD5( I, D, Z, DELTA, RHO, DSIGMA, WORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER I diff --git a/lib/linalg/dlasd6.f b/lib/linalg/dlasd6.f index 5cab78a070..51e67588dd 100644 --- a/lib/linalg/dlasd6.f +++ b/lib/linalg/dlasd6.f @@ -297,8 +297,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -313,10 +311,9 @@ $ LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK, $ IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2016 * * .. Scalar Arguments .. INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL, diff --git a/lib/linalg/dlasd7.f b/lib/linalg/dlasd7.f index 66f665cf88..ff9ba4c36a 100644 --- a/lib/linalg/dlasd7.f +++ b/lib/linalg/dlasd7.f @@ -264,8 +264,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -280,10 +278,9 @@ $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, $ C, S, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL, diff --git a/lib/linalg/dlasd8.f b/lib/linalg/dlasd8.f index fc5c48c528..a769bdb22e 100644 --- a/lib/linalg/dlasd8.f +++ b/lib/linalg/dlasd8.f @@ -152,8 +152,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -166,10 +164,9 @@ SUBROUTINE DLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR, $ DSIGMA, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER ICOMPQ, INFO, K, LDDIFR diff --git a/lib/linalg/dlasda.f b/lib/linalg/dlasda.f index f41a108b80..3e169a4edb 100644 --- a/lib/linalg/dlasda.f +++ b/lib/linalg/dlasda.f @@ -258,8 +258,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -273,10 +271,9 @@ $ DIFL, DIFR, Z, POLES, GIVPTR, GIVCOL, LDGCOL, $ PERM, GIVNUM, C, S, WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER ICOMPQ, INFO, LDGCOL, LDU, N, SMLSIZ, SQRE diff --git a/lib/linalg/dlasdq.f b/lib/linalg/dlasdq.f index e7d3575a98..0c39b24f0d 100644 --- a/lib/linalg/dlasdq.f +++ b/lib/linalg/dlasdq.f @@ -197,8 +197,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -211,10 +209,9 @@ SUBROUTINE DLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, $ U, LDU, C, LDC, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/dlasdt.f b/lib/linalg/dlasdt.f index 37da2d035e..0d9999ea62 100644 --- a/lib/linalg/dlasdt.f +++ b/lib/linalg/dlasdt.f @@ -92,8 +92,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Contributors: @@ -105,10 +103,9 @@ * ===================================================================== SUBROUTINE DLASDT( N, LVL, ND, INODE, NDIML, NDIMR, MSUB ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER LVL, MSUB, N, ND diff --git a/lib/linalg/dlaset.f b/lib/linalg/dlaset.f index 3a0c469a3c..625c757b6b 100644 --- a/lib/linalg/dlaset.f +++ b/lib/linalg/dlaset.f @@ -103,17 +103,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/dlasq1.f b/lib/linalg/dlasq1.f index 468676eebd..27fa30736e 100644 --- a/lib/linalg/dlasq1.f +++ b/lib/linalg/dlasq1.f @@ -101,17 +101,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DLASQ1( N, D, E, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, N diff --git a/lib/linalg/dlasq2.f b/lib/linalg/dlasq2.f index 68d9228704..608ca7a619 100644 --- a/lib/linalg/dlasq2.f +++ b/lib/linalg/dlasq2.f @@ -95,8 +95,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * *> \par Further Details: @@ -112,10 +110,9 @@ * ===================================================================== SUBROUTINE DLASQ2( N, Z, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, N @@ -184,10 +181,18 @@ * * 2-by-2 case. * - IF( Z( 2 ).LT.ZERO .OR. Z( 3 ).LT.ZERO ) THEN - INFO = -2 + IF( Z( 1 ).LT.ZERO ) THEN + INFO = -201 CALL XERBLA( 'DLASQ2', 2 ) RETURN + ELSE IF( Z( 2 ).LT.ZERO ) THEN + INFO = -202 + CALL XERBLA( 'DLASQ2', 2 ) + RETURN + ELSE IF( Z( 3 ).LT.ZERO ) THEN + INFO = -203 + CALL XERBLA( 'DLASQ2', 2 ) + RETURN ELSE IF( Z( 3 ).GT.Z( 1 ) ) THEN D = Z( 3 ) Z( 3 ) = Z( 1 ) @@ -267,8 +272,7 @@ * * Check whether the machine is IEEE conformable. * - IEEE = ILAENV( 10, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 .AND. - $ ILAENV( 11, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 + IEEE = ( ILAENV( 10, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 ) * * Rearrange data for locality: Z=(q1,qq1,e1,ee1,q2,qq2,e2,ee2,...). * diff --git a/lib/linalg/dlasq3.f b/lib/linalg/dlasq3.f index c095bdbbb5..e4bdafe06e 100644 --- a/lib/linalg/dlasq3.f +++ b/lib/linalg/dlasq3.f @@ -173,8 +173,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup auxOTHERcomputational * * ===================================================================== @@ -182,10 +180,9 @@ $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1, $ DN2, G, TAU ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2016 * * .. Scalar Arguments .. LOGICAL IEEE diff --git a/lib/linalg/dlasq4.f b/lib/linalg/dlasq4.f index d4ddbbc7b2..2652ddb2ba 100644 --- a/lib/linalg/dlasq4.f +++ b/lib/linalg/dlasq4.f @@ -135,8 +135,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup auxOTHERcomputational * *> \par Further Details: @@ -151,10 +149,9 @@ SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, $ DN1, DN2, TAU, TTYPE, G ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2016 * * .. Scalar Arguments .. INTEGER I0, N0, N0IN, PP, TTYPE diff --git a/lib/linalg/dlasq5.f b/lib/linalg/dlasq5.f index 3812c879fa..5679ab60a5 100644 --- a/lib/linalg/dlasq5.f +++ b/lib/linalg/dlasq5.f @@ -136,18 +136,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2, $ DN, DNM1, DNM2, IEEE, EPS ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. LOGICAL IEEE diff --git a/lib/linalg/dlasq6.f b/lib/linalg/dlasq6.f index d871386bdb..9218b5060e 100644 --- a/lib/linalg/dlasq6.f +++ b/lib/linalg/dlasq6.f @@ -111,18 +111,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, $ DNM1, DNM2 ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER I0, N0, PP diff --git a/lib/linalg/dlasr.f b/lib/linalg/dlasr.f index 6059c6293a..dd0cedd85e 100644 --- a/lib/linalg/dlasr.f +++ b/lib/linalg/dlasr.f @@ -175,7 +175,7 @@ *> \verbatim *> A is DOUBLE PRECISION array, dimension (LDA,N) *> The M-by-N matrix A. On exit, A is overwritten by P*A if -*> SIDE = 'R' or by A*P**T if SIDE = 'L'. +*> SIDE = 'L' or by A*P**T if SIDE = 'R'. *> \endverbatim *> *> \param[in] LDA @@ -192,17 +192,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER DIRECT, PIVOT, SIDE diff --git a/lib/linalg/dlasrt.f b/lib/linalg/dlasrt.f index 4705311d78..d789239e3d 100644 --- a/lib/linalg/dlasrt.f +++ b/lib/linalg/dlasrt.f @@ -81,17 +81,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DLASRT( ID, N, D, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2016 * * .. Scalar Arguments .. CHARACTER ID diff --git a/lib/linalg/dlasv2.f b/lib/linalg/dlasv2.f index 9371d6d3b2..64a06dee1a 100644 --- a/lib/linalg/dlasv2.f +++ b/lib/linalg/dlasv2.f @@ -107,8 +107,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Further Details: @@ -138,10 +136,9 @@ * ===================================================================== SUBROUTINE DLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN diff --git a/lib/linalg/dlaswp.f b/lib/linalg/dlaswp.f index 202fd8df1b..b35729a205 100644 --- a/lib/linalg/dlaswp.f +++ b/lib/linalg/dlaswp.f @@ -99,8 +99,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup doubleOTHERauxiliary * *> \par Further Details: @@ -115,10 +113,9 @@ * ===================================================================== SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER INCX, K1, K2, LDA, N diff --git a/lib/linalg/dlatrd.f b/lib/linalg/dlatrd.f index a1df43e48a..010a85a212 100644 --- a/lib/linalg/dlatrd.f +++ b/lib/linalg/dlatrd.f @@ -139,8 +139,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERauxiliary * *> \par Further Details: @@ -198,10 +196,9 @@ * ===================================================================== SUBROUTINE DLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/dlatrs.f b/lib/linalg/dlatrs.f index 5ad5f66c55..43f92911d7 100644 --- a/lib/linalg/dlatrs.f +++ b/lib/linalg/dlatrs.f @@ -158,8 +158,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERauxiliary * *> \par Further Details: @@ -238,10 +236,9 @@ SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, $ CNORM, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER DIAG, NORMIN, TRANS, UPLO diff --git a/lib/linalg/dorg2l.f b/lib/linalg/dorg2l.f index 36ff4e5d4b..0a42d4cf5a 100644 --- a/lib/linalg/dorg2l.f +++ b/lib/linalg/dorg2l.f @@ -107,17 +107,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, K, LDA, M, N diff --git a/lib/linalg/dorg2r.f b/lib/linalg/dorg2r.f index 4b71011a9f..c64ad4b0ac 100644 --- a/lib/linalg/dorg2r.f +++ b/lib/linalg/dorg2r.f @@ -107,17 +107,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, K, LDA, M, N diff --git a/lib/linalg/dorgbr.f b/lib/linalg/dorgbr.f index cfebda5abd..1b242ff97f 100644 --- a/lib/linalg/dorgbr.f +++ b/lib/linalg/dorgbr.f @@ -150,17 +150,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 -* *> \ingroup doubleGBcomputational * * ===================================================================== SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 * * .. Scalar Arguments .. CHARACTER VECT @@ -221,8 +218,8 @@ CALL DORGQR( M, N, K, A, LDA, TAU, WORK, -1, IINFO ) ELSE IF( M.GT.1 ) THEN - CALL DORGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK, - $ -1, IINFO ) + CALL DORGQR( M-1, M-1, M-1, A, LDA, TAU, WORK, -1, + $ IINFO ) END IF END IF ELSE @@ -230,8 +227,8 @@ CALL DORGLQ( M, N, K, A, LDA, TAU, WORK, -1, IINFO ) ELSE IF( N.GT.1 ) THEN - CALL DORGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK, - $ -1, IINFO ) + CALL DORGLQ( N-1, N-1, N-1, A, LDA, TAU, WORK, -1, + $ IINFO ) END IF END IF END IF diff --git a/lib/linalg/dorgl2.f b/lib/linalg/dorgl2.f index 5d8985d758..ce1d2c6750 100644 --- a/lib/linalg/dorgl2.f +++ b/lib/linalg/dorgl2.f @@ -106,17 +106,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, K, LDA, M, N diff --git a/lib/linalg/dorglq.f b/lib/linalg/dorglq.f index 912b5de84e..8c37c18b75 100644 --- a/lib/linalg/dorglq.f +++ b/lib/linalg/dorglq.f @@ -120,17 +120,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, K, LDA, LWORK, M, N diff --git a/lib/linalg/dorgql.f b/lib/linalg/dorgql.f index ea12be91b1..45e5bf19f1 100644 --- a/lib/linalg/dorgql.f +++ b/lib/linalg/dorgql.f @@ -121,17 +121,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, K, LDA, LWORK, M, N diff --git a/lib/linalg/dorgqr.f b/lib/linalg/dorgqr.f index 628eeacba7..a41ce7ed56 100644 --- a/lib/linalg/dorgqr.f +++ b/lib/linalg/dorgqr.f @@ -121,17 +121,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, K, LDA, LWORK, M, N diff --git a/lib/linalg/dorgtr.f b/lib/linalg/dorgtr.f index 72623eac06..0a0ab15a78 100644 --- a/lib/linalg/dorgtr.f +++ b/lib/linalg/dorgtr.f @@ -116,17 +116,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/dorm2l.f b/lib/linalg/dorm2l.f index 1014cb2378..c99039c541 100644 --- a/lib/linalg/dorm2l.f +++ b/lib/linalg/dorm2l.f @@ -151,18 +151,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, $ WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER SIDE, TRANS diff --git a/lib/linalg/dorm2r.f b/lib/linalg/dorm2r.f index 632b70e740..ac88eec8dc 100644 --- a/lib/linalg/dorm2r.f +++ b/lib/linalg/dorm2r.f @@ -151,18 +151,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, $ WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER SIDE, TRANS diff --git a/lib/linalg/dormbr.f b/lib/linalg/dormbr.f index f035d0ae66..86abb10072 100644 --- a/lib/linalg/dormbr.f +++ b/lib/linalg/dormbr.f @@ -187,18 +187,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, $ LDC, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER SIDE, TRANS, VECT @@ -240,10 +237,10 @@ * IF( LEFT ) THEN NQ = M - NW = N + NW = MAX( 1, N ) ELSE NQ = N - NW = M + NW = MAX( 1, M ) END IF IF( .NOT.APPLYQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN INFO = -1 @@ -263,7 +260,7 @@ INFO = -8 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -11 - ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN INFO = -13 END IF * @@ -285,7 +282,7 @@ $ -1 ) END IF END IF - LWKOPT = MAX( 1, NW )*NB + LWKOPT = NW*NB WORK( 1 ) = LWKOPT END IF * diff --git a/lib/linalg/dorml2.f b/lib/linalg/dorml2.f index 2c55c7f1fd..a9ddd460d8 100644 --- a/lib/linalg/dorml2.f +++ b/lib/linalg/dorml2.f @@ -151,18 +151,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, $ WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER SIDE, TRANS diff --git a/lib/linalg/dormlq.f b/lib/linalg/dormlq.f index bb5469d273..ef039285ab 100644 --- a/lib/linalg/dormlq.f +++ b/lib/linalg/dormlq.f @@ -159,18 +159,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, $ WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER SIDE, TRANS @@ -217,10 +214,10 @@ * IF( LEFT ) THEN NQ = M - NW = N + NW = MAX( 1, N ) ELSE NQ = N - NW = M + NW = MAX( 1, M ) END IF IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 @@ -236,7 +233,7 @@ INFO = -7 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -10 - ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN INFO = -12 END IF * @@ -246,7 +243,7 @@ * NB = MIN( NBMAX, ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N, K, $ -1 ) ) - LWKOPT = MAX( 1, NW )*NB + TSIZE + LWKOPT = NW*NB + TSIZE WORK( 1 ) = LWKOPT END IF * @@ -267,7 +264,7 @@ NBMIN = 2 LDWORK = NW IF( NB.GT.1 .AND. NB.LT.K ) THEN - IF( LWORK.LT.NW*NB+TSIZE ) THEN + IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK NBMIN = MAX( 2, ILAENV( 2, 'DORMLQ', SIDE // TRANS, M, N, K, $ -1 ) ) diff --git a/lib/linalg/dormql.f b/lib/linalg/dormql.f index 7d2b5d6c32..7c9f189e0d 100644 --- a/lib/linalg/dormql.f +++ b/lib/linalg/dormql.f @@ -159,18 +159,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, $ WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER SIDE, TRANS @@ -269,7 +266,7 @@ NBMIN = 2 LDWORK = NW IF( NB.GT.1 .AND. NB.LT.K ) THEN - IF( LWORK.LT.NW*NB+TSIZE ) THEN + IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK NBMIN = MAX( 2, ILAENV( 2, 'DORMQL', SIDE // TRANS, M, N, K, $ -1 ) ) diff --git a/lib/linalg/dormqr.f b/lib/linalg/dormqr.f index 7f2ebb9ace..4d0bae3a5f 100644 --- a/lib/linalg/dormqr.f +++ b/lib/linalg/dormqr.f @@ -159,18 +159,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, $ WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER SIDE, TRANS @@ -216,10 +213,10 @@ * IF( LEFT ) THEN NQ = M - NW = N + NW = MAX( 1, N ) ELSE NQ = N - NW = M + NW = MAX( 1, M ) END IF IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 @@ -235,7 +232,7 @@ INFO = -7 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -10 - ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN INFO = -12 END IF * @@ -245,7 +242,7 @@ * NB = MIN( NBMAX, ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N, K, $ -1 ) ) - LWKOPT = MAX( 1, NW )*NB + TSIZE + LWKOPT = NW*NB + TSIZE WORK( 1 ) = LWKOPT END IF * @@ -266,7 +263,7 @@ NBMIN = 2 LDWORK = NW IF( NB.GT.1 .AND. NB.LT.K ) THEN - IF( LWORK.LT.NW*NB+TSIZE ) THEN + IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK NBMIN = MAX( 2, ILAENV( 2, 'DORMQR', SIDE // TRANS, M, N, K, $ -1 ) ) diff --git a/lib/linalg/dormtr.f b/lib/linalg/dormtr.f index d2443c1dac..1f664d63cc 100644 --- a/lib/linalg/dormtr.f +++ b/lib/linalg/dormtr.f @@ -163,18 +163,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, $ WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER SIDE, TRANS, UPLO @@ -214,10 +211,10 @@ * IF( LEFT ) THEN NQ = M - NW = N + NW = MAX( 1, N ) ELSE NQ = N - NW = M + NW = MAX( 1, M ) END IF IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 @@ -234,7 +231,7 @@ INFO = -7 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -10 - ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN INFO = -12 END IF * @@ -256,7 +253,7 @@ $ -1 ) END IF END IF - LWKOPT = MAX( 1, NW )*NB + LWKOPT = NW*NB WORK( 1 ) = LWKOPT END IF * diff --git a/lib/linalg/dpotf2.f b/lib/linalg/dpotf2.f index 1fb60a903b..08fa4957fd 100644 --- a/lib/linalg/dpotf2.f +++ b/lib/linalg/dpotf2.f @@ -102,17 +102,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doublePOcomputational * * ===================================================================== SUBROUTINE DPOTF2( UPLO, N, A, LDA, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/dpotrf.f b/lib/linalg/dpotrf.f index 1fa75a4654..1679fc3cd8 100644 --- a/lib/linalg/dpotrf.f +++ b/lib/linalg/dpotrf.f @@ -100,17 +100,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doublePOcomputational * * ===================================================================== SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/dpotrf2.f b/lib/linalg/dpotrf2.f index 0d419c4f00..6c28ce6d67 100644 --- a/lib/linalg/dpotrf2.f +++ b/lib/linalg/dpotrf2.f @@ -99,17 +99,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doublePOcomputational * * ===================================================================== RECURSIVE SUBROUTINE DPOTRF2( UPLO, N, A, LDA, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/drot.f b/lib/linalg/drot.f index 0d33ea76c8..0386626c8f 100644 --- a/lib/linalg/drot.f +++ b/lib/linalg/drot.f @@ -76,8 +76,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * *> \par Further Details: @@ -92,10 +90,9 @@ * ===================================================================== SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION C,S @@ -139,4 +136,7 @@ END DO END IF RETURN +* +* End of DROT +* END diff --git a/lib/linalg/drscl.f b/lib/linalg/drscl.f index 9251143680..fcd8569650 100644 --- a/lib/linalg/drscl.f +++ b/lib/linalg/drscl.f @@ -77,17 +77,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERauxiliary * * ===================================================================== SUBROUTINE DRSCL( N, SA, SX, INCX ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX, N @@ -112,7 +109,7 @@ EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DSCAL + EXTERNAL DSCAL, DLABAD * .. * .. Intrinsic Functions .. INTRINSIC ABS diff --git a/lib/linalg/dscal.f b/lib/linalg/dscal.f index e0a92de6ba..3713427334 100644 --- a/lib/linalg/dscal.f +++ b/lib/linalg/dscal.f @@ -62,8 +62,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * *> \par Further Details: @@ -79,10 +77,9 @@ * ===================================================================== SUBROUTINE DSCAL(N,DA,DX,INCX) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION DA @@ -133,4 +130,7 @@ END DO END IF RETURN +* +* End of DSCAL +* END diff --git a/lib/linalg/dstedc.f b/lib/linalg/dstedc.f index 61b44bc06b..2ed84afaac 100644 --- a/lib/linalg/dstedc.f +++ b/lib/linalg/dstedc.f @@ -173,8 +173,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup auxOTHERcomputational * *> \par Contributors: @@ -188,10 +186,9 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. CHARACTER COMPZ diff --git a/lib/linalg/dsteqr.f b/lib/linalg/dsteqr.f index c34a548984..50a9188c7c 100644 --- a/lib/linalg/dsteqr.f +++ b/lib/linalg/dsteqr.f @@ -124,17 +124,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER COMPZ diff --git a/lib/linalg/dsterf.f b/lib/linalg/dsterf.f index 3401894819..b0f8d36084 100644 --- a/lib/linalg/dsterf.f +++ b/lib/linalg/dsterf.f @@ -79,17 +79,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DSTERF( N, D, E, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, N diff --git a/lib/linalg/dswap.f b/lib/linalg/dswap.f index 94dfea3bb9..b7600aa2d4 100644 --- a/lib/linalg/dswap.f +++ b/lib/linalg/dswap.f @@ -66,8 +66,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * *> \par Further Details: @@ -82,10 +80,9 @@ * ===================================================================== SUBROUTINE DSWAP(N,DX,INCX,DY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -150,4 +147,7 @@ END DO END IF RETURN +* +* End of DSWAP +* END diff --git a/lib/linalg/dsyev.f b/lib/linalg/dsyev.f index ee8c479abe..da7557ee02 100644 --- a/lib/linalg/dsyev.f +++ b/lib/linalg/dsyev.f @@ -125,17 +125,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYeigen * * ===================================================================== SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, UPLO diff --git a/lib/linalg/dsyevd.f b/lib/linalg/dsyevd.f index 2db67846dc..edbe896fe8 100644 --- a/lib/linalg/dsyevd.f +++ b/lib/linalg/dsyevd.f @@ -167,8 +167,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYeigen * *> \par Contributors: @@ -185,10 +183,9 @@ SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, UPLO diff --git a/lib/linalg/dsygs2.f b/lib/linalg/dsygs2.f index a54955c01e..8a39bea77e 100644 --- a/lib/linalg/dsygs2.f +++ b/lib/linalg/dsygs2.f @@ -120,17 +120,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYcomputational * * ===================================================================== SUBROUTINE DSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/dsygst.f b/lib/linalg/dsygst.f index 5055acdf1d..05b90372ab 100644 --- a/lib/linalg/dsygst.f +++ b/lib/linalg/dsygst.f @@ -120,17 +120,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYcomputational * * ===================================================================== SUBROUTINE DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/dsygv.f b/lib/linalg/dsygv.f index 651abc5c7b..5208dbb1f1 100644 --- a/lib/linalg/dsygv.f +++ b/lib/linalg/dsygv.f @@ -167,18 +167,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYeigen * * ===================================================================== SUBROUTINE DSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, $ LWORK, INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, UPLO diff --git a/lib/linalg/dsygvd.f b/lib/linalg/dsygvd.f index 29c78283a7..61134bedce 100644 --- a/lib/linalg/dsygvd.f +++ b/lib/linalg/dsygvd.f @@ -203,8 +203,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYeigen * *> \par Further Details: @@ -227,10 +225,9 @@ SUBROUTINE DSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, $ LWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, UPLO diff --git a/lib/linalg/dsymm.f b/lib/linalg/dsymm.f index 622d2469f1..683e79f6ad 100644 --- a/lib/linalg/dsymm.f +++ b/lib/linalg/dsymm.f @@ -168,8 +168,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level3 * *> \par Further Details: @@ -189,10 +187,9 @@ * ===================================================================== SUBROUTINE DSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -362,6 +359,6 @@ * RETURN * -* End of DSYMM . +* End of DSYMM * END diff --git a/lib/linalg/dsymv.f b/lib/linalg/dsymv.f index 4bf973f10a..17310d7c62 100644 --- a/lib/linalg/dsymv.f +++ b/lib/linalg/dsymv.f @@ -130,8 +130,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level2 * *> \par Further Details: @@ -152,10 +150,9 @@ * ===================================================================== SUBROUTINE DSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -328,6 +325,6 @@ * RETURN * -* End of DSYMV . +* End of DSYMV * END diff --git a/lib/linalg/dsyr2.f b/lib/linalg/dsyr2.f index 8970c4dcfd..4bad19b96b 100644 --- a/lib/linalg/dsyr2.f +++ b/lib/linalg/dsyr2.f @@ -126,8 +126,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level2 * *> \par Further Details: @@ -147,10 +145,9 @@ * ===================================================================== SUBROUTINE DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -293,6 +290,6 @@ * RETURN * -* End of DSYR2 . +* End of DSYR2 * END diff --git a/lib/linalg/dsyr2k.f b/lib/linalg/dsyr2k.f index f3a5940c7f..f5d16e0854 100644 --- a/lib/linalg/dsyr2k.f +++ b/lib/linalg/dsyr2k.f @@ -170,8 +170,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level3 * *> \par Further Details: @@ -192,10 +190,9 @@ * ===================================================================== SUBROUTINE DSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -394,6 +391,6 @@ * RETURN * -* End of DSYR2K. +* End of DSYR2K * END diff --git a/lib/linalg/dsyrk.f b/lib/linalg/dsyrk.f index 4be4d8d3c4..0548c0ce2f 100644 --- a/lib/linalg/dsyrk.f +++ b/lib/linalg/dsyrk.f @@ -148,8 +148,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level3 * *> \par Further Details: @@ -169,10 +167,9 @@ * ===================================================================== SUBROUTINE DSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA,BETA @@ -359,6 +356,6 @@ * RETURN * -* End of DSYRK . +* End of DSYRK * END diff --git a/lib/linalg/dsytd2.f b/lib/linalg/dsytd2.f index 6fb4d5507e..977b6daa41 100644 --- a/lib/linalg/dsytd2.f +++ b/lib/linalg/dsytd2.f @@ -120,8 +120,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYcomputational * *> \par Further Details: @@ -173,10 +171,9 @@ * ===================================================================== SUBROUTINE DSYTD2( UPLO, N, A, LDA, D, E, TAU, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/dsytrd.f b/lib/linalg/dsytrd.f index d330b241fa..3dcfc3db2b 100644 --- a/lib/linalg/dsytrd.f +++ b/lib/linalg/dsytrd.f @@ -139,8 +139,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleSYcomputational * *> \par Further Details: @@ -192,10 +190,9 @@ * ===================================================================== SUBROUTINE DSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/dtrmm.f b/lib/linalg/dtrmm.f index 0241c4d146..b2cc0a1fa8 100644 --- a/lib/linalg/dtrmm.f +++ b/lib/linalg/dtrmm.f @@ -156,8 +156,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level3 * *> \par Further Details: @@ -177,10 +175,9 @@ * ===================================================================== SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -410,6 +407,6 @@ * RETURN * -* End of DTRMM . +* End of DTRMM * END diff --git a/lib/linalg/dtrmv.f b/lib/linalg/dtrmv.f index 11c12ac724..e8af8e6136 100644 --- a/lib/linalg/dtrmv.f +++ b/lib/linalg/dtrmv.f @@ -125,8 +125,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level2 * *> \par Further Details: @@ -147,10 +145,9 @@ * ===================================================================== SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,LDA,N @@ -337,6 +334,6 @@ * RETURN * -* End of DTRMV . +* End of DTRMV * END diff --git a/lib/linalg/dtrsm.f b/lib/linalg/dtrsm.f index 5a92bcafd0..fa8080bc92 100644 --- a/lib/linalg/dtrsm.f +++ b/lib/linalg/dtrsm.f @@ -159,8 +159,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level3 * *> \par Further Details: @@ -181,10 +179,9 @@ * ===================================================================== SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -438,6 +435,6 @@ * RETURN * -* End of DTRSM . +* End of DTRSM * END diff --git a/lib/linalg/dtrsv.f b/lib/linalg/dtrsv.f index 331f1d4311..d8ea9fa898 100644 --- a/lib/linalg/dtrsv.f +++ b/lib/linalg/dtrsv.f @@ -136,17 +136,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup double_blas_level1 * * ===================================================================== SUBROUTINE DTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,LDA,N @@ -333,6 +330,6 @@ * RETURN * -* End of DTRSV . +* End of DTRSV * END diff --git a/lib/linalg/dtrti2.f b/lib/linalg/dtrti2.f index 0a9d5b696c..0d9115554c 100644 --- a/lib/linalg/dtrti2.f +++ b/lib/linalg/dtrti2.f @@ -103,17 +103,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DTRTI2( UPLO, DIAG, N, A, LDA, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER DIAG, UPLO diff --git a/lib/linalg/dtrtri.f b/lib/linalg/dtrtri.f index d34b40bcc0..1cf9a9aafb 100644 --- a/lib/linalg/dtrtri.f +++ b/lib/linalg/dtrtri.f @@ -102,17 +102,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DTRTRI( UPLO, DIAG, N, A, LDA, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER DIAG, UPLO diff --git a/lib/linalg/idamax.f b/lib/linalg/idamax.f index 17041680a4..1be301ea3e 100644 --- a/lib/linalg/idamax.f +++ b/lib/linalg/idamax.f @@ -43,7 +43,7 @@ *> \param[in] INCX *> \verbatim *> INCX is INTEGER -*> storage spacing between elements of SX +*> storage spacing between elements of DX *> \endverbatim * * Authors: @@ -54,8 +54,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup aux_blas * *> \par Further Details: @@ -71,10 +69,9 @@ * ===================================================================== INTEGER FUNCTION IDAMAX(N,DX,INCX) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -123,4 +120,7 @@ END DO END IF RETURN +* +* End of IDAMAX +* END diff --git a/lib/linalg/ieeeck.f b/lib/linalg/ieeeck.f index 2655958b4a..74065c3b4e 100644 --- a/lib/linalg/ieeeck.f +++ b/lib/linalg/ieeeck.f @@ -75,17 +75,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER ISPEC diff --git a/lib/linalg/iladlc.f b/lib/linalg/iladlc.f index c6476113d1..a98e7218bf 100644 --- a/lib/linalg/iladlc.f +++ b/lib/linalg/iladlc.f @@ -71,17 +71,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== INTEGER FUNCTION ILADLC( M, N, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER M, N, LDA diff --git a/lib/linalg/iladlr.f b/lib/linalg/iladlr.f index e8951d86cc..b1abded84b 100644 --- a/lib/linalg/iladlr.f +++ b/lib/linalg/iladlr.f @@ -71,17 +71,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== INTEGER FUNCTION ILADLR( M, N, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER M, N, LDA diff --git a/lib/linalg/ilaenv.f b/lib/linalg/ilaenv.f index 2be0581517..af28503986 100644 --- a/lib/linalg/ilaenv.f +++ b/lib/linalg/ilaenv.f @@ -79,9 +79,9 @@ *> = 9: maximum size of the subproblems at the bottom of the *> computation tree in the divide-and-conquer algorithm *> (used by xGELSD and xGESDD) -*> =10: ieee NaN arithmetic can be trusted not to trap +*> =10: ieee infinity and NaN arithmetic can be trusted not to trap *> =11: infinity arithmetic can be trusted not to trap -*> 12 <= ISPEC <= 16: +*> 12 <= ISPEC <= 17: *> xHSEQR or related subroutines, *> see IPARMQ for detailed explanation *> \endverbatim @@ -132,8 +132,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * *> \par Further Details: @@ -162,10 +160,9 @@ * ===================================================================== INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER*( * ) NAME, OPTS @@ -176,8 +173,8 @@ * * .. Local Scalars .. INTEGER I, IC, IZ, NB, NBMIN, NX - LOGICAL CNAME, SNAME - CHARACTER C1*1, C2*2, C4*2, C3*3, SUBNAM*6 + LOGICAL CNAME, SNAME, TWOSTAGE + CHARACTER C1*1, C2*2, C4*2, C3*3, SUBNAM*16 * .. * .. Intrinsic Functions .. INTRINSIC CHAR, ICHAR, INT, MIN, REAL @@ -189,8 +186,7 @@ * .. Executable Statements .. * GO TO ( 10, 10, 10, 80, 90, 100, 110, 120, - $ 130, 140, 150, 160, 160, 160, 160, 160, - $ 170, 170, 170, 170, 170 )ISPEC + $ 130, 140, 150, 160, 160, 160, 160, 160, 160)ISPEC * * Invalid value for ISPEC * @@ -257,6 +253,8 @@ C2 = SUBNAM( 2: 3 ) C3 = SUBNAM( 4: 6 ) C4 = C3( 2: 3 ) + TWOSTAGE = LEN( SUBNAM ).GE.11 + $ .AND. SUBNAM( 11: 11 ).EQ.'2' * GO TO ( 50, 60, 70 )ISPEC * @@ -270,7 +268,16 @@ * NB = 1 * - IF( C2.EQ.'GE' ) THEN + IF( SUBNAM(2:6).EQ.'LAORH' ) THEN +* +* This is for *LAORHR_GETRFNP routine +* + IF( SNAME ) THEN + NB = 32 + ELSE + NB = 32 + END IF + ELSE IF( C2.EQ.'GE' ) THEN IF( C3.EQ.'TRF' ) THEN IF( SNAME ) THEN NB = 64 @@ -360,9 +367,17 @@ ELSE IF( C2.EQ.'SY' ) THEN IF( C3.EQ.'TRF' ) THEN IF( SNAME ) THEN - NB = 64 + IF( TWOSTAGE ) THEN + NB = 192 + ELSE + NB = 64 + END IF ELSE - NB = 64 + IF( TWOSTAGE ) THEN + NB = 192 + ELSE + NB = 64 + END IF END IF ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN NB = 32 @@ -371,7 +386,11 @@ END IF ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN IF( C3.EQ.'TRF' ) THEN - NB = 64 + IF( TWOSTAGE ) THEN + NB = 192 + ELSE + NB = 64 + END IF ELSE IF( C3.EQ.'TRD' ) THEN NB = 32 ELSE IF( C3.EQ.'GST' ) THEN @@ -664,7 +683,7 @@ * 140 CONTINUE * -* ISPEC = 10: ieee NaN arithmetic can be trusted not to trap +* ISPEC = 10: ieee and infinity NaN arithmetic can be trusted not to trap * * ILAENV = 0 ILAENV = 1 @@ -675,7 +694,7 @@ * 150 CONTINUE * -* ISPEC = 11: infinity arithmetic can be trusted not to trap +* ISPEC = 11: ieee infinity arithmetic can be trusted not to trap * * ILAENV = 0 ILAENV = 1 @@ -686,17 +705,10 @@ * 160 CONTINUE * -* 12 <= ISPEC <= 16: xHSEQR or related subroutines. +* 12 <= ISPEC <= 17: xHSEQR or related subroutines. * ILAENV = IPARMQ( ISPEC, NAME, OPTS, N1, N2, N3, N4 ) RETURN -* - 170 CONTINUE -* -* 17 <= ISPEC <= 21: 2stage eigenvalues and SVD or related subroutines. -* - ILAENV = IPARAM2STAGE( ISPEC, NAME, OPTS, N1, N2, N3, N4 ) - RETURN * * End of ILAENV * diff --git a/lib/linalg/ilazlc.f b/lib/linalg/ilazlc.f index 07dfc93e31..8af3430e61 100644 --- a/lib/linalg/ilazlc.f +++ b/lib/linalg/ilazlc.f @@ -71,17 +71,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== INTEGER FUNCTION ILAZLC( M, N, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER M, N, LDA diff --git a/lib/linalg/ilazlr.f b/lib/linalg/ilazlr.f index 4ca4ed1a44..e0134a6a35 100644 --- a/lib/linalg/ilazlr.f +++ b/lib/linalg/ilazlr.f @@ -71,17 +71,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== INTEGER FUNCTION ILAZLR( M, N, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER M, N, LDA diff --git a/lib/linalg/iparmq.f b/lib/linalg/iparmq.f index e576e0db01..54c05471ca 100644 --- a/lib/linalg/iparmq.f +++ b/lib/linalg/iparmq.f @@ -60,7 +60,7 @@ *> invest in an (expensive) multi-shift QR sweep. *> If the aggressive early deflation subroutine *> finds LD converged eigenvalues from an order -*> NW deflation window and LD.GT.(NW*NIBBLE)/100, +*> NW deflation window and LD > (NW*NIBBLE)/100, *> then the next QR sweep is skipped and early *> deflation is applied immediately to the *> remaining active diagonal block. Setting @@ -100,17 +100,21 @@ *> IPARMQ(ISPEC=16)=1 may be more efficient than *> IPARMQ(ISPEC=16)=2 despite the greater level of *> arithmetic work implied by the latter choice.) +*> +*> ISPEC=17: (ICOST) An estimate of the relative cost of flops +*> within the near-the-diagonal shift chase compared +*> to flops within the BLAS calls of a QZ sweep. *> \endverbatim *> *> \param[in] NAME *> \verbatim -*> NAME is character string +*> NAME is CHARACTER string *> Name of the calling subroutine *> \endverbatim *> *> \param[in] OPTS *> \verbatim -*> OPTS is character string +*> OPTS is CHARACTER string *> This is a concatenation of the string arguments to *> TTQRE. *> \endverbatim @@ -147,8 +151,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 -* *> \ingroup OTHERauxiliary * *> \par Further Details: @@ -184,8 +186,8 @@ *> This depends on ILO, IHI and NS, the *> number of simultaneous shifts returned *> by IPARMQ(ISPEC=15). The default for -*> (IHI-ILO+1).LE.500 is NS. The default -*> for (IHI-ILO+1).GT.500 is 3*NS/2. +*> (IHI-ILO+1) <= 500 is NS. The default +*> for (IHI-ILO+1) > 500 is 3*NS/2. *> *> IPARMQ(ISPEC=14) Nibble crossover point. Default: 14. *> @@ -217,15 +219,18 @@ *> IPARMQ(ISPEC=16) Select structured matrix multiply. *> (See ISPEC=16 above for details.) *> Default: 3. +*> +*> IPARMQ(ISPEC=17) Relative cost heuristic for blocksize selection. +*> Expressed as a percentage. +*> Default: 10. *> \endverbatim *> * ===================================================================== INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, LWORK ) * -* -- LAPACK auxiliary routine (version 3.7.1) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * .. Scalar Arguments .. INTEGER IHI, ILO, ISPEC, LWORK, N @@ -233,12 +238,12 @@ * * ================================================================ * .. Parameters .. - INTEGER INMIN, INWIN, INIBL, ISHFTS, IACC22 + INTEGER INMIN, INWIN, INIBL, ISHFTS, IACC22, ICOST PARAMETER ( INMIN = 12, INWIN = 13, INIBL = 14, - $ ISHFTS = 15, IACC22 = 16 ) - INTEGER NMIN, K22MIN, KACMIN, NIBBLE, KNWSWP + $ ISHFTS = 15, IACC22 = 16, ICOST = 17 ) + INTEGER NMIN, K22MIN, KACMIN, NIBBLE, KNWSWP, RCOST PARAMETER ( NMIN = 75, K22MIN = 14, KACMIN = 14, - $ NIBBLE = 14, KNWSWP = 500 ) + $ NIBBLE = 14, KNWSWP = 500, RCOST = 10 ) REAL TWO PARAMETER ( TWO = 2.0 ) * .. @@ -384,6 +389,12 @@ $ IPARMQ = 2 END IF * + ELSE IF( ISPEC.EQ.ICOST ) THEN +* +* === Relative cost of near-the-diagonal chase vs +* BLAS updates === +* + IPARMQ = RCOST ELSE * ===== invalid value of ispec ===== IPARMQ = -1 diff --git a/lib/linalg/lsame.f b/lib/linalg/lsame.f index d819478696..6aa4007065 100644 --- a/lib/linalg/lsame.f +++ b/lib/linalg/lsame.f @@ -46,17 +46,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup aux_blas * * ===================================================================== LOGICAL FUNCTION LSAME(CA,CB) * -* -- Reference BLAS level1 routine (version 3.1) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER CA,CB diff --git a/lib/linalg/xerbla.f b/lib/linalg/xerbla.f index 4a0350988c..6b141499ee 100644 --- a/lib/linalg/xerbla.f +++ b/lib/linalg/xerbla.f @@ -63,17 +63,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup OTHERauxiliary * * ===================================================================== SUBROUTINE XERBLA( SRNAME, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER*(*) SRNAME diff --git a/lib/linalg/zaxpy.f b/lib/linalg/zaxpy.f index b7b9ee69e4..35c0e4b892 100644 --- a/lib/linalg/zaxpy.f +++ b/lib/linalg/zaxpy.f @@ -72,8 +72,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level1 * *> \par Further Details: @@ -88,10 +86,9 @@ * ===================================================================== SUBROUTINE ZAXPY(N,ZA,ZX,INCX,ZY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ZA @@ -136,4 +133,7 @@ END IF * RETURN +* +* End of ZAXPY +* END diff --git a/lib/linalg/zcopy.f b/lib/linalg/zcopy.f index 3777079730..1efcdb6b0f 100644 --- a/lib/linalg/zcopy.f +++ b/lib/linalg/zcopy.f @@ -65,8 +65,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level1 * *> \par Further Details: @@ -81,10 +79,9 @@ * ===================================================================== SUBROUTINE ZCOPY(N,ZX,INCX,ZY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -122,4 +119,7 @@ END DO END IF RETURN +* +* End of ZCOPY +* END diff --git a/lib/linalg/zdotc.f b/lib/linalg/zdotc.f index e6cd11b21d..bcc29e2dad 100644 --- a/lib/linalg/zdotc.f +++ b/lib/linalg/zdotc.f @@ -39,7 +39,7 @@ *> *> \param[in] ZX *> \verbatim -*> ZX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) *> \endverbatim *> *> \param[in] INCX @@ -50,7 +50,7 @@ *> *> \param[in] ZY *> \verbatim -*> ZY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> ZY is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) *> \endverbatim *> *> \param[in] INCY @@ -67,8 +67,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level1 * *> \par Further Details: @@ -83,10 +81,9 @@ * ===================================================================== COMPLEX*16 FUNCTION ZDOTC(N,ZX,INCX,ZY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -131,4 +128,7 @@ END IF ZDOTC = ZTEMP RETURN +* +* End of ZDOTC +* END diff --git a/lib/linalg/zdscal.f b/lib/linalg/zdscal.f index 71d4da55be..b3546ba206 100644 --- a/lib/linalg/zdscal.f +++ b/lib/linalg/zdscal.f @@ -61,8 +61,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level1 * *> \par Further Details: @@ -78,10 +76,9 @@ * ===================================================================== SUBROUTINE ZDSCAL(N,DA,ZX,INCX) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION DA @@ -117,4 +114,7 @@ END DO END IF RETURN +* +* End of ZDSCAL +* END diff --git a/lib/linalg/zgemm.f b/lib/linalg/zgemm.f index c3ac7551d1..0b712f1b73 100644 --- a/lib/linalg/zgemm.f +++ b/lib/linalg/zgemm.f @@ -166,8 +166,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level3 * *> \par Further Details: @@ -187,10 +185,9 @@ * ===================================================================== SUBROUTINE ZGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -215,7 +212,7 @@ * .. * .. Local Scalars .. COMPLEX*16 TEMP - INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB + INTEGER I,INFO,J,L,NROWA,NROWB LOGICAL CONJA,CONJB,NOTA,NOTB * .. * .. Parameters .. @@ -228,8 +225,7 @@ * Set NOTA and NOTB as true if A and B respectively are not * conjugated or transposed, set CONJA and CONJB as true if A and * B respectively are to be transposed but not conjugated and set -* NROWA, NCOLA and NROWB as the number of rows and columns of A -* and the number of rows of B respectively. +* NROWA and NROWB as the number of rows of A and B respectively. * NOTA = LSAME(TRANSA,'N') NOTB = LSAME(TRANSB,'N') @@ -237,10 +233,8 @@ CONJB = LSAME(TRANSB,'C') IF (NOTA) THEN NROWA = M - NCOLA = K ELSE NROWA = K - NCOLA = M END IF IF (NOTB) THEN NROWB = K @@ -478,6 +472,6 @@ * RETURN * -* End of ZGEMM . +* End of ZGEMM * END diff --git a/lib/linalg/zgemv.f b/lib/linalg/zgemv.f index 7088d383f4..2664454b94 100644 --- a/lib/linalg/zgemv.f +++ b/lib/linalg/zgemv.f @@ -136,8 +136,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -158,10 +156,9 @@ * ===================================================================== SUBROUTINE ZGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -345,6 +342,6 @@ * RETURN * -* End of ZGEMV . +* End of ZGEMV * END diff --git a/lib/linalg/zgerc.f b/lib/linalg/zgerc.f index 058dccfc1c..2eb4349367 100644 --- a/lib/linalg/zgerc.f +++ b/lib/linalg/zgerc.f @@ -109,8 +109,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -130,10 +128,9 @@ * ===================================================================== SUBROUTINE ZGERC(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -222,6 +219,6 @@ * RETURN * -* End of ZGERC . +* End of ZGERC * END diff --git a/lib/linalg/zheev.f b/lib/linalg/zheev.f index 3e87778740..59af34a742 100644 --- a/lib/linalg/zheev.f +++ b/lib/linalg/zheev.f @@ -132,18 +132,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16HEeigen * * ===================================================================== SUBROUTINE ZHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, $ INFO ) * -* -- LAPACK driver routine (version 3.7.0) -- +* -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, UPLO @@ -224,7 +221,7 @@ END IF * IF( N.EQ.1 ) THEN - W( 1 ) = A( 1, 1 ) + W( 1 ) = DBLE( A( 1, 1 ) ) WORK( 1 ) = 1 IF( WANTZ ) $ A( 1, 1 ) = CONE diff --git a/lib/linalg/zheevd.f b/lib/linalg/zheevd.f index 7f58c7f726..a6484eb032 100644 --- a/lib/linalg/zheevd.f +++ b/lib/linalg/zheevd.f @@ -284,7 +284,7 @@ LIWMIN = 1 END IF LOPT = MAX( LWMIN, N + - $ N*ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) ) + $ ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) ) LROPT = LRWMIN LIOPT = LIWMIN END IF diff --git a/lib/linalg/zhemv.f b/lib/linalg/zhemv.f index 3ea0753f40..dad68bf25b 100644 --- a/lib/linalg/zhemv.f +++ b/lib/linalg/zhemv.f @@ -132,8 +132,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -154,10 +152,9 @@ * ===================================================================== SUBROUTINE ZHEMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA,BETA @@ -332,6 +329,6 @@ * RETURN * -* End of ZHEMV . +* End of ZHEMV * END diff --git a/lib/linalg/zher2.f b/lib/linalg/zher2.f index e3a383189d..d1f2b57ec4 100644 --- a/lib/linalg/zher2.f +++ b/lib/linalg/zher2.f @@ -129,8 +129,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -150,10 +148,9 @@ * ===================================================================== SUBROUTINE ZHER2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -312,6 +309,6 @@ * RETURN * -* End of ZHER2 . +* End of ZHER2 * END diff --git a/lib/linalg/zher2k.f b/lib/linalg/zher2k.f index 474c65e575..5c75083cd5 100644 --- a/lib/linalg/zher2k.f +++ b/lib/linalg/zher2k.f @@ -174,8 +174,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level3 * *> \par Further Details: @@ -198,10 +196,9 @@ * ===================================================================== SUBROUTINE ZHER2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -438,6 +435,6 @@ * RETURN * -* End of ZHER2K. +* End of ZHER2K * END diff --git a/lib/linalg/zhetd2.f b/lib/linalg/zhetd2.f index 6c5b8aae3d..a6d900b7c7 100644 --- a/lib/linalg/zhetd2.f +++ b/lib/linalg/zhetd2.f @@ -122,8 +122,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16HEcomputational * *> \par Further Details: @@ -175,10 +173,9 @@ * ===================================================================== SUBROUTINE ZHETD2( UPLO, N, A, LDA, D, E, TAU, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -248,7 +245,7 @@ * ALPHA = A( I, I+1 ) CALL ZLARFG( I, ALPHA, A( 1, I+1 ), 1, TAUI ) - E( I ) = ALPHA + E( I ) = DBLE( ALPHA ) * IF( TAUI.NE.ZERO ) THEN * @@ -276,10 +273,10 @@ A( I, I ) = DBLE( A( I, I ) ) END IF A( I, I+1 ) = E( I ) - D( I+1 ) = A( I+1, I+1 ) + D( I+1 ) = DBLE( A( I+1, I+1 ) ) TAU( I ) = TAUI 10 CONTINUE - D( 1 ) = A( 1, 1 ) + D( 1 ) = DBLE( A( 1, 1 ) ) ELSE * * Reduce the lower triangle of A @@ -292,7 +289,7 @@ * ALPHA = A( I+1, I ) CALL ZLARFG( N-I, ALPHA, A( MIN( I+2, N ), I ), 1, TAUI ) - E( I ) = ALPHA + E( I ) = DBLE( ALPHA ) * IF( TAUI.NE.ZERO ) THEN * @@ -321,10 +318,10 @@ A( I+1, I+1 ) = DBLE( A( I+1, I+1 ) ) END IF A( I+1, I ) = E( I ) - D( I ) = A( I, I ) + D( I ) = DBLE( A( I, I ) ) TAU( I ) = TAUI 20 CONTINUE - D( N ) = A( N, N ) + D( N ) = DBLE( A( N, N ) ) END IF * RETURN diff --git a/lib/linalg/zhetrd.f b/lib/linalg/zhetrd.f index 51c9fc2ec9..5b7d6546cc 100644 --- a/lib/linalg/zhetrd.f +++ b/lib/linalg/zhetrd.f @@ -139,8 +139,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16HEcomputational * *> \par Further Details: @@ -192,10 +190,9 @@ * ===================================================================== SUBROUTINE ZHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -328,7 +325,7 @@ * DO 10 J = I, I + NB - 1 A( J-1, J ) = E( J-1 ) - D( J ) = A( J, J ) + D( J ) = DBLE( A( J, J ) ) 10 CONTINUE 20 CONTINUE * @@ -360,7 +357,7 @@ * DO 30 J = I, I + NB - 1 A( J+1, J ) = E( J ) - D( J ) = A( J, J ) + D( J ) = DBLE( A( J, J ) ) 30 CONTINUE 40 CONTINUE * diff --git a/lib/linalg/zhpr.f b/lib/linalg/zhpr.f index af82dfbd8c..2ba5774a21 100644 --- a/lib/linalg/zhpr.f +++ b/lib/linalg/zhpr.f @@ -109,8 +109,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -130,10 +128,9 @@ * ===================================================================== SUBROUTINE ZHPR(UPLO,N,ALPHA,X,INCX,AP) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. DOUBLE PRECISION ALPHA @@ -274,6 +271,6 @@ * RETURN * -* End of ZHPR . +* End of ZHPR * END diff --git a/lib/linalg/zlacgv.f b/lib/linalg/zlacgv.f index 1e3ca6e73f..dc935e08f4 100644 --- a/lib/linalg/zlacgv.f +++ b/lib/linalg/zlacgv.f @@ -67,17 +67,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLACGV( N, X, INCX ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX, N diff --git a/lib/linalg/zladiv.f b/lib/linalg/zladiv.f index 0bf6ea87d5..ae111d73d6 100644 --- a/lib/linalg/zladiv.f +++ b/lib/linalg/zladiv.f @@ -57,17 +57,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== COMPLEX*16 FUNCTION ZLADIV( X, Y ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 X, Y diff --git a/lib/linalg/zlanhe.f b/lib/linalg/zlanhe.f index 7c7f7f3be4..bbb4843ffd 100644 --- a/lib/linalg/zlanhe.f +++ b/lib/linalg/zlanhe.f @@ -117,17 +117,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16HEauxiliary * * ===================================================================== DOUBLE PRECISION FUNCTION ZLANHE( NORM, UPLO, N, A, LDA, WORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER NORM, UPLO diff --git a/lib/linalg/zlarf.f b/lib/linalg/zlarf.f index f1be80d37b..e555d18ecd 100644 --- a/lib/linalg/zlarf.f +++ b/lib/linalg/zlarf.f @@ -121,17 +121,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER SIDE diff --git a/lib/linalg/zlarfb.f b/lib/linalg/zlarfb.f index b4a2b4d1a0..c5f424db31 100644 --- a/lib/linalg/zlarfb.f +++ b/lib/linalg/zlarfb.f @@ -92,6 +92,8 @@ *> K is INTEGER *> The order of the matrix T (= the number of elementary *> reflectors whose product defines the block reflector). +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. *> \endverbatim *> *> \param[in] V @@ -159,8 +161,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2013 -* *> \ingroup complex16OTHERauxiliary * *> \par Further Details: @@ -195,10 +195,9 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, $ T, LDT, C, LDC, WORK, LDWORK ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2013 * * .. Scalar Arguments .. CHARACTER DIRECT, SIDE, STOREV, TRANS diff --git a/lib/linalg/zlarfg.f b/lib/linalg/zlarfg.f index f8a795d547..d69796cadc 100644 --- a/lib/linalg/zlarfg.f +++ b/lib/linalg/zlarfg.f @@ -99,17 +99,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLARFG( N, ALPHA, X, INCX, TAU ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX, N @@ -175,7 +172,7 @@ BETA = BETA*RSAFMN ALPHI = ALPHI*RSAFMN ALPHR = ALPHR*RSAFMN - IF( ABS( BETA ).LT.SAFMIN ) + IF( (ABS( BETA ).LT.SAFMIN) .AND. (KNT .LT. 20) ) $ GO TO 10 * * New BETA is at most 1, at least SAFMIN diff --git a/lib/linalg/zlarft.f b/lib/linalg/zlarft.f index 78ad2f1481..5ad0996fab 100644 --- a/lib/linalg/zlarft.f +++ b/lib/linalg/zlarft.f @@ -130,8 +130,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup complex16OTHERauxiliary * *> \par Further Details: @@ -163,10 +161,9 @@ * ===================================================================== SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2016 * * .. Scalar Arguments .. CHARACTER DIRECT, STOREV diff --git a/lib/linalg/zlascl.f b/lib/linalg/zlascl.f index c53c6f5ad7..3d53f5ae60 100644 --- a/lib/linalg/zlascl.f +++ b/lib/linalg/zlascl.f @@ -136,17 +136,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2016 * * .. Scalar Arguments .. CHARACTER TYPE diff --git a/lib/linalg/zlaset.f b/lib/linalg/zlaset.f index 796678217b..00f5f595fc 100644 --- a/lib/linalg/zlaset.f +++ b/lib/linalg/zlaset.f @@ -99,17 +99,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLASET( UPLO, M, N, ALPHA, BETA, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lib/linalg/zlasr.f b/lib/linalg/zlasr.f index 69891ba522..07c91329c4 100644 --- a/lib/linalg/zlasr.f +++ b/lib/linalg/zlasr.f @@ -193,17 +193,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER DIRECT, PIVOT, SIDE diff --git a/lib/linalg/zlatrd.f b/lib/linalg/zlatrd.f index ccc040993f..ee2a484723 100644 --- a/lib/linalg/zlatrd.f +++ b/lib/linalg/zlatrd.f @@ -140,8 +140,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * *> \par Further Details: @@ -199,10 +197,9 @@ * ===================================================================== SUBROUTINE ZLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -271,7 +268,7 @@ * ALPHA = A( I-1, I ) CALL ZLARFG( I-1, ALPHA, A( 1, I ), 1, TAU( I-1 ) ) - E( I-1 ) = ALPHA + E( I-1 ) = DBLE( ALPHA ) A( I-1, I ) = ONE * * Compute W(1:i-1,i) @@ -325,7 +322,7 @@ ALPHA = A( I+1, I ) CALL ZLARFG( N-I, ALPHA, A( MIN( I+2, N ), I ), 1, $ TAU( I ) ) - E( I ) = ALPHA + E( I ) = DBLE( ALPHA ) A( I+1, I ) = ONE * * Compute W(i+1:n,i) diff --git a/lib/linalg/zpptrf.f b/lib/linalg/zpptrf.f index 6e50b46828..a34d639131 100644 --- a/lib/linalg/zpptrf.f +++ b/lib/linalg/zpptrf.f @@ -92,8 +92,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * *> \par Further Details: @@ -119,10 +117,9 @@ * ===================================================================== SUBROUTINE ZPPTRF( UPLO, N, AP, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -192,8 +189,8 @@ * * Compute U(J,J) and test for non-positive-definiteness. * - AJJ = DBLE( AP( JJ ) ) - ZDOTC( J-1, AP( JC ), 1, AP( JC ), - $ 1 ) + AJJ = DBLE( AP( JJ ) ) - DBLE( ZDOTC( J-1, + $ AP( JC ), 1, AP( JC ), 1 ) ) IF( AJJ.LE.ZERO ) THEN AP( JJ ) = AJJ GO TO 30 diff --git a/lib/linalg/zpptri.f b/lib/linalg/zpptri.f index cde2f6dc72..a74466eb80 100644 --- a/lib/linalg/zpptri.f +++ b/lib/linalg/zpptri.f @@ -86,17 +86,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZPPTRI( UPLO, N, AP, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -164,7 +161,7 @@ JJ = JJ + J IF( J.GT.1 ) $ CALL ZHPR( 'Upper', J-1, ONE, AP( JC ), 1, AP ) - AJJ = AP( JJ ) + AJJ = DBLE( AP( JJ ) ) CALL ZDSCAL( J, AJJ, AP( JC ), 1 ) 10 CONTINUE * diff --git a/lib/linalg/zscal.f b/lib/linalg/zscal.f index 9f6d4b1d39..8085f5a399 100644 --- a/lib/linalg/zscal.f +++ b/lib/linalg/zscal.f @@ -61,8 +61,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level1 * *> \par Further Details: @@ -78,10 +76,9 @@ * ===================================================================== SUBROUTINE ZSCAL(N,ZA,ZX,INCX) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ZA @@ -114,4 +111,7 @@ END DO END IF RETURN +* +* End of ZSCAL +* END diff --git a/lib/linalg/zsteqr.f b/lib/linalg/zsteqr.f index ac47890685..47f4004e8d 100644 --- a/lib/linalg/zsteqr.f +++ b/lib/linalg/zsteqr.f @@ -125,17 +125,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER COMPZ diff --git a/lib/linalg/zswap.f b/lib/linalg/zswap.f index 6768d5e6e0..93f8fc52d0 100644 --- a/lib/linalg/zswap.f +++ b/lib/linalg/zswap.f @@ -65,8 +65,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level1 * *> \par Further Details: @@ -81,10 +79,9 @@ * ===================================================================== SUBROUTINE ZSWAP(N,ZX,INCX,ZY,INCY) * -* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS level1 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,INCY,N @@ -126,4 +123,7 @@ END DO END IF RETURN +* +* End of ZSWAP +* END diff --git a/lib/linalg/ztpmv.f b/lib/linalg/ztpmv.f index 65aa2a0abc..363fd5a2ac 100644 --- a/lib/linalg/ztpmv.f +++ b/lib/linalg/ztpmv.f @@ -120,8 +120,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -142,10 +140,9 @@ * ===================================================================== SUBROUTINE ZTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -383,6 +380,6 @@ * RETURN * -* End of ZTPMV . +* End of ZTPMV * END diff --git a/lib/linalg/ztpsv.f b/lib/linalg/ztpsv.f index 538888424a..c6f24d0b27 100644 --- a/lib/linalg/ztpsv.f +++ b/lib/linalg/ztpsv.f @@ -123,8 +123,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -144,10 +142,9 @@ * ===================================================================== SUBROUTINE ZTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,N @@ -385,6 +382,6 @@ * RETURN * -* End of ZTPSV . +* End of ZTPSV * END diff --git a/lib/linalg/ztptri.f b/lib/linalg/ztptri.f index 35388194c3..31284ad637 100644 --- a/lib/linalg/ztptri.f +++ b/lib/linalg/ztptri.f @@ -91,8 +91,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * *> \par Further Details: @@ -117,10 +115,9 @@ * ===================================================================== SUBROUTINE ZTPTRI( UPLO, DIAG, N, AP, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER DIAG, UPLO diff --git a/lib/linalg/ztrmm.f b/lib/linalg/ztrmm.f index 0f445f52a7..c59c367cee 100644 --- a/lib/linalg/ztrmm.f +++ b/lib/linalg/ztrmm.f @@ -156,8 +156,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level3 * *> \par Further Details: @@ -177,10 +175,9 @@ * ===================================================================== SUBROUTINE ZTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * -* -- Reference BLAS level3 routine (version 3.7.0) -- +* -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. COMPLEX*16 ALPHA @@ -447,6 +444,6 @@ * RETURN * -* End of ZTRMM . +* End of ZTRMM * END diff --git a/lib/linalg/ztrmv.f b/lib/linalg/ztrmv.f index 52d1ae6799..e8314facb7 100644 --- a/lib/linalg/ztrmv.f +++ b/lib/linalg/ztrmv.f @@ -125,8 +125,6 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16_blas_level2 * *> \par Further Details: @@ -147,10 +145,9 @@ * ===================================================================== SUBROUTINE ZTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) * -* -- Reference BLAS level2 routine (version 3.7.0) -- +* -- Reference BLAS level2 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX,LDA,N @@ -368,6 +365,6 @@ * RETURN * -* End of ZTRMV . +* End of ZTRMV * END diff --git a/lib/linalg/zung2l.f b/lib/linalg/zung2l.f index 1a48c4d6bc..add5cb946b 100644 --- a/lib/linalg/zung2l.f +++ b/lib/linalg/zung2l.f @@ -107,17 +107,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZUNG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, K, LDA, M, N diff --git a/lib/linalg/zung2r.f b/lib/linalg/zung2r.f index 4a3fed0f0d..2823b7ebdd 100644 --- a/lib/linalg/zung2r.f +++ b/lib/linalg/zung2r.f @@ -107,17 +107,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZUNG2R( M, N, K, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, K, LDA, M, N diff --git a/lib/linalg/zungl2.f b/lib/linalg/zungl2.f index 0774cc4405..e7a0b59603 100644 --- a/lib/linalg/zungl2.f +++ b/lib/linalg/zungl2.f @@ -106,17 +106,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZUNGL2( M, N, K, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, K, LDA, M, N diff --git a/lib/linalg/zungql.f b/lib/linalg/zungql.f index c63a47db56..1804ca65ff 100644 --- a/lib/linalg/zungql.f +++ b/lib/linalg/zungql.f @@ -121,17 +121,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZUNGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, K, LDA, LWORK, M, N diff --git a/lib/linalg/zungqr.f b/lib/linalg/zungqr.f index 5f95b64e88..b3f2c4507f 100644 --- a/lib/linalg/zungqr.f +++ b/lib/linalg/zungqr.f @@ -121,17 +121,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZUNGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INFO, K, LDA, LWORK, M, N diff --git a/lib/linalg/zungtr.f b/lib/linalg/zungtr.f index 728854332f..01e100a8cd 100644 --- a/lib/linalg/zungtr.f +++ b/lib/linalg/zungtr.f @@ -116,17 +116,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZUNGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. CHARACTER UPLO From 7901a317c0d6f90bd8f3130c53789bd6f5c6b0ee Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Wed, 20 Jul 2022 16:01:53 -0400 Subject: [PATCH 022/262] Initial version of an LAMMPS older version code update guide --- doc/src/Developer.rst | 1 + doc/src/Developer_updating.rst | 304 ++++++++++++++++++++ doc/utils/sphinx-config/false_positives.txt | 4 + 3 files changed, 309 insertions(+) create mode 100644 doc/src/Developer_updating.rst diff --git a/doc/src/Developer.rst b/doc/src/Developer.rst index bb10fcffd7..dc3fac94ce 100644 --- a/doc/src/Developer.rst +++ b/doc/src/Developer.rst @@ -17,6 +17,7 @@ of time and requests from the LAMMPS user community. Developer_flow Developer_write Developer_notes + Developer_updating Developer_plugins Developer_unittest Classes diff --git a/doc/src/Developer_updating.rst b/doc/src/Developer_updating.rst new file mode 100644 index 0000000000..13e1772589 --- /dev/null +++ b/doc/src/Developer_updating.rst @@ -0,0 +1,304 @@ +Notes for updating code written for older LAMMPS versions +--------------------------------------------------------- + +This section documents how C++ source files that were written for an +older version of LAMMPS need to be updated to be compatible with the +current and future version(s). Due to the active development of LAMMPS +it is likely to always be incomplete. Please contact developer@lammps.org +in case you run across an issue that is not (yet) listed here. Please +also review the latest information about the LAMMPS :doc:`programming style +conventions `. + +Available topics in chronological order are: + +- `Rename of pack/unpack_comm() to pack/unpack_forward_comm()`_ +- `Use ev_init() to initialize variables derived from eflag and vflag`_ +- `Use utils::numeric() functions instead of force->numeric()`_ +- `Use utils::open_potential() function to open potential files`_ +- `Simplify customized error messages`_ +- `Use of "override" instead of "virtual"`_ +- `Simplified and more compact neighbor list requests`_ + +---- + +Rename of pack/unpack_comm() to pack/unpack_forward_comm() +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. versionchanged:: 8Aug2014 + +In this change set the functions to pack data into communication buffers +and to unpack data from communication buffers for :doc:`forward +communications ` were renamed from ``pack_comm()`` +and ``unpack_comm()`` to ``pack_forward_comm()`` and +``unpack_forward_comm()``, respectively. Also the meaning of the return +value of these functions was changed: rather than returning the number +of items per atom stored in the buffer, now the total number of items +added (or unpacked) needs to be returned. Here is an example from the +`PairEAM` class. Of course the member function declaration in corresponding +header file needs to be updated accordingly. + +Old: + +.. code-block:: C++ + + int PairEAM::pack_comm(int n, int *list, double *buf, int pbc_flag, int *pbc) + { + int m = 0; + for (int i = 0; i < n; i++) { + int j = list[i]; + buf[m++] = fp[j]; + } + return 1; + } + +New: + +.. code-block:: C++ + + int PairEAM::pack_forward_comm(int n, int *list, double *buf, int pbc_flag, int *pbc) + { + int m = 0; + for (int i = 0; i < n; i++) { + int j = list[i]; + buf[m++] = fp[j]; + } + return m; + } + +.. note:: + + Because the various "pack" and "unpack" functions are defined in the + respective base classes as dummy functions doing nothing, and because + of the the name mismatch the custom versions in the derived class + will no longer be called, there will be no compilation error when + this change is not applied. Only calculations will suddenly produce + incorrect results because the required forward communication calls + will cease to function correctly. + +Use ev_init() to initialize variables derived from eflag and vflag +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. versionchanged:: 29Mar2019 + +There are several variables that need to be initialized based on +the values of the "eflag" and "vflag" variables and since sometimes +there are new bits added and new variables need to be set to 1 or 0. +To make this consistent, across all styles, there is now an inline +function ``ev_init(eflag, vflag)`` that makes those settings +consistently and calls either ``ev_setup()`` or ``ev_unset()``. +Example from a pair style: + +Old: + +.. code-block:: C++ + + if (eflag || vflag) ev_setup(eflag, vflag); + else evflag = vflag_fdotr = eflag_global = eflag_atom = 0; + +New: + +.. code-block:: C++ + + ev_init(eflag, vflag); + +Not applying this change will not cause a compilation error, but +can lead to inconsistent behavior and incorrect tallying of +energy or virial. + +Use utils::numeric() functions instead of force->numeric() +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. versionchanged:: 18Sep2020 + +The "numeric()" conversion functions (including "inumeric()", +"bnumeric()", and "tnumeric()") have been moved from the Force class to +the utils namespace. Also they take an additional argument that selects +whether the ``Error::all()`` or ``Error::one()`` function should be +called in case of an error. The former should be used when *all* MPI +processes call the conversion function and the latter *must* be used +when they are called from only one or a subset of the MPI processes. + +Old: + +.. code-block:: C++ + + val = force->numeric(FLERR, arg[1]); + num = force->inumeric(FLERR, arg[2]); + +New: + +.. code-block:: C++ + + val = utils::numeric(FLERR, true, arg[1], lmp); + num = utils::inumeric(FLERR, false, arg[2], lmp); + +.. seealso:: + + :cpp:func:`utils::numeric() `, + :cpp:func:`utils::inumeric() `, + :cpp:func:`utils::bnumeric() `, + :cpp:func:`utils::tnumeric() ` + +Use utils::open_potential() function to open potential files +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. versionchanged:: 18Sep2020 + +The :cpp:func:`utils::open_potential() +` function must be used to replace +calls to ``force->open_potential()`` and should be used to replace +``fopen()`` for opening potential files for reading. The custom +function does three additional steps compared to ``fopen()``: 1) it will +try to parse the ``UNITS:`` and ``DATE:`` metadata will stop with an +error on a units mismatch and will print the date info, if present, in +the log file; 2) for pair styles that support it, it will set up +possible automatic unit conversions based on the embedded unit +information and LAMMPS' current units setting; 3) it will not only try +to open a potential file at the given path, but will also search in the +folders listed in the ``LAMMPS_POTENTIALS`` environment variable. This +allows to keep potential files in a common location instead of having to +copy them around for simulations. + +Old: + +.. code-block:: C++ + + fp = force->open_potential(filename); + fp = fopen(filename, "r"); + +New: + +.. code-block:: C++ + + fp = utils::open_potential(filename, lmp); + +Simplify customized error messages +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. versionchanged:: 14May2021 + +Aided by features of the bundled {fmt} library, error messages now +can have a variable number of arguments and the string will be interpreted +as a {fmt} style format string so that custom error messages can be +easily customized without having to use temporary buffers and ``sprintf()``. +Example: + +Old: + +.. code-block:: C++ + + if (fptr == NULL) { + char str[128]; + sprintf(str,"Cannot open AEAM potential file %s",filename); + error->one(FLERR,str); + } + +New: + +.. code-block:: C++ + + if (fptr == nullptr) + error->one(FLERR, "Cannot open AEAM potential file {}: {}", filename, utils::getsyserror()); + +Use of "override" instead of "virtual" +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. versionchanged:: 17Feb2022 + +Since LAMMPS requires C++11 we switched to use the "override" keyword +instead of "virtual" to indicate polymorphism in derived classes. This +allows the C++ compiler to better detect inconsistencies when an +override is intended or not. Please note that "override" has to be +added to **all** polymorph functions in derived classes and "virtual" +*only* to the function in the base class (or the destructor). Here is +an example from the ``FixWallReflect`` class: + +Old: + +.. code-block:: C++ + + FixWallReflect(class LAMMPS *, int, char **); + virtual ~FixWallReflect(); + int setmask(); + void init(); + void post_integrate(); + +New: + +.. code-block:: C++ + + FixWallReflect(class LAMMPS *, int, char **); + ~FixWallReflect() override; + int setmask() override; + void init() override; + void post_integrate() override; + +This change set will neither cause a compilation failure, nor will it +change functionality, but if you plan to submit the updated code for +inclusion into the LAMMPS distribution, it will be requested for achieve +a consistent :doc:`programming style `. + +Simplified function names for forward and reverse communication +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. versionchanged:: 24Mar2022 + +Rather then using the function name to distinguish between the different +forward and reverse communication functions for styles, LAMMPS now uses +the type of the "this" pointer argument. + +Old: + +.. code-block:: C++ + + comm->forward_comm_pair(this); + comm->forward_comm_fix(this); + comm->forward_comm_compute(this); + comm->forward_comm_dump(this); + comm->reverse_comm_pair(this); + comm->reverse_comm_fix(this); + comm->reverse_comm_compute(this); + comm->reverse_comm_dump(this); + +New: + +.. code-block:: C++ + + comm->forward_comm(this); + comm->reverse_comm(this); + +This change is required or else the code will not compile. + +Simplified and more compact neighbor list requests +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. versionchanged:: 24Mar2022 + +This change set reduces the amount of code required to request a +neighbor list. It enforces consistency and no longer requires to change +internal data of the request. More information on neighbor list +requests can be :doc:`found here `. Example from the +``ComputeRDF`` class: + +Old: + +.. code-block:: C++ + + int irequest = neighbor->request(this,instance_me); + neighbor->requests[irequest]->pair = 0; + neighbor->requests[irequest]->compute = 1; + neighbor->requests[irequest]->occasional = 1; + if (cutflag) { + neighbor->requests[irequest]->cut = 1; + neighbor->requests[irequest]->cutoff = mycutneigh; + } + +New: + +.. code-block:: C++ + + auto req = neighbor->add_request(this, NeighConst::REQ_OCCASIONAL); + if (cutflag) req->set_cutoff(mycutneigh); + +Public access to the ``NeighRequest`` class data members has been +removed so this update is *required* to avoid compilation failure. diff --git a/doc/utils/sphinx-config/false_positives.txt b/doc/utils/sphinx-config/false_positives.txt index 9f6edbec4c..9006f99e50 100644 --- a/doc/utils/sphinx-config/false_positives.txt +++ b/doc/utils/sphinx-config/false_positives.txt @@ -291,6 +291,7 @@ blocksize blueviolet bn bni +bnumeric bo Bochkarev Bochum @@ -1482,6 +1483,7 @@ intra intralayer intramolecular ints +inumeric inv invariants inversed @@ -2706,6 +2708,7 @@ polydispersity polyelectrolyte polyhedra Polym +polymorph polymorphism Ponder popen @@ -3463,6 +3466,7 @@ tmin Tmin tmp tN +tnumeric Tobias Toennies Tohoku From 57616478940b8cd7b77eef5cfcdd730779923ed6 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 22 Jul 2022 05:15:50 -0400 Subject: [PATCH 023/262] plug memory leak --- src/GRANULAR/compute_contact_atom.cpp | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/GRANULAR/compute_contact_atom.cpp b/src/GRANULAR/compute_contact_atom.cpp index 91511f57ec..b090fb8631 100644 --- a/src/GRANULAR/compute_contact_atom.cpp +++ b/src/GRANULAR/compute_contact_atom.cpp @@ -32,17 +32,16 @@ using namespace LAMMPS_NS; /* ---------------------------------------------------------------------- */ ComputeContactAtom::ComputeContactAtom(LAMMPS *lmp, int narg, char **arg) : - Compute(lmp, narg, arg), - contact(nullptr) + Compute(lmp, narg, arg), group2(nullptr), contact(nullptr) { - if (narg != 3 && narg != 4) error->all(FLERR,"Illegal compute contact/atom command"); + if ((narg != 3) && (narg != 4)) error->all(FLERR, "Illegal compute contact/atom command"); jgroup = group->find("all"); jgroupbit = group->bitmask[jgroup]; if (narg == 4) { group2 = utils::strdup(arg[3]); jgroup = group->find(group2); - if (jgroup == -1) error->all(FLERR, "Compute contact/atom group2 ID does not exist"); + if (jgroup == -1) error->all(FLERR, "Compute contact/atom group2 ID {} does not exist", group2); jgroupbit = group->bitmask[jgroup]; } @@ -54,8 +53,7 @@ ComputeContactAtom::ComputeContactAtom(LAMMPS *lmp, int narg, char **arg) : // error checks - if (!atom->sphere_flag) - error->all(FLERR,"Compute contact/atom requires atom style sphere"); + if (!atom->sphere_flag) error->all(FLERR, "Compute contact/atom requires atom style sphere"); } /* ---------------------------------------------------------------------- */ @@ -63,6 +61,7 @@ ComputeContactAtom::ComputeContactAtom(LAMMPS *lmp, int narg, char **arg) : ComputeContactAtom::~ComputeContactAtom() { memory->destroy(contact); + delete[] group2; } /* ---------------------------------------------------------------------- */ From c9c9139fd6fc2058b4b7ef78bfa528b0b111396f Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 22 Jul 2022 05:21:13 -0400 Subject: [PATCH 024/262] fix off-by-one error and resulting out-of-bounds write access. --- src/REACTION/fix_bond_react.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/REACTION/fix_bond_react.cpp b/src/REACTION/fix_bond_react.cpp index 0405971bdd..f487b8303f 100644 --- a/src/REACTION/fix_bond_react.cpp +++ b/src/REACTION/fix_bond_react.cpp @@ -1725,7 +1725,7 @@ void FixBondReact::inner_crosscheck_loop() int num_choices = 0; for (int i = 0; i < nfirst_neighs; i++) { if (type[(int)atom->map(xspecial[atom->map(glove[pion][1])][i])] == onemol->type[(int)onemol_xspecial[pion][neigh]-1]) { - if (num_choices > 5) { // here failed because too many identical first neighbors. but really no limit if situation arises + if (num_choices == 5) { // here failed because too many identical first neighbors. but really no limit if situation arises status = GUESSFAIL; return; } From 48ad917d9e27156c426ad9f542ff4ac4fa208a4a Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 22 Jul 2022 05:33:12 -0400 Subject: [PATCH 025/262] initialized pointers to null --- src/CG-SPICA/angle_spica.cpp | 17 +++++++++++------ src/CG-SPICA/pair_lj_spica.cpp | 16 +++++++++------- src/CG-SPICA/pair_lj_spica_coul_long.cpp | 9 ++++++--- 3 files changed, 26 insertions(+), 16 deletions(-) diff --git a/src/CG-SPICA/angle_spica.cpp b/src/CG-SPICA/angle_spica.cpp index d25779d60c..ff19f29b75 100644 --- a/src/CG-SPICA/angle_spica.cpp +++ b/src/CG-SPICA/angle_spica.cpp @@ -21,17 +21,17 @@ #include "angle_spica.h" -#include #include "atom.h" -#include "neighbor.h" -#include "pair.h" -#include "domain.h" #include "comm.h" +#include "domain.h" +#include "error.h" #include "force.h" #include "math_const.h" #include "memory.h" -#include "error.h" +#include "neighbor.h" +#include "pair.h" +#include #include "lj_spica_common.h" @@ -43,7 +43,12 @@ using namespace LJSPICAParms; /* ---------------------------------------------------------------------- */ -AngleSPICA::AngleSPICA(LAMMPS *lmp) : Angle(lmp) { repflag = 0;} +AngleSPICA::AngleSPICA(LAMMPS *lmp) : + Angle(lmp), k(nullptr), theta0(nullptr), lj_type(nullptr), lj1(nullptr), lj2(nullptr), + lj3(nullptr), lj4(nullptr), rminsq(nullptr), emin(nullptr) +{ + repflag = 0; +} /* ---------------------------------------------------------------------- */ diff --git a/src/CG-SPICA/pair_lj_spica.cpp b/src/CG-SPICA/pair_lj_spica.cpp index 6a14d12146..32af30cd2b 100644 --- a/src/CG-SPICA/pair_lj_spica.cpp +++ b/src/CG-SPICA/pair_lj_spica.cpp @@ -1,4 +1,3 @@ -// clang-format off /* ---------------------------------------------------------------------- LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator https://www.lammps.org/, Sandia National Laboratories @@ -19,15 +18,15 @@ #include "pair_lj_spica.h" -#include -#include #include "atom.h" #include "comm.h" -#include "force.h" -#include "neigh_list.h" -#include "memory.h" #include "error.h" +#include "force.h" +#include "memory.h" +#include "neigh_list.h" +#include +#include #define LMP_NEED_SPICA_FIND_LJ_TYPE 1 #include "lj_spica_common.h" @@ -37,7 +36,9 @@ using namespace LJSPICAParms; /* ---------------------------------------------------------------------- */ -PairLJSPICA::PairLJSPICA(LAMMPS *lmp) : Pair(lmp) +PairLJSPICA::PairLJSPICA(LAMMPS *lmp) : + Pair(lmp), lj_type(nullptr), cut(nullptr), epsilon(nullptr), sigma(nullptr), lj1(nullptr), + lj2(nullptr), lj3(nullptr), lj4(nullptr), offset(nullptr), rminsq(nullptr), emin(nullptr) { respa_enable = 0; single_enable = 1; @@ -71,6 +72,7 @@ PairLJSPICA::~PairLJSPICA() } } +// clang-format off /* ---------------------------------------------------------------------- */ void PairLJSPICA::compute(int eflag, int vflag) diff --git a/src/CG-SPICA/pair_lj_spica_coul_long.cpp b/src/CG-SPICA/pair_lj_spica_coul_long.cpp index 416561c3a1..9b32f8eafb 100644 --- a/src/CG-SPICA/pair_lj_spica_coul_long.cpp +++ b/src/CG-SPICA/pair_lj_spica_coul_long.cpp @@ -46,7 +46,10 @@ using namespace LJSPICAParms; /* ---------------------------------------------------------------------- */ -PairLJSPICACoulLong::PairLJSPICACoulLong(LAMMPS *lmp) : Pair(lmp) +PairLJSPICACoulLong::PairLJSPICACoulLong(LAMMPS *lmp) : + Pair(lmp), lj_type(nullptr), cut_lj(nullptr), cut_ljsq(nullptr), + epsilon(nullptr), sigma(nullptr), lj1(nullptr), lj2(nullptr), lj3(nullptr), + lj4(nullptr), offset(nullptr), rminsq(nullptr), emin(nullptr) { ewaldflag = pppmflag = 1; respa_enable = 0; @@ -550,8 +553,8 @@ void PairLJSPICACoulLong::write_data_all(FILE *fp) /* ---------------------------------------------------------------------- */ -double PairLJSPICACoulLong::single(int i, int j, int itype, int jtype, double rsq, double factor_coul, - double factor_lj, double &fforce) +double PairLJSPICACoulLong::single(int i, int j, int itype, int jtype, double rsq, + double factor_coul, double factor_lj, double &fforce) { double r2inv, r, grij, expm2, t, erfc, prefactor; double fraction, table, forcecoul, forcelj, phicoul, philj; From 40920ac6e14e29477e779666f065e14c38c5bb4d Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 22 Jul 2022 12:41:43 -0400 Subject: [PATCH 026/262] improved error messages for duplicate or missing entries in manybody potential files --- src/INTERLAYER/pair_drip.cpp | 8 ++++++-- src/INTERLAYER/pair_ilp_graphene_hbn.cpp | 8 ++++---- src/INTERLAYER/pair_kolmogorov_crespi_full.cpp | 8 ++++++-- src/INTERLAYER/pair_kolmogorov_crespi_z.cpp | 8 ++++++-- src/INTERLAYER/pair_lebedeva_z.cpp | 6 ++++-- src/KSPACE/pair_coul_streitz.cpp | 4 ++-- src/MANYBODY/pair_comb.cpp | 6 ++++-- src/MANYBODY/pair_comb3.cpp | 6 ++++-- src/MANYBODY/pair_edip.cpp | 8 ++++++-- src/MANYBODY/pair_edip_multi.cpp | 6 ++++-- src/MANYBODY/pair_extep.cpp | 6 ++++-- src/MANYBODY/pair_gw.cpp | 6 ++++-- src/MANYBODY/pair_nb3b_harmonic.cpp | 8 ++++++-- src/MANYBODY/pair_sw.cpp | 6 ++++-- src/MANYBODY/pair_tersoff.cpp | 6 ++++-- src/MANYBODY/pair_tersoff_mod.cpp | 6 ++++-- src/MANYBODY/pair_tersoff_table.cpp | 6 ++++-- src/MANYBODY/pair_threebody_table.cpp | 8 ++++++-- src/MANYBODY/pair_vashishta.cpp | 6 ++++-- src/MISC/pair_agni.cpp | 4 ++-- 20 files changed, 88 insertions(+), 42 deletions(-) diff --git a/src/INTERLAYER/pair_drip.cpp b/src/INTERLAYER/pair_drip.cpp index 2bd6a16e8c..e7b340c516 100644 --- a/src/INTERLAYER/pair_drip.cpp +++ b/src/INTERLAYER/pair_drip.cpp @@ -256,11 +256,15 @@ void PairDRIP::read_file(char *filename) int n = -1; for (int m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement) { - if (n >= 0) error->all(FLERR, "DRIP potential file has duplicate entry"); + if (n >= 0) + error->all(FLERR, "DRIP potential file has a duplicate entry for: {} {}", elements[i], + elements[j]); n = m; } } - if (n < 0) error->all(FLERR, "Potential file is missing an entry"); + if (n < 0) + error->all(FLERR, "Potential file is missing an entry for: {} {}", elements[i], + elements[j]); elem2param[i][j] = n; } } diff --git a/src/INTERLAYER/pair_ilp_graphene_hbn.cpp b/src/INTERLAYER/pair_ilp_graphene_hbn.cpp index 8e502a9f1f..49b2adbd33 100644 --- a/src/INTERLAYER/pair_ilp_graphene_hbn.cpp +++ b/src/INTERLAYER/pair_ilp_graphene_hbn.cpp @@ -313,14 +313,14 @@ void PairILPGrapheneHBN::read_file(char *filename) for (int m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement) { if (n >= 0) - error->all(FLERR, "{} potential file {} has a duplicate entry", variant_map[variant], - filename); + error->all(FLERR, "{} potential file {} has a duplicate entry for: {} {}", + variant_map[variant], filename, elements[i], elements[j]); n = m; } } if (n < 0) - error->all(FLERR, "{} potential file {} is missing an entry", variant_map[variant], - filename); + error->all(FLERR, "{} potential file {} is missing an entry for: {} {}", + variant_map[variant], filename, elements[i], elements[j]); elem2param[i][j] = n; cutILPsq[i][j] = params[n].rcut * params[n].rcut; } diff --git a/src/INTERLAYER/pair_kolmogorov_crespi_full.cpp b/src/INTERLAYER/pair_kolmogorov_crespi_full.cpp index 0c005d53a2..116018f18a 100644 --- a/src/INTERLAYER/pair_kolmogorov_crespi_full.cpp +++ b/src/INTERLAYER/pair_kolmogorov_crespi_full.cpp @@ -289,11 +289,15 @@ void PairKolmogorovCrespiFull::read_file(char *filename) int n = -1; for (int m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement) { - if (n >= 0) error->all(FLERR, "KC potential file has duplicate entry"); + if (n >= 0) + error->all(FLERR, "KC potential file has a duplicate entry for: {} {}", elements[i], + elements[j]); n = m; } } - if (n < 0) error->all(FLERR, "Potential file is missing an entry"); + if (n < 0) + error->all(FLERR, "Potential file is missing an entry for: {} {}", elements[i], + elements[j]); elem2param[i][j] = n; cutKCsq[i][j] = params[n].rcut * params[n].rcut; } diff --git a/src/INTERLAYER/pair_kolmogorov_crespi_z.cpp b/src/INTERLAYER/pair_kolmogorov_crespi_z.cpp index 144e09cb50..a2abdc9a1c 100644 --- a/src/INTERLAYER/pair_kolmogorov_crespi_z.cpp +++ b/src/INTERLAYER/pair_kolmogorov_crespi_z.cpp @@ -379,11 +379,15 @@ void PairKolmogorovCrespiZ::read_file(char *filename) int n = -1; for (int m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement) { - if (n >= 0) error->all(FLERR, "Potential file has duplicate entry"); + if (n >= 0) + error->all(FLERR, "Potential file has a duplicate entry for: {} {}", elements[i], + elements[j]); n = m; } } - if (n < 0) error->all(FLERR, "Potential file is missing an entry"); + if (n < 0) + error->all(FLERR, "Potential file is missing an entry for: {} {}", elements[i], + elements[j]); elem2param[i][j] = n; } } diff --git a/src/INTERLAYER/pair_lebedeva_z.cpp b/src/INTERLAYER/pair_lebedeva_z.cpp index 95e23d3348..0c2c285504 100644 --- a/src/INTERLAYER/pair_lebedeva_z.cpp +++ b/src/INTERLAYER/pair_lebedeva_z.cpp @@ -376,11 +376,13 @@ void PairLebedevaZ::read_file(char *filename) int n = -1; for (int m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement) { - if (n >= 0) error->all(FLERR,"Potential file has duplicate entry"); + if (n >= 0) error->all(FLERR,"Potential file has a duplicate entry for: {} {}", + elements[i], elements[j]); n = m; } } - if (n < 0) error->all(FLERR,"Potential file is missing an entry"); + if (n < 0) error->all(FLERR,"Potential file is missing an entry for: {} {}", + elements[i], elements[j]); elem2param[i][j] = n; } } diff --git a/src/KSPACE/pair_coul_streitz.cpp b/src/KSPACE/pair_coul_streitz.cpp index f388f4cc88..d0ad285f31 100644 --- a/src/KSPACE/pair_coul_streitz.cpp +++ b/src/KSPACE/pair_coul_streitz.cpp @@ -253,11 +253,11 @@ void PairCoulStreitz::setup_params() n = -1; for (m = 0; m < nparams; m++) { if (i == params[m].ielement) { - if (n >= 0) error->all(FLERR,"Potential file has duplicate entry"); + if (n >= 0) error->all(FLERR,"Potential file has duplicate entry for: {}", elements[i]); n = m; } } - if (n < 0) error->all(FLERR,"Potential file is missing an entry"); + if (n < 0) error->all(FLERR,"Potential file is missing an entry for: {}", elements[i]); elem1param[i] = n; } diff --git a/src/MANYBODY/pair_comb.cpp b/src/MANYBODY/pair_comb.cpp index 90e2d72512..ddaf378445 100644 --- a/src/MANYBODY/pair_comb.cpp +++ b/src/MANYBODY/pair_comb.cpp @@ -687,11 +687,13 @@ void PairComb::setup_params() for (m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement && k == params[m].kelement) { - if (n >= 0) error->all(FLERR,"Potential file has duplicate entry"); + if (n >= 0) error->all(FLERR,"Potential file has a duplicate entry for: {} {} {}", + elements[i], elements[j], elements[k]); n = m; } } - if (n < 0) error->all(FLERR,"Potential file is missing an entry"); + if (n < 0) error->all(FLERR,"Potential file is missing an entry for: {} {} {}", + elements[i], elements[j], elements[k]); elem3param[i][j][k] = n; } diff --git a/src/MANYBODY/pair_comb3.cpp b/src/MANYBODY/pair_comb3.cpp index 7c126bf8ab..e5ea235363 100644 --- a/src/MANYBODY/pair_comb3.cpp +++ b/src/MANYBODY/pair_comb3.cpp @@ -642,11 +642,13 @@ void PairComb3::setup_params() for (m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement && k == params[m].kelement) { - if (n >= 0) error->all(FLERR,"Potential file has duplicate entry"); + if (n >= 0) error->all(FLERR,"Potential file has a duplicate entry for: {} {} {}", + elements[i], elements[j], elements[k]); n = m; } } - if (n < 0) error->all(FLERR,"Potential file is missing an entry"); + if (n < 0) error->all(FLERR,"Potential file is missing an entry for: {} {} {}", + elements[i], elements[j], elements[k]); elem3param[i][j][k] = n; } diff --git a/src/MANYBODY/pair_edip.cpp b/src/MANYBODY/pair_edip.cpp index 8becba670b..87ccf9b18a 100644 --- a/src/MANYBODY/pair_edip.cpp +++ b/src/MANYBODY/pair_edip.cpp @@ -871,11 +871,15 @@ void PairEDIP::setup_params() n = -1; for (m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement && k == params[m].kelement) { - if (n >= 0) error->all(FLERR, "Potential file has duplicate entry"); + if (n >= 0) + error->all(FLERR, "Potential file has a duplicate entry for: {} {} {}", elements[i], + elements[j], elements[k]); n = m; } } - if (n < 0) error->all(FLERR, "Potential file is missing an entry"); + if (n < 0) + error->all(FLERR, "Potential file is missing an entry for: {} {} {}", elements[i], + elements[j], elements[k]); elem3param[i][j][k] = n; } diff --git a/src/MANYBODY/pair_edip_multi.cpp b/src/MANYBODY/pair_edip_multi.cpp index 4710dcce0a..cb50426033 100644 --- a/src/MANYBODY/pair_edip_multi.cpp +++ b/src/MANYBODY/pair_edip_multi.cpp @@ -687,11 +687,13 @@ void PairEDIPMulti::setup() for (m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement && k == params[m].kelement) { - if (n >= 0) error->all(FLERR,"Potential file has duplicate entry"); + if (n >= 0) error->all(FLERR,"Potential file has a duplicate entry for: {} {} {}", + elements[i], elements[j], elements[k]); n = m; } } - if (n < 0) error->all(FLERR,"Potential file is missing an entry"); + if (n < 0) error->all(FLERR,"Potential file is missing an entry for: {} {} {}", + elements[i], elements[j], elements[k]); elem3param[i][j][k] = n; } diff --git a/src/MANYBODY/pair_extep.cpp b/src/MANYBODY/pair_extep.cpp index 7f6d266050..f8446e16eb 100644 --- a/src/MANYBODY/pair_extep.cpp +++ b/src/MANYBODY/pair_extep.cpp @@ -696,11 +696,13 @@ void PairExTeP::setup() for (m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement && k == params[m].kelement) { - if (n >= 0) error->all(FLERR,"Potential file has duplicate entry"); + if (n >= 0) error->all(FLERR,"Potential file has a duplicate entry for: {} {} {}", + elements[i], elements[j], elements[k]); n = m; } } - if (n < 0) error->all(FLERR,"Potential file is missing an entry"); + if (n < 0) error->all(FLERR,"Potential file is missing an entry for: {} {} {}", + elements[i], elements[j], elements[k]); elem3param[i][j][k] = n; } diff --git a/src/MANYBODY/pair_gw.cpp b/src/MANYBODY/pair_gw.cpp index 3e948880ca..ba315bdf70 100644 --- a/src/MANYBODY/pair_gw.cpp +++ b/src/MANYBODY/pair_gw.cpp @@ -427,11 +427,13 @@ void PairGW::setup_params() if (i == params[m].ielement && j == params[m].jelement && k == params[m].kelement) { if (n >= 0) - error->all(FLERR,"Potential file has duplicate entry"); + error->all(FLERR,"Potential file has a duplicate entry for: {} {} {}", + elements[i], elements[j], elements[k]); n = m; } } - if (n < 0) error->all(FLERR,"Potential file is missing an entry"); + if (n < 0) error->all(FLERR,"Potential file is missing an entry for: {} {} {}", + elements[i], elements[j], elements[k]); elem3param[i][j][k] = n; } diff --git a/src/MANYBODY/pair_nb3b_harmonic.cpp b/src/MANYBODY/pair_nb3b_harmonic.cpp index d74c504aea..3b25ac00a3 100644 --- a/src/MANYBODY/pair_nb3b_harmonic.cpp +++ b/src/MANYBODY/pair_nb3b_harmonic.cpp @@ -314,11 +314,15 @@ void PairNb3bHarmonic::setup_params() n = -1; for (m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement && k == params[m].kelement) { - if (n >= 0) error->all(FLERR, "Potential file has duplicate entry"); + if (n >= 0) + error->all(FLERR, "Potential file has a duplicate entry for: {} {} {}", elements[i], + elements[j], elements[k]); n = m; } } - if (n < 0) error->all(FLERR, "Potential file is missing an entry"); + if (n < 0) + error->all(FLERR, "Potential file is missing an entry for: {} {} {}", elements[i], + elements[j], elements[k]); elem3param[i][j][k] = n; } diff --git a/src/MANYBODY/pair_sw.cpp b/src/MANYBODY/pair_sw.cpp index de2a7ac8d6..ce1f8193fd 100644 --- a/src/MANYBODY/pair_sw.cpp +++ b/src/MANYBODY/pair_sw.cpp @@ -438,11 +438,13 @@ void PairSW::setup_params() for (m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement && k == params[m].kelement) { - if (n >= 0) error->all(FLERR,"Potential file has duplicate entry"); + if (n >= 0) error->all(FLERR,"Potential file has a duplicate entry for: {} {} {}", + elements[i], elements[j], elements[k]); n = m; } } - if (n < 0) error->all(FLERR,"Potential file is missing an entry"); + if (n < 0) error->all(FLERR,"Potential file is missing an entry for: {} {} {}", + elements[i], elements[j], elements[k]); elem3param[i][j][k] = n; } diff --git a/src/MANYBODY/pair_tersoff.cpp b/src/MANYBODY/pair_tersoff.cpp index 37ea0bfebf..8b4a51ae95 100644 --- a/src/MANYBODY/pair_tersoff.cpp +++ b/src/MANYBODY/pair_tersoff.cpp @@ -543,11 +543,13 @@ void PairTersoff::setup_params() for (m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement && k == params[m].kelement) { - if (n >= 0) error->all(FLERR,"Potential file has duplicate entry"); + if (n >= 0) error->all(FLERR,"Potential file has a duplicate entry for: {} {} {}", + elements[i], elements[j], elements[k]); n = m; } } - if (n < 0) error->all(FLERR,"Potential file is missing an entry"); + if (n < 0) error->all(FLERR,"Potential file is missing an entry for: {} {} {}", + elements[i], elements[j], elements[k]); elem3param[i][j][k] = n; } diff --git a/src/MANYBODY/pair_tersoff_mod.cpp b/src/MANYBODY/pair_tersoff_mod.cpp index bc34edfb75..f2edf81ba5 100644 --- a/src/MANYBODY/pair_tersoff_mod.cpp +++ b/src/MANYBODY/pair_tersoff_mod.cpp @@ -177,11 +177,13 @@ void PairTersoffMOD::setup_params() for (m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement && k == params[m].kelement) { - if (n >= 0) error->all(FLERR,"Potential file has duplicate entry"); + if (n >= 0) error->all(FLERR,"Potential file has a duplicate entry for: {} {} {}", + elements[i], elements[j], elements[k]); n = m; } } - if (n < 0) error->all(FLERR,"Potential file is missing an entry"); + if (n < 0) error->all(FLERR,"Potential file is missing an entry for: {} {} {}", + elements[i], elements[j], elements[k]); elem3param[i][j][k] = n; } diff --git a/src/MANYBODY/pair_tersoff_table.cpp b/src/MANYBODY/pair_tersoff_table.cpp index dee1fd3237..421d2c1e14 100644 --- a/src/MANYBODY/pair_tersoff_table.cpp +++ b/src/MANYBODY/pair_tersoff_table.cpp @@ -896,11 +896,13 @@ void PairTersoffTable::setup_params() for (m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement && k == params[m].kelement) { - if (n >= 0) error->all(FLERR,"Potential file has duplicate entry"); + if (n >= 0) error->all(FLERR,"Potential file has a duplicate entry for: {} {} {}", + elements[i], elements[j], elements[k]); n = m; } } - if (n < 0) error->all(FLERR,"Potential file is missing an entry"); + if (n < 0) error->all(FLERR,"Potential file is missing an entry for: {} {} {}", + elements[i], elements[j], elements[k]); elem3param[i][j][k] = n; } diff --git a/src/MANYBODY/pair_threebody_table.cpp b/src/MANYBODY/pair_threebody_table.cpp index 2f4bc83f5a..044f69a8da 100644 --- a/src/MANYBODY/pair_threebody_table.cpp +++ b/src/MANYBODY/pair_threebody_table.cpp @@ -403,11 +403,15 @@ void PairThreebodyTable::setup_params() n = -1; for (m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement && k == params[m].kelement) { - if (n >= 0) error->all(FLERR, "Potential file has duplicate entry"); + if (n >= 0) + error->all(FLERR, "Potential file has a duplicate entry for: {} {} {}", elements[i], + elements[j], elements[k]); n = m; } } - if (n < 0) error->all(FLERR, "Potential file is missing an entry"); + if (n < 0) + error->all(FLERR, "Potential file is missing an entry for: {} {} {}", elements[i], + elements[j], elements[k]); elem3param[i][j][k] = n; } diff --git a/src/MANYBODY/pair_vashishta.cpp b/src/MANYBODY/pair_vashishta.cpp index 6ce6c6f59a..30855fa6da 100644 --- a/src/MANYBODY/pair_vashishta.cpp +++ b/src/MANYBODY/pair_vashishta.cpp @@ -410,11 +410,13 @@ void PairVashishta::setup_params() for (m = 0; m < nparams; m++) { if (i == params[m].ielement && j == params[m].jelement && k == params[m].kelement) { - if (n >= 0) error->all(FLERR,"Potential file has duplicate entry"); + if (n >= 0) error->all(FLERR,"Potential file has a duplicate entry for: {} {} {}", + elements[i], elements[j], elements[k]); n = m; } } - if (n < 0) error->all(FLERR,"Potential file is missing an entry"); + if (n < 0) error->all(FLERR,"Potential file is missing an entry for: {} {} {}", + elements[i], elements[j], elements[k]); elem3param[i][j][k] = n; } diff --git a/src/MISC/pair_agni.cpp b/src/MISC/pair_agni.cpp index 46cc630f2d..ee744173fc 100644 --- a/src/MISC/pair_agni.cpp +++ b/src/MISC/pair_agni.cpp @@ -406,11 +406,11 @@ void PairAGNI::setup_params() n = -1; for (m = 0; m < nparams; m++) { if (i == params[m].ielement) { - if (n >= 0) error->all(FLERR,"Potential file has duplicate entry"); + if (n >= 0) error->all(FLERR,"Potential file has a duplicate entry for: {}", elements[i]); n = m; } } - if (n < 0) error->all(FLERR,"Potential file is missing an entry"); + if (n < 0) error->all(FLERR,"Potential file is missing an entry for: {}", elements[i]); elem1param[i] = n; } From cdf600b8cd81354d859b38e91165bf1c5401c795 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 22 Jul 2022 14:34:09 -0400 Subject: [PATCH 027/262] update description --- doc/src/Developer_updating.rst | 36 ++++++++++++++++++++++++++-------- 1 file changed, 28 insertions(+), 8 deletions(-) diff --git a/doc/src/Developer_updating.rst b/doc/src/Developer_updating.rst index 13e1772589..f33632d91a 100644 --- a/doc/src/Developer_updating.rst +++ b/doc/src/Developer_updating.rst @@ -1,16 +1,21 @@ Notes for updating code written for older LAMMPS versions --------------------------------------------------------- -This section documents how C++ source files that were written for an -older version of LAMMPS need to be updated to be compatible with the -current and future version(s). Due to the active development of LAMMPS -it is likely to always be incomplete. Please contact developer@lammps.org -in case you run across an issue that is not (yet) listed here. Please -also review the latest information about the LAMMPS :doc:`programming style -conventions `. +This section documents how C++ source files that are available *outside +of the LAMMPS source distribution* (e.g. in external USER packages or as +source files provided as a supplement to a publication) that are written +for an older version of LAMMPS and thus need to be updated to be +compatible with the current version of LAMMPS. Due to the active +development of LAMMPS it is likely to always be incomplete. Please +contact developer@lammps.org in case you run across an issue that is not +(yet) listed here. Please also review the latest information about the +LAMMPS :doc:`programming style conventions `, especially +if you are considering to submit the updated version for inclusion into +the LAMMPS distribution. -Available topics in chronological order are: +Available topics in mostly chronological order are: +- `Setting flags in the constructor`_ - `Rename of pack/unpack_comm() to pack/unpack_forward_comm()`_ - `Use ev_init() to initialize variables derived from eflag and vflag`_ - `Use utils::numeric() functions instead of force->numeric()`_ @@ -21,6 +26,21 @@ Available topics in chronological order are: ---- +Setting flags in the constructor +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +As LAMMPS gains additional functionality, new flags may need to be set +in the constructor or a class to signal compatibility with such features. +Most of the time the defaults are chosen conservatively, but sometimes +the conservative choice is the uncommon choice, and then those settings +need to be made when updating code. + +Pair styles: + + - ``manybody_flag``: set to 1 if your pair style is not pair-wise additive + - ``restartinfo``: set to 0 if your pair style does not store data in restart files + + Rename of pack/unpack_comm() to pack/unpack_forward_comm() ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ From 87d1aef54360c2a2cea44dbfcbff818a0f0f6b1a Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Sun, 24 Jul 2022 18:12:04 -0400 Subject: [PATCH 028/262] clarify whom to contact with questions about pre-built binaries. update ubuntu info --- doc/src/Install.rst | 18 ++++-- doc/src/Install_conda.rst | 7 ++ doc/src/Install_linux.rst | 130 ++++++++++++++++---------------------- 3 files changed, 76 insertions(+), 79 deletions(-) diff --git a/doc/src/Install.rst b/doc/src/Install.rst index 157bd32208..04e5333fea 100644 --- a/doc/src/Install.rst +++ b/doc/src/Install.rst @@ -3,10 +3,20 @@ Install LAMMPS You can download LAMMPS as an executable or as source code. -With source code, you also have to :doc:`build LAMMPS `. But you -have more flexibility as to what features to include or exclude in the -build. If you plan to :doc:`modify or extend LAMMPS `, then you -need the source code. +When downloading the LAMMPS source code, you also have to :doc:`build +LAMMPS `. But you have more flexibility as to what features to +include or exclude in the build. When you download and install +pre-compiled LAMMPS executables, you are limited to install which +version of LAMMPS is available and which features are included of these +builds. If you plan to :doc:`modify or extend LAMMPS `, then +you **must** build LAMMPS from the source code. + +.. note:: + + If you have questions about the pre-compiled LAMMPS executables, you + need to contact the people preparing those executables. The LAMMPS + developers have no control over their choices of how they configure + and build their packages and when they update them. .. toctree:: :maxdepth: 1 diff --git a/doc/src/Install_conda.rst b/doc/src/Install_conda.rst index 972c09d7d3..efb7b6146a 100644 --- a/doc/src/Install_conda.rst +++ b/doc/src/Install_conda.rst @@ -38,3 +38,10 @@ up the Conda capability. .. _openkim: https://openkim.org .. _conda: https://docs.conda.io/en/latest/index.html .. _mini_conda_install: https://docs.conda.io/en/latest/miniconda.html + +.. note:: + + If you have questions about these pre-compiled LAMMPS executables, + you need to contact the people preparing those packages. The LAMMPS + developers have no control over their choices of how they configure + and build their packages and when they update them. diff --git a/doc/src/Install_linux.rst b/doc/src/Install_linux.rst index bc44fe3b07..15a244f117 100644 --- a/doc/src/Install_linux.rst +++ b/doc/src/Install_linux.rst @@ -3,13 +3,19 @@ Download an executable for Linux Binaries are available for different versions of Linux: -| :ref:`Pre-built Ubuntu Linux executables ` -| :ref:`Pre-built Fedora Linux executables ` -| :ref:`Pre-built EPEL Linux executables (RHEL, CentOS) ` -| :ref:`Pre-built OpenSuse Linux executables ` -| :ref:`Gentoo Linux executable ` -| :ref:`Arch Linux build-script ` -| +- :ref:`Pre-built Ubuntu Linux executables ` +- :ref:`Pre-built Fedora Linux executables ` +- :ref:`Pre-built EPEL Linux executables (RHEL, CentOS) ` +- :ref:`Pre-built OpenSuse Linux executables ` +- :ref:`Gentoo Linux executable ` +- :ref:`Arch Linux build-script ` + +.. note:: + + If you have questions about these pre-compiled LAMMPS executables, + you need to contact the people preparing those packages. The LAMMPS + developers have no control over their choices of how they configure + and build their packages and when they update them. ---------- @@ -18,41 +24,28 @@ Binaries are available for different versions of Linux: Pre-built Ubuntu Linux executables ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -A pre-built LAMMPS executable suitable for running on the latest -Ubuntu Linux versions, can be downloaded as a Debian package. This -allows you to install LAMMPS with a single command, and stay -up-to-date with the current stable version of LAMMPS by simply updating -your operating system. Please note, that the repository below offers -two LAMMPS packages, ``lammps-daily`` and ``lammps-stable``. The -LAMMPS developers recommend to use the ``lammps-stable`` package for -any production simulations. The ``lammps-daily`` package is built -from the LAMMPS development sources, and those versions may have known -issues and bugs when new features are added and the software has not -undergone full release testing. - -To install the appropriate personal-package archives (PPAs), do the -following once: - -.. code-block:: bash - - $ sudo add-apt-repository ppa:gladky-anton/lammps - $ sudo add-apt-repository ppa:openkim/latest - $ sudo apt-get update +A pre-built LAMMPS executable suitable for running on the latest Ubuntu +Linux versions, can be downloaded as a Debian package. This allows you +to install LAMMPS with a single command, and stay (mostly) up-to-date +with the current stable version of LAMMPS by simply updating your +operating system. To install LAMMPS do the following once: .. code-block:: bash - $ sudo apt-get install lammps-stable + $ sudo apt-get install lammps -This downloads an executable named ``lmp_stable`` to your box, which -can then be used in the usual way to run input scripts: +This downloads an executable named ``lmp`` to your box and multiple +packages with supporting data, examples and libraries as well as any +missing dependencies. This executable can then be used in the usual way +to run input scripts: .. code-block:: bash - $ lmp_stable -in in.lj + $ lmp -in in.lj -To update LAMMPS to the most current stable version, do the following: +To update LAMMPS to the latest packaged version, do the following: .. code-block:: bash @@ -60,44 +53,24 @@ To update LAMMPS to the most current stable version, do the following: which will also update other packages on your system. -To get a copy of the current documentation and examples: - -.. code-block:: bash - - $ sudo apt-get install lammps-stable-doc - -which will download the doc files in -``/usr/share/doc/lammps-stable-doc/doc`` and example problems in -``/usr/share/doc/lammps-doc/examples``. - -To get a copy of the current potentials files: - -.. code-block:: bash - - $ sudo apt-get install lammps-stable-data - -which will download the potentials files to -``/usr/share/lammps-stable/potentials``. The ``lmp_stable`` binary is -hard-coded to look for potential files in this directory (it does not -use the ``LAMMPS_POTENTIALS`` environment variable, as described -in :doc:`pair_coeff ` command). - -The ``lmp_stable`` binary is built with the :ref:`KIM package ` which -results in the above command also installing the ``kim-api`` binaries when LAMMPS -is installed. In order to use potentials from `openkim.org `_, you -can install the ``openkim-models`` package +The ``lmp`` binary is built with the :ref:`KIM package ` included, +which results in the above command also installing the ``kim-api`` +binaries when LAMMPS is installed. In order to use potentials from +`openkim.org `_, you can also install the ``openkim-models`` +package .. code-block:: bash $ sudo apt-get install openkim-models +Or use the KIM-API commands to download and install individual models. To un-install LAMMPS, do the following: .. code-block:: bash - $ sudo apt-get remove lammps-stable + $ sudo apt-get remove lammps -Please use ``lmp_stable -help`` to see which compilation options, packages, +Please use ``lmp -help`` to see which compilation options, packages, and styles are included in the binary. Thanks to Anton Gladky (gladky.anton at gmail.com) for setting up this @@ -110,21 +83,21 @@ Ubuntu package capability. Pre-built Fedora Linux executables ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Pre-built LAMMPS packages for stable releases are available -in the Fedora Linux distribution as of version 28. The packages -can be installed via the dnf package manager. There are 3 basic -varieties (lammps = no MPI, lammps-mpich = MPICH MPI library, -lammps-openmpi = OpenMPI MPI library) and for each support for -linking to the C library interface (lammps-devel, lammps-mpich-devel, -lammps-openmpi-devel), the header for compiling programs using -the C library interface (lammps-headers), and the LAMMPS python -module for Python 3. All packages can be installed at the same -time and the name of the LAMMPS executable is ``lmp`` and ``lmp_openmpi`` -or ``lmp_mpich`` respectively. By default, ``lmp`` will refer to the -serial executable, unless one of the MPI environment modules is loaded -(``module load mpi/mpich-x86_64`` or ``module load mpi/openmpi-x86_64``). -Then the corresponding parallel LAMMPS executable can be used. -The same mechanism applies when loading the LAMMPS python module. +Pre-built LAMMPS packages for stable releases are available in the +Fedora Linux distribution as of Fedora version 28. The packages can be +installed via the dnf package manager. There are 3 basic varieties +(lammps = no MPI, lammps-mpich = MPICH MPI library, lammps-openmpi = +OpenMPI MPI library) and for each support for linking to the C library +interface (lammps-devel, lammps-mpich-devel, lammps-openmpi-devel), the +header for compiling programs using the C library interface +(lammps-headers), and the LAMMPS python module for Python 3. All +packages can be installed at the same time and the name of the LAMMPS +executable is ``lmp`` and ``lmp_openmpi`` or ``lmp_mpich`` respectively. +By default, ``lmp`` will refer to the serial executable, unless one of +the MPI environment modules is loaded (``module load mpi/mpich-x86_64`` +or ``module load mpi/openmpi-x86_64``). Then the corresponding parallel +LAMMPS executable can be used. The same mechanism applies when loading +the LAMMPS python module. To install LAMMPS with OpenMPI and run an input ``in.lj`` with 2 CPUs do: @@ -273,3 +246,10 @@ Alternatively, you may use an AUR helper to install these packages. Note that the AUR provides build-scripts that download the source and the build the package on your machine. + +.. note:: + + It looks like the Arch Linux AUR repository build scripts for LAMMPS + have not been updated since the 29 October 2020 version. You may want + to consider installing a more current version of LAMMPS from source + directly. From 762e79c49dcd4309629fe5a97b5f4cdc1d0b4ade Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 25 Jul 2022 08:56:51 -0400 Subject: [PATCH 029/262] initialize possibly uninitialized variabled --- src/AMOEBA/amoeba_polar.cpp | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/AMOEBA/amoeba_polar.cpp b/src/AMOEBA/amoeba_polar.cpp index f0670ea8c6..b8020cb513 100644 --- a/src/AMOEBA/amoeba_polar.cpp +++ b/src/AMOEBA/amoeba_polar.cpp @@ -499,6 +499,18 @@ void PairAmoeba::polar_real() urc3[k] = rc3[k] * factor_uscale; urc5[k] = rc5[k] * factor_uscale; } + } else { + // avoid uninitialized data access when damp == 0.0 + psc3 = psc5 = psc7 = dsc3 = dsc5 = dsc7 = usc3 = usc5 = 0.0; + psr3 = psr5 = psr7 = dsr3 = dsr5 = dsr7 = usr5 = 0.0; + prc3[0] = prc3[1] = prc3[2] = 0.0; + drc3[0] = drc3[1] = drc3[2] = 0.0; + prc5[0] = prc5[1] = prc5[2] = 0.0; + drc5[0] = drc5[1] = drc5[2] = 0.0; + prc7[0] = prc7[1] = prc7[2] = 0.0; + drc7[0] = drc7[1] = drc7[2] = 0.0; + urc3[0] = urc3[1] = urc3[2] = 0.0; + urc5[0] = urc5[1] = urc5[2] = 0.0; } // apply charge penetration damping to scale factors From bcc49aca844343a838fbc8bf801b759f5a7251a3 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 25 Jul 2022 09:01:26 -0400 Subject: [PATCH 030/262] fix logic issue --- src/AMOEBA/amoeba_utils.cpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/AMOEBA/amoeba_utils.cpp b/src/AMOEBA/amoeba_utils.cpp index b01b9f11b6..332b62708e 100644 --- a/src/AMOEBA/amoeba_utils.cpp +++ b/src/AMOEBA/amoeba_utils.cpp @@ -84,9 +84,9 @@ void PairAmoeba::kmpole() if (bondneigh[j] < smallest) { smallest = bondneigh[j]; k = j; + bondneigh[k] = bondneigh[m]; + bondneigh[m] = smallest; } - bondneigh[k] = bondneigh[m]; - bondneigh[m] = smallest; } } From e99494d838c8fa3034e919222c0367c0a33affd0 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 25 Jul 2022 09:02:54 -0400 Subject: [PATCH 031/262] fix copy-n-paste error --- src/AMOEBA/amoeba_kspace.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/AMOEBA/amoeba_kspace.cpp b/src/AMOEBA/amoeba_kspace.cpp index 22b83c1b59..5e12deae1c 100644 --- a/src/AMOEBA/amoeba_kspace.cpp +++ b/src/AMOEBA/amoeba_kspace.cpp @@ -1137,7 +1137,7 @@ void PairAmoeba::kewald() // NOTE: also worry about satisfying Tinker minfft ? while (!factorable(ndfft1)) ndfft1++; - while (!factorable(ndfft2)) ndfft3++; + while (!factorable(ndfft2)) ndfft2++; while (!factorable(ndfft3)) ndfft3++; } From 6dc966408704ed604b209539aec4c4d087f55392 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 25 Jul 2022 09:06:09 -0400 Subject: [PATCH 032/262] avoid uninitialized data access --- src/AMOEBA/angle_amoeba.cpp | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/AMOEBA/angle_amoeba.cpp b/src/AMOEBA/angle_amoeba.cpp index 4b9342f058..33b89a29f5 100644 --- a/src/AMOEBA/angle_amoeba.cpp +++ b/src/AMOEBA/angle_amoeba.cpp @@ -53,6 +53,9 @@ AngleAmoeba::AngleAmoeba(LAMMPS *lmp) : Angle(lmp) ub_k = nullptr; ub_r0 = nullptr; + + setflag_a = setflag_ba = setflag_ub = nullptr; + enable_angle = enable_urey = 0; } /* ---------------------------------------------------------------------- */ From f736248efb484b1f199eceb75c4d5969262fcc7e Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 25 Jul 2022 09:17:37 -0400 Subject: [PATCH 033/262] replace calls to pow() with faster functions for integer powers --- src/AMOEBA/amoeba_hal.cpp | 13 +++++++++---- src/AMOEBA/amoeba_induce.cpp | 9 ++++++--- src/AMOEBA/amoeba_kspace.cpp | 11 +++++++---- src/AMOEBA/amoeba_multipole.cpp | 5 ++++- src/AMOEBA/amoeba_polar.cpp | 10 +++++++--- src/AMOEBA/amoeba_repulsion.cpp | 2 +- src/AMOEBA/pair_amoeba.cpp | 7 +++++-- 7 files changed, 39 insertions(+), 18 deletions(-) diff --git a/src/AMOEBA/amoeba_hal.cpp b/src/AMOEBA/amoeba_hal.cpp index 21bb7ad099..896595945e 100644 --- a/src/AMOEBA/amoeba_hal.cpp +++ b/src/AMOEBA/amoeba_hal.cpp @@ -16,12 +16,17 @@ #include "atom.h" #include "error.h" +#include "math_special.h" #include "neigh_list.h" #include using namespace LAMMPS_NS; +using MathSpecial::square; +using MathSpecial::cube; +using MathSpecial::powint; + enum{VDWL,REPULSE,QFER,DISP,MPOLE,POLAR,USOLV,DISP_LONG,MPOLE_LONG,POLAR_LONG}; /* ---------------------------------------------------------------------- @@ -114,14 +119,14 @@ void PairAmoeba::hal() } eps *= factor_hal; - rv7 = pow(rv,7.0); - rik6 = pow(rik2,3.0); + rv7 = powint(rv,7); + rik6 = cube(rik2); rik7 = rik6 * rik; rho = rik7 + ghal*rv7; tau = (dhal+1.0) / (rik + dhal*rv); - tau7 = pow(tau,7.0); + tau7 = powint(tau,7); dtau = tau / (dhal+1.0); - gtau = eps*tau7*rik6*(ghal+1.0)*pow(rv7/rho,2.0); + gtau = eps*tau7*rik6*(ghal+1.0)*square(rv7/rho); e = eps*tau7*rv7*((ghal+1.0)*rv7/rho-2.0); de = -7.0 * (dtau*e+gtau); diff --git a/src/AMOEBA/amoeba_induce.cpp b/src/AMOEBA/amoeba_induce.cpp index 3d9d7809cc..43688cef94 100644 --- a/src/AMOEBA/amoeba_induce.cpp +++ b/src/AMOEBA/amoeba_induce.cpp @@ -22,6 +22,7 @@ #include "fft3d_wrap.h" #include "fix_store.h" #include "math_const.h" +#include "math_special.h" #include "memory.h" #include "my_page.h" #include "neigh_list.h" @@ -32,6 +33,8 @@ using namespace LAMMPS_NS; using namespace MathConst; +using MathSpecial::cube; + enum{INDUCE,RSD,SETUP_AMOEBA,SETUP_HIPPO,KMPOLE,AMGROUP}; // forward comm enum{FIELD,ZRSD,TORQUE,UFLD}; // reverse comm enum{VDWL,REPULSE,QFER,DISP,MPOLE,POLAR,USOLV,DISP_LONG,MPOLE_LONG,POLAR_LONG}; @@ -732,7 +735,7 @@ void PairAmoeba::uscale0b(int mode, double **rsd, double **rsdp, damp = pdi * pdamp[jtype]; if (damp != 0.0) { pgamma = MIN(pti,thole[jtype]); - damp = -pgamma * pow((r/damp),3.0); + damp = -pgamma * cube(r/damp); if (damp > -50.0) { expdamp = exp(damp); scale3 *= 1.0 - expdamp; @@ -1332,7 +1335,7 @@ void PairAmoeba::udirect2b(double **field, double **fieldp) } } else { pgamma = MIN(pti,thole[jtype]); - damp = pgamma * pow(r/damp,3.0); + damp = pgamma * cube(r/damp); if (damp < 50.0) { expdamp = exp(-damp); scale3 = 1.0 - expdamp; @@ -1384,7 +1387,7 @@ void PairAmoeba::udirect2b(double **field, double **fieldp) damp = pdi * pdamp[jtype]; if (damp != 0.0) { pgamma = MIN(pti,thole[jtype]); - damp = pgamma * pow(r/damp,3.0); + damp = pgamma * cube(r/damp); if (damp < 50.0) { expdamp = exp(-damp); scale3 = 1.0 - expdamp; diff --git a/src/AMOEBA/amoeba_kspace.cpp b/src/AMOEBA/amoeba_kspace.cpp index 5e12deae1c..51b206b6d8 100644 --- a/src/AMOEBA/amoeba_kspace.cpp +++ b/src/AMOEBA/amoeba_kspace.cpp @@ -17,6 +17,7 @@ #include "atom.h" #include "domain.h" #include "math_const.h" +#include "math_special.h" #include "memory.h" #include @@ -24,6 +25,8 @@ using namespace LAMMPS_NS; using namespace MathConst; +using MathSpecial::powint; + #define ANINT(x) ((x)>0 ? floor((x)+0.5) : ceil((x)-0.5)) /* ---------------------------------------------------------------------- @@ -173,13 +176,13 @@ void PairAmoeba::dftmod(double *bsmod, double *bsarray, int nfft, int order) factor = MY_PI * k / nfft; for (j = 1; j <= jcut; j++) { arg = factor / (factor + MY_PI*j); - sum1 += pow(arg,order); - sum2 += pow(arg,order2); + sum1 += powint(arg,order); + sum2 += powint(arg,order2); } for (j = 1; j <= jcut; j++) { arg = factor / (factor - MY_PI*j); - sum1 += pow(arg,order); - sum2 += pow(arg,order2); + sum1 += powint(arg,order); + sum2 += powint(arg,order2); } zeta = sum2 / sum1; } diff --git a/src/AMOEBA/amoeba_multipole.cpp b/src/AMOEBA/amoeba_multipole.cpp index 5d11bde1ab..8466a8fe1d 100644 --- a/src/AMOEBA/amoeba_multipole.cpp +++ b/src/AMOEBA/amoeba_multipole.cpp @@ -20,6 +20,7 @@ #include "domain.h" #include "fft3d_wrap.h" #include "math_const.h" +#include "math_special.h" #include "memory.h" #include "neigh_list.h" @@ -29,6 +30,8 @@ using namespace LAMMPS_NS; using namespace MathConst; +using MathSpecial::square; + enum{FIELD,ZRSD,TORQUE,UFLD}; // reverse comm enum{VDWL,REPULSE,QFER,DISP,MPOLE,POLAR,USOLV,DISP_LONG,MPOLE_LONG,POLAR_LONG}; @@ -670,7 +673,7 @@ void PairAmoeba::multipole_kspace() nzlo = m_kspace->nzlo_fft; nzhi = m_kspace->nzhi_fft; - pterm = pow((MY_PI/aewald),2.0); + pterm = square(MY_PI/aewald); volterm = MY_PI * volbox; n = 0; diff --git a/src/AMOEBA/amoeba_polar.cpp b/src/AMOEBA/amoeba_polar.cpp index b8020cb513..ad6b585f25 100644 --- a/src/AMOEBA/amoeba_polar.cpp +++ b/src/AMOEBA/amoeba_polar.cpp @@ -20,6 +20,7 @@ #include "domain.h" #include "fft3d_wrap.h" #include "math_const.h" +#include "math_special.h" #include "memory.h" #include "neigh_list.h" @@ -29,6 +30,9 @@ using namespace LAMMPS_NS; using namespace MathConst; +using MathSpecial::square; +using MathSpecial::cube; + enum{FIELD,ZRSD,TORQUE,UFLD}; // reverse comm enum{MUTUAL,OPT,TCG,DIRECT}; enum{VDWL,REPULSE,QFER,DISP,MPOLE,POLAR,USOLV,DISP_LONG,MPOLE_LONG,POLAR_LONG}; @@ -82,7 +86,7 @@ void PairAmoeba::polar() // compute the Ewald self-energy torque and virial terms - term = (4.0/3.0) * felec * pow(aewald,3.0) / MY_PIS; + term = (4.0/3.0) * felec * cube(aewald) / MY_PIS; for (i = 0; i < nlocal; i++) { dix = rpole[i][1]; @@ -454,7 +458,7 @@ void PairAmoeba::polar_real() damp = pdi * pdamp[jtype]; if (damp != 0.0) { pgamma = MIN(pti,thole[jtype]); - damp = pgamma * pow(r/damp,3.0); + damp = pgamma * cube(r/damp); if (damp < 50.0) { expdamp = exp(-damp); sc3 = 1.0 - expdamp; @@ -1272,7 +1276,7 @@ void PairAmoeba::polar_kspace() int nlocal = atom->nlocal; double volbox = domain->prd[0] * domain->prd[1] * domain->prd[2]; - pterm = pow((MY_PI/aewald),2.0); + pterm = square(MY_PI/aewald); volterm = MY_PI * volbox; // initialize variables required for the scalar summation diff --git a/src/AMOEBA/amoeba_repulsion.cpp b/src/AMOEBA/amoeba_repulsion.cpp index 0784a32d0b..041d74e54d 100644 --- a/src/AMOEBA/amoeba_repulsion.cpp +++ b/src/AMOEBA/amoeba_repulsion.cpp @@ -504,7 +504,7 @@ void PairAmoeba::damprep(double r, double r2, double rr1, double rr3, dmpk24 = dmpk23 * dmpk2; dmpk25 = dmpk24 * dmpk2; term = dmpi22 - dmpk22; - pre = 8192.0 * dmpi23 * dmpk23 / pow(term,4.0); + pre = 8192.0 * dmpi23 * dmpk23 / (term*term*term*term); tmp = 4.0 * dmpi2 * dmpk2 / term; s = (dampi-tmp)*expk + (dampk+tmp)*expi; diff --git a/src/AMOEBA/pair_amoeba.cpp b/src/AMOEBA/pair_amoeba.cpp index be5f9c73df..e8b7b71753 100644 --- a/src/AMOEBA/pair_amoeba.cpp +++ b/src/AMOEBA/pair_amoeba.cpp @@ -25,6 +25,7 @@ #include "force.h" #include "gridcomm.h" #include "group.h" +#include "math_special.h" #include "memory.h" #include "modify.h" #include "my_page.h" @@ -40,6 +41,8 @@ using namespace LAMMPS_NS; +using MathSpecial::powint; + enum{INDUCE,RSD,SETUP_AMOEBA,SETUP_HIPPO,KMPOLE,AMGROUP,PVAL}; // forward comm enum{FIELD,ZRSD,TORQUE,UFLD}; // reverse comm enum{ARITHMETIC,GEOMETRIC,CUBIC_MEAN,R_MIN,SIGMA,DIAMETER,HARMONIC,HHG,W_H}; @@ -1956,7 +1959,7 @@ void PairAmoeba::choose(int which) // taper coeffs - double denom = pow(off-cut,5.0); + double denom = powint(off-cut,5); c0 = off*off2 * (off2 - 5.0*off*cut + 10.0*cut2) / denom; c1 = -30.0 * off2*cut2 / denom; c2 = 30.0 * (off2*cut+off*cut2) / denom; @@ -2026,7 +2029,7 @@ void PairAmoeba::mix() } else if (epsilon_rule == HHG) { eij = 4.0 * (ei*ej) / ((sei+sej)*(sei+sej)); } else if (epsilon_rule == W_H) { - eij = 2.0 * (sei*sej) * pow(ri*rj,3.0) / (pow(ri,6.0) + pow(rj,6.0)); + eij = 2.0 * (sei*sej) * powint(ri*rj,3) / (powint(ri,6) + powint(rj,6)); } else { eij = sei * sej; } From 7b54b974d3dbc1f29f6eaa68fea2adf034f47447 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 25 Jul 2022 11:48:21 -0400 Subject: [PATCH 034/262] remove dead code --- src/dump_custom.h | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/dump_custom.h b/src/dump_custom.h index b27a9950cd..dd653d5e98 100644 --- a/src/dump_custom.h +++ b/src/dump_custom.h @@ -127,11 +127,6 @@ class DumpCustom : public Dump { void header_item(bigint); void header_item_triclinic(bigint); - typedef int (DumpCustom::*FnPtrConvert)(int, double *); - FnPtrConvert convert_choice; // ptr to convert data functions - int convert_image(int, double *); - int convert_noimage(int, double *); - typedef void (DumpCustom::*FnPtrWrite)(int, double *); FnPtrWrite write_choice; // ptr to write data functions void write_binary(int, double *); From 5f6785017138f173bfa14e7552f3537fd97e3674 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 25 Jul 2022 22:32:59 -0400 Subject: [PATCH 035/262] correct typos --- doc/src/Intro_citing.rst | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/src/Intro_citing.rst b/doc/src/Intro_citing.rst index e10b1857f1..aaf62028ae 100644 --- a/doc/src/Intro_citing.rst +++ b/doc/src/Intro_citing.rst @@ -33,9 +33,9 @@ initial versions of LAMMPS is: DOI for the LAMMPS source code ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -LAMMPS developers use the `Zenodo service at CERN `_ -to create digital object identifies (DOI) for stable releases of the -LAMMPS source code. There are two types of DOIs for the LAMMPS source code. +The LAMMPS developers use the `Zenodo service at CERN `_ +to create digital object identifiers (DOI) for stable releases of the +LAMMPS source code. There are two types of DOIs for the LAMMPS source code. The canonical DOI for **all** versions of LAMMPS, which will always point to the **latest** stable release version is: From d347a27a396dde34254739e17f5876e9fa32d0f1 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Tue, 26 Jul 2022 09:18:21 -0400 Subject: [PATCH 036/262] add reference --- doc/src/label.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/src/label.rst b/doc/src/label.rst index 710a1b1b40..430587135f 100644 --- a/doc/src/label.rst +++ b/doc/src/label.rst @@ -38,7 +38,7 @@ Restrictions Related commands """""""""""""""" -none +:doc:`jump `, :doc:`next ` Default From b2cdc4091908478a3054b55d48d3e2516ccdf6ef Mon Sep 17 00:00:00 2001 From: Paulius Velesko Date: Tue, 26 Jul 2022 16:00:43 +0000 Subject: [PATCH 037/262] Enable CHIP-SPV support --- cmake/Modules/Packages/GPU.cmake | 14 ++++++++++++-- lib/gpu/lal_pre_cuda_hip.h | 12 ++++++------ 2 files changed, 18 insertions(+), 8 deletions(-) diff --git a/cmake/Modules/Packages/GPU.cmake b/cmake/Modules/Packages/GPU.cmake index 75569aa55d..36409378be 100644 --- a/cmake/Modules/Packages/GPU.cmake +++ b/cmake/Modules/Packages/GPU.cmake @@ -233,7 +233,7 @@ elseif(GPU_API STREQUAL "OPENCL") elseif(GPU_API STREQUAL "HIP") if(NOT DEFINED HIP_PATH) if(NOT DEFINED ENV{HIP_PATH}) - set(HIP_PATH "/opt/rocm/hip" CACHE PATH "Path to HIP installation") + message(FATAL_ERROR "GPU_API=HIP requires HIP_PATH to be defined") else() set(HIP_PATH $ENV{HIP_PATH} CACHE PATH "Path to HIP installation") endif() @@ -261,6 +261,8 @@ elseif(GPU_API STREQUAL "HIP") if(HIP_PLATFORM STREQUAL "hcc" OR HIP_PLATFORM STREQUAL "amd") set(HIP_ARCH "gfx906" CACHE STRING "HIP target architecture") + elseif(HIP_PLATFORM STREQUAL "spirv") + set(HIP_ARCH "spirv" CACHE STRING "HIP target architecture") elseif(HIP_PLATFORM STREQUAL "nvcc") find_package(CUDA REQUIRED) set(HIP_ARCH "sm_50" CACHE STRING "HIP primary CUDA architecture (e.g. sm_60)") @@ -321,7 +323,15 @@ elseif(GPU_API STREQUAL "HIP") set(CUBIN_FILE "${LAMMPS_LIB_BINARY_DIR}/gpu/${CU_NAME}.cubin") set(CUBIN_H_FILE "${LAMMPS_LIB_BINARY_DIR}/gpu/${CU_NAME}_cubin.h") - if(HIP_PLATFORM STREQUAL "hcc" OR HIP_PLATFORM STREQUAL "amd") + if(HIP_PLATFORM STREQUAL "spirv") + configure_file(${CU_FILE} ${CU_CPP_FILE} COPYONLY) + + add_custom_command(OUTPUT ${CUBIN_FILE} + VERBATIM COMMAND ${HIP_HIPCC_EXECUTABLE} -c -O3 -DUSE_HIP -D_${GPU_PREC_SETTING} -DLAMMPS_${LAMMPS_SIZES} -I${LAMMPS_LIB_SOURCE_DIR}/gpu -o ${CUBIN_FILE} ${CU_CPP_FILE} + DEPENDS ${CU_CPP_FILE} + COMMENT "Gerating ${CU_NAME}.cubin") + + elseif(HIP_PLATFORM STREQUAL "hcc" OR HIP_PLATFORM STREQUAL "amd") configure_file(${CU_FILE} ${CU_CPP_FILE} COPYONLY) if(HIP_COMPILER STREQUAL "clang") diff --git a/lib/gpu/lal_pre_cuda_hip.h b/lib/gpu/lal_pre_cuda_hip.h index 47a005b998..f6ab1b5b6b 100644 --- a/lib/gpu/lal_pre_cuda_hip.h +++ b/lib/gpu/lal_pre_cuda_hip.h @@ -30,7 +30,7 @@ // ------------------------------------------------------------------------- -#if defined(__HIP_PLATFORM_HCC__) || defined(__HIP_PLATFORM_AMD__) +#if defined(__HIP_PLATFORM_HCC__) || defined(__HIP_PLATFORM_AMD__) || defined(__HIP_PLATFORM_SPIRV__) #define CONFIG_ID 303 #define SIMD_SIZE 64 #else @@ -112,7 +112,7 @@ // KERNEL MACROS - TEXTURES // ------------------------------------------------------------------------- -#if defined(__HIP_PLATFORM_HCC__) || defined(__HIP_PLATFORM_AMD__) +#if defined(__HIP_PLATFORM_HCC__) || defined(__HIP_PLATFORM_AMD__) || defined(__HIP_PLATFORM_SPIRV__) #define _texture(name, type) __device__ type* name #define _texture_2d(name, type) __device__ type* name #else @@ -135,8 +135,8 @@ ans=__hiloint2double(qt.y, qt.x); \ } #else - #define fetch4(ans,i,pos_tex) ans=tex1Dfetch(pos_tex, i); - #define fetch(ans,i,q_tex) ans=tex1Dfetch(q_tex,i); + #define fetch4(ans,i,pos_tex) tex1Dfetch(&ans, pos_tex, i); + #define fetch(ans,i,q_tex) tex1Dfetch(&ans, q_tex,i); #endif #else #define fetch4(ans,i,x) ans=x[i] @@ -152,7 +152,7 @@ #define mu_tex mu_ #endif -#if defined(__HIP_PLATFORM_HCC__) || defined(__HIP_PLATFORM_AMD__) +#if defined(__HIP_PLATFORM_HCC__) || defined(__HIP_PLATFORM_AMD__) || defined(__HIP_PLATFORM_SPIRV__) #undef fetch4 #undef fetch @@ -209,7 +209,7 @@ #endif #endif -#if defined(CUDA_PRE_NINE) || defined(__HIP_PLATFORM_HCC__) || defined(__HIP_PLATFORM_AMD__) +#if defined(CUDA_PRE_NINE) || defined(__HIP_PLATFORM_HCC__) || defined(__HIP_PLATFORM_AMD__) || defined(__HIP_PLATFORM_SPIRV__) #ifdef _SINGLE_SINGLE #define shfl_down __shfl_down From e973a4b31c74f3fab26010e324a863d8b02a6bd1 Mon Sep 17 00:00:00 2001 From: Paulius Velesko Date: Tue, 26 Jul 2022 16:14:43 +0000 Subject: [PATCH 038/262] workaround for CHIP-SPV different textrure func --- .gitignore | 1 - lib/gpu/lal_pre_cuda_hip.h | 7 +++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index 0cc211ab09..bd2d0ea705 100644 --- a/.gitignore +++ b/.gitignore @@ -55,4 +55,3 @@ out/RelWithDebInfo out/Release out/x86 out/x64 -benchmark/* diff --git a/lib/gpu/lal_pre_cuda_hip.h b/lib/gpu/lal_pre_cuda_hip.h index f6ab1b5b6b..ec666a2863 100644 --- a/lib/gpu/lal_pre_cuda_hip.h +++ b/lib/gpu/lal_pre_cuda_hip.h @@ -134,9 +134,12 @@ int2 qt = tex1Dfetch(q_tex,i); \ ans=__hiloint2double(qt.y, qt.x); \ } + #elseif defined(__HIP_PLATFORM_SPIRV__) + #define fetch4(ans,i,pos_tex) tex1Dfetch(&ans, pos_tex, i); + #define fetch(ans,i,q_tex) tex1Dfetch(&ans, q_tex,i); #else - #define fetch4(ans,i,pos_tex) tex1Dfetch(&ans, pos_tex, i); - #define fetch(ans,i,q_tex) tex1Dfetch(&ans, q_tex,i); + #define fetch4(ans,i,pos_tex) ans=tex1Dfetch(pos_tex, i); + #define fetch(ans,i,q_tex) ans=tex1Dfetch(q_tex,i); #endif #else #define fetch4(ans,i,x) ans=x[i] From 4f8a1ca52685f65965aab558641b7ce58b39c86e Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Tue, 26 Jul 2022 12:32:42 -0400 Subject: [PATCH 039/262] correct formatting --- doc/lammps.1 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lammps.1 b/doc/lammps.1 index 5f1c25867e..586627258e 100644 --- a/doc/lammps.1 +++ b/doc/lammps.1 @@ -161,7 +161,7 @@ list references for specific cite-able features used during a run. .TP \fB\-pk