c--------------------------------------------------------------- c Correction TP 4 LTM c Copyright P TRAU IPST 2004-2005 c--------------------------------------------------------------- c saisie des données c--------------------------------------------------------------- subroutine SaisieDonnees() implicit none include 'tp4.inc' integer i print *,'combien de briques ?' read *,NBB if (NBB.gt.MAX.or.NBB.le.0) then print *,'pas possible !' stop endif do 20 i=1,NBB print *,'brique ',i,' coin le plus proche de l origine ? ' read *,X(i),Y(i),Z(i) print*,'longueurs de la brique ',i,' ?' read*,LX(i),LY(i),LZ(i) 20 continue end subroutine SaisieDonnees c---------------------------------------------------------------- c affichage des données c---------------------------------------------------------------- subroutine AfficheDonnees() implicit none include 'tp4.inc' integer i do 10 i=1,NBB print*,'les coordonnées du coin ',i,' sont: ',X(i),Y(i),Z(i) print*,'les longueurs de la brique ',i,' sont: ',LX(i),LY(i),LZ(i) 10 continue end subroutine AfficheDonnees c--------------------------------------------------------------- c volume d'une brique : calcule le volume de la i-ième brique c--------------------------------------------------------------- real function volume(i) implicit none include'tp4.inc' integer i volume=lx(i)*ly(i)*lz(i) end function volume c-------------------------------------------------------------- c volume total c-------------------------------------------------------------- real function volumetot() implicit none include 'tp4.inc' integer i real tot,volume tot=0 do 10 i=1,nbb tot=tot+volume(i) 10 continue volumetot=tot end function volumetot c-------------------------------------------------------------- c centre de gravité : calcule ses coordonnées xg,yg,zg c-------------------------------------------------------------- subroutine rechercheCdG(xg,yg,zg) implicit none include 'tp4.inc' integer i real xg,yg,zg,v,vt,volume,volumetot xg=0 yg=0 zg=0 vt=volumetot() do 10 i=1,nbb v=volume(i)/vt xg=xg+((x(i)+lx(i)/2)*v) yg=yg+((y(i)+ly(i)/2)*v) zg=zg+((z(i)+lz(i)/2)*v) 10 continue print*,'les coordonnées du CdG sont',xg,yg,zg end subroutine rechercheCdG c-------------------------------------------------------------- c translation c-------------------------------------------------------------- subroutine translation(tx,ty,tz) implicit none include'tp4.inc' real tx,ty,tz integer i do 10 i=1,nbb x(i)=x(i)+tx y(i)=y(i)+ty z(i)=z(i)+tz 10 continue end subroutine translation c-------------------------------------------------------------- c rotation c-------------------------------------------------------------- subroutine rotation(rot) implicit none include'tp4.inc' integer rot,i real tmp c rotation autour de x if(rot.eq.1)then do 10 i=1,nbb tmp=y(i) y(i)=-z(i) z(i)=tmp tmp=ly(i) ly(i)=-lz(i) lz(i)=tmp 10 continue c rotation autour de -x else if(rot.eq.-1)then do 20 i=1,nbb tmp=-y(i) y(i)=z(i) z(i)=tmp tmp=-ly(i) ly(i)=lz(i) lz(i)=tmp 20 continue c rotation autour de y else if(rot.eq.2)then do 30 i=1,nbb tmp=z(i) z(i)=-x(i) z(i)=tmp tmp=lz(i) lz(i)=-lx(i) lx(i)=tmp 30 continue c rotation autour de -y else if(rot.eq.-2)then do 40 i=1,nbb tmp=-z(i) z(i)=x(i) z(i)=tmp tmp=-lz(i) lz(i)=lx(i) lx(i)=tmp 40 continue c rotation autour de z else if(rot.eq.3)then do 50 i=1,nbb tmp=x(i) x(i)=-y(i) y(i)=tmp tmp=lx(i) lx(i)=-ly(i) ly(i)=tmp 50 continue c rotation autour de -z else if(rot.eq.3)then do 60 i=1,nbb tmp=-x(i) x(i)=y(i) y(i)=tmp tmp=-lx(i) lx(i)=ly(i) ly(i)=tmp 60 continue else print*,'cas non prévu' endif end subroutine rotation c--------------------------------------------------------------- c dit si le point px,xy,pz est dans la i-ième brique c--------------------------------------------------------------- logical function DansUne(i,px,py,pz) implicit none include'tp4.inc' integer i real px,py,pz DansUne=px.ge.x(i).and.px.le.x(i)+lx(i) .and. + py.ge.y(i).and.py.le.y(i)+ly(i) .and. + pz.ge.z(i).and.pz.le.z(i)+lz(i) end function DansUne c-------------------------------------------------------------- c dit si le point px,xy,pz est dans une des briques c-------------------------------------------------------------- logical function DansPiece(px,py,pz) implicit none include 'tp4.inc' integer i real px,py,pz logical DansUne,test test=.false. do 10 i=1,nbb if (dansUne(i,px,py,pz)) test=.true. 10 continue DansPiece=test end function DansPiece c------------------------------------------------------------ c program test c------------------------------------------------------------ program test implicit none include 'tp4.inc' integer i,rot,choix real volume,volumetot,xg,yg,zg,tx,ty,tz logical DansPiece choix=-1; nbb=0 do while(choix.ne.0) print*,'1:saisie, 3:affiche, print*,'5:volume, 6:voltot, 7:CdG, 8:transl, 9:rot, 0:quitter' read*,choix if(choix.eq.1) then call SaisieDonnees else if(choix.eq.3) then call AfficheDonnees else if(choix.eq.5) then print*,'de quelle brique voulez vous calculer le volume?' read*,i print*,'le volume de la brique',i,' est:',volume(i) else if(choix.eq.6) then print*,'le volume total est',volumetot() else if(choix.eq.7) then call rechercheCdG(xg,yg,zg) else if(choix.eq.8) then print*,'vecteur déplacement (sur x,y et z) ?' read*,tx,ty,tz call translation(tx,ty,tz) else if(choix.eq.9) then print*,'rotation de 90° autour de ? ' print*,'1=+x, -1=-x, 2=+y, -2=-y, 3=+z, -3=-z ?' read*,rot call rotation(rot) else if(choix.eq.10) then print*,'point à tester (x,y et z) ?' read*,tx,ty,tz print*,'DansPiece me dit : ', DansPiece(tx,ty,tz) else if(choix.ne.0) then print*,'cas non prévu, recommencez !' endif enddo end program test