Bonsoir tout le monde, j'ai besoin de votre aide, j'ai un code pédagogique de calcul matriciel en fortran et je veux le traduire en Turbo Pascal puis en Delphi je compte sur votre aide les amis
voici le code :
logical IPRINT, PGIVEN, INCID, CONV
real L, NUMER
dimension P(10), PGIVEN(10), A(10,10), C(10,10), D(10,10),
1 L(10,10), INCID(10,10), Q(10,10)
*****************************************
***** Lecture des Données *****
*****************************************
1 read (5,100) N, IMAX, RHO, EPS, F, IPRINT, (PGIVEN(i), i = 1,N)
read (5,101) (P(i), i = 1,N)
do 2 i = 1,N
read (5,102) (INCID(i,,j), j = 1,i)
read (5,101) (D(i,j), j = 1,i)
2 read (5,101) (L(i,j), j = 1,i)
*****************************************
***** transformation des matrices symetriques D, L et INCID et
calcul des elements de la matice C *****
*****************************************
FACTOR = 8.*12.**5*RHO*F/(3.1415926**2*32.2*(60.*7.48)**2*144.)
do 3 i = 1,N
do 3 j = 1,i
C(i,j) = 0.
if (i.EQ.j) go to 3
if (INCID(i,j)) C(i,j) = FACTOR*L(i,j)/D(i,j)**5
D(j,i) = D(i,j)
L(j,i) = L(i,j)
INCID(j,i) = INCID(i,j)
C(j,i) = C(i,j)
3 continue
*****************************************
***** ecriture des données initiales du reseau *****
*****************************************
write (6,200) N,ITMAX,RHO,EPS,F,IPRINT,(i, P(i),PGIVEN(i),i=1,N)
write (6,201)
do 4 i = 1,N
4 write (6,202) i, i, N, (INCID(i,j), j = 1,N)
write (6,201)
do 5 i = 1,N
5 write (6,203) i, i, N, (D(i,j), j = 1,N)
write (6,201)
do 6 i = 1,N
6 write (6,204) i, i, N, (L(i,j), j = 1,N)
*****************************************
***** calcul des approximations successives des pressions aux
noeuds *****
****************************************
if (IPRINT) write (6,205) (i, i = 1,N)
do 9 ITER = 1, IMAX
CONV = .true.
do 8 j = 1, N
if (PGIVEN) go to 8
NUMER = 0.
DENOM = 0.
do 7 i = 1, N
if (.not. INCID(i,j)) go to 7
A(i,j) = 1.0/SQRT(C(i,j)*ABS(P(i)-P(j)))
NUMER = NUMER + A(i,j)*P(i)
DEMON = DEMON + A(i,j)
7 continue
SAVEP = P(j)
P(j) = NUMER/DENOM
if (ABS(SAVEP-P(j)).GE.EPS) CONV = .false.
8 continue
if (IPRINT) write (6,206) ITER, (P(i), i = 1,N)
if (CONV) go to 10
9 continue
write (6,207) ITMAX
*****************************************
***** calcul des debits dans chaque troncon *****
*****************************************
10 do 11 i = 1,N
do 11 j = 1,i
Q(i,j) = 0.
Q(j,i) = 0.
if (i.EQ.j.OR..not.INCID(i,j)) go to 11
Q(i,j) = (P(i)-P(j))/SQRT(C(i,j)*ABS(P(i)-P(j)))
Q(j,i) = -Q(i,j)
11 continue
****************************************
***** ecriture des pressions finales et des debits *****
****************************************
write (6,208) ITER, N
do 12 i = 1,N
12 write (6,209) i, P(i), (Q(i,j), j = 1,N)
go to 1
***************************************
***** formats des etats d'entrées/sorties *****
***************************************
100 format(3x,i2,17x,i3,15x,F5.1,15x,E5.0/4x,F6.3,14x,L1 /
1 (30x,20(L1,1x)))
101 format(30x,5F8.3)
102 format(30x,20(L1,1x))
200 format(23H1FLOW IN A PIPE NETWORK/ 10H0N = ,13/ 10H ITMAX
1=, i3/ 10H RHO =, F7.3/ 10H EPS =, E10.2/ 10H F =,
2 F7.3/10H IPRINT =, 2x, L1/ 3H0 i, 6x, 4HP(i), 4x,9HPGIVEN(i)
3 (1H, i2, F10.3, 6x, L1))
201 format(1H0/1H0)
202 format(7H0INCID(,i2,13H, 1)...INCID(, i2, 1H,,i2, 3H) = ,
1 40(L1, 1x)/ (1H, 29x, 40(L1, 1x)))
203 format(3H0D(,i2, 9H, 1)...D(,i2,1H,,i2, 1H), 9x, 1H= , 8F10.3 /
1 (1H, 29x, 8F10.3))
204 format(3H0L(,i2, 9H, 1)...L(,i2,1H,,i2, 1H), 9x, 1H= , 8F10.3 /
1 (1H, 29x, 8F10.3))
205 format(1H0/ 5H0ITER,7x,16HPRESSURE AT NODE/ (1H,11x,8(i1,9x)))
206 format(1H, i3, 3x, 8F10.4/ (1H , 6x, 8F10.4))
207 format(35H0SOLUTIONS FAILED TO CONVERGE AFTER,i3,11H ITERATIONS)
208 format(1H0/26H0PRESSURES AND FLOWS AFTER, i3,15H ITERATIONS ARE/
1 3H0 i,5x,4HP(i),7x,16HQ(i, 1)...Q(i,,i2,1H) / 1H , 7x, 3HPSI,
2 14x, 7HGAL/MIN//)
209 format(1H , i2, F10.4, 5x, 8F10.3/ (1H , 17x, 8F10.3))
end