Написание программы на языке ФОРТРАН, реализующей требуемые действия над матрицами произвольной размерности: умножение ленточной симметричной матрицы на вектор (Лабораторная работа № 3), страница 3

      !glavnaya funktsia

      PROGRAM main

      COMMON /array/ a(200000000)

      COMMON /error/ er

      COMMON /size/ max_i, max_j   

      INTEGER*2 I11,I12,I13,I14,I21,I22,I23,I24,I1,I2,I3,I4

      CALL gettim(I11,I12,I13,I14)

      CALL input_matrix

      CALL gettim(I21,I22,I23,I24)

      I1=I21-I11

      I2=I22-I12+I1*60

      I3=I23-I13+I2*60

      I4=I24-I14+I3*100

      PRINT *,I1,I2,I3,I4

      IF (er.NE.0) GOTO 50

      CALL input_vector

      IF (er.NE.0) GOTO 50     

      CALL gettim(I11,I12,I13,I14)     

      CALL multiplication(a(1),a((max_i-1)*max_j+1),a(max_i*max_j+1),

     *a((max_i+1)*max_j+1))

      CALL gettim(I21,I22,I23,I24)

      I1=I21-I11

      I2=I22-I12+I1*60

      I3=I23-I13+I2*60

      I4=I24-I14+I3*100

      PRINT *,I1,I2,I3,I4   

      CALL output

      IF (er.NE.0) GOTO 50

      PRINT *,'programma vipolnena, resultat v faile'

      GOTO 51

50    PRINT *,'programma ne vipolnena'

51    PAUSE

      END

generator.for

      PROGRAM generator

      DIMENSION d(200000000)

      n=8

      OPEN(1,FILE='in_mat.bin',ACCESS='direct',RECL=4*n,ERR=10)

      OPEN(2,FILE='in_vec.bin',ACCESS='direct',RECL=4*n,ERR=10)

      OPEN(3,FILE='in_diag.bin',ACCESS='direct',RECL=4*n,ERR=10)

      PRINT *,'vvedite 6irinu lenti'

      READ *,max_i

      IF (max_i.LE.0) THEN

         PRINT *,'neccorectnie dannie('

         GOTO 8

      ENDIF  

      PRINT *,'a teper razmernost matritsi'

      READ *,max_j

      IF ((max_j.LT.max_i).OR.(max_i*(max_j+2).GT.200000000)) THEN

         PRINT *,'necorrectnie dannie(('

         GOTO 8

      ENDIF

      WRITE(1,REC=1,ERR=11) max_i

      WRITE(1,REC=2,ERR=11) max_j

      PRINT *,'ok,dannie vvedeni. Podozhdite pozhaluista'     

      k=2

      lp=0

      DO 5 j=1,max_j

         DO 5 i=1,max_i-1

            lp=lp+1

            IF ((j+i).LE.max_i) THEN

               d(lp)=0

            ELSE

               d(lp)=i+j-2

            ENDIF

5           CONTINUE    

      DO 9 lp=0,max_i*max_j,n

         k=k+1

9        WRITE(1,REC=k,ERR=11) (d(lp+l),l=1,n)

      WRITE(2,REC=1,ERR=11) max_j

      DO 6 i=1,max_j

6        d(i)=i

      k=1

      DO 12 j=1,max_j,n

         k=k+1

12       WRITE(2,REC=k,ERR=11) (d(j+i-1),i=1,n)

      k=0

      DO 13 j=1,max_j,n

         k=k+1

13       WRITE(3,REC=k,ERR=11) (d(j+i-1),i=1,n)

      GOTO 7

10    PRINT *,'Nevozmozhno otkrit fail'

      GOTO 8

11    PRINT *,'O6ibka zapisi'

      GOTO 8

7     PRINT *,'Matritsa i vector uspe6no sgenerirovani'

8     CLOSE(1)

      CLOSE(2)

      PAUSE

      END 

print.for

      ! funktsia vvoda matritsi

      SUBROUTINE input_matrix

      COMMON /array/ a(200000000)

      COMMON /size/ max_i, max_j

      COMMON /error/ er

      n=1

      er=0

      OPEN(1,FILE='in_mat.bin',ACCESS='direct',RECL=4*n,ERR=10)

      OPEN(2,FILE='in_diag.bin',ACCESS='direct',RECL=4*n,ERR=10)

      READ(1,REC=1,ERR=11) max_i

      READ(1,REC=2,ERR=11) max_j      

      IF (((max_i.GT.max_j).OR.(max_i.LE.0)).OR.(max_i*(max_j+2)

     *.GT.200000000)) THEN

         er=1

         GOTO 6

      ENDIF           

      l=2

      DO 5 i=1,(max_i-1)*max_j,n

         l=l+1

5        READ(1,REC=l,ERR=11) (a(i-1+m),m=1,n)     

      l=0

      DO 7 i=1,max_j,n

         l=l+1

7        READ(2,REC=l,ERR=11) (a((max_i-1)*max_j+i-1+m),m=1,n)

      GOTO 6

10    PRINT *,'O6ibka otkritiya faila'

      er=1

      GOTO 6

11    PRINT *,'O6ibka 4teniya 1'

      er=1

      GOTO 6

6     CLOSE(2)

      CLOSE(1)   

      END

      ! funktsia raspe4atki matritsi

      SUBROUTINE printer(d_mat,diag)     

      COMMON /size/ max_i, max_j

      COMMON /error/ er