
FTN,L 
      PROGRAM BTES5 
      DOUBLE PRECISION TM,TI,TC,Y,SI,S,F,DET
      DIMENSION TM(10,10),TI(10,11),TC(10,10),Y(10) 
      CALL BELL 
      WRITE( 6,130) 
  130 FORMAT("1") 
      SI=1.00000000 
      S=SI
      TM(1,1)=.5
      DO 10 I=2,10
      S=S+SI
      F=0.000000000 
      DO 20 J=1,I 
      F=F+SI
      TM(I,J)=1./(S+F)
   20 TM(J,I)=TM(I,J) 
      N=I 
      DO 30 L=1,N 
      DO 30 J=1,N 
   30 TI(L,J)=TM(L,J) 
      CALL SGDSM(N,TI,Y,DET,0)  
      DO 15 L=1,N 
      DO 15 J=1,N 
      TC(L,J)=0.
      DO 15 K=1,N 
      TC(L,J)=TM(L,K)*TI(K,J)+TC(L,J) 
   15 CONTINUE
      WRITE( 6,60)
   60 FORMAT(////10X," MATRIX IS")
      DO 50 J=1,N 
      WRITE( 6,70) (TM(J,L),L=1,N)
 70   FORMAT(1X10D13.7) 
   50 CONTINUE
      WRITE( 6,100) 
 100  FORMAT(//" IDENTITY IS")
      DO 90 J=1,N 
      WRITE( 6,110) (TC(J,L),L=1,N) 
 110  FORMAT(1X10D13.7) 
   90 CONTINUE
   10 CONTINUE
      CALL BELL 
      END 
      SUBROUTINE SGDSM(N,A,X,DETER,IFLAG) 
      DOUBLE PRECISION ONE,DETER,PIVOT,A,Y,X,AIJCK
      DIMENSION IROW(10),JCOL(10),JORD(10),Y(10),A(10,11),X(10) 
      IU=11 
      MAX=N 
      IF (IFLAG .GE. 0) MAX=N+1 
      INDIC=IFLAG 
      ONE=1.00000000
      DETER=ONE 
      DO 18 K=1,N 
      KM1=K-1 
      PIVOT=0.00000000
      DO 11 I=1,N 
      DO 11 J=1,N 
      IF (K .EQ. 1) GO TO 9 
      DO 8 ISCAN=1,KM1
      DO 8 JSCAN=1,KM1
      IF (I .EQ. IROW(ISCAN)) GO TO 11
      IF (J .EQ. JCOL(JSCAN)) GO TO 11
    8 CONTINUE
    9 IF(DABS(A(I,J)).LE.DABS(PIVOT)) GO TO 11
      PIVOT=A(I,J)
      IROW(K)=I 
      JCOL(K)=J 
   11 CONTINUE
      IROWK=IROW(K) 
      JCOLK=JCOL(K) 
      DETER=DETER*PIVOT 
      DO 14 J=1,MAX 
      A(IROWK,J)=A(IROWK,J)/PIVOT 
   14 CONTINUE
      A(IROWK,JCOLK)=ONE/PIVOT
      DO 18 I=1,N 
      AIJCK=A(I,JCOLK)
      IF (I .EQ. IROWK) GO TO 18
      A(I,JCOLK)=-AIJCK/PIVOT 
      DO 17 J=1,MAX 
      IF (J .NE. JCOLK) A(I,J)=A(I,J)-AIJCK*A(IROWK,J)
   17 CONTINUE
   18 CONTINUE
       DO 20 I=1,N
      IROWI=IROW(I) 
      JCOLI=JCOL(I) 
      JORD(IROWI)=JCOLI 
   20 IF (INDIC .GE. 0) X(JCOLI)=A(IROWI,MAX) 
      INTCH=0 
      NM1=N-1 
      DO 22 I=1,NM1 
      IP1=I+1 
      DO 22 J=IP1,N 
      IF (JORD(J) .GE. JORD(I)) GO TO 22
      JTEMP=JORD(J) 
      JORD(J)=JORD(I) 
      JORD(I)=JTEMP 
      INTCH=INTCH+1 
   22 CONTINUE
      IF (INTCH/2*2 .NE. INTCH) DETER= -DETER 
   24 IF(INDIC .LE. 0.) GO TO 26
      RETURN
   26 DO 28 J=1,N 
      DO 27 I=1,N 
      IROWI=IROW(I) 
      JCOLI=JCOL(I) 
   27 Y(JCOLI)=A(IROWI,J) 
      DO 28 I=1,N 
   28 A(I,J)=Y(I) 
      DO 30 I=1,N 
      DO 29 J=1,N 
      IROWJ=IROW(J) 
      JCOLJ=JCOL(J) 
   29 Y(IROWJ)=A(I,JCOLJ) 
      DO 30 J=1,N 
   30 A(I,J)=Y(J) 
      RETURN
      END 
      SUBROUTINE BELL 
      DIMENSION IBELL(4)
      DATA IBELL / 3400B,0,3400B,0 /
  999 FORMAT ( 4A2 )
      WRITE ( 1,999 ) IBELL 
      RETURN
      END 
      END$
                                                                  