C PERT      SOURCE    OF166741  25/02/20    21:17:25     12165          
      SUBROUTINE PERT
      IMPLICIT INTEGER(I-N)
      IMPLICIT  REAL*8(A-H,O-Z)
C
C=======================================================================
C  =  PERTURBATION DANS UNE SUITE DE NOMBRE                           =
C  =                                                                  =
C  =  SYNTAXE :                                                       =
C  =                                                                  =
C  =    LIST1  = PERT LIST2 ( 'SIGN'      )                           =
C  =                        ( 'AMPL' XAMP )                           =
C  =                        ( 'INIT' IINT ) ;                         =
C  =                                                                  =
C  =                                                                  =
C  =    LIST2   : OBJET DE TYPE LISTREEL CONTENANT LE SIGNAL A TRAITER=
C  =    LIST1   : OBJET DE TYPE LISTREEL CONTENANT LE SIGNAL REPONSE  =
C  =                                                                  =
C  =    XAMP    : AMPLITUDE MOYENNE DE LA PERTURMATION (RAD)          =
C  =    IINT    : INITIALISATION DU GENERATEUR ALEATOIRE              =
C  =                                                                  =
C  =                                                                  =
C  =  CREATION    : 90/08/08                                          =
C  =  PROGRAMMEUR : PEG                                               =
C=======================================================================
C

-INC PPARAM
-INC CCOPTIO
-INC SMEVOLL
-INC SMLREEL
-INC CCREEL
C
      POINTEUR IPSIG.MLREEL,IPRES.MLREEL
C
      PARAMETER (NMOCLE=3)
      CHARACTER*4 MOTCLE(NMOCLE)
      DATA MOTCLE/'SIGN','AMPL','INIT'/
C
      LSIGN=0
      LAMPL=0
      IINT=0
C
C     LECTURE DE L'OBJET LISTREEL CONTENANT LE SIGNAL
C
      CALL LIROBJ('LISTREEL',IPSIG,1,IRET1)
      IF(IRET1.EQ.0) RETURN
C
C     LECTURE DES MOTS-CLEF (OPTIONEL)
C
 1    CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0)
C
      IF(IVAL.EQ.0)GOTO 9
      GOTO(101,102,103),IVAL
C     ---> "SIGN"
 101  LSIGN=1
      GOTO 1
C     ---> "AMPL"
 102  LAMPL=1
      CALL LIRREE(XAMP,1,IRET1)
      IF(IRET1.EQ.0) RETURN
      GOTO 1
C     ---> "INIT"
 103  CALL LIRENT(IINT,1,IRET1)
      IF(IRET1.NE.0)THEN
        IINT=-ABS(IINT)
      ELSE
         RETURN
      ENDIF
C
 9    IF(IERR.NE.0) RETURN
C
      IF(LSIGN+LAMPL.EQ.0) LSIGN=1
C
C     DIMENSION DES TABLEAUX
C
      SEGACT IPSIG
      JG=IPSIG.PROG(/1)
C
C     CREATION DE L'OBJET RESULTAT
C
      SEGINI IPRES
C
C     TRAVAIL EN AMPLITUDE
C
      IF(LAMPL.EQ.0)THEN
        DO 10 IE1=1,JG
          IPRES.PROG(IE1)=IPSIG.PROG(IE1)
 10     CONTINUE
      ELSE
C
C     AMPL.1) ZERO
C
        DO 15 IE1=1,JG
          IPRES.PROG(IE1)=0.D0
 15     CONTINUE
C
C     AMPL.2) TRANSFERT "ALEATOIRE" DE PUISSANCE
C
        DO 16 IE1=1,JG
          XX=IPSIG.PROG(IE1)**2
          PHASE=TDRAN1(IINT)*XAMP*XPI/180
          CCOS2=COS(PHASE)**2
          SSIN2=1-CCOS2
          IPRES.PROG(IE1)=IPRES.PROG(IE1)+XX*CCOS2
          IF(IE1.EQ.1)THEN
            IPRES.PROG(IE1+1)=IPRES.PROG(IE1+1)+XX*SSIN2
          ELSEIF(IE1.EQ.JG)THEN
            IPRES.PROG(IE1-1)=IPRES.PROG(IE1-1)+XX*SSIN2
          ELSE
            IPRES.PROG(IE1+1)=IPRES.PROG(IE1+1)+XX*SSIN2/2
            IPRES.PROG(IE1-1)=IPRES.PROG(IE1-1)+XX*SSIN2/2
          ENDIF
 16     CONTINUE
C
C     AMPL.3) RESTITUTION DES MODULES SIGNES
C
        DO 17 IE1=1,JG
          IPRES.PROG(IE1)=SQRT(IPRES.PROG(IE1))
     >                   *SIGN(1.D0,IPSIG.PROG(IE1))
 17     CONTINUE
      ENDIF

C
C     TRAVAIL EN SIGNE
C
      IF(LSIGN.NE.0)THEN
        DO 20 IE1=1,JG
          IPRES.PROG(IE1)=IPRES.PROG(IE1)
     >                   *SIGN(1.D0,TDRAN1(IINT)-.5D0)
 20     CONTINUE
      ENDIF
C
      SEGDES IPSIG
      SEGDES IPRES
C
      CALL ECROBJ('LISTREEL',IPRES)
      RETURN
      END