C MAPP SOURCE BP208322 16/11/18 21:19:04 9177 SUBROUTINE MAPP IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C C======================================================================= C = = C = CONSTRUCTION D'UN OBJET DE TYPE EVOL CONTENANT LES POINTS D'UNE = C = SECTION DE POINCARE = C = = C = SYNTAXE : CART = MAPP (COUL) EVOLF EVOLD EVOLV = C = = C = SUR UN EVENEMENT SE PRODUISANT SUR EVOLF A L'ABSCISSE T, ON = C = EMPLIT CART AVEC L'ORDONNEE A L'ABSCISSE T DE EVOLD, EN ABSCISSE = C = ET L'ORDONNEE A L'ABSCISSE T DE EVOLV, EN ORDONNEE. = C = = C = L'EVENEMENT EST LE PASSAGE DE 0. A UNE VALEUR DE L'ORDONNEE DE = C = EVOLF = C = = C = = C = MEVOL1 : POINTEUR SUR MEVOLF (OBJET EVOLUTION) = C = MEVOL2 : POINTEUR SUR MEVOLD " " = C = MEVOL3 : POINTEUR SUR MEVOLV " " = C = KEVOL1 : POINTEUR SUR KEVOLF = C = KEVOL2 : POINTEUR SUR KEVOLD = C = KEVOL3 : POINTEUR SUR KEVOLV = C = MLREE1 : POINTEUR SUR LA LISTREEL ORDONNEE DE EVOLF = C = MLREE2 : POINTEUR SUR LA LISTREEL ORDONNEE DE EVOLD = C = MLREE3 : POINTEUR SUR LA LISTREEL ORDONNEE DE EVOLV = C = = C = CREATION : 25/03/87 = C = PROGRAMMATEUR : BEAUFILS = C======================================================================= C -INC CCGEOME -INC PPARAM -INC CCOPTIO -INC CCREEL -INC SMEVOLL -INC SMLREEL POINTEUR KEVOL3.KEVOLL,MEVOL3.MEVOLL POINTEUR MLREE4.MLREEL,MLREE5.MLREEL C CHARACTER*12 MOTX,MOTY CHARACTER *72 TI,TI2,TI3 C CALL LIRMOT(NCOUL,NBCOUL,ICOUL,0) IF(ICOUL.EQ.0) ICOUL=IDCOUL+1 ICOUL=ICOUL-1 C CALL LIROBJ('EVOLUTIO',IPEV1,1,IRET) CALL LIROBJ('EVOLUTIO',IPEV2,1,IRET) CALL LIROBJ('EVOLUTIO',IPEV3,1,IRET) C IF(IERR.NE.0) GOTO 100 C C LES 3 OBJETS EVOLUTION DOIVENT ETRE DE MEME LONGUEUR C MEVOL1=IPEV1 SEGACT MEVOL1 KEVOL1=MEVOL1.IEVOLL(1) SEGACT KEVOL1 MLREE1=KEVOL1.IPROGY SEGACT MLREE1 L1=MLREE1.PROG(/1) C MEVOL2=IPEV2 SEGACT MEVOL2 KEVOL2=MEVOL2.IEVOLL(1) SEGACT KEVOL2 TI2=KEVOL2.KEVTEX MOTX=KEVOL2.NOMEVY MLREE2=KEVOL2.IPROGY SEGACT MLREE2 L2=MLREE2.PROG(/1) C MEVOL3=IPEV3 SEGACT MEVOL3 KEVOL3=MEVOL3.IEVOLL(1) SEGACT KEVOL3 TI3=KEVOL3.KEVTEX MOTY=KEVOL3.NOMEVY MLREE3=KEVOL3.IPROGY SEGACT MLREE3 L3=MLREE3.PROG(/1) C C IF((L1.EQ.L2).AND.(L1.EQ.L3))GOTO 10 CALL ERREUR(337) GOTO 100 C C CREATION DE L'OBJET CART DE TYPE EVOLUTIO C 10 CONTINUE N=1 SEGINI MEVOLL IPMAP=MEVOLL TI(1:72)=TITREE IEVTEX=TI ITYEVO='REEL' SEGINI KEVOLL IEVOLL(1)=KEVOLL TYPX='LISTREEL' TYPY='LISTREEL' cbp KEVTEX=TI if (KEVOL2.KEVTEX .eq. KEVOL3.KEVTEX) then KEVTEX=KEVOL2.KEVTEX else KEVTEX='POINCARE MAP' endif C NOMEVX=MOTX NOMEVY=MOTY NUMEVX=ICOUL NUMEVY='REEL' C JG=L1 SEGINI MLREE4 IPROGX=MLREE4 SEGINI MLREE5 IPROGY=MLREE5 cbp on dimensionne d'abord au maxi puis on ajustera JG=0 C C L'EVENEMENT EST PRIS SUR LE PREMIER OBJET EVOLUTION CITE EN C ARGUMENT C DO 20 I=1,L1 FORC=MLREE1.PROG(I) c IF(ABS(FORC).LE.1.E-10) GOTO 20 IF(ABS(FORC).LE.XSPETI) GOTO 20 C IL Y A CHOC : ON TIENT L'EVENEMENT C LE DEUXIEME OBJET EVOL CONCERNE LE DEPLACEMENT D'UN POINT C LE TROISIEME OBJET EVOL CONCERNE LA VITESSE DU MEME POINT DEPL=MLREE2.PROG(I) VITE=MLREE3.PROG(I) C C DEPL ET VITE FORMENT UN POINT DE LA CARTE JG=JG+1 MLREE4.PROG(JG)=DEPL MLREE5.PROG(JG)=VITE C 20 CONTINUE C C C AJUSTE ET DESACTIVE LES LISTREEL via JG C SEGADJ,MLREE4,MLREE5 SEGDES,MLREE4,MLREE5 SEGDES MLREE1,MLREE2,MLREE3 C C C DESACTIVE LES MEVOL ET AUTRES KEVOL C SEGDES KEVOLL,KEVOL1,KEVOL2,KEVOL3 SEGDES MEVOLL,MEVOL1,MEVOL2,MEVOL3 C C CALL ECROBJ('EVOLUTIO',IPMAP) C 100 CONTINUE RETURN END