Licence techno méca
correction examen d'informatique
Première session 2004

Attention, ceci n'est qu'une proposition. Certaines réponses très différentes ont rapporté des points. Comme souvent, il n'était pas nécessaire de tout traiter.

question 1

	subroutine SaisieNoeud(X,Y,nb)
	implicit none
	real X(*),Y(*)
	integer nb,i
	print *,'combien de noeuds ?'
	read *,nb
	do 10 i=1,nb
	  print *,'noeud n° ',i, '-> coord X ? '
	  read *,X(i)
	  print *,' -> coord Y ? '
	  read *,Y(i)
10	continue
	end subroutine SaisieNoeud

	subroutine SaisieElem(P1,P2,P3,nb)
	implicit none
	integer P2(*),P1(*),P3(*)
	integer nb,i
	print *,'combien d''éléments ?'
	read *,nb
	do 10 i=1,nb
	  print *,'Element n° ',i, 'point 1 ? '
	  read *,P1(i)
	  print *,' -> point 2 ? '
	  read *,P2(i)
	  print *,' -> point 3 ? '
	  read *,P3(i)
10	continue
	end subroutine SaisieElem

c question 2

c common (supposé écrit dans le fichier "common.inc") 
	implicit none
	integer maxelem,maxnoeud
	parameter (maxnoeud=10000)
	parameter (maxelem=10000)
	real X(maxnoeud),Y(maxnoeud)
	integer P1(maxelem),P2(maxelem),P3(maxelem)
	integer nbnoeuds,nbelems
	common/maillage/X,Y,P1,P2,P3,nbnoeuds,nbelems

	program test
	include 'common.inc'
	call saisieNoeud(X,Y,nbnoeuds)
	call saisieElem(P1,P2,P3,nbelems)
	end program test

c question 3

	logical function trigo(s1,s2,s3)
	include 'common.inc'
	integer s1,s2,s3
	real x12,y12,x13,y13,pv
	x12=x(s2)-x(s1)
	y12=y(s2)-y(s1)
	x13=x(s3)-x(s1)
	y13=y(s3)-y(s1)
	pv=x12*y13-y12*x13
	if(pv.GT.0) then
	  trigo=.true.
	else
	  trigo=.false.
	endif
c s'il est nul le triangle est "plat" (pts alignés) mais on a dit de ne rien vérifier
	end function trigo

	subroutine reorganise()
	include 'common.inc'
	logical trigo
	integer i,tmp
	do 10 i=1,nbelems
	  if ( trigo(P1(i),P2(i),P3(i)) ) then
	    tmp=P2(i)
	    P2(i)=P3(i)
	    P3(i)=tmp
	  endif
10	continue
	end subroutine reorganise

c question 4

	integer function combien(s)
	include 'common.inc'
	integer i,nb,s
	nb=0
	do 10 i=1,nbelems
	  if(P1(i).EQ.s.OR.P2(i).EQ.s.OR.P3(i).EQ.s) nb=nb+1
10	continue
	combien=nb
	end function combien

c question 5 :

Quand je dois faire la même chose sur plusieurs tableaux, j'utilise un sous-programme pour ne l'écrire qu'une fois (pour X et Y, pour P1,P2 et P3)

	subroutine echangecoord(Coord,s1,s2)
	implicit none
	real coord(*),tmp
	integer s1,s2
	tmp=coord(s1)
	coord(s1)=coord(s2)
	coord(s2)=tmp
	end subroutine echangecoord
	
	subroutine echpt(Pi,s1,s2,nb)
	implicit none
	integer s,nb,s1,s2,Pi(*)
	do 10 s=1,nb
	  if(Pi(s).eq.s1) then 
          Pi(s)=s2
	  elseif(Pi(s).eq.s2) then
	    Pi(s)=s1
	  endif
10	continue
	end subroutine echpt

	subroutine echangePts(s1,s2)
	include 'common.inc'
	integer s1,s2
	call echangecoord(X,s1,s2)
	call echangecoord(Y,s1,s2)
	call echpt(P1,s1,s2,nbelems)
	call echpt(P2,s1,s2,nbelems)
	call echpt(P3,s1,s2,nbelems)
	end subroutine echangePts

c question 6

	logical function estarrete(e,s1,s2)
	include 'common.inc'
	integer e,s1,s2
	if ( (P1(e).eq.s1.OR.P2(e).eq.s1.OR.P3(e).eq.s1)
     + .and. (P1(e).eq.s2.OR.P2(e).eq.s2.OR.P3(e).eq.s2) )then
	  estarrete=.true.
	else
	  estarrete=.false.
	endif
	end function estarrete

	integer function nbfoisarrete(s1,s2)
	include 'common.inc'
	integer e,s1,s2,nb
	logical estarrete
	nb=0
	do 10 e=1,nbelems
	  if (estarrete(e,s1,s2)) nb=nb+1
10	continue
	nbfoisarrete=nb
	end function nbfoisarrete

	subroutine affarretes
	include 'common.inc'
	integer s1,s2
	integer nbfoisarrete
	do 10 s1=1,nbnoeuds
	  do 20 s2=s1+1,nbnoeuds
	    if(nbfoisarrete(s1,s2).eq.2) then
	      print*,s1,' et ',s2,' forment une arrete'
	    endif
20	  continue
10	continue
	end subroutine affarretes

pour retourner au sujets de cet examen, cliquez ici (n'est-il pas dans une autre fenêtre ?).

Patrick TRAU, ULP - IPST mars 04