MINICERN/packlib/kernlib/kerngen/tcgen/tlres.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:53  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10       SUBROUTINE TLRES (A,B,AUX)
  11 C
  12 C CERN PROGLIB# E230    TLRES           .VERSION KERNFOR  2.09  751101
  13 C ORIG. 11/05/74 WH+WM
  14 C
  15 C.  SUBROUTINE TLRES          L.S. REDIDUAL VECTOR          HART/MATT
  16 C.
  17 C.        INVERSE HOUSEHOLDER TRANSFORMATION APPLIED TO LSQ RESIDUALS
  18 C.        THE RESIDUALS ARE RETURNED IN B
  19 C.  ARGUMENTS
  20 C.        A,B,AUX,(M1,M,N,L,IER) WHICH ARE DEFINED AS FOR TLS
  21 C.  REMARK
  22 C.        CONSTRAINED AND UNCONSTRAINED VERSION COMBINED
  23 C.
  24 C.-------------------------------------------------------------------
  25 C
  26       COMMON /TLSDIM/ M1,M,N,L,IER
  27       COMMON /SLATE/ BETA,I,IB,IST,KK,KN,K1,LN,LV,KKEND,DUM(30)
  28       DIMENSION A(*), B(*), AUX(*)
  29 C
  30       IF(IER.EQ.0) GO TO 100
  31       IER = IABS(IER)
  32 C
  33 C     SET FIRST IER ELEMENTS OF EACH B VECTOR TO ZERO
  34       LN = L * IER
  35       DO 10 I=1,LN
  36    10 B(I)=0.
  37 C
  38 C      TRANSFORMATION LOOP
  39       K1 = MAX (N,L)
  40       IST = (IER-1) * (N+1) + 1
  41       KKEND = IER - M1
  42       DO 30 KK=1,KKEND
  43       LV = M - IER + KK
  44       KN = K1 + IER - KK + 1
  45       BETA = -1./(AUX(KN)*A(IST))
  46       IB = (IER-KK) * L + 1
  47       IF (LV.EQ.1)                     GO TO     20
  48       CALL TLSTEP(A(IST),B(IB),N,L,LV,L,BETA)
  49       GO TO        30
  50    20 DO           25        J=1,L
  51       JST = IB + J - 1
  52    25 B(JST) = B(JST)*(1.-BETA*A(IST)**2)
  53    30 IST = IST -N -1
  54   100 RETURN
  55       END