C SIAR      SOURCE    OF166741  25/02/20    21:17:35     12165          
      SUBROUTINE SIAR
      IMPLICIT INTEGER(I-N)
      IMPLICIT  REAL*8(A-H,O-Z)
C=======================================================================
C    OPERATEUR SIAR
C
C    A*EVOLUTION ET/OU V*EVOLUTION ET/OU D*EVOLUTION
C
C    = SIAR PSNS*EVOLUTION
C
C          (M*EVOLUTION FREQ*LISTREEL (TFINAL*FLOTTANT))
C       OU (TFINAL*FLOTTANT)
C
C          (OPTION*MOT (TT*FLOTTANT OU II*ENTIER))
C=======================================================================
C    OPTION:
C
C    OPTION='ACCE' OU 'VITE' OU 'DEPL' PERMET DE GENERER UNIQUEMENT
C           LE SIGNAL DU TYPE INDIQUE.
C
C    OPTION='TINI' + TT PERMET D'INDIQUER UN AUTRE INSTANT INITIAL
C           QUE LE DEFAUT.
C
C    OPTION='NPOI' + NN PERMET D'INDIQUER EXPLICITEMENT LE NOMBRE DE
C           POINTS EN TEMPS DU SIGNAL GENERE.
C
C    OPTION='NSIN' + NN PERMET DE SPECIFIER LE NB DE SERIE GENEREES.
C
C    OPTION='INIT' + NN PERMET D'INITIALISER LE GENERATEUR ALEATOIRE.
C
C    OPTION='NCOU' + NN PERMET DE GENERER PLUSIEURS COURBES
C=======================================================================
C    PROGRAMMEUR : P.P.
C=======================================================================
C
      CHARACTER *72 TI
      CHARACTER*12 MOTX,MOTY
C
      PARAMETER (NMOCLE=9)
      CHARACTER*4 MOTCLE(NMOCLE)
      LOGICAL LACCE,LVITE,LDEPL,LMODU, LHARM
C

-INC PPARAM
-INC CCOPTIO
-INC SMEVOLL
-INC SMLREEL
C
      POINTEUR IACCE.MLREEL,IVITE.MLREEL,IDEPL.MLREEL,ITEMP.MLREEL
      POINTEUR JACCE.MEVOLL,JVITE.MEVOLL,JDEPL.MEVOLL
      POINTEUR KACCE.KEVOLL,KVITE.KEVOLL,KDEPL.KEVOLL
      POINTEUR IPREQ.MLREEL,IPOWE.MLREEL
      SEGMENT MTRAV
          IMPLIED IFREQ(2,NBFREQ)
          IMPLIED F(NSINUS),SRAC(NSINUS),PHASE(NSINUS)
      ENDSEGMENT
C
C     1) LECTURE DES DONNEES GIBIANE
C
C     1.1) LISTE DES MOTS CLEF
C
      DATA MOTCLE/'ACCE','VITE','DEPL','INIT','NCOU',
     >            'TINI','NPOI','NSIN','HARM'/
C
C     1.2) DEFAUTS
C
C
      LACCE=.FALSE.
      LVITE=.FALSE.
      LDEPL=.FALSE.
C
      NCOURB=1
      INITRD=0
      NSINUS=0
      NPOINT=0
      TFINAL=0.D0
      TDEBUT=0.D0
      LHARM=.FALSE.
C
C     1.3) LECTURE DE L'OBJET EVOLUTIO CONTENANT LE "POWER SPECTRUM"
C
      CALL LIROBJ('EVOLUTIO',IPPS,1,IRET)
      IF(IRET.EQ.0) GOTO 666
C
C     1.4) LECTURE CONDITIONNELLE DE L'OBJET EVOLUTIO CONTENANT
C          LES FONCTIONS DE MODULATIONS
C
      CALL LIROBJ('EVOLUTIO',IPMOD,0,IRET)
      IF(IRET.EQ.0)THEN
        LMODU=.FALSE.
      ELSE
        LMODU=.TRUE.
      ENDIF
C
C     1.5) LECTURE DE L'OBJET LISTREEL CONTENANT LES FREQUENCES
C          CAS OU LMODU=.TRUE.
C
      IF(LMODU)THEN
        CALL LIROBJ('LISTREEL',IPFRE,1,IRET)
        IF(IRET.EQ.0) GOTO 666
C
C     1.6) LECTURE DE L'OBJET FLOTTANT INDIQUANT TFINAL (OPTIONEL)
C          CAS OU LMODU=.TRUE.
C
        CALL LIRREE(TFINA1,0,IRET)
        IF(IRET.NE.0)THEN
            TFINAL=TFINA1
        ENDIF
C
C     1.7) LECTURE DE L'OBJET FLOTTANT INDIQUANT TFINAL
C          CAS OU LMODU=.FALSE.
C
      ELSE
        CALL LIRREE(TFINAL,1,IRET)
        IF(IRET.EQ.0) GOTO 666
      ENDIF
C
C     1.8) LECTURE DES MOTS-CLEF
C          (OPTIONEL)
C
 1    CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0)
C
      IF(IVAL.EQ.0)GOTO 9
      GOTO(101,102,103,104,105,106,107,108,109),IVAL
C     ---> "ACCE"
 101  LACCE=.TRUE.
      GOTO 1
C     ---> "VITE"
 102  LVITE=.TRUE.
      GOTO 1
C     ---> "DEPL"
 103  LDEPL=.TRUE.
      GOTO 1
C     ---> "INIT" + NN
 104  CALL LIRENT(INITRD,1,IRET)
      IF(IRET.EQ.0) GOTO 666
      INITRD=-ABS(INITRD)
      GOTO 1
C     ---> "NCOU" + NN
 105  CALL LIRENT(NCOURB,1,IRET)
      IF(IRET.EQ.0) GOTO 666
      GOTO 1
C     ---> "TINI" + XX
 106  CALL LIRREE(TDEBUT,1,IRET)
      IF(IRET.EQ.0) GOTO 666
      GOTO 1
C     ---> "NPOI" + NN
 107  CALL LIRENT(NPOINT,1,IRET)
      IF(IRET.EQ.0) GOTO 666
      GOTO 1
C     ---> "NSIN" + NN
 108  CALL LIRENT(NSINUS,1,IRET)
      IF(IRET.EQ.0) GOTO 666
      GOTO 1
C     ---> "HARM"
 109  LHARM=.TRUE.
      GOTO 1
C
 9    CONTINUE
C
C     2) VERIFICATION DE LA COHERENCE DES DONNEES M, FREQ ET PSNS
C        (SI LMODU=.TRUE.)
C
      IF (LMODU)THEN
C
C     2.1) NB DE COURBE/NB D'INTERVALLE DE FREQUENCE
C
        MEVOL2=IPMOD
        SEGACT MEVOL2
        NBFREQ=MEVOL2.IEVOLL(/1)
C
        MLREE3=IPFRE
        SEGACT MLREE3
        NBFRE1=MLREE3.PROG(/1) -1
C
        IF(NBFREQ.NE.NBFRE1)THEN
          SEGDES MEVOL2
          SEGDES MLREE3
          CALL ERREUR(578)
          GOTO 666
        ENDIF
C
C     2.2) DEBUT ET FIN DES FONCTIONS DE MODULATION
C
        KEVOLL=MEVOL2.IEVOLL(1)
        SEGACT KEVOLL
        MLREEL=IPROGX
        SEGACT MLREEL
        TINI=PROG(1)
        TFIN=PROG(PROG(/1))
        SEGDES MLREEL
        SEGDES KEVOLL
C
        IF (NBFREQ.GT.1)THEN
          DO 10 IE1=2,NBFREQ
            KEVOLL=MEVOL2.IEVOLL(IE1)
            SEGACT KEVOLL
            MLREEL=IPROGX
            SEGACT MLREEL
            TINI1=PROG(1)
            TFIN1=PROG(PROG(/1))
            SEGDES MLREEL
            SEGDES KEVOLL
            IF((ABS(TINI-TINI1)+ABS(TFIN-TFIN1)).GT.1.D-6)THEN
              SEGDES MEVOL2
              SEGDES MLREE3
              CALL ERREUR(579)
              GOTO 666
            ENDIF
 10         CONTINUE
        ENDIF
C
        FRMI1=MLREE3.PROG(1)
        FRMA1=MLREE3.PROG(NBFREQ+1)
C
      ELSE
        NBFREQ=1
        TINI=0.D0
        TFIN=TFINAL
      ENDIF
C
      TE=TFIN-TINI
