CTITLESACPHS -- CHANGE PHASE OF WAVELET 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR D. NYMAN 00000020 CA DESIGNER D. NYMAN 00000030 CA LANGUAGE S/370 FORTRAN H 00000040 C WRITTEN 12/14/78 00000050 C REVISED 00000060 CA 00000070 CA 00000080 CA CALL SACPHS (WAV, LENG, PHASE, U, NP, NX, IER) 00000090 CA 00000100 CA INPUT WAV = MINIMUM PHASE WAVELET ARRAY R4 00000110 CA LENG = NUMBER OF ELEMENTS IN ARRAY WAV I4 00000120 CA PHASE = DESIRED PHASE OF WAVELET R4 00000130 CA U = WORK ARRAY R4 00000140 CA NP = NUMBER OF ELEMENTS IN U, A POWER OF 2 I4 00000150 CA NX = LOG(NP) TO BASE 2: NP=2**NX I4 00000160 CA 00000170 CA OUTPUT WAV = MIXED PHASE WAVELET R4 00000180 CA LENG = NUMBER OF ELEMENTS IN WAV = 2 * LENG - 1 I4 00000190 CA IER = 0: NO ERROR I4 00000200 CA 1: F.T. SIN/COS TABLE INADEQUATE 00000210 CA 00000220 CA 00000230 CA THIS ROUTINE CHANGES THE PHASE OF AN ASSUMED MINIMUM PHASE 00000240 CA INPUT WAVELET TO A MIXED PHASE WAVELET. PHASE CAN VARY FROM 00000250 CA -1.0 FOR MINIMUM PHASE TO 1.0 FOR MAXIMUM PHASE. THE OUTPUT 00000260 CA WAVELET IS A MIXTURE OF A MINIMUM PHASE WAVELET (MAXIMUM PHASE 00000270 CA WAVELET IF PHASE > 0) AND A ZERO PHASE WAVELET, WHERE THE 00000280 CA RELATIVE CONTRIBUTIONS ARE SPECIFIED BY THE PARAMETER PHASE. 00000290 CA 00000300 C=======================================================================00000310 C EJECT 00000320 C=======================================================================00000330 C 00000340 C CONSTANTS AND VARIABLES -- LOCAL 00000350 C LEN = OUTPUT WAVELET LENGTH I4 00000360 C P = WAVELET PHASE VS. FREQUENCY R4 00000370 C SN = SIGN OF ZERO FREQUENCY FOURIER TRANSFORM VALUE R4 00000380 C 00000390 C=======================================================================00000400 C EJECT 00000410 C 00000420 SUBROUTINE SACPHS (WAV, LENG, PHASE, U, NP, NX, IER) 00000430 C 00000440 EXTERNAL S1ATP 00000450 DIMENSION WAV(1),U(1) 00000460 C 00000470 C FOURIER TRANSFORM INPUT WAVELET 00000480 C 00000490 LEN=LENG*2-1 00000500 CALL ARMVE (WAV,U,LENG) 00000510 CALL ARSET (U(LENG+1),NP-LENG,0) 00000520 CALL S2DFT2 (NX,U,&30) 00000530 C 00000540 C SET SN, CHANGE SIGN OF FOURIER TRANSFORM IF SN < 0 00000550 C 00000560 SN=SIGN(1.,U(1)) 00000570 IF (SN.LT.0.) CALL ARREVF (U,U,NP) 00000580 C 00000590 C CALCULATE FOURIER AMPLITUDE AND CONTINUOUS PHASE 00000600 C 00000610 P0=0. 00000620 C 00000630 DO 10 J=3,NP,2 00000640 P=ATAN2(U(J+1),U(J)) 00000650 IF (ABS(P-P0).GT.3.14159265) P0=P0+SIGN(6.28318531,P-P0) 00000660 U(J)=SQRT(U(J)*U(J)+U(J+1)*U(J+1))*SN 00000670 U(J+1)=U(J-1)+P-P0 00000680 10 P0=P 00000690 C 00000700 C RECONSTRUCT FOURIER TRANSFORM, BUT WITH 00000710 C A PHASE OF (-PHASE) * ORIGINAL PHASE 00000720 C 00000730 P0=-PHASE 00000740 C 00000750 DO 20 K=1,NP,2 00000760 P=U(K+1)*P0 00000770 U(K+1)=U(K)*SIN(P) 00000780 20 U(K)=U(K)*COS(P) 00000790 C 00000800 U(NP+1)=0. 00000810 U(NP+2)=0. 00000820 C 00000830 C INVERSE FOURIER TRANSFORM AND MOVE RESULT TO WAV 00000840 C 00000850 CALL S2DFI2 (NX,U,&30) 00000860 CALL ARMVE (U(NP+2-LENG),WAV,LENG-1) 00000870 CALL ARMVE (U,WAV(LENG),LENG) 00000880 LENG=LEN 00000890 IER=0 00000900 GO TO 100 00000910 C 00000920 C F.T. SIN/COS TABLE INADEQUATE 00000930 C 00000940 30 IER=1 00000950 C 00000960 100 RETURN 00000970 C 00000980 END 00000990