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 / rsg.bak1 < prev    next >
Text File  |  1996-09-28  |  2KB  |  71 lines
  1. C
  2. C     THIS INPUT SUBROUTINE READS A REAL MATRIX FROM SYSIN OF
  3. C     ORDER N.
  4. C     TO GENERATE THE MATRIX  A  INITIALLY,  INITIL  IS TO BE 0.
  5. C     TO REGENERATE THE MATRIX  A  FOR THE PURPOSE OF THE RESIDUAL
  6. C     CALCULATION,  INITIL  IS TO BE  1.
  7. C
  8. C     THIS ROUTINE IS CATALOGUED AS  EISPDRV4(RGREADI).
  9. C
  10.       DOUBLE PRECISION A(20,20),b(20,20)
  11.       INTEGER  IA( 20),ib(20)
  12.       DATA ireadb/2/,IREADA/1/,IWRITE/6/
  13. C
  14.       open(unit=ireadb,file='FILE47')
  15.       open(unit=ireada,file='FILE35')
  16.       rewind ireada
  17.       rewind ireadb
  18.       write(6,*)' what matrix do you want?'
  19.       read(5,*)nn
  20.     1 continue
  21.       READ(IREADA,5,end=99)N, M
  22.     5 FORMAT(I6,6X,I6)
  23.       IF( N .EQ. 0 )  GO TO  99
  24.       IF (M .NE. 1) GO TO 16
  25.       DO  10  I = 1,N
  26.          READ(IREADA,17) (IA(J), J=I,N)  
  27.          DO   9  J = I,N
  28.            A(I,J) = DFLOAT(IA(J))
  29.     9      A(J,I) =  A(I,J)
  30.    10 CONTINUE
  31.    11 CONTINUE
  32.       READ(IREADB,5) N,M
  33.       IF( M .NE. 1 ) GO TO 28
  34.       DO 15 I = 1,N
  35.          READ(IREADB,17) (IB(J), J=I,N)   
  36.          DO 14 J = I,N
  37.             B(I,J)=DFLOAT(IB(J))
  38.    14       B(J,I)=B(I,J)
  39.    15 CONTINUE
  40.       GO TO 22
  41.    16 CONTINUE
  42.       DO  18  I = 1,N
  43.          READ(IREADA,17) (IA(J), J=1,N)  
  44.    17    FORMAT(6I12)
  45.          DO  18  J = 1,N
  46.    18      A(I,J) = DFLOAT(IA(J))
  47.       GO TO 11
  48.    28 CONTINUE
  49.       DO 25 I = 1,N
  50.          READ(IREADB,17) (IB(J),J=1,N) 
  51.          DO 25 J = 1,N
  52.    25    B(I,J) = DFLOAT(IB(J))
  53.    22 CONTINUE
  54.    19 continue
  55.       if( nn .ne. n )  go to 1
  56.       write(6,*)'a=<'
  57.       do 20 i = 1,n
  58.          write(6,29)(a(i,j),j=1,n)
  59.    29    format(10f8.0)
  60.    20 continue
  61.       write(6,*)'>'
  62.       write(6,*)'b=<'
  63.       do 200 i = 1,n
  64.          write(6,29)(b(i,j),j=1,n)
  65.   200 continue
  66.       write(6,*)'>'
  67.       go to 1
  68.    99 continue
  69.       STOP
  70.       END
  71.