C
C     2.3) INTERVALLE DE FREQUENCE DU SPECTRE DE PUISSANCE
C
      MEVOL1=IPPS
      SEGACT MEVOL1
      KEVOL1=MEVOL1.IEVOLL(1)
      SEGACT KEVOL1
C
      ICOUL=KEVOL1.NUMEVX
C
      IPREQ=KEVOL1.IPROGX
      IPOWE=KEVOL1.IPROGY
      SEGACT IPREQ
      FRMI=IPREQ.PROG(1)
      NSPT=IPREQ.PROG(/1)
      FRMA=IPREQ.PROG(NSPT)
C
      IF(LMODU)THEN
C
        IF ((ABS(FRMI-FRMI1)+ABS(FRMA-FRMA1)).GT.1.D-6)THEN
          SEGDES IPREQ
          SEGDES KEVOL1
          SEGDES MEVOL1
          SEGDES MEVOL2
          SEGDES MLREE3
          CALL ERREUR(580)
          GOTO 666
        ENDIF
      ENDIF
C
C     2.4) INTERVALLE DE TEMPS
C
      IF(TDEBUT.LT.(TINI-1.D-6))THEN
        CALL ERREUR(586)
        GOTO 666
      ELSEIF(TDEBUT.LT.TINI.OR.TDEBUT.EQ.0.D0)THEN
        TDEBUT=TINI
      ENDIF
C
      IF(TFINAL.GT.(TFIN+1.D-6))THEN
        CALL ERREUR(587)
        GOTO 666
      ELSEIF(TFINAL.GT.TFIN.OR.TFINAL.EQ.0.D0)THEN
        TFINAL=TFIN
      ENDIF
C
      TEF=TFINAL-TDEBUT
C
C     3) CALCUL DES BORNES ET DES DIFFERENTS DEFAUTS
C
C        LACCE, LVITE ET LDEPL
C        SPECTRE DE PUISSANCE (NSINUS)
C        NOMBRE DE POINT D'EVALUATION EN TEMPS (NPOINT)
C
      IF((.NOT.LACCE).AND.(.NOT.LVITE).AND.(.NOT.LDEPL))THEN
        LACCE=.TRUE.
        LVITE=.TRUE.
        LDEPL=.TRUE.
      ENDIF
C
C
      DT=1/(2*FRMA)
      NPOITT=INT((TE-1.D-6)/DT)+1
      NPOITB=((INT(100*(TEF-1.D-6)/TE)+1)*NPOITT)/100+1
C
      IF(NPOINT.EQ.0)THEN
        NPOINT=NPOITB
      ELSE
        TEST=DBLE(NPOINT-NPOITB)/NPOITB
        IF(ABS(TEST).GT..1D0)THEN
          REAERR(1)=TEST
          CALL ERREUR(-280)
        ENDIF
      ENDIF
      DTEF=TEF/(NPOINT-1)
C
      NN=INT(LOG(TE/DT)/LOG(2.D0)+1.D-6)
      TEFO=2**NN*DT
      NSINSB=INT(FRMA*TEFO-1.D-6)+1
      NSINSS=INT(NSINSB*FRMI/FRMA-1.D-6)+1
      FRMI1=NSINSS/DBLE(NSINSB)*FRMA
      NSINSB=NSINSB-NSINSS+1
      IF(NSINUS.EQ.0)THEN
        NSINUS=NSINSB
        FRMI=FRMI1
        DFR=(FRMA-FRMI)/(NSINUS-1)
        XDECA=1.D0
      ELSE
        TEST=DBLE(NSINUS-NSINSB)/NSINSB
        IF(ABS(TEST).GT..1D0)THEN
          REAERR(1)=TEST
          CALL ERREUR(-281)
        ENDIF
        DFR=(FRMA-FRMI)/NSINUS
        XDECA=0.5D0
      ENDIF
C
C     4) REMPLISSAGE DES TABLEAUX DE TRAVAIL "STATIQUES"
C
      SEGINI MTRAV
C
C     4.1) INDICE MIN/MAX DES BANDES DE FREQUENCE
C          CHARGEMENT DES POINTS INTERPOLE POUR F ET S
C
      SEGACT IPOWE
      DPI=8*ATAN(1.D0)
      PI=DPI/2
