home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / eispack-1.0-src.tgz / tar.out / contrib / eispack / tests / rst.f < prev    next >
Text File  |  1996-09-28  |  1KB  |  59 lines
  1. C
  2. C     THIS INPUT SUBROUTINE READS A REAL SYMMETRIC BAND MATRIX
  3. C     FROM SYSIN OF ORDER  N,  AND BAND WIDTH  MB .
  4. C     TO GENERATE THE MATRIX  ST  INITIALLY,  INITIL  IS TO BE 0.
  5. C     TO REGENERATE THE MATRIX  ST  FOR THE PURPOSE OF THE RESIDUAL
  6. C     CALCULATION,  INITIL  IS TO BE  1.
  7. C
  8. C     THIS ROUTINE IS CATALOGUED AS  EISPDRV4(RSBREADI).
  9. C
  10.       DOUBLE PRECISION ST(20,20),STHOLD(20,20)
  11.       INTEGER  IA( 5)
  12.       DATA IREADA/1/,IWRITE/6/
  13. C
  14.       open(unit=ireada,file='FILE51')
  15.       rewind ireada
  16.       write(6,*)' what matrix do you want?'
  17.       read(5,*)nn
  18.     1 continue
  19.       READ(IREADA,5) N,MB
  20.     5 FORMAT(2I6)
  21.       IF( N .EQ. 0 )  GO TO  70
  22.       DO 8 I = 1,N
  23.          DO 7 J = 1,MB
  24.             ST(I,J) = 0.0D0
  25.     7    CONTINUE
  26.     8 CONTINUE
  27.       DO 15 I=1,N
  28.          MBB = MIN0(MB,N-I+1)
  29.          READ(IREADA,10) (IA(J),J=1,MBB)
  30.    10    FORMAT(6I12)
  31.          DO 11 J=1,MBB
  32.            M = MB+1-J
  33.            K = I+J-1
  34.    11      ST(K,M) = DFLOAT(IA(J))
  35.    15 CONTINUE
  36.    19 continue
  37.       if( nn .ne. n )  go to 1
  38.       do 21 i = 1,n
  39.          st(i,i)=st(i,2)
  40.          if( i .ne. 2 ) st(i,2) = 0.0
  41.    21 continue
  42.       st(1,2) = st(2,1)
  43.       do 23 i = 3,n
  44.          st(i,i-1) = st(i,1)
  45.          st(i-1,i) = st(i,i-1)
  46.          st(i,1) = 0.0
  47.    23 continue
  48.       write(6,*)'a=<'
  49.       do 20 i = 1,n
  50.          write(6,22)(st(i,j),j=1,n)
  51.    22    format(10f8.0)
  52.    20 continue
  53.       write(6,*)'>'
  54.       go to 1
  55.    99 continue
  56.    70 continue
  57.       STOP
  58.       END
  59.