home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 2 / 2398 / dcond.cc next >
Encoding:
C/C++ Source or Header  |  1990-12-28  |  2.0 KB  |  72 lines
  1. /*
  2. Name          dcond - Improves the accuracy of dsweep when the diagonal 
  3.                       elements of a are not of the same order of magnitude.
  4.  
  5. Usage         #include "usual.h"
  6.               #include "tools.h"
  7.               void dcond(REAL *a, INTEGER n, REAL *s,INTEGER isw)
  8.  
  9. Prototype in  tools.h
  10.  
  11. Description   a is a symmetric, positive definite, n by n matrix stored 
  12.               columnwise with no unused space and first element in a[0]; i.e.,
  13.               for (j=1; j<=n; j++) for (i=1; i<=n; i++) aij=a[n*(j-1)+(i-1)];
  14.               will traverse the matrix with aij being the element in the 
  15.               i-th row and j-th column.  s is a work vector of length n.
  16.               The intended calling sequence is:
  17.                 dcond(a,n,s,0);
  18.                 ier=dsweep(a,n,eps);
  19.                 dcond(a,n,s,1);
  20.               The usage
  21.                 dcond(a,n,s,0);
  22.               will return a correlation matrix in a and the standard errors 
  23.               in s when a is a variance-covariance matrix.
  24.  
  25. Remark        dscond.c is dcond.f as translated by f2c (version of 3 February 
  26.               1990  3:36:42) with some reworking to remove dependence on f2c 
  27.               libraries.
  28.  
  29. Return value  None.
  30.  
  31. Functions     Library: (none)
  32. called        Sublib:  (none)
  33. */
  34.  
  35. #include "usual.h"
  36. #include "tools.h"
  37.  
  38. void dcond(REAL *a, INTEGER n, REAL *s, INTEGER isw)
  39. {
  40.     /* System generated locals */
  41.     INTEGER a_dim1, a_offset, i_1, i_2;
  42.  
  43.     /* Local variables */
  44.     INTEGER i, j;
  45.  
  46.     /* Parameter adjustments */
  47.     a_dim1 = n;
  48.     a_offset = a_dim1 + 1;
  49.     a -= a_offset;
  50.     --s;
  51.  
  52.     /* Function Body */
  53.     if (isw == 1) {
  54.         goto L20;
  55.     }
  56.     i_1 = n;
  57.     for (i = 1; i <= i_1; ++i) {
  58.         s[i] = sqrt(a[i + i * a_dim1]);
  59.     }
  60. L20:
  61.     i_1 = n;
  62.     for (i = 1; i <= i_1; ++i) {
  63.         i_2 = n;
  64.         for (j = 1; j <= i_2; ++j) {
  65.             if (s[i] * s[j] != 0.) {
  66.                 a[i + j * a_dim1] /= s[i] * s[j];
  67.             }
  68.         }
  69.     }
  70.     return;
  71. }
  72.