C
      IFREQ(1,1)=1
      IF (LMODU)THEN
        IEFREQ=2
        FRM =MLREE3.PROG(IEFREQ)
      ELSE
        FRM=FRMA
      ENDIF
      IEF=2
      FR=IPREQ.PROG(IEF)
      DO 15 IE1=1,NSINUS
        F(IE1)=(IE1-XDECA)*DFR + FRMI
        DO 11 IE2=IEF,NSPT
          IF(F(IE1).GT.(FR+1.D-6))THEN
            FR=IPREQ.PROG(IE2+1)
          ELSE
            GOTO 12
          ENDIF
 11       CONTINUE
 12     IEF=IE2
        SS= IPOWE.PROG(IEF)-(FR-F(IE1))/(FR-IPREQ.PROG(IEF-1))
     >                     *(IPOWE.PROG(IEF)-IPOWE.PROG(IEF-1))
        SRAC(IE1)=SQRT(2*SS*DFR)
        DO 13 IE2=IEFREQ,NBFREQ+1
          IF(F(IE1).GT.(FRM+1.D-6))THEN
            FRM =MLREE3.PROG(IE2+1)
            IFREQ(2,IE2-1)=IE1-1
            IFREQ(1,IE2  )=IE1
          ELSE
            GOTO 14
          ENDIF
 13       CONTINUE
 14     IEFREQ=IE2
 15     CONTINUE
      IFREQ(2,NBFREQ)=NSINUS
      SEGDES IPREQ
      SEGDES IPOWE
      SEGDES KEVOL1
      SEGDES MEVOL1
      IF(LMODU)SEGDES MLREE3
C
C     4.2) DETECTION DE BANDE VIDE
C
      IF(NBFREQ.GT.1)THEN
        DO 16 IE1=2,NBFREQ
          IF(IFREQ(1,IE1).GT.IFREQ(2,IE1))THEN
            IFREQ(1,IE1)=0
            INTERR(1)=IE1
          ENDIF
 16     CONTINUE
      ENDIF
C
C     4.3) ON REMPLIT LE TABLEAU DES TEMPS
C
      JG=NPOINT
      SEGINI ITEMP
      TEF=TDEBUT
      DO 20 IE1=1,NPOINT
        ITEMP.PROG(IE1)=TEF
        TEF=TEF+DTEF
 20     CONTINUE
      SEGDES ITEMP
C
C     4.4) INITIALISATION DES EVOLL RESULTATS
C
      N=NCOURB
      IF(LACCE)THEN
        SEGINI JACCE
        TI='Signal en acceleration'
        JACCE.IEVTEX=TI
      ENDIF
      IF(LVITE)THEN
        SEGINI JVITE
        TI='Signal en vitesse'
        JVITE.IEVTEX=TI
      ENDIF
      IF(LDEPL)THEN
        SEGINI JDEPL
        TI='Signal en deplacement'
        JDEPL.IEVTEX=TI
      ENDIF
C
C     4.5) INITIALISATION DES PHASES (CAS HARMONIQUE)
C
      IF(LHARM)THEN
        DO 25 IE1=1,NSINUS
          PHASE(IE1)=0.D0
 25       CONTINUE
      ENDIF
C
C     5) LOOP SUR LES COURBES
C
      MOTX='Temps(s)'
      DO 46 IE1=1,NCOURB
C
C     5.1) GENERATION DES PHASE (CAS ALEATOIRE)
C
        IF(.NOT.LHARM)THEN
          DO 30 IE2=1,NSINUS
            PHASE(IE2)=TDRAN1(INITRD) * DPI
 30         CONTINUE
        ENDIF
C
C     5.2) ETABLISSEMENT DES KEVOLL RESULTATS ET INITIALISATION DES REEL
C
        JG=NPOINT
        IF(LACCE)THEN
C
          SEGINI KACCE
          JACCE.IEVOLL(IE1)=KACCE
C
          WRITE(TI,'(A22,1X,A6,1X,I2)')'Signal en acceleration',
     >             'numero',IE1
          WRITE(MOTY,'(9HAccelera.,1X,I2)')IE1
          SEGINI IACCE
C
          KACCE.KEVTEX=TI
          KACCE.NUMEVX=ICOUL
          KACCE.NUMEVY='REEL'
          KACCE.TYPX='LISTREEL'
          KACCE.IPROGX=ITEMP
          KACCE.TYPY='LISTREEL'
          KACCE.IPROGY=IACCE
          KACCE.NOMEVY=MOTY(1:12)
          SEGDES KACCE
