Esope source files

   1 : C PERT      SOURCE    CHAT      05/01/13    02:13:04     5004           
   2 :       SUBROUTINE PERT
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT  REAL*8(A-H,O-Z)
   5 : C
   6 : C=======================================================================
   7 : C  =  PERTURBATION DANS UNE SUITE DE NOMBRE                           =
   8 : C  =                                                                  =
   9 : C  =  SYNTAXE :                                                       =
  10 : C  =                                                                  =
  11 : C  =    LIST1  = PERT LIST2 ( 'SIGN'      )                           =
  12 : C  =                        ( 'AMPL' XAMP )                           =
  13 : C  =                        ( 'INIT' IINT ) ;                         =
  14 : C  =                                                                  =
  15 : C  =                                                                  =
  16 : C  =    LIST2   : OBJET DE TYPE LISTREEL CONTENANT LE SIGNAL A TRAITER=
  17 : C  =    LIST1   : OBJET DE TYPE LISTREEL CONTENANT LE SIGNAL REPONSE  =
  18 : C  =                                                                  =
  19 : C  =    XAMP    : AMPLITUDE MOYENNE DE LA PERTURMATION (RAD)          =
  20 : C  =    IINT    : INITIALISATION DU GENERATEUR ALEATOIRE              =
  21 : C  =                                                                  =
  22 : C  =                                                                  =
  23 : C  =  CREATION    : 90/08/08                                          =
  24 : C  =  PROGRAMMEUR : PEG                                               =
  25 : C=======================================================================
  26 : C
  27 : -INC CCOPTIO
  28 : -INC SMEVOLL
  29 : -INC SMLREEL
  30 : -INC CCREEL
  31 : C
  32 :       POINTEUR IPSIG.MLREEL,IPRES.MLREEL
  33 : C
  34 :       PARAMETER (NMOCLE=3)
  35 :       CHARACTER*4 MOTCLE(NMOCLE)
  36 :       DATA MOTCLE/'SIGN','AMPL','INIT'/
  37 : C
  38 :       LSIGN=0
  39 :       LAMPL=0
  40 :       IINT=0
  41 : C
  42 : C     LECTURE DE L'OBJET LISTREEL CONTENANT LE SIGNAL
  43 : C
  43 :       CALL LIROBJ('LISTREEL',IPSIG,1,IRET1)
  44 :       IF(IRET1.EQ.0) RETURN
  45 : C
  46 : C     LECTURE DES MOTS-CLEF (OPTIONEL)
  47 : C
  47 :  1    CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0)
  48 : C
  49 :       IF(IVAL.EQ.0)GOTO 9
  50 :       GOTO(101,102,103),IVAL
  51 : C     ---> "SIGN"
  52 :  101  LSIGN=1
  53 :       GOTO 1
  54 : C     ---> "AMPL"
  55 :  102  LAMPL=1
  55 :       CALL LIRREE(XAMP,1,IRET1)
  56 :       IF(IRET1.EQ.0) RETURN
  57 :       GOTO 1
  58 : C     ---> "INIT"
  58 :  103  CALL LIRENT(IINT,1,IRET1)
  59 :       IF(IRET1.NE.0)THEN
  60 :         IINT=-ABS(IINT)
  61 :       ELSE
  62 :          RETURN
  63 :       ENDIF
  64 : C
  65 :  9    IF(IERR.NE.0) RETURN
  66 : C
  67 :       IF(LSIGN+LAMPL.EQ.0) LSIGN=1
  68 : C
  69 : C     DIMENSION DES TABLEAUX
  70 : C
  71 :       SEGACT IPSIG
  72 :       JG=IPSIG.PROG(/1)
  73 : C
  74 : C     CREATION DE L'OBJET RESULTAT
  75 : C
  76 :       SEGINI IPRES
  77 : C
  78 : C     TRAVAIL EN AMPLITUDE
  79 : C
  80 :       IF(LAMPL.EQ.0)THEN
  81 :         DO 10 IE1=1,JG
  82 :           IPRES.PROG(IE1)=IPSIG.PROG(IE1)
  83 :  10     CONTINUE
  84 :       ELSE
  85 : C 
  86 : C     AMPL.1) ZERO
  87 : C
  88 :         DO 15 IE1=1,JG
  89 :           IPRES.PROG(IE1)=0.D0
  90 :  15     CONTINUE
  91 : C 
  92 : C     AMPL.2) TRANSFERT "ALEATOIRE" DE PUISSANCE
  93 : C
  94 :         DO 16 IE1=1,JG
  95 :           XX=IPSIG.PROG(IE1)**2
  96 :           PHASE=TDRAN1(IINT)*XAMP*XPI/180
  97 :           CCOS2=COS(PHASE)**2
  98 :           SSIN2=1-CCOS2
  99 :           IPRES.PROG(IE1)=IPRES.PROG(IE1)+XX*CCOS2
 100 :           IF(IE1.EQ.1)THEN
 101 :             IPRES.PROG(IE1+1)=IPRES.PROG(IE1+1)+XX*SSIN2 
 102 :           ELSEIF(IE1.EQ.JG)THEN
 103 :             IPRES.PROG(IE1-1)=IPRES.PROG(IE1-1)+XX*SSIN2
 104 :           ELSE
 105 :             IPRES.PROG(IE1+1)=IPRES.PROG(IE1+1)+XX*SSIN2/2
 106 :             IPRES.PROG(IE1-1)=IPRES.PROG(IE1-1)+XX*SSIN2/2
 107 :           ENDIF
 108 :  16     CONTINUE
 109 : C 
 110 : C     AMPL.3) RESTITUTION DES MODULES SIGNES
 111 : C
 112 :         DO 17 IE1=1,JG
 113 :           IPRES.PROG(IE1)=SQRT(IPRES.PROG(IE1))
 114 :      >                   *SIGN(1.D0,IPSIG.PROG(IE1))
 115 :  17     CONTINUE
 116 :       ENDIF
 117 : 
 118 : C
 119 : C     TRAVAIL EN SIGNE
 120 : C
 121 :       IF(LSIGN.NE.0)THEN
 122 :         DO 20 IE1=1,JG
 123 :           IPRES.PROG(IE1)=IPRES.PROG(IE1)
 124 :      >                   *SIGN(1.D0,TDRAN1(IINT)-.5D0)
 125 :  20     CONTINUE
 126 :       ENDIF
 127 : C
 128 :       SEGDES IPSIG
 129 :       SEGDES IPRES
 130 : C
 130 :       CALL ECROBJ('LISTREEL',IPRES)
 131 :       RETURN
 132 :       END
 133 :  
 134 :  
 135 :  
 136 :  
 137 :  
 138 :