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