C
          DO 31 IE2=1,NPOINT
            IACCE.PROG(IE2)=0.D0
 31         CONTINUE
        ENDIF
C
        IF(LVITE)THEN
C
          SEGINI KVITE
          JVITE.IEVOLL(IE1)=KVITE
C
          WRITE(TI,'(A17,1X,A6,1X,I2)')'Signal en vitesse',
     >             'numero',IE1
          WRITE(MOTY,'(9HVitesse  ,1X,I2)')IE1
          SEGINI IVITE
C
          KVITE.KEVTEX=TI
          KVITE.NUMEVX=ICOUL
          KVITE.NUMEVY='REEL'
          KVITE.TYPX='LISTREEL'
          KVITE.IPROGX=ITEMP
          KVITE.TYPY='LISTREEL'
          KVITE.IPROGY=IVITE
          KVITE.NOMEVY=MOTY(1:12)
          SEGDES KVITE
C
          DO 32 IE2=1,NPOINT
            IVITE.PROG(IE2)=0.D0
 32         CONTINUE
        ENDIF
C
        IF(LDEPL)THEN
C
          SEGINI KDEPL
          JDEPL.IEVOLL(IE1)=KDEPL
C
          WRITE(TI,'(A21,1X,A6,1X,I2)')'Signal en deplacement',
     >             'numero',IE1
          WRITE(MOTY,'(9HDeplacem.,1X,I2)')IE1
          SEGINI IDEPL
C
          KDEPL.KEVTEX=TI
          KDEPL.NUMEVX=ICOUL
          KDEPL.NUMEVY='REEL'
          KDEPL.TYPX='LISTREEL'
          KDEPL.IPROGX=ITEMP
          KDEPL.TYPY='LISTREEL'
          KDEPL.IPROGY=IDEPL
          KDEPL.NOMEVY=MOTY(1:12)
          SEGDES KDEPL
C
          DO 33 IE2=1,NPOINT
            IDEPL.PROG(IE2)=0.D0
 33         CONTINUE
        ENDIF
C
C     5.3) BOUCLE SUR LES BANDES DE FREQUENCE
C
        DO 44 IE2=1,NBFREQ
          IF(IFREQ(1,IE2).EQ.0)GOTO 44
          IF(LMODU)THEN
            KEVOLL=MEVOL2.IEVOLL(IE2)
            SEGACT KEVOLL
            MLREE1=IPROGX
            MLREE2=IPROGY
            SEGACT MLREE1
            SEGACT MLREE2
            INDICE=2
            XTIN=MLREE1.PROG(INDICE-1)
            XTOU=MLREE1.PROG(INDICE)
            XMIN=MLREE2.PROG(INDICE-1)
            RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN)
            XMTK=XMIN
          ELSE
            XMTK=1.D0
            RATE=0.D0
            XTIN=TINI
          ENDIF
C
C     5.3bis) CONDITION INITIALE U=V=0 A T=TINI
C
          IF(LVITE.OR.LDEPL)THEN
            XIVITE=0.D0
            IF (LDEPL) XIDEPL=0.D0
            DO 330 IE3=IFREQ(1,IE2),IFREQ(2,IE2)
              CCOS=COS(DPI*F(IE3)*TINI+PHASE(IE3))
              SSIN=SIN(DPI*F(IE3)*TINI+PHASE(IE3))
              XIVITE=XIVITE +XMTK*SRAC(IE3)/(DPI*F(IE3))*SSIN
     >        +RATE*SRAC(IE3)/(DPI*F(IE3))**2*CCOS
              IF(LDEPL)THEN
                XIDEPL=XIDEPL -XMTK*SRAC(IE3)/(DPI*F(IE3))**2*CCOS
     >          +2*RATE*SRAC(IE3)/(DPI*F(IE3))**3*SSIN
              ENDIF
 330          CONTINUE
          ENDIF


C
C     5.4) BOUCLE SUR LE TEMPS ET INTERPOLATION DES M
C
          TEF=TDEBUT
          DO 42 IE3=1,NPOINT
            IF(LMODU)THEN
              IF (TEF.GT.(XTOU+1.E-5))THEN
                DO 35 IE4=INDICE,MLREE1.PROG(/1)
                  INDICE=INDICE+1
                  IF(LDEPL)XTOTI=XTOU-XTIN
                  XMIN=MLREE2.PROG(INDICE-1)
                  XTOU=MLREE1.PROG(INDICE)
                  XTIN=MLREE1.PROG(INDICE-1)
                  RATEM=RATE
                  RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN)
                  RATEM=RATE-RATEM
