Télécharger la plaquette Cast3M


fr en

Télécharger pert.eso

Retour à la liste

Numérotation des lignes : 

pert

  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.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMEVOLL
  31. -INC SMLREEL
  32. -INC CCREEL
  33. C
  34.       POINTEUR IPSIG.MLREEL,IPRES.MLREEL
  35. C
  36.       PARAMETER (NMOCLE=3)
  37.       CHARACTER*4 MOTCLE(NMOCLE)
  38.       DATA MOTCLE/'SIGN','AMPL','INIT'/
  39. C
  40.       LSIGN=0
  41.       LAMPL=0
  42.       IINT=0
  43. C
  44. C     LECTURE DE L'OBJET LISTREEL CONTENANT LE SIGNAL
  45. C
  46.       CALL LIROBJ('LISTREEL',IPSIG,1,IRET1)
  47.       IF(IRET1.EQ.0) RETURN
  48. C
  49. C     LECTURE DES MOTS-CLEF (OPTIONEL)
  50. C
  51.  1    CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0)
  52. C
  53.       IF(IVAL.EQ.0)GOTO 9
  54.       GOTO(101,102,103),IVAL
  55. C     ---> "SIGN"
  56.  101  LSIGN=1
  57.       GOTO 1
  58. C     ---> "AMPL"
  59.  102  LAMPL=1
  60.       CALL LIRREE(XAMP,1,IRET1)
  61.       IF(IRET1.EQ.0) RETURN
  62.       GOTO 1
  63. C     ---> "INIT"
  64.  103  CALL LIRENT(IINT,1,IRET1)
  65.       IF(IRET1.NE.0)THEN
  66.         IINT=-ABS(IINT)
  67.       ELSE
  68.          RETURN
  69.       ENDIF
  70. C
  71.  9    IF(IERR.NE.0) RETURN
  72. C
  73.       IF(LSIGN+LAMPL.EQ.0) LSIGN=1
  74. C
  75. C     DIMENSION DES TABLEAUX
  76. C
  77.       SEGACT IPSIG
  78.       JG=IPSIG.PROG(/1)
  79. C
  80. C     CREATION DE L'OBJET RESULTAT
  81. C
  82.       SEGINI IPRES
  83. C
  84. C     TRAVAIL EN AMPLITUDE
  85. C
  86.       IF(LAMPL.EQ.0)THEN
  87.         DO 10 IE1=1,JG
  88.           IPRES.PROG(IE1)=IPSIG.PROG(IE1)
  89.  10     CONTINUE
  90.       ELSE
  91. C
  92. C     AMPL.1) ZERO
  93. C
  94.         DO 15 IE1=1,JG
  95.           IPRES.PROG(IE1)=0.D0
  96.  15     CONTINUE
  97. C
  98. C     AMPL.2) TRANSFERT "ALEATOIRE" DE PUISSANCE
  99. C
  100.         DO 16 IE1=1,JG
  101.           XX=IPSIG.PROG(IE1)**2
  102.           PHASE=TDRAN1(IINT)*XAMP*XPI/180
  103.           CCOS2=COS(PHASE)**2
  104.           SSIN2=1-CCOS2
  105.           IPRES.PROG(IE1)=IPRES.PROG(IE1)+XX*CCOS2
  106.           IF(IE1.EQ.1)THEN
  107.             IPRES.PROG(IE1+1)=IPRES.PROG(IE1+1)+XX*SSIN2
  108.           ELSEIF(IE1.EQ.JG)THEN
  109.             IPRES.PROG(IE1-1)=IPRES.PROG(IE1-1)+XX*SSIN2
  110.           ELSE
  111.             IPRES.PROG(IE1+1)=IPRES.PROG(IE1+1)+XX*SSIN2/2
  112.             IPRES.PROG(IE1-1)=IPRES.PROG(IE1-1)+XX*SSIN2/2
  113.           ENDIF
  114.  16     CONTINUE
  115. C
  116. C     AMPL.3) RESTITUTION DES MODULES SIGNES
  117. C
  118.         DO 17 IE1=1,JG
  119.           IPRES.PROG(IE1)=SQRT(IPRES.PROG(IE1))
  120.      >                   *SIGN(1.D0,IPSIG.PROG(IE1))
  121.  17     CONTINUE
  122.       ENDIF
  123.  
  124. C
  125. C     TRAVAIL EN SIGNE
  126. C
  127.       IF(LSIGN.NE.0)THEN
  128.         DO 20 IE1=1,JG
  129.           IPRES.PROG(IE1)=IPRES.PROG(IE1)
  130.      >                   *SIGN(1.D0,TDRAN1(IINT)-.5D0)
  131.  20     CONTINUE
  132.       ENDIF
  133. C
  134.       SEGDES IPSIG
  135.       SEGDES IPRES
  136. C
  137.       CALL ECROBJ('LISTREEL',IPRES)
  138.       RETURN
  139.       END
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  

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