Ïîäïðîãðàììû, ïðåäíàçíà÷åííûå äëÿ ðåøåíèÿ çàäà÷ èç îáùåé îáúåêòíîé îáëàñòè, îáùèå êîíñòàíòû è ïåðåìåííûå óäîáíî îáúåäèíèòü â ìîäóëü.
ÏÐÈÌÅÐ:
Îáúåäèíèòü â ìîäóëü ïîäïðîãðàììû
· ïðîèçâåäåíèÿ äâóõ ìàòðèö,
· ïðåäñòàâëåíèÿ ìàòðèöû â âèäå ïðîèçâåäåíèÿ íèæíåé è âåðõíåé òðåóãîëüíîé,
· âû÷èñëåíèÿ îáðàòíîé ìàòðèöû è
· îïðåäåëèòåëÿ ìàòðèöû.
MODULE MATRIX
! Ðàçäåë îáúÿâëåíèÿ äàííûõ ìîäóëÿ
! Êîíñòàíòà Ì áóäåò äîñòóïíà â ëþáîé ïðîãðàììå, ê êîòîðîé ïîäêëþ÷åí ìîäóëü
INTEGER, PARAMETER :: M=8
! Êîíñòàíòà L áóäåò äîñòóïíà òîëüêî â ìîäóëå
INTEGER, PRIVATE, PARAMETER :: L=24
CONTAINS ! Ðàçäåë îáúÿâëåíèÿ ìîäóëüíûõ ïîäïðîãðàìì
! Ïîäïðîãðàììà MULTIPLY ïåðåìíîæàåò äâå êâàäðàòíûå ìàòðèöû:
! ìàòðèöó À è ìàòðèöó B,
! ðåçóëüòàò ìàòðèöà Ñ.
SUBROUTINE MULTIPLY(N,A,B,C)
INTEGER I,J,K
REAL(8) A(N,N), B(N,N), C(N,N)
C=0
DO I=1, N
DO J=1, N
DO K=1,N
C(I,J)=C(I,J)+A(I,K)*B(K,J)
END DO
END DO
END DO
END SUBROUTINE ! END MULTIPLY
! Ïðîöåäóðà ïðåäñòàâëåíèÿ ìàòðèöû A â âèäå íèæíåé (B)
! è âåðõíåé (D) òðåóãîëüíûõ ìàòðèö
SUBROUTINE TRIANGULAR(N,A,B,D)
INTEGER I, J, K
REAL (8) P,G, A(N,N), B(N,N), D(N,N)
D=0.0
B=0.0
DO I=1,N
D(I,I)=1.0
END DO
DO I= 1, N
DO K=1, N
IF (K<=I) THEN
P=0.0
DO J=1, K-1
P=P+B(I,J)*D(J,K)
END DO
B(I,K)=A(I,K)-P;
ELSE
G=0.0
DO J=1, I-1
G=G+B(I,J)*D(J,K)
END DO
D(I,K)=(A(I,K)-G)/B(I,I)
END IF
END DO
END DO
END SUBROUTINE !TRIANGULAR
! Ïðîöåäóðà îáðàùåíèÿ ìàòðèöû A, ðåçóëüòàò – ìàòðèöà R îáðàòíàÿ ê A
SUBROUTINE REVERSE(N,A,R)
INTEGER I,J,K
REAL(8) P, B(N,N),D(N,N),Y(N,N),R(N,N),A(N,N),S(N),T(N)
CALL TRIANGULAR(N,A,B,D)
DO K=1, N
DO I=1,N
T(I)=0.0
IF (I==K)T(I)=1.0
END DO
DO I=1,N
P=0.0
DO J=1, I-1
P=P+B(I,J)*S(J)
END DO
S(I)=(T(I)-P)/B(I,I)
END DO
DO I=1, N
Y(I,K)=S(I)
END DO
END DO
DO K=1, N
DO I=1, N
T(I)=Y(I,K)
END DO
DO I=N, 1 ,-1
P=0.0
DO J=I+1, N
P=P+D(I,J)*S(J);
END DO
S(I)=(T(I)-P)/D(I,I);
END DO
DO I=1,N
R(I,K)=S(I)
END DO
END DO;
END SUBROUTINE ! REVERSE
! Ïðîöåäóðà âû÷èñëåíèÿ îïðåäåëèòåëÿ ìàòðèöû A
FUNCTION DETERM(N,A)
REAL (8) B(N,N),D(N,N),A(N,N),P,Q
INTEGER (4) I
CALL TRIANGULAR(N,A,B,D)
P=1.0
Q=1.0
DO I=1,N
P=P*B(I,I)
Q=Q*D(I,I)
END DO
DETERM=P*Q
END FUNCTION !DETERMINANT
SUBROUTINE WRITE_L(LP)
PRINT ('(A5,I4)'), 'L= ',L
LP=L
RETURN
END SUBROUTINE ! WRITE_L
END MODULE !MATRIX
PROGRAM REV_MATR
USE MATRIX
REAL(8), ALLOCATABLE, DIMENSION(:,:) ::A,R
REAL(8) D
INTEGER I, J, K, N
OPEN(25,FILE='REVERS_A.TXT')
READ(25,*) N
ALLOCATE(A(N,N))
ALLOCATE(R(N,N))
READ(25,*) ((A(I,J),J=1,N),I=1,N)
CALL REVERSE(N,A,R)
CALL WRITE_L(LP)
WRITE(25,'(/4(A5,I4))') ' N= ',N,' M= ',M, 'L= ',L,' LP= ',LP WRITE(25,'(/)')
WRITE(25,*) ' MATRIX A'
WRITE(25,'(/(<N>F8.4))')((A(I,J),J=1,N),I=1,N)
WRITE(25,'(/)')
WRITE(25,*) ' REVERSE A'
WRITE(25,'(/(<N>F8.4))')((R(I,J),J=1,N),I=1,N)
D=DETERM(N,A)
WRITE(25,'(/A5,F5.2)') ' DET= ',D
DEALLOCATE(A)
DEALLOCATE(R)
CLOSE(25)
END