C
C     5.4bis) DETERMINATION DES CONDITIONS DE RECOLAGES POUR L'INTEGRATION
C             NUMERIQUE
C
                  IF(LVITE.OR.LDEPL)THEN
                  IF(LDEPL)XIDEPL=XIDEPL+XIVITE*XTOTI
                    DO 331 IE5=IFREQ(1,IE2),IFREQ(2,IE2)
                      CCOS=COS(DPI*F(IE5)*XTIN+PHASE(IE5))
                      SSIN=SIN(DPI*F(IE5)*XTIN+PHASE(IE5))
                      XIVITE=XIVITE
     >                +RATEM*SRAC(IE5)/(DPI*F(IE5))**2*CCOS
                      IF(LDEPL)THEN
                        XIDEPL=XIDEPL
     >                  +2*RATEM*SRAC(IE5)/(DPI*F(IE5))**3*SSIN
                      ENDIF
 331                CONTINUE
                  ENDIF
C
                  IF (TEF.LE.(XTOU+1.E-5))GOTO 36
 35               CONTINUE
 36             CONTINUE
              ENDIF
              XMTK=XMIN + RATE *(TEF-XTIN)
            ENDIF
C
C     5.4ter) MODIFICATIONS LIEES AUX CONDITIONS INITIALES ET DE
C             RECOLAGE
C
            IF(LVITE)IVITE.PROG(IE3)=IVITE.PROG(IE3)-XIVITE
            IF(LDEPL)IDEPL.PROG(IE3)=IDEPL.PROG(IE3)-XIDEPL
     >                         -XIVITE*(TEF-XTIN)
C
C      5.5) BOUCLE SUR LES FREQUENCE DANS CHAQUE BANDE
C           ET CALCUL DU SIGNAL
C
            DO 40 IE4=IFREQ(1,IE2),IFREQ(2,IE2)
              CCOS=COS(DPI*F(IE4)*TEF+PHASE(IE4))
              SSIN=SIN(DPI*F(IE4)*TEF+PHASE(IE4))
              IF(LACCE)THEN
                IACCE.PROG(IE3)=IACCE.PROG(IE3)
     >          +XMTK*SRAC(IE4)*CCOS
              ENDIF
              IF(LVITE)THEN
                IVITE.PROG(IE3)=IVITE.PROG(IE3)
     >          +XMTK*SRAC(IE4)/(DPI*F(IE4))*SSIN
     >          +RATE*SRAC(IE4)/(DPI*F(IE4))**2*CCOS
              ENDIF
              IF(LDEPL)THEN
                IDEPL.PROG(IE3)=IDEPL.PROG(IE3)
     >          -XMTK*SRAC(IE4)/(DPI*F(IE4))**2*CCOS
     >          +2*RATE*SRAC(IE4)/(DPI*F(IE4))**3*SSIN
              ENDIF
 40           CONTINUE
C
            TEF=TEF+DTEF
 42         CONTINUE
C
          IF(LMODU)THEN
            SEGDES MLREE1
            SEGDES MLREE2
            SEGDES KEVOLL
          ENDIF
C
 44       CONTINUE
C
C     5.6) DESACTIVATION DES CALCULS
C
        IF(LACCE)SEGDES IACCE
        IF(LVITE)SEGDES IVITE
        IF(LDEPL)SEGDES IDEPL
 46     CONTINUE
C
      IF(LACCE)SEGDES JACCE
      IF(LVITE)SEGDES JVITE
      IF(LDEPL)SEGDES JDEPL
C
      IF(LMODU)SEGDES MEVOL2
C
C     6) DESTRUCTION DE LA ZONE DE TRAVAIL ET RETOUR A GIBIANE
C
      SEGSUP MTRAV
C
      IF(LDEPL)CALL ECROBJ('EVOLUTIO',JDEPL)
      IF(LVITE)CALL ECROBJ('EVOLUTIO',JVITE)
      IF(LACCE)CALL ECROBJ('EVOLUTIO',JACCE)
C
 666  CONTINUE
      RETURN
      END