Télécharger mapp.eso

Retour à la liste

mapp
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
 
 
 
 
 
 
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales