【正文】 EAD(1,*)(X(I),I=1,50)CCCCCCCCCCC 非零相位遞歸濾波的設計 CCCCCCCCC DO 10 I=0,49 X1(I)= X2(I)= DO 20 J=1,I20 X1(I)=X1(I)+A(J)*X(IJ) IF() THEN X2(I)= ELSE DO 30 K=1,I30 X2(i)=X2(i)+B(k)*Y_DNZ(IK) END IF Y_DNZ(I)=X1(I)X2(I)10 CONTINUE OPEN(2,FILE=39。,FORM=39。,STATUS=39。) K=LOG()/LOG() IF(2**)THEN K=K+1 ENDIF NFFT=2**K DO 10,I=50,50 IF()THEN H(I+51)=*F ELSE H(I+51)=SIN(2*PI**I*DT)/(PI*I*DT) END IF10 CONTINUE DO 20,I=102,12820 H(I)= DO 30,I=1,12830 H2(I)=CMPLX(H(I),) CALL FFT(128,H2,) DO 40,I=1,128 H2_R(I)=REAL(H2(I)) H2_I(I)=AIMAG(H2(I)) H_S(I)=(H2_R(I)**2+H2_I(I)**2)40 CONTINUE WRITE(2,*)(H_S(I),I=1,128) WRITE(1,*)(H(I),I=1,128) CLOSE(1) CLOSE(2) END CCCCCCCCCCCCC FFT 子程序 CCCCCCCCCCCCCC SUBROUTINE FFT(LX,CX,SIGNI) COMPLEX CX(LX),CARG,CEXP,CW,CTEMP J=1 SC= IF()SC= SIG=SIGNI DO 30 I=1,LX IF()GO TO 10 CTEMP=CX(J)*SC CX(J)=CX(I)*SC CX(I)=CTEMP 10 M=LX/2 20 IF()GO TO 30 J=JM M=M/2 IF()GO TO 20 30 J=J+M L=1 40 ISTEP=2*L DO 50 M=1,L CARG=(,)*(*SIG*(M1))/L CW=CEXP(CARG) DO 50 I=M,LX,ISTEP CTEMP=CW*CX(I+L) CX(I+L)=CX(I)CTEMP 50 CX(I)=CX(I)+CTEMP L=ISTEP IF()GO TO 40 RETURN END5. 頻譜分析CCCCCCCCCCCCC 頻譜分析 CCCCCCCCCCCCCC PROGRAM MAIN PARAMETER (PI=,DT=) REAL XSIN(200),X(200),WAVE(200) REAL X_SIN_R(200),X_SIN_I(200) REAL X_R(200),X_I(200) REAL X_WAVE_R(200),X_WAVE_I(200) REAL SINSPRT(200),XSPRT(200),WAVESPRT(200) REAL DF COMPLEX XSIN_C(200),X_C(200),X_WAVE_C(200) CCCCCCCCCCCC 對 SIN 的分析 CCCCCCCCCCCC DO 100 I=1,128 XSIN(I)=SIN(2*I*PI/)100 CONTINUECCCCCCCCC 是數據轉換成復數形式 CCCCCCCCCC DO 200 I=1,128200 XSIN_C(I)=CMPLX(XSIN(I),) CALL FFT(128,XSIN_C,) DO 300 I=1,128 300 X_SIN_R(I)=REAL(XSIN_C(I)) DO 400 I=1,128400 X_SIN_I(I)=AIMAG(XSIN_C(I)) OPEN(1,FILE=39。,FORM=39。,STATUS=39。) DO 3 I=1,1283 WAVESPRT(I)=SQRT(X_WAVE_R(I)**2+X_WAVE_I(I)**2) WRITE(4,*)(WAVESPRT(I), I=1,128) CLOSE(4) CLOSE(3) ENDCCCCCCCCCCCCCCC FFT 子程序 CCCCCCCCCCCCCCCCC SUBROUTINE FFT(LX,CX,SIGNI) COMPLEX CX(LX),CARG,CEXP,CW,CTEMP J=1 SC= IF()SC= SIG=SIGNI DO 30 I=1,LX IF()GO TO 10 CTEMP=CX(J)*SC CX(J)=CX(I)*SC CX(I)=CTEMP 10 M=LX/2 20 IF()GO TO 30 J=JM M=M/2 IF()GO TO 20 30 J=J+M L=1 40 ISTEP=2*L DO 50 M=1,L CARG=(,)*(*SIG*(M1))/L CW=CEXP(CARG) DO 50 I=M,LX,ISTEP CTEMP=CW*CX(I+L) CX(I+L)=CX(I)CTEMP 50 CX(I)=CX(I)+CTEMP L=ISTEP IF()GO TO 40 RETURN END6. 分析補零對振幅譜的影響CCCCCCCCCCC 分析補零對振幅譜的影響 CCCCCCCCCCC PROGRAM MAINCCCCCCCCCCC 不補零時的振幅普 CCCCCCCCCCCCCCCCCCCCCCCCCCCC 對函數 SIN 的分析 CCCCCCCCCCCCCCCC PARAMETER (PI=) REAL XSIN(150),XWAVE(150) REAL XWAVE_R(150),XWAVE_I(150) REAL XSIN_Z(150),XWAVE_Z(150) REAL XSIN_R(150),XSIN_I(150) COMPLEX XSIN_60C(150),XWAVE_60C(150) COMPLEX XSIN_64C(150),XWAVE_64C(150) COMPLEX XSIN_128C(150),XWAVE_128C(150) REAL XSIN_60S(150),XWAVE_60ZS(150) REAL XSIN_64S(150),XWAVE_64ZS(150) REAL XSIN_128S(150),XWAVE_128ZS(150) OPEN(1,FILE=39。,FORM=39。,STATUS=39。) DO 31 I=61,64 31 XSIN(I)= DO 32 I=1,64 32 XSIN_64C(I)=CMPLX(XSIN(I),) CALL DFT(64,XSIN_64C,) DO 33 I=1,6433 XSIN_R(I)=REAL(XSIN_64C(I)) DO 34 I=1,6434 XSIN_I(I)=AIMAG(XSIN_64C(I)) DO 35 I=1,6435 XSIN_64S(I)=SQRT(XSIN_R(I)**2+XSIN_I(I)**2) WRITE(4,*)(XSIN_64S(I),I=1,64) CLOSE(4) OPEN(5,FILE=39。,FORM=39。,STATUS=39。) READ(1,*)(X(I),I=1,100)CCCCCCCCCCCCCCC低通濾波器CCCCCCCCCCCCC DO 10 I=50,50 IF ()THEN H(I)=2*F*PI/PI ELSE H(I)=SIN(2*PI*F*I*DT)/(PI*I*DT) END IF10 CONTINUE CALL CON(X,H,Y_LINEAR,100,101,200)CCCCCCCCCCCC輸出濾波后的數據CCCCCCCCCCCCCCC OPEN(2,FILE=39。,FORM=39。,STATUS=39。) READ(1,*)(R(I),I=1,200)CCCCCCCCCCCCCC 求合成地震記錄 CCCCCCCCCCCCCC CALL CON(R,B,X_CONV,200,12,211)CCCCCCCCCCCC 求地震子波的自相關 CCCCCCCCCCCC CALL AUTCOR(211,211,X_CONV,RXX)CCCCCCCCCCCCCCC 求反濾波因子 CCCCCCCCCCCCCCC CALL PEO(211,RXX,A) OPEN(2,FILE=39。,FORM=39。,STATUS=39。) OPEN(2,FILE=39。,FORM=39。,STATUS=39。) DO 100 I=1,10 READ(1,*)(X(I,J),J=1,100)100 CONTINUE PRINT*,39。,STATUS=39。,FORM=39。) WRITE(1,*)(B_CONV(I),I=1,32) CLOSE(1) ENDCCCCCCCCCCCCCC FFT子程序 CCCCCCCCCCCCCC SUBROUTINE FFT(LX,CX,SIGNI) C