AbstractLinAlgPack: C++ Interfaces For Vectors, Matrices And Related Linear Algebra Objects Version of the Day
dchud_c.c
00001 /*
00002 // @HEADER
00003 // ***********************************************************************
00004 // 
00005 // Moocho: Multi-functional Object-Oriented arCHitecture for Optimization
00006 //                  Copyright (2003) Sandia Corporation
00007 // 
00008 // Under terms of Contract DE-AC04-94AL85000, there is a non-exclusive
00009 // license for use of this work by or on behalf of the U.S. Government.
00010 // 
00011 // Redistribution and use in source and binary forms, with or without
00012 // modification, are permitted provided that the following conditions are
00013 // met:
00014 //
00015 // 1. Redistributions of source code must retain the above copyright
00016 // notice, this list of conditions and the following disclaimer.
00017 //
00018 // 2. Redistributions in binary form must reproduce the above copyright
00019 // notice, this list of conditions and the following disclaimer in the
00020 // documentation and/or other materials provided with the distribution.
00021 //
00022 // 3. Neither the name of the Corporation nor the names of the
00023 // contributors may be used to endorse or promote products derived from
00024 // this software without specific prior written permission.
00025 //
00026 // THIS SOFTWARE IS PROVIDED BY SANDIA CORPORATION "AS IS" AND ANY
00027 // EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
00028 // IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
00029 // PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL SANDIA CORPORATION OR THE
00030 // CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
00031 // EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
00032 // PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
00033 // PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
00034 // LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
00035 // NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
00036 // SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
00037 //
00038 // Questions? Contact Roscoe A. Bartlett (rabartl@sandia.gov) 
00039 // 
00040 // ***********************************************************************
00041 // @HEADER
00042 */
00043 
00044 /* translated by f2c from dchud.f and hand modified. */
00045 
00046 #include "Moocho_Config.h"
00047 
00048 
00049 #if !defined(HAVE_MOOCHO_FORTRAN)
00050 
00051 
00052 #include "Teuchos_BLAS_wrappers.hpp"
00053 #include <math.h>
00054 
00055 
00056 void dchud_c(double r__[], int *ldr, int *p,
00057   double x[], double z__[], int *ldz, int *nz,
00058   double y[], double *rho, double c__[], double s[]
00059   )
00060 /*
00061 double *r__;
00062 int *ldr, *p;
00063 double *x, *z__;
00064 int *ldz, *nz;
00065 double *y, *rho, *c__, *s;
00066 */
00067 {
00068   /* System generated locals */
00069   int r_dim1, r_offset, z_dim1, z_offset, i__1, i__2;
00070   double d__1, d__2;
00071 
00072   /* Local variables */
00073   double zeta;
00074   int i__, j;
00075   double t, scale, azeta;
00076   double xj;
00077   int jm1;
00078 
00079 /* ***FIRST EXECUTABLE STATEMENT  DCHUD */
00080   /* Parameter adjustments */
00081   r_dim1 = *ldr;
00082   r_offset = 1 + r_dim1 * 1;
00083   r__ -= r_offset;
00084   --x;
00085   z_dim1 = *ldz;
00086   z_offset = 1 + z_dim1 * 1;
00087   z__ -= z_offset;
00088   --y;
00089   --rho;
00090   --c__;
00091   --s;
00092 
00093   /* Function Body */
00094   i__1 = *p;
00095   for (j = 1; j <= i__1; ++j) {
00096     xj = x[j];
00097 
00098 /*    APPLY THE PREVIOUS ROTATIONS. */
00099 
00100     jm1 = j - 1;
00101     if (jm1 < 1) {
00102       goto L20;
00103     }
00104     i__2 = jm1;
00105     for (i__ = 1; i__ <= i__2; ++i__) {
00106       t = c__[i__] * r__[i__ + j * r_dim1] + s[i__] * xj;
00107       xj = c__[i__] * xj - s[i__] * r__[i__ + j * r_dim1];
00108       r__[i__ + j * r_dim1] = t;
00109 /* L10: */
00110     }
00111 L20:
00112 
00113 /*    COMPUTE THE NEXT ROTATION. */
00114 
00115     DROTG_F77(&r__[j + j * r_dim1], &xj, &c__[j], &s[j]);
00116 /* L30: */
00117   }
00118 
00119 /*   IF REQUIRED, UPDATE Z AND RHO. */
00120 
00121   if (*nz < 1) {
00122     goto L70;
00123   }
00124   i__1 = *nz;
00125   for (j = 1; j <= i__1; ++j) {
00126     zeta = y[j];
00127     i__2 = *p;
00128     for (i__ = 1; i__ <= i__2; ++i__) {
00129       t = c__[i__] * z__[i__ + j * z_dim1] + s[i__] * zeta;
00130       zeta = c__[i__] * zeta - s[i__] * z__[i__ + j * z_dim1];
00131       z__[i__ + j * z_dim1] = t;
00132 /* L40: */
00133     }
00134     azeta = fabs(zeta);
00135     if (azeta == 0. || rho[j] < 0.) {
00136       goto L50;
00137     }
00138     scale = azeta + rho[j];
00139 /* Computing 2nd power */
00140     d__1 = azeta / scale;
00141 /* Computing 2nd power */
00142     d__2 = rho[j] / scale;
00143     rho[j] = scale * sqrt(d__1 * d__1 + d__2 * d__2);
00144 L50:
00145 /* L60: */
00146     ;
00147   }
00148 L70:
00149 
00150   return;
00151 
00152 } /* dchud_ */
00153 
00154 
00155 #endif // !defined(HAVE_MOOCHO_FORTRAN)
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends