 |
forums.silverfrost.com
Welcome to the Silverfrost forums
|
| View previous topic :: View next topic |
| Author |
Message |
pogiako111
Joined: 24 Feb 2012
Posts: 4
|
 Posted: Fri Feb 24, 2012 3:17 pm Post subject: error 399 - using fortran 95 |
 |
|
Hello guys! hope you are doing fine,
I would go straight to my question, i am trying to solve gaussian elimination using fortran and i saw a book in our library that has the codes and i tried it in fortran 95
| Code: | C GAUSSIAN ELIMINATION METHOD FOR A SYSTEM OF LINEAR EQUATIONS
C
C
C A(I,J) REPRESENTS THE ELEMENTS OF THE AUGMENTED MATRIX BEING
C REDUCED BY THE GAUSSIAN ELIMINATION METHOD A1(I,J) ARE THE
C ELEMENTS OF THE ORIGINAL AUGMENTED MATRIX , X(I) ARE THE
C UNKNOWN VARIABLES, IS THE NUMBER OF EQUATIONS, M IS THE
C NUMBER OF COLUMNS IN THE AUGMENTED MATRIX, K REPRESENTS THE
C NUMBER OF THE PIVOT ROW AND B(I) REPRESENTS THE CONSTANTS ON
C THE RIGHT-HAND SIDE OF THE GIVEN SYSTEM OF EQUATIONS
C
C
DIMENSION A(10,11),A1(10,11),X(10)
C
C ENTER THE COEFFICIANT MATRIX
C
READ(5,*)N
M=N+1
READ(5,*)((A(I,J),J=1,M),I=1,N)
DO 1 I=1,N
DO 1 J=1,M
1 A1(I,J)=A(I,J)
C
C CALL SUBROUTINE TO SOLVE THE SYSTEM OF EQUATIONS
C
CALL GAUSS(N,A,X)
WRITE(6,9)
9 FORMAT(2X, 'THE SOLUTION TO THE EQUATIONS IS:'//)
DO 10 I=1,N
10 WRITE(6,11)I,X(I)
11 FORMAT(2X, 'X(',I1,')=',F12.5)
WRITE(6,12)
12 FORMAT(//2X,'THE CONSTANT VECTOR THE EQUATIONS IS:'//)
C
C CALCULATE THE CONSTANT VECTOR B USING THE SOLUTION
C OBTAINED TO CHECK THE ACCURACY OF THE RESULTS
C
DO 13 I=,N
Y=0.0
DO 14 J=1,N
14 Y=Y+X(J)*A1(I,J)
WRITE(6,15)I,Y
15 FORMAT(2X,'B(',I1,')=',F12.5)
13 CONTINUE
STOP
END
C
C
SUBORDINATE GAUSS(N,A,X)
DIMENSION A(10,11),X(10)
N1=N-1
M=N+1
C
C FIND THE ROW WITH THE LARGEST PIVOT ELEMENT
C
DO 2 K=1,N1
K1=K+1
K2=K
B0=ABS(A(K,K))
DO 3 I=K1,N
B1=ABS(A(I,K))
IF((B0-B1) .LT.0.0) THEN
B0=B1
K2=I
END IF
3 CONTINUE
IF((K2-K) .NE. 0) THEN
C
C INTERCHANGE RWOS TO OBTAIN THE LARGEST PIVOT ELEMENT
DO 5 J=K,M
C=A(K2,J)
A(K2,J)=A(K,J)
5 A(K,J)=C
END IF
DO 2 I=K1,N
C
C APPLY THE GAUSSIAN ELIMINATION ALGORITHM
C
DO 6 J=K1,M
6 A(I,J)=A(I,J)-A(I,K)*A(K,J)/A(K,K)
2 A(I,K)=0.0
C
C APPLY BACK SUBSTITUTION
C
X(N)=A(N,M)/A(N,N)
DO 7 I1=1,N1
I=N-I1
S=0.0
J1=I+1
DO 8 J=J1,N
8 S=S+A(I,J)*X(J)
7 X(I)=(A(I,M)-S)/A(I,I)
RETURN
END
|
the problem is it states that
error 399 - Unrecognised statement, did you forget to add /FIXED_FORMAT?
I dont know what is the problem.. is it the book or my compiler..
I am using silverfrost Fn95
and also the book is kind a old it dates back to 90's.. do you think i should try it using fortran 77? sorry I miss some details, i am totally new using fortran |
|
| Back to top |
|
 |
Wilfried Linder
Joined: 14 Nov 2007
Posts: 314
Location: D�sseldorf, Germany
|
| Posted: Fri Feb 24, 2012 4:14 pm Post subject: |
|
|
This is really VERY old Fortran style...
Start PLATO, click unto File > New, then select "Fixed format Fortran file" and copy your code into the window.
Correct two errors:
| Code: | C CALCULATE THE CONSTANT VECTOR B USING THE SOLUTION
C OBTAINED TO CHECK THE ACCURACY OF THE RESULTS
C
DO 13 I=1,N
Y=0.0 |
and
| Code: | C
SUBROUTINE GAUSS(N,A,X)
DIMENSION A(10,11),X(10) |
Then, the code will be compiled.
Best regards
Wilfried |
|
| Back to top |
|
|
pogiako111
Joined: 24 Feb 2012
Posts: 4
|
| Posted: Fri Feb 24, 2012 7:05 pm Post subject: Re: |
|
|
| Wilfried Linder wrote: | This is really VERY old Fortran style...
Start PLATO, click unto File > New, then select "Fixed format Fortran file" and copy your code into the window.
Correct two errors:
| Code: | C CALCULATE THE CONSTANT VECTOR B USING THE SOLUTION
C OBTAINED TO CHECK THE ACCURACY OF THE RESULTS
C
DO 13 I=1,N
Y=0.0 |
and
| Code: | C
SUBROUTINE GAUSS(N,A,X)
DIMENSION A(10,11),X(10) |
Then, the code will be compiled.
Best regards
Wilfried |
wow you are my hero!  Thank you so much! I managed to correct the two errors the problem is that after i compiled the file, all i can see is just a blank space..
I thought i would see a question like enter the coefficient matrix..
I tried to enter some values but it results with an run time error  |
|
| Back to top |
|
|
Wilfried Linder
Joined: 14 Nov 2007
Posts: 314
Location: D�sseldorf, Germany
|
| Posted: Sat Feb 25, 2012 7:55 am Post subject: |
|
|
In your first text you wrote that you are quite new in Fortran, so it might be a good idea first to read a little bit about this language 
Expressions like READ(5,...)... means that the programme waits until you key in values (unit 5 = keyboard). In your case, you first have to define the dimension (say 7; then key in 7 and then hit return), after that you must give in the co-efficients (in this case 7*7 = 49 values). I think that usually you want to read the values from a file or get them from another part of your software. So, the code you have is only an example:
| Quote: | READ(5,*)N
M=N+1
READ(5,*)((A(I,J),J=1,M),I=1,N) |
Regards - Wilfried |
|
| Back to top |
|
|
Wilfried Linder
Joined: 14 Nov 2007
Posts: 314
Location: D�sseldorf, Germany
|
| Posted: Sat Feb 25, 2012 8:57 am Post subject: |
|
|
May be the following example can help. Here, the co-efficients are created randomly. I use this example in my lessons in Informatics. Please copy the code into PLATO (fixed format!), then directly after it the code from the next post. Save it as TEST.FOR, then compile and link. Please note that in Fortran 95 there are a lot of matrix functions, so coding of Gauss it no more necessary nowadays.
| Code: | WINAPP
OPTIONS(INTL)
PROGRAM MAT_INV
IMPLICIT NONE
integer*4 dim_A,ctrl,i,j,k,rtcode
real*8 A(1:25,1:50),B(1:25,1:50),P(1:25,1:25)
real*8 random,dr
character*500 string
dim_A = 9
dr = 5.D0
j = winio@('%ca[Invert matrix]%sy[3d_thin]&')
j = winio@('Dimension %dd%il%3rd%ff&',1,1,25,dim_A)
j = winio@('Entries from intervall +/- %2rf%ff&',dr)
j = winio@('%nl%cn%`7bt[OK]')
j = winio@('%lw%sy[3d_thin]%fn[Arial]%ts&',ctrl,1.D0)
j = winio@('%120.40cw[vscroll,hscroll]',6)
dr = max(dr,1.D0)
c co-efficients with random generator:
call date_time_seed@()
write(6,'(/,A,/)')'Start matrix:'
do i = 1,dim_A
string = ' '
do j = 1,dim_A
A(i,j) = dr*random()-dr
if (i == j) then
A(i,j+dim_A) = 1.D0
else
A(i,j+dim_A) = 0.D0
end if
k = 10*(j-1)+1
write(string(k:k+9),'(F10.3)')A(i,j)
end do
write(6,'(A)')string
end do
B = A
c invert matrix
call invert(dim_A,A,rtcode)
if (rtcode < 0) then
write(6,'(/,A)')'*** Rank defect ***'
else
c result:
write(6,'(/,A,/)')'Invers matrix:'
do i = 1,dim_A
string = ' '
do j = 1,dim_A
k = 10*(j-1)+1
write(string(k:k+9),'(F10.3)')A(i,j+dim_A)
end do
write(6,'(A)')string
end do
c test:
write(6,'(/,A,/)')'Test:'
do i = 1,dim_A
string = ' '
do j = 1,dim_A
P(i,j) = 0.D0
do k = 1,dim_A
P(i,j) = P(i,j)+B(i,k)*A(k,j+dim_A)
end do
k = 10*(j-1)+1
write(string(k:k+9),'(F10.3)')P(i,j)
end do
write(6,'(A)')string
end do
end if
end |
--> continued in the next post
Last edited by Wilfried Linder on Sat Feb 25, 2012 9:10 am; edited 1 time in total |
|
| Back to top |
|
|
Wilfried Linder
Joined: 14 Nov 2007
Posts: 314
Location: D�sseldorf, Germany
|
| Posted: Sat Feb 25, 2012 9:00 am Post subject: |
|
|
| Code: | subroutine invert(dim_A,A,rtcode)
IMPLICIT NONE
integer*4 dim_A,zdim_A,i,j,k,rtcode
real*8 A(1:25,1:50)
real*8 r,fastnix
rtcode = -1
fastnix = 10.D0*tiny(1.D0)
zdim_A = 2*dim_A
do k = 1,dim_A
c if A(k,k) = 0, change rows
if (A(k,k) < fastnix) then
do i = k+1,dim_A
if (A(i,k) > fastnix) then
do j = 1,zdim_A
r = A(k,j)
A(k,j) = A(i,j)
A(i,j) = r
end do
exit
end if
end do
end if
c transform to upper triangle matrix
do i = k,dim_A
if (abs(A(i,k)) > fastnix) then
r = A(i,k)
do j = 1,zdim_A
A(i,j) = A(i,j)/r
end do
if (i > k) then
do j = 1,zdim_A
A(i,j) = A(i,j)-A(k,j)
end do
end if
end if
end do
end do
c diagonal element equal 0 --> return
do k = 1,dim_A
if (abs(A(k,k)) < fastnix) return
end do
c transform to diagonal matrix
do k = dim_A-1,1,-1
do i = k,1,-1
r = A(i,k+1)
do j = 1,zdim_A
A(i,j) = A(i,j)-r*A(k+1,j)
end do
end do
end do
rtcode = 0
return
end |
Regards - Wilfried |
|
| Back to top |
|
|
mecej4
Joined: 31 Oct 2006
Posts: 1899
|
| Posted: Sat Feb 25, 2012 3:34 pm Post subject: Re: |
|
|
| Thanks for the picture. Now, for the first time, I know how how Silverfrost-created blank output looks! |
|
| Back to top |
|
|
pogiako111
Joined: 24 Feb 2012
Posts: 4
|
| Posted: Sun Feb 26, 2012 12:37 pm Post subject: |
|
|
I am lost i don't know if i could still make a program to solve Gaussian elimination or Bisection method..
@Wilfried
Thank you so much for your effort to help me..
| Code: | C PROGRAM TO SOLVE EQUATION
C BY USING GAUSSIAN-ELIMINATION METHOD
DIMENSION A(10,10),X(10)
WRITE(*,*)'NUMBER OFEQUATION IS'
READ(*,*) N
WRITE(*,*)'ENTER THE COEFFICIENT & CONSTANTS:'
DO 25 I=1,N
READ(*,20)(A(I,J),J=1,N+1)
20 FORMAT(10F15.5)
25 CONTINUE
DO 40 I=1,N-1
IF(A(I,I).EQ.0) THEN
DO 42 J=I+1,N
IF(A(J,I).NE.0) THEN
DO 44 K=1,N+1
T=A(I,K)
A(I,K)=A(J,K)
A(J,K)=T
44 CONTINUE
GOTO 15
ENDIF
42 CONTINUE
ENDIF
IF((J.EQ.N).AND.(A(J,I).EQ.0)) THEN
WRITE(*,*)'SOLUTION IS NOT POSSIBLE'
ENDIF
STOP
15 DO 50 J=I+1,N
T=A(J,I)/A(I,I)
DO 52 K=1,N+1
A(J,K)=A(J,K)-T*A(I,K)
52 CONTINUE
50 CONTINUE
40 CONTINUE
IF(A(N,N).EQ.0) THEN
WRITE(*,*)'SOLUTION IS NOT POSIBLE'
ELSE
X(N)=A(N,N+1)/A(N,N)
ENDIF
STOP
DO 60 I=N-1,1,-1
S=0
DO 62 J=I+1,N
S=S+A(I,J)*X(J)
62 CONTINUE
X(I)=(A(I,N+1)-S)/A(I,I)
60 CONTINUE
WRITE(*,*)'SOLUTIONS'
DO 70 I=1,N
WRITE(*,55) I,X(I)
55 FORMAT(5X,'X(',I2',)=',F15.5)
70 CONTINUE
END
|
| Code: | PROGRAM bs
c To find zero of an equation by bisection method
write(*,40)
40 format(1x,'To find a real root of an equation using Bisection',\)
write(*,50)
50 format(' method.')
write(*,*)
write(*,*)'Enter numbers between which the root is to be found:'
read(*,*)a,b
IF((f(a).GT.0).AND.(f(b).LT.0))THEN
w=a
a=b
b=w
ENDIF
write(*,*)'Input error value:'
read(*,*)e
20 c=(a+b)/2
IF(abs(f(c)).LT.e) GOTO 30
IF(f(c).LT.0)THEN
a=c
ELSE
b=c
ENDIF
GOTO 20
30 write(*,10)c
10 format(1x,'The approximate root of the function is:',F8.3)
STOP
END
function f(c)
f=c*c-5*c+6
return
|
I tried this one to fortran 95 and fortran power station..
I still get an error..
I have nothing to present this coming Tuesday |
|
| Back to top |
|
|
mecej4
Joined: 31 Oct 2006
Posts: 1899
|
| Posted: Sun Feb 26, 2012 2:34 pm Post subject: |
|
|
At most educational institutions, taking a program from a book and presenting it without attribution and as your completed homework is probably in violation of the student honesty code. Therefore,
| Quote: | | I have nothing to present this coming Tuesday |
is probably a good way to resolve the situation.
The second program (bisection), probably taken from an old book, works fine, once you remove the backslash from the FORMAT statement -- the use of a backslash to prevent outputting an end-of-recored prior to console input is a non-standard extension. |
|
| Back to top |
|
|
pogiako111
Joined: 24 Feb 2012
Posts: 4
|
| Posted: Sun Feb 26, 2012 4:44 pm Post subject: Re: |
|
|
| of course the credits will be given to the author of the codes,finally i managed to have the bisection method working, the problem is that when the answer is showing the program shuts down automatically |
|
| Back to top |
|
|
Wilfried Linder
Joined: 14 Nov 2007
Posts: 314
Location: D�sseldorf, Germany
|
| Posted: Sun Feb 26, 2012 5:58 pm Post subject: |
|
|
It makes few sense just to copy code from elsewhere. If you start your bisection, select (say) 30 and 50 for the interval and 40 as error value. What happens? I guess - nothing. The programme hangs.
Add the following for example:
| Code: | write(*,*)'Input error value:'
read(*,*)e
ccccc
d=(a+b)/2+1
ccccc
20 c=(a+b)/2
ccccc
if (c .lt. d) then
d=c
else
write(*,*)'No iteration - check input values!'
stop
end if
ccccc
IF(abs(f(c)).LT.e) GOTO 30 |
You MUST look for a good introduction into the Fortran language and study this at first. After that you will at least better understand code from other people.
Regards - Wilfried |
|
| Back to top |
|
|
mecej4
Joined: 31 Oct 2006
Posts: 1899
|
| Posted: Sun Feb 26, 2012 5:58 pm Post subject: |
|
|
| Quote: | | when the answer is showing the program shuts down automatically |
This problem does not arise when you run the compiled program in a Command Window.
In an IDE, you can add a PAUSE statement or a READ(*,*) statement just before the END PROGRAM statement. Or, if you are running inside a debugger, you can set a breakpoint at the end of the main program. |
|
| Back to top |
|
|
PaulLaidler
Site Admin
Joined: 21 Feb 2005
Posts: 8210
Location: Salford, UK
|
| Posted: Sun Feb 26, 2012 8:42 pm Post subject: |
|
|
| This is true for many IDEs but Plato automatically adds a pause for you. |
|
| Back to top |
|
|
JohnCampbell
Joined: 16 Feb 2006
Posts: 2615
Location: Sydney
|
| Posted: Mon Feb 27, 2012 12:54 am Post subject: |
|
|
While I agree with mecej4, I hope these revisions of your Gaussian solution help.
You had misplaced your STOP statement and I have converted to Fortran 90 format with indent layout to identify the DO loops.
Hopefully I found all your typing errors. | Code: | !C PROGRAM TO SOLVE EQUATION
!C BY USING GAUSSIAN-ELIMINATION METHOD
Real*8 A(10,11),X(10), T, S
integer*4 N, i,j,k
logical near_zero
external near_zero
!
WRITE(*,*)'NUMBER OF EQUATION IS'
READ (*,*) N
WRITE(*,*)'ENTER THE COEFFICIENT & CONSTANTS:'
DO I=1,N
READ(*,20)(A(I,J),J=1,N+1)
end do
20 FORMAT(10F15.5)
!
! You should echo the matrix read
!
DO I=1,N
IF ( near_zero (A(I,I)) ) THEN ! swap rows for non-zero
DO J=I+1,N
IF ( near_zero (A(J,I)) ) CYCLE
DO K=1,N+1
T=A(I,K)
A(I,K)=A(J,K)
A(J,K)=T
end do
exit
end do
IF ( near_zero (A(I,I)) ) THEN ! no non-zero found
WRITE(*,*)'SOLUTION IS NOT POSSIBLE'
STOP
ENDIF
ENDIF
!
DO J=I+1,N
T=A(J,I)/A(I,I)
DO K=1,N+1
A(J,K)=A(J,K)-T*A(I,K)
end do
end do
end do
!
X(N)=A(N,N+1)/A(N,N) ! Is X stored in A(:,N+1) ?
!
DO I = N-1,1,-1
S=0
DO J = I+1,N
S=S+A(I,J)*X(J)
end do
X(I)=(A(I,N+1)-S)/A(I,I)
end do
!
WRITE(*,*)'SOLUTIONS'
DO I=1,N
WRITE(*,55) I,X(I)
end do
55 FORMAT(5X,'X(',I0,')=',F15.5)
!
END
logical function near_zero (x)
!
! function to test if the value is too small
! test depends on size of other coefficients
!
real*8 x
near_zero = abs(x) < 1.d-10
end function near_zero
|
|
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
