PROGRAM dokl
IMPLICIT NONE
INTEGER*4 nmax,n,k
PARAMETER (nmax=50)
REAL*8 W1(0:nmax),W2(0:nmax),a,R,silnia,S,p
OPEN(1,FILE='w1.dat')
C
WRITE (*,*) ' Podaj a oraz R '
READ (*,*) a,R
DO 50 n=0,nmax
S=0
DO 30 k=0,n
S=S+((a*R)**k)/silnia(k)
30 CONTINUE
W1(n)=(-(silnia(n)*EXP(- a*R))/a**(n+1))*S+silnia(n)/a**(n+1)
S=0
k=0
40 p=(a*R)**(n+1+k)/silnia(n+1+k)
S=S+p
k=k+1
W2(n)=((silnia(n)*EXP(-a*R))/a**(n+1))*S
IF (S*1.0D-20.LT.p) GOTO 40
50 CONTINUE
DO 60 n=0,nmax
WRITE (1,*) ' n=',n,' W1=',W1(n),' W2=',W2(n)
60 CONTINUE
END
C
REAL*8 FUNCTION silnia(n)
INTEGER*4 n,i
REAL*8 s
S=1
DO 10 i=1,n
10 S=S*i
Silnia=S
RETURN
END
PROGRAM Iter2
IMPLICIT NONE
REAL x,y,x0,y0,eps,dx,dy,f1,f2
WRITE(*,*) ' Podaj x0, y0 oraz epsilon '
READ(*,*) x0,y0,eps
10 x=SQRT((x0*y0+5*x0-1)/2)
y=SQRT(x0+3*ALOG(x0))
dx=ABS(x0-x)
dy=ABS(y0-y)
x0=x
y0=y
IF((dx.GT.eps).OR.(dy.GT.eps)) GOTO 10
f1=2*x**2-x*y-5*x+1
f2=x+3*ALOG(x)-y**2
WRITE(*,*) ' F1=',f1,' F2=',f2,
WRITE(*,*) ' x=',x,' y=',y
PAUSE
END
PROGRAM TESTMA
IMPLICIT NONE
REAL A(1:30,1:30),B(1:30,1:30),C(1:30,1:30),W(1:30),X(1:30)
INTEGER*4 NA,MA,NB,MB,N
CHARACTER*50 OPIS
CALL CZYTMAT('A.DAT'//CHAR(0),A,NA,MA)
OPIS=' MACIERZ A'
CALL PISZMAT('WY.DAT'//CHAR(0),0,OPIS,A,NA,MA)
CALL CZYTMAT('B.DAT'//CHAR(0),B,NB,MB)
OPIS=' MACIERZ B'
CALL PISZMAT('WY.DAT'//CHAR(0),1,OPIS,B,NB,MB)
IF(MA.EQ.NB) THEN
CALL MNOZMAT(A,B,C,NA,MA,MB)
OPIS=' MACIERZ C'
CALL PISZMAT('WY.DAT'//CHAR(0),2,OPIS,C,NA,MB)
ELSE
WRITE(*,*) ' MACIERZE NIEZGODNE'
PAUSE
ENDIF
CALL CZYTWEK('X.DAT'//CHAR(0),W,N)
OPIS=' WEKTOR W'
CALL PISZWEK('WY.DAT'//CHAR(0),1,OPIS,W,N)
IF(MA.EQ.N) THEN
CALL MATWEK(A,W,X,NA,MA)
OPIS=' MACIERZ*WEKTOR X'
CALL PISZWEK('WY.DAT'//CHAR(0),2,OPIS,X,NA)
ELSE
WRITE(*,*) ' MACIERZ I WEKTOR SA NIEZGODNE'
PAUSE
ENDIF
STOP
END
--------------------------
Plik *.BAT
RMFORT MACIERZ/N /L > MACIERZ.LST
PAUSE
RMFORT TESTMA/N /L > TESTMA.LST
PAUSE
PLINK86 FI TESTMA,MACIERZ LIB C:\RMFORT\RMFORT.LIB
PAUSE
TESTMA
SUBROUTINE CzytMat(plik,A,n,m)
Implicit NONE
REAL A(1:30,1:30)
INTEGER n,m,i,j
CHARACTER*50 plik
OPEN(1,FILE=plik)
READ(1,*) n,m
DO 20 i=1,n
READ(1,*) (A(i,j),j=1,m)
20 CONTINUE
CLOSE(1)
RETURN
END
C
SUBROUTINE PiszMat(plik,jak,opis,A,n,m)
IMPLICIT NONE
REAL A(1:30,1:30)
INTEGER n,m,i,j,jak
CHARACTER*50 plik,opis
IF (jak.eq.0) THEN
OPEN(1,FILE=plik)
ELSE
OPEN(1,FILE=plik,ACCESS='append')
ENDIF
WRITE(1,*) opis
WRITE(1,300) n,m
300 FORMAT(2I4)
310 FORMAT(7F12.4)
DO 20 i=1,n
WRITE(1,310) (A(i,j),j=1,m)
20 CONTINUE
CLOSE(1)
RETURN
END
SUBROUTINE CzytWek(plik,A,n)
IMPLICIT NONE
REAL A(1:30)
INTEGER n,i
CHARACTER*50 plik
OPEN(1,FILE=plik)
READ(1,*) n
READ(1,*) (A(i),i=1,n)
CLOSE(1)
RETURN
END
SUBROUTINE PiszWek(plik,jak,opis,A,n)
IMPLICIT NONE
REAL A(1:30)
INTEGER n,i,jak
CHARACTER*50 plik,opis
IF (jak.eq.0) THEN
OPEN(1,FILE=plik)
ELSE
OPEN(1,FILE=plik,ACCESS='append')
ENDIF
WRITE(1,*) opis
WRITE(1,300) n
300 FORMAT(2I4)
310 FORMAT(7F12.4)
WRITE(1,310) (A(i),i=1,n)
CLOSE(1)
RETURN
END
C
SUBROUTINE MnozMat (A,B,C,na,ma,mb)
IMPLICIT NONE
REAL A(1:30,1:30),B(1:30,1:30),C(1:30,1:30),S
INTEGER na,ma,mb,i,j,k
DO 30 I=1,na
DO 20 J=1,mb
S=0
DO 10 k=1,ma
S=S+A(i,k)*B(k,j)
10 CONTINUE
C(i,j)=S
20 CONTINUE
30 CONTINUE
RETURN
END
C
SUBROUTINE MatWek(A,B,X,na,ma,n)
IMPLICIT NONE
REAL A(1:30,1:30),B(1:30),X(1:30),S
INTEGER na,ma,n,i,k
DO 30 I=1,na
S=0
DO 10 k=1,ma
S=S+A(i,k)*B(k)
10 CONTINUE
X(i)=S
30 CONTINUE
RETURN
End