Advertisement
Guest User

Untitled

a guest
Dec 9th, 2018
81
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.       PROGRAM LAB
  2.       IMPLICIT NONE
  3.       COMMON/size/x,n,m
  4.       INTEGER x,n,m
  5.       REAL array(100000)
  6.       CALL GetSize()
  7.       CALL ReadMatrix(array(1))
  8.       CALL ReadVector(array(n*2+m+1))
  9.       CALL Mult(array(1),array(n+1),array(n*2+1),
  10.      *array(n*2+m+1),array(n*2+m+x+1))
  11.       CALL OutMatrix(array(1),array(n+1),array(n*2+1))
  12.       CALL Output(array(n*2+m+x+1))
  13.       PAUSE
  14.       STOP
  15.       END
  16.      
  17.      
  18.      
  19.       SUBROUTINE GetSize()
  20.       IMPLICIT NONE
  21.       COMMON/size/x,n,m
  22.       INTEGER n,m,r,x
  23.       OPEN(1,FILE='size.txt',ERR=1)
  24.       READ(1, *) x,n,m
  25.       CLOSE(1)
  26.       GOTO 2
  27.    1  PAUSE 'Error reading file.'
  28.       STOP    
  29.    2  CONTINUE
  30.       END
  31.      
  32.      
  33.      
  34.       SUBROUTINE ReadMatrix(Xi)
  35.       IMPLICIT NONE
  36.       REAL Xi(*)
  37.       COMMON/size/x,n,m
  38.       INTEGER n,m,i,x
  39.      
  40.       OPEN(2,FILE='an.txt',err=1)
  41.       DO i=1,n,1
  42.       READ(2, *) Xi(i)
  43.       END DO
  44.       CLOSE(3)
  45.  
  46.       OPEN(3,FILE='ja.txt',err=1)
  47.       DO i=1,n,1
  48.       READ(3, *) Xi(n+i)
  49.       END DO
  50.       CLOSE(4)
  51.      
  52.       OPEN(4,FILE='ia.txt',err=1)
  53.       DO i=1,m,1
  54.       READ(4, *) Xi(n*2+i)
  55.       END DO
  56.       CLOSE(4)
  57.  
  58.       GOTO 2
  59.    1  PAUSE 'Error reading file.'
  60.       STOP
  61.    2  CONTINUE  
  62.       END
  63.      
  64.      
  65.      
  66.       SUBROUTINE ReadVector(Xi)
  67.       IMPLICIT NONE
  68.       COMMON/size/x,n,m
  69.       INTEGER n,m,i,x
  70.       REAL Xi(*)
  71.      
  72.       OPEN(5,FILE='vector.txt',err=1)
  73.       DO i=1,x,1
  74.       READ(5, *) Xi(i)
  75.       END DO
  76.       CLOSE(6)
  77.      
  78.       GOTO 2
  79.    1  PAUSE 'Error reading file.'
  80.       STOP
  81.    2  CONTINUE  
  82.       END
  83.      
  84.      
  85.      
  86.       SUBROUTINE Mult(an, ja, ia, v, result)
  87.       IMPLICIT NONE
  88.       COMMON/size/x,n,m
  89.       INTEGER n,m,lim1,lim2,prom,i,j,x
  90.       REAL an(n), ja(n), ia(m), v(x), result(x),k
  91.      
  92.       DO i=1,n,1
  93.       PRINT *,an(i)
  94.       END DO
  95.      
  96.       DO i=1,m,1
  97.       lim1 = ia(i)
  98.       lim2 = ia(i+1) - 1
  99.       DO j=lim1,lim2,1
  100.       prom=ja(j)
  101.       result(i)=result(i)+v(prom)*an(j)
  102.       k = result(i)
  103.       END DO
  104.       END DO
  105.      
  106.       RETURN
  107.       END
  108.      
  109.      
  110.      
  111.       SUBROUTINE OutMatrix(an, ja, ia)
  112.       IMPLICIT NONE
  113.       COMMON/size/x,n,m
  114.       INTEGER n,m,i,j,x,q,c,w
  115.       REAL an(n), ja(n), ia(m)
  116.       OPEN (7,FILE='outMatrix.txt')
  117.      
  118.       q = 1
  119.       DO j=1,x,1
  120.       IF(ia(j) .LT. ia(j+1)) THEN
  121.       c = 1
  122.       ELSE
  123.       c = 0
  124.       ENDIF
  125.       w = ia(j+1) - ia(j)
  126.      
  127.       DO i=1,x,1
  128.       IF(ja(q).EQ.i.AND.c.EQ.1.AND.w.GT.0) THEN
  129.       WRITE (7,30) an(q)
  130.       q = q + 1
  131.       w = w - 1
  132.       ELSE
  133.       WRITE (7,30) 0.0
  134.       ENDIF
  135.      
  136.       ENDDO
  137.       WRITE (7,20)
  138.      
  139.       ENDDO
  140.      
  141.       CLOSE(7)
  142.      
  143.    20 FORMAT (A1, ' ')
  144.    30 FORMAT (E10.4, ' ' \)
  145.       END
  146.      
  147.      
  148.      
  149.       SUBROUTINE Output(Xi)
  150.       IMPLICIT NONE
  151.       COMMON/size/x,n,m
  152.       REAL Xi(*)
  153.       INTEGER n,m,i,x
  154.       OPEN (6,FILE='output.txt')
  155.       DO i=1,x,1
  156.       WRITE (6,20) Xi(i)
  157.       END DO
  158.       CLOSE(6)
  159.      
  160.    20 FORMAT (E10.4)
  161.       END
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement