programme principal . . .

Version imprimable

11/02/2013, 14h24
MEKKADRA

programme principal . . .

Bonjour les amis
J'ai un problème simple et j'espère obtenir de l'aide dès que possible.
Le problème est dans l'écriture d'un programme majeur pour exécuter des programmes que vous résoudre les équations

Je fais le programme suivant et demander la correction
Ou d'autres idées

**************************************************************
function fd(x)
real fd
real x
fd=x**3+2*x+1
return
end

subroutine dichotomie
real a,b,eps,xm
integer n,i
write(*,*)'enter a,b and eps'
read(*,*)a,b,eps
n=log(abs(a-b)/eps)/log(2.0)+1
do i=1,n
xm=(a+b)/2
if (fd(a)*fd(xm)<0) then
b=xm
else
a=xm
endif
enddo
write(*,*)'{',a,',',b,',}'
write(*,*)'xm=',xm,'f(xm)=',fd(xm)
endsubroutine
*************************************************************
function fb(x)
real fb
real x
fb=x**3+2*x+1
return
end

subroutine balayage
real a,b,p,xsuite
write(*,*)'entre les valeurs suivant a b p'
read(*,*)a,b,p
10 xsuite=a+p
if(fb(a)*fb(xsuite)<0)then
write(*,*)'la solution est dans [',a,',',xsuite,']'
else
a=a+p
goto 10
endif
endsubroutine

****************************************************************
function fl(x)
real fl
real x
fl=x**3+2*x+1
return
end

subroutine lagr
real x0,x1,x2,eps
write(*,*)'entrer x0: '
read(*,*)x0
write(*,*)'entrer x1: '
read(*,*)x1
write(*,*)'entrer x2: '
read(*,*)x2
write(*,*)'entrer eps: '
read(*,*)eps
do while (abs(fl(x2))>=eps)
x2=x1-(fl(x1)*(x1-x0))/(fl(x1)-fl(x0))
x0=x1
x1=x2
write(*,*)'la valeur de la racine est',x2
enddo
endsubroutine

******************************************************************
function fn(x)
real fn
real x
fn=3*x**3+2*x+1
return
end

function dfn(x)
real dfn
real x
dfn=x**3+2
return
end

subroutine newton
real x0,x1
real eps
write(*,*)'entrer x0: '
read(*,*)x0
write(*,*)'entrer x1: '
read(*,*)x1
write(*,*)'entrer eps: '
read(*,*)eps
do while (abs(fn(x0))>=eps)
x1=x0-fn(x0)/dfn(x0)
write(*,*)'valeur de la racine est',x1
x0=x1
enddo
endsubroutine

*************************************************************
function fp(x)
real fp
real x
fp=-(x**3+1)/2
return
end

subroutine pfd
real x1
real eps
write(*,*)'donner la valeur de x1'
read(*,*)x1
write(*,*)'donner la valeur de epsilon'
read(*,*)eps
x=x1
do while (abs(x-fp(x))>=eps)
write(*,*)'valeur de racine est',x
y=fp(x)
x=y
end do
write(*,*)x,fp(x)
endsubroutine

do while(i.ne.6)
write(*,*)'1.Dichotomie'
write(*,*)'2.Balayage'
write(*,*)'3.Lagrange'
write(*,*)'4.Newton'
write(*,*)'5.Point fixe'
write(*,*)'6.Quiter'
write(*,*)'Votre choix: '
read(*,*)i
if(i.eq.1)then
call dichotomie
else
if(i.eq.2)then
call balayage
else
if(i.eq.3)then
call lagr
else
if(i.eq.4)then
call newton
else
if(i.eq.5)then
call pfd
endif
endif
endif
endif
endif
enddo
end program
11/02/2013, 18h02
__dardanos__

Bonjour.
Il manque l'instruction annonçant le début du programme principal.
Ajouter par exemple : "program main", juste avant la ligne "do while(i.ne.6)".
Ça compile, et renvoie un résultat.

Je n'avais pas bien compris la question. Voici ma proposition :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
program main
    implicit none
    integer :: i
    character(len=20), dimension(:), allocatable :: tab_ch
    tab_ch = (/ "1) Dichotomie ", "2) Balayage   ", "3) Lagrange   ", &
                "4) Newton     ", "5) Point fixe ", "6) Quiter     ", &
                "Votre choix:  "  /)
    do
        print '(100(a/))', ( trim(tab_ch(i)), i = 1, size(tab_ch) )
        read(*,*) i
        select case (i)
            case (1); call dichotomie
            case (2); call balayage
            case (3); call lagr
            case (4); call newton
            case (5); call pfd
            case (6); exit
        end select
    enddo
end program

merci pour l'aide mais il ya un petit probleme
cette probleme quand je essayez exicuter le .
le probleme est das cette partie:
Code:

1 2 3 tab_ch = (/ "1) Dichotomie ", "2) Balayage ", "3) Lagrange ", & "4) Newton ", "5) Point fixe ", "6) Quiter ", & "Votre choix: " /)
entre

Code:

tab_ch = (/ "1)

Si le caractère ")" pose problème, il faut le supprimer.

Ton compilateur est peut-être trop ancien.
Ça tourne avec gfortran (gcc 4.6.2).

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
program main
    implicit none
    integer :: i
    integer, parameter :: nb_choix = 7
    character(len=20), dimension(7) :: tab_ch
    tab_ch = (/ "1 Dichotomie ", "2 Balayage   ", "3 Lagrange   ", &
                "4 Newton     ", "5 Point fixe ", "6 Quiter     ", &
                "Votre choix: "  /)
    do
        print '(a)', tab_ch ; read(*,*) i
        select case (i)
            case (1); call dichotomie
            case (2); call balayage
            case (3); call lagr
            case (4); call newton
            case (5); call pfd
            case (6); exit
        end select
    enddo
 
end program

13/02/2013, 19h09
Sylvain Bergeron

Citation:

Envoyé par MEKKADRA

...

Code:

tab_ch = (/ "1)

Le problème est probablement avec la réallocation dynamique requise pour cette ligne. Cette facilité est introduite par Fortran 2003 et ton compilateur est probablement antérieur. Tu dois donc déclarer directement le tableau (comme __dardanos__ l'a fait) ou insérer un allocate() juste avant la ligne tab_ch = (/ ...