MINICERN/packlib/kernlib/kerngen/tcgen/smxinv.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 #if !defined(CERNLIB_TCGEN)
  11       SUBROUTINE SMXINV (A,NDIM,IFAIL)
  12 C
  13 C CERN PROGLIB# F107    SMXINV          .VERSION KERNFOR  1.0   720503
  14 C ORIG. 03/05/72 CL
  15 C
  16       DIMENSION A(*),INDEX(100),RI(100)
  17 C
  18       DATA  TOL / 1.E-12/
  19 C
  20       IFAIL=0
  21       N=NDIM
  22       NP1=N+1
  23          DO 10 I=1,N
  24    10 INDEX(I)=1
  25 C
  26          DO 80 I=1,N
  27 C
  28 C--                FIND PIVOT
  29       PIVOT=0.
  30       JJ=1
  31          DO 20 J=1,N
  32       IF (INDEX(J).EQ.0) GO TO 19
  33       ELM=ABS (A(JJ))
  34       IF (ELM.LE.PIVOT) GO TO 19
  35       PIVOT=ELM
  36       K=J
  37       KK=JJ
  38    19 JJ=JJ+NP1
  39    20 CONTINUE
  40       IF (PIVOT/ABS(A(1)).LT.TOL) GO TO 100
  41       INDEX(K)=0
  42       PIVOT=-A(KK)
  43 C
  44 C--                ELIMINATION
  45       KJ=K
  46       NP=N
  47 C
  48          DO 70 J=1,N
  49       IF (J-K) 34,30,34
  50 C
  51    30 A(KJ)=1./PIVOT
  52       RI(J)=0.
  53       NP=1
  54       GO TO 70
  55 C
  56    34 ELM=-A(KJ)
  57    40 RI(J)=ELM/PIVOT
  58       IF (ELM.EQ.0.) GO TO 50
  59 C
  60       JL=J
  61          DO 45 L=1,J
  62       A(JL)=A(JL)+ELM*RI(L)
  63    45 JL=JL+N
  64 C
  65    50 A(KJ)=RI(J)
  66 C
  67    70 KJ=KJ+NP
  68 C
  69    80 CONTINUE
  70 C
  71 C--                CHANGE THE SIGN AND PROVISIONAL FILL-UP
  72       IJ0=1
  73       JI0=1
  74          DO 95 I=1,N
  75       IJ=IJ0
  76       JI=JI0
  77 C
  78          DO 90 J=1,I
  79       A(IJ)=-A(IJ)
  80       A(JI)=A(IJ)
  81       IJ=IJ+N
  82       JI=JI+1
  83    90 CONTINUE
  84 C
  85       IJ0=IJ0+1
  86       JI0=JI0+N
  87    95 CONTINUE
  88       RETURN
  89 C
  90 C--                FAILURE RETURN
  91   100 IFAIL=1
  92       RETURN
  93       END
  94 #endif