Examen programmation ltm
Première session 2005
pistes de solutions

c correction sujet FORTRAN LTM janvier 2005 (treillis plans)
c copyright P. TRAU - IPST ULP Strasbourg - janvier 2005
c

C Q1 : zone commune (dans ltmj05c.inc)
	integer maxn, maxb
	parameter (maxn=100)
	parameter (maxb=(2*maxn)-3)
	integer nbn,nbb
	real X(maxn),Y(maxn)
	integer N1(maxb),N2(maxb)
	common/geom/X,Y,N1,N2,nbn,nbb

C Q1 : les subroutines        
	subroutine saisie
        implicit none
	include 'ltmj05c.inc'
        integer i
        print *,'combien de noeuds ?'
        read *,nbn
        do 10 i=1,nbn
          print *,i,'-> X,Y ? ' 
          read *,X(i),Y(i)
10      continue
	nbb=2*nbn-3
	print *,'entrez les',nbb,' barres :'
        do 20 i=1,nbb
          print *,i,'-> numero des deux extremites ? ' 
          read *,N1(i),N2(i)
20      continue
        end subroutine saisie
	
        subroutine affiche
        implicit none
	include 'ltmj05c.inc'
        integer i
        print *,'il y a',nbn,' noeuds :'
        do 10 i=1,nbn
          print *,i,'-> X=',X(i),' Y=',Y(i) 
10      continue
	print *,'il y a',nbb,' barres :'
        do 20 i=1,nbb
          print *,i, '-> N1=',N1(i),' N2=',N2(i)
20      continue
        end subroutine affiche
	
C Q2	
	integer function nbconnexions(n)
        implicit none
	include 'ltmj05c.inc'
        integer i,n,nb
	nb=0
	do 10 i=1,nbb
	  if(N1(i).eq.n.or.N2(i).eq.n)nb=nb+1
10	continue
	nbconnexions=nb
	end function nbconnexions
	
C Q3
	real function longueur(n)
        implicit none
	include 'ltmj05c.inc'
	integer n
        real dx,dy
	dx=X(N1(n))-X(N2(n))
	dy=Y(N1(n))-Y(N2(n))
	longueur=sqrt(dx*dx+dy*dy)
	end function longueur

C Q4	
	integer function pluslongue()
        implicit none
	include 'ltmj05c.inc'
	integer nb,i,il
	real lmax,l,longueur
	nb=0
	lmax=0
	do 10 i=1,nbb
	  l=longueur(i)
	  if(l.gt.lmax)then
	    lmax=l
	    il=i
	    nb=0
	  elseif(l.eq.lmax)then
	    nb=nb+1
	  endif
10	continue
	if(nb>1)then
	  print*,'la barre',il,' fait partie des',nb,' plus longues'
	else
	  print*,'la barre',il,' est la plus longue'
	endif
	pluslongue=il
	end function pluslongue

C Q5	Rq : si je disais que cette question rapporte peu de points, c'est
c	pour qu'on ne l'éeacute;crive pas, mais qu'on l'utilise dans la question 6
c	ou ce calcul est necessaire
	real function sens(B,N)
        implicit none
	include 'ltmj05c.inc'
	integer B,N,autre
	real dl,longueur
	if(N.eq.N1(B))then
	  autre=N2(B)
	else
	  autre=N1(B)
	endif
	dl=X(autre)-X(B)
	sens=dl/longueur(B)
	end function sens
	
C Q6 on rajoute dans ltmj05c.inc (ou dans un fichier separe)
	integer maxl
	parameter (maxl=2*maxn)
	real matrice(maxl,maxb)
	common/mat/matrice

C Q6 : les subroutines
	subroutine equilibreX(noeud,l)
        implicit none
	include 'ltmj05c.inc'
	integer noeud,l,i
	real sens
	do 10 i=1,nbb
	  if(noeud.eq.N1(i).or.noeud.eq.N2(i))then
	    matrice(l,i)=sens(i,noeud)
	  else 
	    matrice(l,i)=0
	  endif
10	continue
	end subroutine equilibreX
	
	subroutine defmatrice
        implicit none
	include 'ltmj05c.inc'
	integer i
	do 10 i=1,nbn
	  call equilibreX(i,2*i-1)
	  call equilibreY(i,2*i)
10	continue
	end subroutine defmatrice
	
C Q7 : le - fait partie du nom, comme tout autre caractèegrave;re. Le point signifie
c que l'on change de DNS. A Strasbourg nous n'avons qu'un seul DNS pour toutes
c les universitéeacute;s, alors qu'àagrave; Tours il y en a plusieurs (un par composante ?), 
c en tous cas il y en a un àagrave; l'IUT
	

je ne déeacute;voile pas les notes individuelles, mais voici leur réeacute;partition :

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

Patrick TRAU, ULP - IPST janvier 05