Download syslin.eso

Back to the list

   1 : C SYSLIN    SOURCE    CHAT      05/01/13    03:29:02     5004           
   2 :        SUBROUTINE SYSLIN(IPO1)
   3 : 
   4 :       IMPLICIT INTEGER(I-N)
   5 :        IMPLICIT REAL*8 (A-H,O-Z)
   6 : 
   7 : -INC CCOPTIO
   8 : -INC SMLREEL
   9 : 
  10 :        SEGMENT TRAV
  11 :           REAL*8 T(J)
  12 :           REAL*8 S(I)
  13 :           INTEGER MF(J)
  14 :        ENDSEGMENT
  15 : 
  16 :        TRAV=IPO1
  17 :        SEGACT TRAV*MOD
  18 :        N=T(/1)
  19 :      
  20 :        IF(N.LE.1) THEN
  21 :           IF( S(1).NE.0.D0) T(1)=T(1)/S(1)
  22 :           GOTO 9999
  23 :        ENDIF
  24 :        IA=0
  25 :        KF=N
  26 :        M=N-1
  27 :        DO 30 I=1,M
  28 :             IA=IA+1
  29 :             II=I+1
  30 :             D=0.D0
  31 :             IF(S(IA).NE.0.D0) D=1.D0/S(IA)
  32 :             XI=T(I)
  33 :             T(I)=D*XI
  34 :             K=KF
  35 :             DO 20 J=II,N
  36 :                  IA=IA+1
  37 :                  B=S(IA)*D
  38 :                  T(J)=T(J)-B*XI
  39 :                  DO 10 KA=IA,KF
  40 :                       K=K+1
  41 :                       S(K)=S(K)-B*S(KA)
  42 :  10              CONTINUE
  43 :                  S(IA)=B
  44 :  20          CONTINUE
  45 :              KF=KF+N-I
  46 :  30    CONTINUE
  47 :        XN=T(N)
  48 :        T(N)=0.D0
  49 :        IF(S(KF).NE.0.D0) T(N)=XN/S(KF)
  50 :        L=N
  51 :        DO 50 I=1,M
  52 :             B=T(L)
  53 :             KF=L
  54 :             L=L-1
  55 :             DO 40 J=1,L
  56 :                  T(J)=T(J)-S(KF)*B
  57 :                  KF=KF+N-J
  58 :  40         CONTINUE
  59 :  50    CONTINUE
  60 :       
  61 : 
  62 :  9999  RETURN               
  63 :        END
  64 :  
  65 :  
  66 :  

© Cast3M 2003 - All rights reserved.
Disclaimer