Télécharger pert.eso

Retour à la liste

Numérotation des lignes :

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

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