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

            l=l+1

5           WRITE(3,REC=l,ERR=11) s(j)

      !perevod diagonali     

      DO 6 i=1,max_j

         READ(5,*,ERR=11) d

6        WRITE(6,REC=i,ERR=11) d     

      !perevod vectora

      READ(2,*,ERR=11) max_j

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

      DO 9 i=1,max_j

         READ(2,*,ERR=11) d

9        WRITE(4,REC=i+1,ERR=11) d

      GOTO 8

10    PRINT *,'Nevozmozhno otkrit fail'     

      GOTO 7

11    PRINT *,'O6ibka 4tenia/zapisi'

      GOTO 7

8     PRINT *,'preobrazovanie vipolneno uspe6no'

7     CLOSE(1)

      CLOSE(2)

      CLOSE(3)

      CLOSE(4)

      CLOSE(5)

      CLOSE(6)

      PAUSE

      END

main_for_bin.for

      ! funktsia vvoda matritsi

      SUBROUTINE input_matrix

      COMMON /array/ a(200000000)

      COMMON /size/ max_i, max_j

      COMMON /error/ er

      n=8

      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

      k=max_j      

      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 vvoda vectora

      SUBROUTINE input_vector

      COMMON /array/ a(200000000)

      COMMON /error/ er

      COMMON /size/ max_i,max_j

      n=8

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

      READ(3,REC=1,ERR=21) max_k

      IF (max_k.NE.max_j) THEN

         er=1

         GOTO 16

      ENDIF

      k=max_i*max_j

      j=1

      i=1

15    IF (i.LE.max_j) THEN        

         j=j+1

         READ(3,REC=j,ERR=21) (a(k+l),l=1,n)

         k=k+n

         i=i+n

         GOTO 15

      ENDIF     

      GOTO 16   

20    PRINT *,'O6ibka otkritiya faila'

      er=1

      GOTO 16

21    PRINT *,'O6ibka 4teniya 2'

      er=1

      GOTO 16

16    CLOSE(3)   

      END 

      !funktsia umnozhenia matritsi na vector

      SUBROUTINE multiplication(d_mat,diag,vec,rez)          

      COMMON /error/ er

      COMMON /size/ max_i,max_j 

      DIMENSION d_mat(max_i-1,max_j), diag(max_j), vec(max_j),

     *rez(max_j)                

      DO 28 j=1,max_i-1

         rez(j)=rez(j)+diag(j)*vec(j)

         k=2

         DO 28 i=1,max_i-1

            IF (d_mat(i,j).NE.0) THEN

               rez(j)=rez(j)+vec(i+j-max_i)*d_mat(i,j)              

               rez(j-k)=rez(j-k)+vec(i+j-max_i+k)*d_mat(i,j)

            ENDIF

28          k=k-1

      DO 29 j=max_i,max_j

         rez(j)=rez(j)+diag(j)*vec(j)

         k=2

         DO 29 i=1,max_i-1            

            rez(j)=rez(j)+vec(i+j-max_i)*d_mat(i,j)           

            rez(j-k)=rez(j-k)+vec(i+j-max_i+k)*d_mat(i,j)        

29       k=k-1

      END

      !functsia vivoda vectora resultata

      SUBROUTINE output

      COMMON /array/ a(200000000)

      COMMON /size/ max_i,max_j

      COMMON /error/ er

      OPEN (4,FILE='output.txt',ERR=40)

      DO 35 j=max_j*(max_i+1)+1,max_j*(max_i+2),1

35       WRITE (4,31,ERR=37) a(j)

      GOTO 36

31    FORMAT (E10.4)

40    PRINT *,'O6ibka otkritiya faila'

      er=1

      GOTO 36

37    PRINT *,'O6ibka zapisi'

      er=1

      GOTO 36

36    CLOSE(4)   

      END