1 /* -- translated by f2c (version 20191129). 2 You must link the resulting object file with libf2c: 3 on Microsoft Windows system, link with libf2c.lib; 4 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 5 or, if you install libf2c.a in a standard place, with -lf2c -lm 6 -- in that order, at the end of the command line, as in 7 cc *.o -lf2c -lm 8 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 9 10 http://www.netlib.org/f2c/libf2c.zip 11 */ 12 13 #include "f2c.h" 14 15 /* > \brief \b DGEBAK 16 17 =========== DOCUMENTATION =========== 18 19 Online html documentation available at 20 http://www.netlib.org/lapack/explore-html/ 21 22 > \htmlonly 23 > Download DGEBAK + dependencies 24 > <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgebak. 25 f"> 26 > [TGZ]</a> 27 > <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgebak. 28 f"> 29 > [ZIP]</a> 30 > <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgebak. 31 f"> 32 > [TXT]</a> 33 > \endhtmlonly 34 35 Definition: 36 =========== 37 38 SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, 39 INFO ) 40 41 CHARACTER JOB, SIDE 42 INTEGER IHI, ILO, INFO, LDV, M, N 43 DOUBLE PRECISION SCALE( * ), V( LDV, * ) 44 45 46 > \par Purpose: 47 ============= 48 > 49 > \verbatim 50 > 51 > DGEBAK forms the right or left eigenvectors of a real general matrix 52 > by backward transformation on the computed eigenvectors of the 53 > balanced matrix output by DGEBAL. 54 > \endverbatim 55 56 Arguments: 57 ========== 58 59 > \param[in] JOB 60 > \verbatim 61 > JOB is CHARACTER*1 62 > Specifies the type of backward transformation required: 63 > = 'N', do nothing, return immediately; 64 > = 'P', do backward transformation for permutation only; 65 > = 'S', do backward transformation for scaling only; 66 > = 'B', do backward transformations for both permutation and 67 > scaling. 68 > JOB must be the same as the argument JOB supplied to DGEBAL. 69 > \endverbatim 70 > 71 > \param[in] SIDE 72 > \verbatim 73 > SIDE is CHARACTER*1 74 > = 'R': V contains right eigenvectors; 75 > = 'L': V contains left eigenvectors. 76 > \endverbatim 77 > 78 > \param[in] N 79 > \verbatim 80 > N is INTEGER 81 > The number of rows of the matrix V. N >= 0. 82 > \endverbatim 83 > 84 > \param[in] ILO 85 > \verbatim 86 > ILO is INTEGER 87 > \endverbatim 88 > 89 > \param[in] IHI 90 > \verbatim 91 > IHI is INTEGER 92 > The integers ILO and IHI determined by DGEBAL. 93 > 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. 94 > \endverbatim 95 > 96 > \param[in] SCALE 97 > \verbatim 98 > SCALE is DOUBLE PRECISION array, dimension (N) 99 > Details of the permutation and scaling factors, as returned 100 > by DGEBAL. 101 > \endverbatim 102 > 103 > \param[in] M 104 > \verbatim 105 > M is INTEGER 106 > The number of columns of the matrix V. M >= 0. 107 > \endverbatim 108 > 109 > \param[in,out] V 110 > \verbatim 111 > V is DOUBLE PRECISION array, dimension (LDV,M) 112 > On entry, the matrix of right or left eigenvectors to be 113 > transformed, as returned by DHSEIN or DTREVC. 114 > On exit, V is overwritten by the transformed eigenvectors. 115 > \endverbatim 116 > 117 > \param[in] LDV 118 > \verbatim 119 > LDV is INTEGER 120 > The leading dimension of the array V. LDV >= max(1,N). 121 > \endverbatim 122 > 123 > \param[out] INFO 124 > \verbatim 125 > INFO is INTEGER 126 > = 0: successful exit 127 > < 0: if INFO = -i, the i-th argument had an illegal value. 128 > \endverbatim 129 130 Authors: 131 ======== 132 133 > \author Univ. of Tennessee 134 > \author Univ. of California Berkeley 135 > \author Univ. of Colorado Denver 136 > \author NAG Ltd. 137 138 > \date November 2011 139 140 > \ingroup doubleGEcomputational 141 142 ===================================================================== igraphdgebak_(char * job,char * side,integer * n,integer * ilo,integer * ihi,doublereal * scale,integer * m,doublereal * v,integer * ldv,integer * info)143 Subroutine */ int igraphdgebak_(char *job, char *side, integer *n, integer *ilo, 144 integer *ihi, doublereal *scale, integer *m, doublereal *v, integer * 145 ldv, integer *info) 146 { 147 /* System generated locals */ 148 integer v_dim1, v_offset, i__1; 149 150 /* Local variables */ 151 integer i__, k; 152 doublereal s; 153 integer ii; 154 extern /* Subroutine */ int igraphdscal_(integer *, doublereal *, doublereal *, 155 integer *); 156 extern logical igraphlsame_(char *, char *); 157 extern /* Subroutine */ int igraphdswap_(integer *, doublereal *, integer *, 158 doublereal *, integer *); 159 logical leftv; 160 extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen); 161 logical rightv; 162 163 164 /* -- LAPACK computational routine (version 3.4.0) -- 165 -- LAPACK is a software package provided by Univ. of Tennessee, -- 166 -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 167 November 2011 168 169 170 ===================================================================== 171 172 173 Decode and Test the input parameters 174 175 Parameter adjustments */ 176 --scale; 177 v_dim1 = *ldv; 178 v_offset = 1 + v_dim1; 179 v -= v_offset; 180 181 /* Function Body */ 182 rightv = igraphlsame_(side, "R"); 183 leftv = igraphlsame_(side, "L"); 184 185 *info = 0; 186 if (! igraphlsame_(job, "N") && ! igraphlsame_(job, "P") && ! igraphlsame_(job, "S") 187 && ! igraphlsame_(job, "B")) { 188 *info = -1; 189 } else if (! rightv && ! leftv) { 190 *info = -2; 191 } else if (*n < 0) { 192 *info = -3; 193 } else if (*ilo < 1 || *ilo > max(1,*n)) { 194 *info = -4; 195 } else if (*ihi < min(*ilo,*n) || *ihi > *n) { 196 *info = -5; 197 } else if (*m < 0) { 198 *info = -7; 199 } else if (*ldv < max(1,*n)) { 200 *info = -9; 201 } 202 if (*info != 0) { 203 i__1 = -(*info); 204 igraphxerbla_("DGEBAK", &i__1, (ftnlen)6); 205 return 0; 206 } 207 208 /* Quick return if possible */ 209 210 if (*n == 0) { 211 return 0; 212 } 213 if (*m == 0) { 214 return 0; 215 } 216 if (igraphlsame_(job, "N")) { 217 return 0; 218 } 219 220 if (*ilo == *ihi) { 221 goto L30; 222 } 223 224 /* Backward balance */ 225 226 if (igraphlsame_(job, "S") || igraphlsame_(job, "B")) { 227 228 if (rightv) { 229 i__1 = *ihi; 230 for (i__ = *ilo; i__ <= i__1; ++i__) { 231 s = scale[i__]; 232 igraphdscal_(m, &s, &v[i__ + v_dim1], ldv); 233 /* L10: */ 234 } 235 } 236 237 if (leftv) { 238 i__1 = *ihi; 239 for (i__ = *ilo; i__ <= i__1; ++i__) { 240 s = 1. / scale[i__]; 241 igraphdscal_(m, &s, &v[i__ + v_dim1], ldv); 242 /* L20: */ 243 } 244 } 245 246 } 247 248 /* Backward permutation 249 250 For I = ILO-1 step -1 until 1, 251 IHI+1 step 1 until N do -- */ 252 253 L30: 254 if (igraphlsame_(job, "P") || igraphlsame_(job, "B")) { 255 if (rightv) { 256 i__1 = *n; 257 for (ii = 1; ii <= i__1; ++ii) { 258 i__ = ii; 259 if (i__ >= *ilo && i__ <= *ihi) { 260 goto L40; 261 } 262 if (i__ < *ilo) { 263 i__ = *ilo - ii; 264 } 265 k = (integer) scale[i__]; 266 if (k == i__) { 267 goto L40; 268 } 269 igraphdswap_(m, &v[i__ + v_dim1], ldv, &v[k + v_dim1], ldv); 270 L40: 271 ; 272 } 273 } 274 275 if (leftv) { 276 i__1 = *n; 277 for (ii = 1; ii <= i__1; ++ii) { 278 i__ = ii; 279 if (i__ >= *ilo && i__ <= *ihi) { 280 goto L50; 281 } 282 if (i__ < *ilo) { 283 i__ = *ilo - ii; 284 } 285 k = (integer) scale[i__]; 286 if (k == i__) { 287 goto L50; 288 } 289 igraphdswap_(m, &v[i__ + v_dim1], ldv, &v[k + v_dim1], ldv); 290 L50: 291 ; 292 } 293 } 294 } 295 296 return 0; 297 298 /* End of DGEBAK */ 299 300 } /* igraphdgebak_ */ 301 302