Antistrofh tetragwnikou pinaka

[CHRIS_MALL]

Geia sas paidia kai Kala Xristougenna!

Tha ithela na rwtisw an gnwrizei kaneis ton algorithmo atistrofhs tetragwnikou pinaka kalyptwntas omws oles tis periptwseis! An ton exei kai ypolpoimeno

se fortran 90/95 tha tou eimai ypoxreos!

Efxaristw :-P

[antonis_wrx]

να υποθέσω ότι είσαι φοιτητής της ΗΜΜΥ ΕΜΠ 2ο έτος και έχεις την γνωστή εργασία για την ανάλυση? Το πρόγραμμα της δισκέτας δεν βοηθάει? Δεν το κοίταξα αλλά νομίζω ότι ίσως με κάποιες αλλαγές θα κάνει αυτό που θες..

 

C PROGRAM DGAUS

C

C GAUSS' ELIMINATION METHOD

C

PARAMETER(ND=10)

DOUBLE PRECISION A,B,D

DIMENSION A(ND,ND),B(ND),L(ND)

READ(5,*) N,IOPT

READ(5,*) ((A(I,J),J=1,N),I=1,N)

READ(5,*) (B(I),I=1,N)

WRITE(6,*) 'INPUT:'

WRITE(6,*) 'N=',N,' IOPT=',IOPT

WRITE(6,*) 'A='

DO 10 I=1,N

WRITE(6,*) (A(I,J),J=1,N)

10 WRITE(6,*) ' '

WRITE(6,*) 'B=',(B(I),I=1,N)

WRITE(6,*) ' '

WRITE(6,*) 'OUTPUT:'

CALL DGAUSS(ND,N,A,B,IOPT,D,IREG,L)

WRITE(6,*) 'D=',D,' IREG=',IREG

IF(IREG.EQ.0) STOP

WRITE(6,*) 'X=',(B(I),I=1,N)

STOP

END

C-------------------------------------------------------------------

SUBROUTINE DGAUSS(ND,N,A,B,IOPT,D,IREG,L)

C

C DECOMPOSITION OF THE MATRIX A AND/OR SOLUTION OF THE

C LINEAR SYSTEM AX=B BY GAUSS' ELIMINATION METHOD

C

C INPUT:

C ND: MAXIMUM COLUMN DIMENSION OF ARRAYS

C N: DIMENSION OF ARRAYS

C A: SYSTEM MATRIX (NXN)

C B: RIGHT-HAND SIDE VECTOR (N)

C IOPT = 0, DECOMPOSITION OF A AND SOLUTION OF THE SYSTEM

C = 1, DECOMPOSITION OF A ONLY

C = 2, SOLUTION OF THE SYSTEM (SKIPS DECOMPOSITION)

C

C OUTPUT:

C A: DECOMPOSED MATRIX (LOWER\UPPER PART), IF IOPT=0 OR 1

C B:=X: SOLUTION VECTOR STORED IN B (N)

C D: DETERMINANT OF A

C IREG = 0, SINGULAR MATRIX A

C = 1, REGULAR MATRIX A

C L: VECTOR OF PIVOTING INDICES (N)

C

DOUBLE PRECISION A,B,D,S,EE

DIMENSION A(ND,N),B(ND),L(ND)

EE=1.D-12

IREG=1

NM=N-1

IF(IOPT.EQ.2) GO TO 60

C

C TRIANGULAR DECOMPOSITION OF A WITH MAXIMUM COLUMN PIVOTING

C (ELIMINATION WITH MULTIPLIERS STORED IN THE LOWER PART OF A)

C

D=1.D0

DO 10 K=1,NM

KP=K+1

M=K

DO 20 I=KP,N

IF(DABS(A(I,K)).GT.DABS(A(M,K))) M=I

20 CONTINUE

L(K)=M

D=D*A(M,K)

IF(DABS(A(M,K)).LE.EE) GO TO 100

IF(M.EQ.K) GO TO 30

D=-D

DO 40 J=K,N

S=A(M,J)

A(M,J)=A(K,J)

40 A(K,J)=S

30 DO 50 I=KP,N

S=A(I,K)/A(K,K)

A(I,K)=S

DO 50 J=KP,N

50 A(I,J)=A(I,J)-S*A(K,J)

10 CONTINUE

D=D*A(N,N)

IF(DABS(A(N,N)).LE.EE) GO TO 100

IF(IOPT.EQ.1) RETURN

C

C ELIMINATION OPERATIONS ON B

C

60 DO 70 K=1,NM

KP=K+1

M=L(K)

S=B(M)

B(M)=B(K)

B(K)=S

DO 70 I=KP,N

70 B(I)=B(I)-A(I,K)*S

C

C BACK-SUBSTITUTION

C

B(N)=B(N)/A(N,N)

DO 80 I=1,NM

K=N-I

KP=K+1

S=0.D0

DO 90 J=KP,N

90 S=S+A(K,J)*B(J)

80 B(K)=(B(K)-S)/A(K,K)

RETURN

100 IREG=0

RETURN

END

[powerfty]

Ontws i lusi pou proteinei o antwnis_wrx einai apli kai sou lynei to provlima. Xrisimopoieis apaloifi Gauss gia agnwsto kathe mia apo tis stiles tou antistrofou pinaka kai epanalamvanontas gia kathe stili exeis sto telos ton antistrofo pinaka. Mia alli lysi einai na xrisimopoihseis epanaliptiki methodo ksekinwntas apo enan pinaka B0 proseggisi tou antirstrofou sou kai epanaliptika proseggizeis ton antistrofo, wspou meta apo ena ikanopoihtiko plithos epanalipsewn exeis vrei enan pinaka pou einai poly konta, an oxi o idios, ston antristrofo pou psaxneis. An theleis perissotera panw sti methodo auti koitakse to Numerical Recipes in C/C++ h Fortran (den kserw an to exei sti Fortran, ypothetw) alliws steile mou pm na sou dwsw ton algorithmo.

[CHRIS_MALL]

Ευχαριστώ πολύ παιδιά για το ενδιαφέρον, θα με βουθούσε περισσότερο αν ο κώδικας ήταν σε fortran 90 γραμμένος (χωρίς go to εννοώ) ! Ελπίζω να βρω άκρη, αν ωστόσο γνωρίζει κανείς κάτι άλλο (καθώς είναι συνηθισμένο πρόβλημα η αντιστροφή πίνακα) ας με ενημερώση.

Ευχαριστώ

 

Υ.Γ.Δεν πρόκειται για εκπόνηση εργασίας φίλε μου!