Télécharger moment.eso

Retour à la liste

Numérotation des lignes :

  1. C MOMENT SOURCE CHAT 05/01/13 01:51:06 5004
  2. C =============================================
  3. C SUBROUTINE OF COMPUTATION OF THE MOMENTS
  4. SUBROUTINE MOMENT(FRQ,ETA,TE,NSPT,F,S, IG, XL0,XL1,XL2)
  5. C =============================================
  6. C
  7. C CALLED BY POSPRESP
  8. C FROM A.P.+ P.P. 27/2/90+2/4/90
  9. C
  10. C
  11. C COMPUTATION OF STATIONARY MOMENTS OF POWER SPRECTRUM
  12. C OF THE RESPONSE OF AN OSCILATOR WITH Wn AND Eta
  13. C MODULUS OF THE TRANSFER FUNCTION USED:
  14. C
  15. C IG=1 |H(iW)|**2=| (Wn**2+i*2*Eta*Wn*W)/
  16. C ((Wn**2-W**2)+i*2*Eta**2*W*Wn) | ** 2
  17. C = (4*Eta**2*Wn**2*W**2+Wn**4)/
  18. C ((Wn**2-W**2)**2+4*Eta**2*W**2*Wn**2)
  19. C ( Transfer Function from Base Acceleration to Absolute Acceleration )
  20. C
  21. C IG=2 |H(iW)|**2=W**2/((Wn**2-W**2)**2+4*Eta**2*W**2*Wn**2)
  22. C ( Transfer Function from Base Acceleration to Relative Velocity )
  23. C
  24. C IG=3 |H(iW)|**2=1/((Wn**2-W**2)**2+4*Eta**2*W**2*Wn**2)
  25. C ( Transfer Function from Base Acceleration to Relative Displacement )
  26. C
  27. C
  28. C BASE ACCELERATION POWER SPECTRUM ASSUMED LINEAR BETWEEN
  29. C THE POINTS (F1,S1) and (F2,S2)
  30. C
  31. C S(w)=C1*w+C2
  32. C
  33. C ( ANALYTICAL INTEGRATION )
  34. C
  35. C =============================================
  36. IMPLICIT INTEGER(I-N)
  37. IMPLICIT REAL*8 (A-H,O-Z)
  38. DIMENSION F(NSPT),S(NSPT)
  39. C
  40. ETQD=ETA*ETA
  41. ETRM=SQRT(1-ETQD)
  42. UMMET=1.0D0-2*ETQD
  43. XL0=0.0D0
  44. XL1=0.0D0
  45. XL2=0.0D0
  46. DPI=8*ATAN(1.0D0)
  47. PI=DPI/2
  48. OMG=DPI*FRQ
  49. OMG2=OMG*OMG
  50. OMG3=OMG2*OMG
  51. OMG4=OMG2*OMG2
  52. OMG6=OMG4*OMG2
  53. DO 100 IESP=1,NSPT-1
  54. IF (((F(IESP+1)-F(IESP)).LT.1.0D-8).OR.((S(IESP).LT.1.0D-8)
  55. > .AND.(S(IESP+1).LT.1.0D-8))) GOTO 99
  56. S1=S(IESP)
  57. S2=S(IESP+1)
  58. X1=DPI*F(IESP)/OMG
  59. X2=DPI*F(IESP+1)/OMG
  60. XLMPQ=(LOG((X2*X2*X2*X2-2*UMMET*X2*X2+1)/
  61. > (X1*X1*X1*X1-2*UMMET*X1*X1+1)))
  62. XLMA=(LOG((X2*X2-2*X2*ETRM+1)/
  63. > (X2*X2+2*X2*ETRM+1)*
  64. > (X1*X1+2*X1*ETRM+1)/
  65. > (X1*X1-2*X1*ETRM+1)))
  66. XLMA0=(LOG((X2*X2+2*X2*ETRM+1)/
  67. > (X2*X2-2*X2*ETRM+1)*
  68. > (X1*X1-2*X1*ETRM+1)/
  69. > (X1*X1+2*X1*ETRM+1)))
  70. TNGE=((X2*X2-X1*X1)*2*ETA*ETRM/
  71. > (X1*X1*X2*X2-UMMET*(X1*X1+X2*X2)+1))
  72. TANG=(2*ETA*(X2-X1)*(1+X2*X1)/
  73. > ((1-X1*X1)*(1-X2*X2)+4*ETQD*X1*X2))
  74. C
  75. IF(TANG.LT.0.D0)THEN
  76. ARC=PI
  77. ELSE
  78. ARC=0.D0
  79. END IF
  80. IF(TNGE.LT.0.D0)THEN
  81. ARCTM=PI
  82. ELSE
  83. ARCTM=0.D0
  84. END IF
  85. ARC=ARC+ATAN(TANG)
  86. ARCTM=ARCTM+ATAN(TNGE)
  87. C
  88. DDF=(F(IESP+1)-F(IESP))*DPI
  89. DDF2=(F(IESP+1)**2-F(IESP)**2)*DPI**2
  90. C1=(S2-S1)/DDF
  91. C2=S1-C1*F(IESP)*DPI
  92. C
  93. ZZ0=(ARC/4/ETA+XLMA0/ETRM/8)/OMG3
  94. ZZ1=ARCTM/ETRM/ETA/OMG2/4
  95. ZZ2=(ARC/4/ETA+XLMA/ETRM/8)/OMG
  96. ZZ3=(XLMPQ+UMMET/ETA/ETRM*ARCTM)/4
  97. C
  98. GOTO(1,2,3),IG
  99. C
  100. 1 AP0=(C1*(4*ETQD*OMG2*ZZ3+OMG4*ZZ1)+
  101. > C2*(4*ETQD*OMG2*ZZ2+OMG4*ZZ0) )/DPI
  102. AP1=(C1*(4*ETQD*OMG2*DDF+
  103. > OMG4*(1+8*ETQD*UMMET)*ZZ2-4*OMG6*ETQD*ZZ0)+
  104. > C2*(4*ETQD*OMG2*ZZ3+OMG4*ZZ1) )/DPI
  105. AP2=(C1*(4*ETQD*OMG2*DDF2/2+
  106. > OMG4*(1+8*ETQD*UMMET)*ZZ3-4*OMG6*ETQD*ZZ1)+
  107. > C2*(4*ETQD*OMG2*DDF+
  108. > OMG4*(1+8*ETQD*UMMET)*ZZ2-4*OMG6*ETQD*ZZ0) )/DPI
  109. GOTO 10
  110. C
  111. C
  112. 2 AP0=(C1*ZZ3+C2*ZZ2)/DPI
  113. AP1=(C1*(DDF+2*OMG2*UMMET*ZZ2-OMG4*ZZ0)+C2*ZZ3)/DPI
  114. AP2=(C1*(DDF2/2.+2*OMG2*UMMET*ZZ3-OMG4*ZZ1)+
  115. > C2*(DDF+2*OMG2*UMMET*ZZ2-OMG4*ZZ0))/DPI
  116. GOTO 10
  117. C
  118. 3 AP0=(C1*ZZ1+C2*ZZ0)/DPI
  119. AP1=(C1*ZZ2+C2*ZZ1)/DPI
  120. AP2=(C1*ZZ3+C2*ZZ2)/DPI
  121. GOTO 10
  122. C
  123. 10 IF (AP0.GT.0.D0) THEN
  124. XL0=XL0+AP0
  125. END IF
  126. IF (AP1.GT.0.D0) THEN
  127. XL1=XL1+AP1
  128. END IF
  129. IF (AP2.GT.0.D0) THEN
  130. XL2=XL2+AP2
  131. END IF
  132. 99 CONTINUE
  133. 100 CONTINUE
  134. RETURN
  135. END
  136.  
  137.  

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