C ALGORITHM 588, COLLECTED ALGORITHMS FROM ACM. C ALGORITHM APPEARED IN ACM-TRANS. MATH. SOFTWARE, VOL.8, NO. 4, C DEC., 1982, P.369-370, P. 344-468. SUBROUTINE HANKEL(BMAX,NB,NREL,TOL,NTOL,NORD,FUN1,IJREL,ZWORK, HAN 10 * ZANS,ARG,NOFUN1,IERR) C======================================================================= INTEGER NB,NREL,NTOL,NORD(NREL),IJREL(2,NREL),NOFUN1,IERR REAL BMAX,TOL,ARG(NB) COMPLEX ZWORK(283,NREL),ZANS(NB,NREL) C======================================================================= C C PURPOSE C C THE PURPOSE OF SUBPROGRAM HANKEL IS TO PROVIDE IN SINGLE PRECISION C A GENERAL ALGORITHM FOR FAST COMPLEX HANKEL TRANSFORMS OF ORDERS C 0 AND 1 USING RELATED AND LAGGED CONVOLUTIONS. C C AUTHOR C C ANDERSON, W.L., U.S. GEOLOGICAL SURVEY, DENVER, COLORADO. C C REFERENCES C C 1. ANDERSON, W.L., IMPROVED DIGITAL FILTERS FOR EVALUATING C FOURIER AND HANKEL TRANSFORM INTEGRALS. N.T.I.S REPT. C PB-242-800, SPRINGFIELD, VA., 1975. C C 2. ANDERSON, W.L., NUMERICAL INTEGRATION OF RELATED HANKEL C TRANSFORMS OF ORDERS 0 AND 1 BY ADAPTIVE DIGITAL FILTERING. C GEOPHYSICS 44 (JULY 1979), 1287-1305. C C LANGUAGE C C ANS-FORTRAN (X3.9-1966) IS USED, WITH THE EXCEPTION OF THE C CHARACTERS <,[,&,:,],> APPEARING IN SOME COMMENT STATEMENTS. C C ABSTRACT C C BY COMBINING BOTH ADAPTIVE LAGGED CONVOLUTION (SEE [1]) AND C ADAPTIVE RELATED CONVOLUTION (SEE [2]), SUBPROGRAM HANKEL C MINIMIZES EXTERNAL FUN1 CALLS (NOFUN1 AT EXIT) IN EVALUATING A C TOTAL OF NB*NREL COMPLEX HANKEL TRANSFORMS OF ORDERS 0 AND (OR) 1, C WHERE NB IS THE NUMBER OF LAGGED CONVOLUTIONS, AND NREL IS THE C NUMBER OF RELATED CONVOLUTIONS. C DIRECT CONVOLUTION METHODS (SEE [1],[2]) DO NOT REQUIRE BESSEL C FUNCTION EVALUATIONS, AND HENCE ARE GENERALLY AN ORDER OF C MAGNITUDE FASTER TO COMPUTE THAN MOST DIRECT NUMERICAL C INTEGRATION METHODS. BY USING PREVIOUSLY SAVED TRANSFORM INPUT C FUNCTION EVALUATIONS, BOTH LAGGED CONVOLUTION AND RELATED C CONVOLUTION FURTHER REDUCE SIGNIFICANTLY THE NUMBER OF TRANSFORM C INPUT FUNCTION EVALUATIONS REQUIRED OVER DIRECT CONVOLUTION. C LAGGED CONVOLUTION IS SELECTED WHEN NB>1, WHICH DEFINES ARG(NB) C OVER ANY DESIRED TRANSFORM ARGUMENT RANGE (BMIN,BMAX). RESULTS ARE C STORED AT THE FILTER SPACING IN ARRAYS ARG(NB) AND ZANS(NB,NREL) C FOR LATER USE IN SPLINE INTERPOLATION, ETC. GIVEN BMAX,NB, THE C VALUE OF BMIN (NOT GIVEN) CAN BE COMPUTED FROM THE EXPRESSION C BMIN=BMAX*EXP(-.2*(NB-1)), WHICH MUST BE .GT. 0.0 FOR THE C GIVEN MACHINE EXPONENT RANGE. C RELATED CONVOLUTION IS SELECTED WHEN NREL>1, AND BY GIVEN C SIMPLE ALGEBRAIC RELATIONSHIPS BETWEEN FUN1 AND EACH NREL RELATED C TRANSFORM INPUT FUNCTION, DEFINED AS G**I * FUN1(G)**J, WHERE C FUN1(G) IS THE FIRST TRANSFORM INPUT FUNCTION, AND ARRAY C IJREL(2,NREL)= PAIRS OF I,J INTEGERS (NEGATIVE, 0, OR POSITIVE). C THE ORDER OF ALL RELATED CONVOLUTIONS MUST BE GIVEN IN NORD(NREL), C AND MUST BE EITHER 0 OR 1, BUT CAN BE IN ANY DESIRED SEQUENCE. C HIGHER INTEGER ORDERS MAY BE EXPRESSED IN TERMS OF ORDERS 0 AND 1 C BY USING THE RECURRENCE RELATION JN-1(X)+JN+1(X)=2*N*JN(X)/X. C THE EQUALLY-SPACED J0,J1 FILTER ABSCISSAS ARE GENERATED IN C DOUBLE-PRECISION (TO CONSERVE STORAGE AND REDUCE ROUND-OFF), C BUT ARE USED IN SINGLE-PRECISION IN THE COMPLEX FUNCTION FUN1. C BOTH J0 AND J1 FILTER RESPONSE FUNCTIONS (WEIGHTS) WERE C DESIGNED TO HAVE IDENTICAL ABSCISSA VALUES IN [2]. THE C STORED J0,J1 FILTER WEIGHTS USED IN SUBPROGRAM HANKEL ARE TAKEN C FROM [2]. MUCH OF THE LOGIC USED IN HANKEL FOLLOWS THE C CODING USED IN [1] AND [2]. THE MAJOR DIFFERENCES ARE IN THE C DEFINITION OF RELATED INPUT FUNCTIONS (SEE IJREL,ZWORK), AND C FOR HANDLING OSCILLATING FUNCTIONS (SEE NTOL,ITOL). C C FOUR GENERAL CASES ARE POSSIBLE USING SUBPROGRAM HANKEL. C C CASE 1. SINGLE DIRECT CONVOLUTION AT B=BMAX=BMIN (NB=1,NREL=1). C CASE 2. RELATED CONVOLUTIONS AT A CONSTANT B=BMAX (NB=1,NREL>1). C CASE 3. LAGGED CONVOLUTIONS IN (BMIN,BMAX) (NB>1,NREL=1). C CASE 4. BOTH RELATED AND LAGGED CONVOLUTIONS (NB>1,NREL>1). C C MACHINE DEPENDENT REMARKS C C THIS SUBPROGRAM WAS IMPLEMENTED AND TESTED ON A 32-BIT WORD C MACHINE WITH EXP-RANGE APPROXIMATELY 10**-38 TO 10**+38 AND 24-BIT C MANTISSA (ABOUT 7-DECIMAL DIGITS). ONLY SINGLE-PRECISION C COMPLEX ARITHMETIC IS USED. DOUBLE-PRECISION REAL WORDS HAVE THE C SAME EXP-RANGE, WITH A 56-BIT MANTISSA (ABOUT 16-DECIMAL DIGITS). C FOR MACHINES WITH OTHER WORD SIZES, CHANGES IN THE NUMBER OF C DIGITS RETAINED IN SOME DATA STATEMENTS MAY BE REQUIRED. C C DESCRIPTION OF PARAMETERS C C INPUT C C BMAX - INITIAL HANKEL TRANSFORM ARGUMENT B=BMAX>0.0 (ANY CASE), C USED IN INTEGRAL FROM 0 TO INFINITY OF C FUN1(G)*JN(G*B)*DG, WHERE JN=BESSEL FUNCTION OF ORDER N, C N=0 OR 1, AND B>0.0. (SEE FUN1 DEFINITION BELOW). C NB - NUMBER OF LAGGED CONVOLUTIONS DESIRED (NB.GE.1). USE C NB=1 IF B=BMIN=BMAX (I.E., CASE 1 OR 2). USE C NB>1 IF B IS LAGGED IN (BMIN,BMAX), WHERE C BMIN=BMAX*EXP(-.2*(NB-1)) DOES NOT UNDERFLOW THE EXPONENT C RANGE. THE B-LAGGED SPACING IS .2 IN LOG-SPACE. FOR C CONVENIENCE IN SPLINE INTERPOLATION LATER, EACH B IN C (BMIN,BMAX) IS RETURNED IN ARRAY ARG(I),I=1,NB, WHERE C ARG(I+1)/ARG(I)=EXP(.2) FOR ALL I. IF BMAX>BMIN>0 IS C GIVEN, THEN AN EFFECTIVE VALUE OF NB IS DETERMINED AS C NB=AINT(5.*ALOG(BMAX/BMIN))+I, WHERE I>1 IS RECOMMENDED, C PARTICULARLY IF USING SUBSEQUENT SPLINE INTERPOLATION FOR C A DIFFERENT B-SPACING THAN USED IN THE SAMPLED FILTERS. IF C SPLINE INTERPOLATION IS TO BE USED LATER, IT IS GENERALLY C BEST TO USE ALOG(ARG(I)) INSTEAD OF ARG(I) -VS- ZANS(I,J), C FOR I=1,NB, AND FOR ANY GIVEN J BETWEEN 1 AND NREL. NOTE C NB IS USED AS AN ADJUSTABLE DIMENSION IN ZANS(NB,NREL). C NREL - NUMBER OF RELATED CONVOLUTIONS DESIRED (NREL.GE.1). USE C NREL=1 IF ONLY A SINGLE COMPLEX HANKEL TRANSFORM IS USED. C NREL>1 REQUIRES ARRAY IJREL(2,NREL) (SEE BELOW). C NOTE NREL IS USED AS ADJUSTABLE DIMENSIONS IN ARRAYS C ZANS(NB,NREL),ZWORK(283,NREL),NORD(NREL),IJREL(2,NREL). C TOL - REQUESTED REAL TRUNCATION TOLERANCE AT BOTH FILTER TAILS C FOR ADAPTIVE CONVOLUTION FOR ALL NB*NREL TRANSFORMS. THE C TRUNCATION CRITERION IS ESTABLISHED DURING CONVOLUTION IN C A FIXED ABSCISSA RANGE (USING WEIGHTS 131-149) OF EITHER C ORDER FILTER AS THE MAXIMUM ABSOLUTE CONVOLVED PRODUCT C TIMES TOL. THE CONVOLUTION SUMMATION IS TERMINATED C ON EITHER SIDE OF THE FIXED RANGE WHENEVER THE ABSOLUTE C PRODUCT .LE. THE TRUNCATION CRITERION. BOTH REAL AND C IMAGINARY PARTS OF THE COMPLEX SUMMATION MUST SATISFY C THE TRUNCATION CRITERION INDEPENDENTLY. IN GENERAL, A C DECREASING TOLERANCE WILL PRODUCE HIGHER ACCURACY SINCE C MORE FILTER WEIGHTS ARE USED (UNLESS EXPONENT UNDERFLOW C OCCURS IN THE TRANSFORM INPUT FUNCTION EVALUATION). C ONE MAY SET TOL=0.0 TO OBTAIN MAXIMUM ACCURACY FOR ALL C NB*NREL COMPLEX HANKEL TRANSFORMS IN ZANS(NB,NREL). C HOWEVER, THE ACTUAL RELATIVE ERRORS CANNOT BE EXPECTED C TO BE SMALLER THAN ABOUT .1E-7 REGARDLESS OF THE TOLERANCE C VALUE USED, SINCE SINGLE-PRECISION FILTER WEIGHTS AND C SINGLE-PRECISION COMPLEX FUNCTIONS ARE USED. IN ANY EVENT, C ONE SHOULD ALWAYS CHOOSE TOL<>TOL) MAY OCCUR. C NTOL - NUMBER OF CONSECUTIVE TIMES THE TRUNCATION CRITERION (TOL) C IS TO BE MET AT EITHER FILTER TAIL BEFORE FILTER C TRUNCATION OCCURS. NTOL=1 SHOULD BE USED FOR INPUT C FUNCTIONS THAT DO NOT HAVE MANY ZEROS IN (0,INFINITY). FOR C OSCILLATORY FUNCTIONS WITH MANY ZEROS, NTOL>1 MAY BE USED C TO INSURE A PREMATURE CUTOFF DOES NOT OCCUR FOR TRUNCATION C (SEE USE OF ITOL,NTOL,TOL IN THE CODE BELOW). C NORD - INTEGER ARRAY NORD(NREL) GIVING THE NREL ORDERS (0 OR 1) C OF EACH RELATED HANKEL TRANSFORM. IF ANY NORD(I),I=1,NREL, C IS NOT 0 OR 1, THEN ORDER 1 WILL BE ASSUMED. C FUN1 - NAME OF AN EXTERNAL DECLARED COMPLEX FUNCTION OF A REAL C ARGUMENT DEFINING THE 1ST TRANSFORM INPUT FUNCTION OF THE C SET OF RELATED TRANSFORMS TO BE EVALUATED. AN EXTERNAL C FUN1 STATEMENT MUST APPEAR IN THE CALLING PROGRAM. THE C COMPLEX FUNCTION FUN1(G) SUBPROGRAM MUST BE CODED BY THE C USER AND MUST BE A CONTINUOUS DECREASING COMPLEX FUNCTION C FOR ALL REAL G>0.0. THE VALUE OF G MUST BE UNCHANGED C UPON RETURN FROM FUN1. A MULTIPLE-POLE OF FUN1(G) AT G=0.0 C CAN EXIST, PROVIDED THE HANKEL TRANSFORM CONVERGES (NOTE C FUN1(0.0) IS NOT USED). A SINGLE REAL FUNCTION F1(G) MAY C BE CODED AS FUN1=CMPLX(F1(G),0.0). TWO INDEPENDENT REAL C FUNCTIONS F1(G),F2(G) MAY BE INTEGRATED IN PARALLEL BY C CODING FUN1=CMPLX(F1(G),F2(G)). GENERALLY, FUN1(G) C IS DEFINED ANALYTICALLY FOR ALL G>0.0. HOWEVER, C DISCRETELY DEFINED FUNCTIONS MAY BE USED IF FUN1(G) C RETURNS A SMOOTH INTERPOLATION VALUE (E.G., VIA CUBIC C SPLINES) WHICH SATISFIES THE CONTINUITY CONDITION FOR ALL C G>0, AND PROVIDED THE PROPER LIMITING VALUE OF FUN1(G) IS C GIVEN AS G TENDS TO INFINITY. PARAMETERS OTHER C THAN G NEEDED IN FUN1(G) MAY BE INCLUDED BY USING LABELED C COMMON IN FUN1 AND IN THE USERS CALLING PROGRAM. IF C FUN1(G) IS AN OSCILLATING FUNCTION, THEN THE HIGHEST C FREQUENCY COMPONENT (IN LOG-SPACE) SHOULD NOT EXCEED THE C FILTER NYQUIST FREQUENCY, 1/(2*0.2). IN GENERAL, C SUBPROGRAM HANKEL PERFORMS BEST WHEN USING SMOOTH, WELL- C BEHAVED FUNCTIONS FUN1(G), THAT ARE CHARACTERIZED AS C MONOTONICALLY DECREASING FUNCTIONS WITH RELATIVELY FEW C ZEROS FOR G>0. (SEE THE ACCURACY WARNING UNDER TOL, AND C ERROR CONDITION (4).) C IJREL - INTEGER ARRAY IJREL(2,NREL) USED WHEN NREL>1 TO DEFINE C THE PAIR OF I,J INTEGER EXPONENTS FOR EACH RELATED INPUT C FUNCTION. THE RELATED INPUT FUNCTIONS ARE ASSUMED C TO BE SIMPLY RELATED IN TERMS OF FUN1 VIA THE INTEGER C ARRAY IJREL(2,K),K=2,NREL. THAT IS, WE ASSUME THE K-TH C RELATED INPUT FUNCTION IS GIVEN (SEE STATEMENT 160) AS C FUNK(G)=G**IJREL(1,K) * FUN1(G)**IJREL(2,K), WHERE C THE INTEGER EXPONENTS MAY BE POSITIVE, ZERO, OR NEGATIVE. C IN THIS WAY, ONLY FUN1 NEED BE DECLARED AN EXTERNAL C COMPLEX FUNCTION. MORE COMPLICATED CODE COULD BE USED FOR C THE RELATED FUNCTIONS, PROVIDED THE MEANING OF IJREL(2,K) C IS REDEFINED AND STATEMENT 160 IS CHANGED (ALSO, SEE C ERROR CONDITION (3) BELOW). WHEN NREL=1, ARRAY C IJREL IS A DUMMY NAME (I.E., NOT REFERENCED). C IF NREL>1, THEN THE STATEMENT AT LABEL 160 C IS DEFINED ONLY FOR K=J=2,...,NREL. THAT IS, C IJREL(1,1),IJREL(2,1) ARE NOT USED IN THIS VERSION. C ZWORK - COMPLEX WORK ARRAY ZWORK(283,NREL), WHICH IS USED TO HOLD C VARIOUS COMPUTED FUNCTIONAL VALUES DURING RELATED AND C LAGGED CONVOLUTIONS. A STORAGE ROLL FEATURE USING C ZWORK(283,NREL) AND INTERNAL ARRAY KEY(283) ALLOWS FOR C ANY B RANGE (BMIN,BMAX) TO BE USED DURING CONVOLUTION. C C OUTPUT C C ZANS - THE COMPLEX ARRAY ZANS(NB,NREL) IS RETURNED GIVING THE C NB*NREL COMPLEX HANKEL TRANSFORMS, WITH CORRESPONDING C B ARGUMENTS GIVEN IN REAL ARRAY ARG(NB). C ARG - REAL ARRAY ARG(NB) IS RETURNED GIVING THE RESULTING C B ARGUMENTS IN (BMIN,BMAX), WHERE ARG(I+1)/ARG(I)=EXP(.2), C I=1,NB-1 (THIS ARRAY COULD BE ELIMINATED TO SAVE STORAGE C AND REGENERATED AFTER THE CALL HANKEL, IF DESIRED). C NOFUN1 - NUMBER OF DIRECT FUN1 EVALUATIONS USED FOR ALL NB*NREL C COMPLEX HANKEL TRANSFORMS. NOFUN1 IS USUALLY NOT MORE C THAN THE NUMBER OF WEIGHTS NEEDED FOR A SINGLE DIRECT C CONVOLUTION, FOR ANY NB AND NREL. C IERR - ERROR RETURN CODE. THE FOLLOWING CODES ARE POSSIBLE -- C = 0, NO ERROR IN INPUT PARAMETERS. ZANS,ARG COMPUTED. C = 1, IMPROPER INPUT PARAMETERS (I.E., NB<1,NREL<1,BMAX<=0, C OR BMAX*EXP(-.2*(NB-1))<=0.0). ZANS,ARG NOT COMPUTED. C C C ERROR CONDITIONS C C (1) IMPROPER INPUT PARAMETERS GIVEN (SEE IERR=1 ABOVE). C (2) UNDERFLOW CONDITIONS ARE POSSIBLE DURING CONVOLUTION, DUE TO C THE BEHAVIOR OF FUN1, VALUE OF B IN (BMIN,BMAX), TOL, AND C NTOL. EXPONENT AND (OR) ARITHMETIC UNDERFLOW TRAPS MUST RETURN C A VALUE OF 0.0 FOR THE COMPUTER SYSTEM BEING USED. NOTE THAT C UNDERFLOW MAY ALSO OCCUR IN THE USERS EXTERNAL FUNCTION C FUN1(G) FOR ANY VALUE OF G AS SET BY SUBPROGRAM HANKEL. C (3) AN UNRECOVERABLE OVERFLOW CONDITION CAN OCCUR IN EXECUTING C STATEMENT 160, DEPENDING ON THE VALUE OF B IN (BMIN,BMAX), C TOL, OR THE INTEGER EXPONENTS USED IN IJREL(2,NREL),NREL>1. C IN GENERAL, EXTREMELY SMALL OR LARGE VALUES OF B SHOULD BE C AVOIDED (SEE ACCURACY WARNING UNDER TOL ABOVE). ALSO, IN MANY C CASES, EXPONENT OVERFLOW CAN BE AVOIDED BY PROPER CHOICE OF C FUN1 AND THE RELATED INPUT FUNCTION ORDERING DEFINED BY C THE IJREL SIGNED INTEGER EXPONENTS. C (4) UNDETECTED ERRORS ARE POSSIBLE IF FUN1 IS IMPROPERLY CODED, OR C DOES NOT YIELD SINGLE-PRECISION COMPLEX ACCURACY, OR IS C NOT A CONTINUOUS DECREASING COMPLEX FUNCTION FOR ALL G>0. C C USAGE C C SUBPROGRAM HANKEL IS CALLED AS FOLLOWS (USE NUMERICAL VALUES FOR C , EXCLUDING < AND >, IN DECLARATIONS) -- C C COMPLEX ZANS(, -OR- ),ZWORK(283,) C DIMENSION ARG(),NORD(),IJREL(2,) C EXTERNAL ZFUN1 CC-----READ/LOAD INPUT PARAMETERS FOR HANKEL AS REQUIRED C ... C CALL HANKEL(BMAX,NB,NREL,TOL,NTOL,NORD,ZFUN1,IJREL,ZWORK, C * ZANS,ARG,NOFUN1,IERR) C IF(IERR.EQ.1) STOP C ... C END C COMPLEX FUNCTION ZFUN1(G) CC-----INSERT USER SUPPLIED CODE FOR EVALUATION OF ZFUN1(G),G>0.0 C END C C======================================================================= COMPLEX C,CMAX,ZSUM,ZERO,FUN1 INTEGER KEY(283) DOUBLE PRECISION E,ER,Y1,Y,ABSCIS DIMENSION T(2),TMAX(2) DIMENSION WT0(283),WT1(283) C-----WE DEFINE COMPLEX C,CMAX TO BE EQUIVALENT TO REAL ARRAYS T(2), C TMAX(2), RESPECTIVELY, FOR USE IN THE TRUNCATION CRITERION TESTS, C WHERE C IS ANY CONVOLUTION PRODUCT AND CMAX IS THE MAXIMUM C CONVOLVED PRODUCT IN THE FIXED ABSCISSA RANGE (SEE PARAMETER TOL). EQUIVALENCE (C,T(1)),(CMAX,TMAX(1)) DATA ZERO/(0.0,0.0)/ C-----ABSCIS=BASE CONSTANT FOR FILTER ABSCISSA GENERATION DATA ABSCIS/0.7358852661479794460D0/ C-----E=DEXP(.2D0), ER=1.0D0/E (ALSO USED IN ABSCISSA GENERATION) DATA E,ER/1.221402758160169834D0,0.818730753077981859D0/ C-----WT0(I)=J0 HANKEL TRANSFORM FILTER WEIGHTS FOR I=1,283 DATA * WT0( 1),WT0( 2),WT0( 3),WT0( 4), * WT0( 5),WT0( 6),WT0( 7),WT0( 8), * WT0( 9),WT0( 10),WT0( 11),WT0( 12), * WT0( 13),WT0( 14),WT0( 15),WT0( 16), * WT0( 17),WT0( 18),WT0( 19),WT0( 20), * WT0( 21),WT0( 22),WT0( 23),WT0( 24), * WT0( 25),WT0( 26),WT0( 27),WT0( 28), * WT0( 29),WT0( 30),WT0( 31),WT0( 32), * WT0( 33),WT0( 34),WT0( 35),WT0( 36)/ * 2.1969101E-11, 4.1201161E-09,-6.1322980E-09, 7.2479291E-09, *-7.9821627E-09, 8.5778983E-09,-9.1157294E-09, 9.6615250E-09, *-1.0207546E-08, 1.0796633E-08,-1.1393033E-08, 1.2049873E-08, *-1.2708789E-08, 1.3446466E-08,-1.4174300E-08, 1.5005577E-08, *-1.5807160E-08, 1.6747136E-08,-1.7625961E-08, 1.8693427E-08, *-1.9650840E-08, 2.0869789E-08,-2.1903555E-08, 2.3305308E-08, *-2.4407377E-08, 2.6033678E-08,-2.7186773E-08, 2.9094334E-08, *-3.0266804E-08, 3.2534013E-08,-3.3672072E-08, 3.6408936E-08, *-3.7425022E-08, 4.0787921E-08,-4.1543242E-08, 4.5756842E-08/ DATA * WT0( 37),WT0( 38),WT0( 39),WT0( 40), * WT0( 41),WT0( 42),WT0( 43),WT0( 44), * WT0( 45),WT0( 46),WT0( 47),WT0( 48), * WT0( 49),WT0( 50),WT0( 51),WT0( 52), * WT0( 53),WT0( 54),WT0( 55),WT0( 56), * WT0( 57),WT0( 58),WT0( 59),WT0( 60), * WT0( 61),WT0( 62),WT0( 63),WT0( 64), * WT0( 65),WT0( 66),WT0( 67),WT0( 68), * WT0( 69),WT0( 70),WT0( 71),WT0( 72)/ *-4.6035233E-08, 5.1425075E-08,-5.0893896E-08, 5.7934897E-08, *-5.6086570E-08, 6.5475248E-08,-6.1539913E-08, 7.4301996E-08, *-6.7117043E-08, 8.4767837E-08,-7.2583120E-08, 9.7366568E-08, *-7.7553611E-08, 1.1279873E-07,-8.1416723E-08, 1.3206914E-07, *-8.3217217E-08, 1.5663185E-07,-8.1482581E-08, 1.8860593E-07, *-7.3963141E-08, 2.3109673E-07,-5.7243707E-08, 2.8867452E-07, *-2.6163525E-08, 3.6808773E-07, 2.7049871E-08, 4.7932617E-07, * 1.1407365E-07, 6.3720626E-07, 2.5241961E-07, 8.6373487E-07, * 4.6831433E-07, 1.1916346E-06, 8.0099716E-07, 1.6696015E-06/ DATA * WT0( 73),WT0( 74),WT0( 75),WT0( 76), * WT0( 77),WT0( 78),WT0( 79),WT0( 80), * WT0( 81),WT0( 82),WT0( 83),WT0( 84), * WT0( 85),WT0( 86),WT0( 87),WT0( 88), * WT0( 89),WT0( 90),WT0( 91),WT0( 92), * WT0( 93),WT0( 94),WT0( 95),WT0( 96), * WT0( 97),WT0( 98),WT0( 99),WT0(100), * WT0(101),WT0(102),WT0(103),WT0(104), * WT0(105),WT0(106),WT0(107),WT0(108)/ * 1.3091334E-06, 2.3701475E-06, 2.0803829E-06, 3.4012978E-06, * 3.2456774E-06, 4.9240402E-06, 5.0005198E-06, 7.1783540E-06, * 7.6367633E-06, 1.0522038E-05, 1.1590021E-05, 1.5488635E-05, * 1.7510398E-05, 2.2873836E-05, 2.6368006E-05, 3.3864387E-05, * 3.9610390E-05, 5.0230379E-05, 5.9397373E-05, 7.4612122E-05, * 8.8951409E-05, 1.1094809E-04, 1.3308026E-04, 1.6511335E-04, * 1.9895671E-04, 2.4587195E-04, 2.9728181E-04, 3.6629770E-04, * 4.4402013E-04, 5.4589361E-04, 6.6298832E-04, 8.1375348E-04, * 9.8971624E-04, 1.2132772E-03, 1.4772052E-03, 1.8092022E-03/ DATA * WT0(109),WT0(110),WT0(111),WT0(112), * WT0(113),WT0(114),WT0(115),WT0(116), * WT0(117),WT0(118),WT0(119),WT0(120), * WT0(121),WT0(122),WT0(123),WT0(124), * WT0(125),WT0(126),WT0(127),WT0(128), * WT0(129),WT0(130),WT0(131),WT0(132), * WT0(133),WT0(134),WT0(135),WT0(136), * WT0(137),WT0(138),WT0(139),WT0(140), * WT0(141),WT0(142),WT0(143),WT0(144)/ * 2.2045122E-03, 2.6980811E-03, 3.2895354E-03, 4.0238764E-03, * 4.9080203E-03, 6.0010999E-03, 7.3216878E-03, 8.9489225E-03, * 1.0919448E-02, 1.3340696E-02, 1.6276399E-02, 1.9873311E-02, * 2.4233627E-02, 2.9555699E-02, 3.5990069E-02, 4.3791529E-02, * 5.3150319E-02, 6.4341372E-02, 7.7506720E-02, 9.2749987E-02, * 1.0980561E-01, 1.2791555E-01, 1.4525830E-01, 1.5820085E-01, * 1.6058576E-01, 1.4196085E-01, 8.9781222E-02,-1.0238278E-02, *-1.5083434E-01,-2.9059573E-01,-2.9105437E-01,-3.7973244E-02, * 3.8273717E-01, 2.2014118E-01,-4.7342635E-01, 1.9331133E-01/ DATA * WT0(145),WT0(146),WT0(147),WT0(148), * WT0(149),WT0(150),WT0(151),WT0(152), * WT0(153),WT0(154),WT0(155),WT0(156), * WT0(157),WT0(158),WT0(159),WT0(160), * WT0(161),WT0(162),WT0(163),WT0(164), * WT0(165),WT0(166),WT0(167),WT0(168), * WT0(169),WT0(170),WT0(171),WT0(172), * WT0(173),WT0(174),WT0(175),WT0(176), * WT0(177),WT0(178),WT0(179),WT0(180)/ * 5.3839527E-02,-1.1909845E-01, 9.9317051E-02,-6.6152628E-02, * 4.0703241E-02,-2.4358316E-02, 1.4476533E-02,-8.6198067E-03, * 5.1597053E-03,-3.1074602E-03, 1.8822342E-03,-1.1456545E-03, * 7.0004347E-04,-4.2904226E-04, 2.6354444E-04,-1.6215439E-04, * 9.9891279E-05,-6.1589037E-05, 3.7996921E-05,-2.3452250E-05, * 1.4479572E-05,-8.9417427E-06, 5.5227518E-06,-3.4114252E-06, * 2.1074101E-06,-1.3019229E-06, 8.0433617E-07,-4.9693681E-07, * 3.0702417E-07,-1.8969219E-07, 1.1720069E-07,-7.2412496E-08, * 4.4740283E-08,-2.7643004E-08, 1.7079403E-08,-1.0552634E-08/ DATA * WT0(181),WT0(182),WT0(183),WT0(184), * WT0(185),WT0(186),WT0(187),WT0(188), * WT0(189),WT0(190),WT0(191),WT0(192), * WT0(193),WT0(194),WT0(195),WT0(196), * WT0(197),WT0(198),WT0(199),WT0(200), * WT0(201),WT0(202),WT0(203),WT0(204), * WT0(205),WT0(206),WT0(207),WT0(208), * WT0(209),WT0(210),WT0(211),WT0(212), * WT0(213),WT0(214),WT0(215),WT0(216)/ * 6.5200311E-09,-4.0284597E-09, 2.4890232E-09,-1.5378695E-09, * 9.5019040E-10,-5.8708696E-10, 3.6273937E-10,-2.2412348E-10, * 1.3847792E-10,-8.5560821E-11, 5.2865474E-11,-3.2664392E-11, * 2.0182948E-11,-1.2470979E-11, 7.7057678E-12,-4.7611713E-12, * 2.9415274E-12,-1.8170081E-12, 1.1221034E-12,-6.9271067E-13, * 4.2739744E-13,-2.6344388E-13, 1.6197105E-13,-9.9147443E-14, * 6.0487998E-14,-3.6973097E-14, 2.2817964E-14,-1.4315547E-14, * 9.1574735E-15,-5.9567236E-15, 3.9209969E-15,-2.5911739E-15, * 1.6406939E-15,-8.8248590E-16, 3.0195409E-16, 2.2622634E-17/ DATA * WT0(217),WT0(218),WT0(219),WT0(220), * WT0(221),WT0(222),WT0(223),WT0(224), * WT0(225),WT0(226),WT0(227),WT0(228), * WT0(229),WT0(230),WT0(231),WT0(232), * WT0(233),WT0(234),WT0(235),WT0(236), * WT0(237),WT0(238),WT0(239),WT0(240), * WT0(241),WT0(242),WT0(243),WT0(244), * WT0(245),WT0(246),WT0(247),WT0(248), * WT0(249),WT0(250),WT0(251),WT0(252)/ *-8.0942556E-17,-3.7172363E-17, 1.9299542E-16,-3.3388160E-16, * 4.6174116E-16,-5.8627358E-16, 7.2227767E-16,-8.7972941E-16, * 1.0211793E-15,-1.0940039E-15, 1.0789555E-15,-9.7089714E-16, * 7.4110927E-16,-4.1700094E-16, 8.5977184E-17, 1.3396469E-16, *-1.7838410E-16, 4.8975421E-17, 1.9398153E-16,-5.0046989E-16, * 8.3280985E-16,-1.1544640E-15, 1.4401527E-15,-1.6637066E-15, * 1.7777129E-15,-1.7322187E-15, 1.5247247E-15,-1.1771155E-15, * 6.9747910E-16,-1.2088956E-16,-4.8382957E-16, 1.0408292E-15, *-1.5220450E-15, 1.9541597E-15,-2.4107448E-15, 2.9241438E-15/ DATA * WT0(253),WT0(254),WT0(255),WT0(256), * WT0(257),WT0(258),WT0(259),WT0(260), * WT0(261),WT0(262),WT0(263),WT0(264), * WT0(265),WT0(266),WT0(267),WT0(268), * WT0(269),WT0(270),WT0(271),WT0(272), * WT0(273),WT0(274),WT0(275),WT0(276), * WT0(277),WT0(278),WT0(279),WT0(280), * WT0(281),WT0(282),WT0(283)/ *-3.5176475E-15, 4.2276125E-15,-5.0977851E-15, 6.1428456E-15, *-7.3949962E-15, 8.8597601E-15,-1.0515959E-14, 1.2264584E-14, *-1.3949870E-14, 1.5332490E-14,-1.6146782E-14, 1.6084121E-14, *-1.4962523E-14, 1.2794804E-14,-9.9286701E-15, 6.8825809E-15, *-4.0056107E-15, 1.5965079E-15,-7.2732961E-18,-4.0433218E-16, *-6.5679655E-16, 3.3011866E-15,-7.3545910E-15, 1.2394851E-14, *-1.7947697E-14, 2.3774303E-14,-3.0279168E-14, 3.9252831E-14, *-5.5510504E-14, 9.0505371E-14,-1.7064873E-13/ C-----WT1(I)=J1 HANKEL TRANSFORM FILTER WEIGHTS FOR I=1,283 DATA * WT1( 1),WT1( 2),WT1( 3),WT1( 4), * WT1( 5),WT1( 6),WT1( 7),WT1( 8), * WT1( 9),WT1( 10),WT1( 11),WT1( 12), * WT1( 13),WT1( 14),WT1( 15),WT1( 16), * WT1( 17),WT1( 18),WT1( 19),WT1( 20), * WT1( 21),WT1( 22),WT1( 23),WT1( 24), * WT1( 25),WT1( 26),WT1( 27),WT1( 28), * WT1( 29),WT1( 30),WT1( 31),WT1( 32), * WT1( 33),WT1( 34),WT1( 35),WT1( 36)/ *-4.2129715E-16, 5.3667031E-15,-7.1183962E-15, 8.9478500E-15, *-1.0767891E-14, 1.2362265E-14,-1.3371129E-14, 1.3284178E-14, *-1.1714302E-14, 8.4134738E-15,-3.7726725E-15,-1.4263879E-15, * 6.1279163E-15,-9.1102765E-15, 9.9696405E-15,-9.3649955E-15, * 8.6009018E-15,-8.9749846E-15, 1.1153987E-14,-1.4914821E-14, * 1.9314024E-14,-2.3172388E-14, 2.5605477E-14,-2.6217555E-14, * 2.5057768E-14,-2.2485539E-14, 1.9022752E-14,-1.5198084E-14, * 1.1422464E-14,-7.9323958E-15, 4.8421406E-15,-2.1875032E-15, *-3.2177842E-17, 1.8637565E-15,-3.3683643E-15, 4.6132219E-15/ DATA * WT1( 37),WT1( 38),WT1( 39),WT1( 40), * WT1( 41),WT1( 42),WT1( 43),WT1( 44), * WT1( 45),WT1( 46),WT1( 47),WT1( 48), * WT1( 49),WT1( 50),WT1( 51),WT1( 52), * WT1( 53),WT1( 54),WT1( 55),WT1( 56), * WT1( 57),WT1( 58),WT1( 59),WT1( 60), * WT1( 61),WT1( 62),WT1( 63),WT1( 64), * WT1( 65),WT1( 66),WT1( 67),WT1( 68), * WT1( 69),WT1( 70),WT1( 71),WT1( 72)/ *-5.6209538E-15, 6.4192841E-15,-6.8959928E-15, 6.9895792E-15, *-6.5355935E-15, 5.6125163E-15,-4.1453931E-15, 2.6358827E-15, *-9.5104370E-16, 1.4600474E-16, 5.6166519E-16, 8.2899246E-17, * 5.0032100E-16, 4.3752205E-16, 2.1052293E-15,-9.5451973E-16, * 6.4004437E-15,-2.1926177E-15, 1.1651003E-14, 5.8415433E-16, * 1.8044664E-14, 1.0755745E-14, 3.0159022E-14, 3.3506138E-14, * 5.8709354E-14, 8.1475200E-14, 1.2530006E-13, 1.8519112E-13, * 2.7641786E-13, 4.1330823E-13, 6.1506209E-13, 9.1921659E-13, * 1.3698462E-12, 2.0447427E-12, 3.0494477E-12, 4.5501001E-12/ DATA * WT1( 73),WT1( 74),WT1( 75),WT1( 76), * WT1( 77),WT1( 78),WT1( 79),WT1( 80), * WT1( 81),WT1( 82),WT1( 83),WT1( 84), * WT1( 85),WT1( 86),WT1( 87),WT1( 88), * WT1( 89),WT1( 90),WT1( 91),WT1( 92), * WT1( 93),WT1( 94),WT1( 95),WT1( 96), * WT1( 97),WT1( 98),WT1( 99),WT1(100), * WT1(101),WT1(102),WT1(103),WT1(104), * WT1(105),WT1(106),WT1(107),WT1(108)/ * 6.7870250E-12, 1.0126237E-11, 1.5104976E-11, 2.2536053E-11, * 3.3617368E-11, 5.0153839E-11, 7.4818173E-11, 1.1161804E-10, * 1.6651222E-10, 2.4840923E-10, 3.7058109E-10, 5.5284353E-10, * 8.2474468E-10, 1.2303750E-09, 1.8355034E-09, 2.7382502E-09, * 4.0849867E-09, 6.0940898E-09, 9.0913020E-09, 1.3562651E-08, * 2.0233058E-08, 3.0184244E-08, 4.5029477E-08, 6.7176304E-08, * 1.0021488E-07, 1.4950371E-07, 2.2303208E-07, 3.3272689E-07, * 4.9636623E-07, 7.4049804E-07, 1.1046805E-06, 1.6480103E-06, * 2.4585014E-06, 3.6677163E-06, 5.4714550E-06, 8.1626422E-06/ DATA * WT1(109),WT1(110),WT1(111),WT1(112), * WT1(113),WT1(114),WT1(115),WT1(116), * WT1(117),WT1(118),WT1(119),WT1(120), * WT1(121),WT1(122),WT1(123),WT1(124), * WT1(125),WT1(126),WT1(127),WT1(128), * WT1(129),WT1(130),WT1(131),WT1(132), * WT1(133),WT1(134),WT1(135),WT1(136), * WT1(137),WT1(138),WT1(139),WT1(140), * WT1(141),WT1(142),WT1(143),WT1(144)/ * 1.2176782E-05, 1.8166179E-05, 2.7099223E-05, 4.0428804E-05, * 6.0307294E-05, 8.9971508E-05, 1.3420195E-04, 2.0021123E-04, * 2.9860417E-04, 4.4545291E-04, 6.6423156E-04, 9.9073275E-04, * 1.4767050E-03, 2.2016806E-03, 3.2788147E-03, 4.8837292E-03, * 7.2596811E-03, 1.0788355E-02, 1.5973323E-02, 2.3612041E-02, * 3.4655327E-02, 5.0608141E-02, 7.2827752E-02, 1.0337889E-01, * 1.4207357E-01, 1.8821315E-01, 2.2996815E-01, 2.5088500E-01, * 2.0334626E-01, 6.0665451E-02,-2.0275683E-01,-3.5772336E-01, *-1.8280529E-01, 4.7014634E-01, 7.2991233E-03,-3.0614594E-01/ DATA * WT1(145),WT1(146),WT1(147),WT1(148), * WT1(149),WT1(150),WT1(151),WT1(152), * WT1(153),WT1(154),WT1(155),WT1(156), * WT1(157),WT1(158),WT1(159),WT1(160), * WT1(161),WT1(162),WT1(163),WT1(164), * WT1(165),WT1(166),WT1(167),WT1(168), * WT1(169),WT1(170),WT1(171),WT1(172), * WT1(173),WT1(174),WT1(175),WT1(176), * WT1(177),WT1(178),WT1(179),WT1(180)/ * 2.4781735E-01,-1.1149185E-01, 2.5985386E-02, 1.0850279E-02, *-2.2830217E-02, 2.4644647E-02,-2.2895284E-02, 2.0197032E-02, *-1.7488968E-02, 1.5057670E-02,-1.2953923E-02, 1.1153254E-02, *-9.6138436E-03, 8.2952090E-03,-7.1628361E-03, 6.1882910E-03, *-5.3482055E-03, 4.6232056E-03,-3.9970542E-03, 3.4560118E-03, *-2.9883670E-03, 2.5840861E-03,-2.2345428E-03, 1.9323046E-03, *-1.6709583E-03, 1.4449655E-03,-1.2495408E-03, 1.0805480E-03, *-9.3441130E-04, 8.0803899E-04,-6.9875784E-04, 6.0425624E-04, *-5.2253532E-04, 4.5186652E-04,-3.9075515E-04, 3.3790861E-04/ DATA * WT1(181),WT1(182),WT1(183),WT1(184), * WT1(185),WT1(186),WT1(187),WT1(188), * WT1(189),WT1(190),WT1(191),WT1(192), * WT1(193),WT1(194),WT1(195),WT1(196), * WT1(197),WT1(198),WT1(199),WT1(200), * WT1(201),WT1(202),WT1(203),WT1(204), * WT1(205),WT1(206),WT1(207),WT1(208), * WT1(209),WT1(210),WT1(211),WT1(212), * WT1(213),WT1(214),WT1(215),WT1(216)/ *-2.9220916E-04, 2.5269019E-04,-2.1851585E-04, 1.8896332E-04, *-1.6340753E-04, 1.4130796E-04,-1.2219719E-04, 1.0567099E-04, *-9.1379828E-05, 7.9021432E-05,-6.8334412E-05, 5.9092726E-05, *-5.1100905E-05, 4.4189914E-05,-3.8213580E-05, 3.3045496E-05, *-2.8576356E-05, 2.4711631E-05,-2.1369580E-05, 1.8479514E-05, *-1.5980307E-05, 1.3819097E-05,-1.1950174E-05, 1.0334008E-05, *-8.9364160E-06, 7.7278366E-06,-6.6827083E-06, 5.7789251E-06, *-4.9973715E-06, 4.3215167E-06,-3.7370660E-06, 3.2316575E-06, *-2.7946015E-06, 2.4166539E-06,-2.0898207E-06, 1.8071890E-06/ DATA * WT1(217),WT1(218),WT1(219),WT1(220), * WT1(221),WT1(222),WT1(223),WT1(224), * WT1(225),WT1(226),WT1(227),WT1(228), * WT1(229),WT1(230),WT1(231),WT1(232), * WT1(233),WT1(234),WT1(235),WT1(236), * WT1(237),WT1(238),WT1(239),WT1(240), * WT1(241),WT1(242),WT1(243),WT1(244), * WT1(245),WT1(246),WT1(247),WT1(248), * WT1(249),WT1(250),WT1(251),WT1(252)/ *-1.5627811E-06, 1.3514274E-06,-1.1686576E-06, 1.0106059E-06, *-8.7392952E-07, 7.5573750E-07,-6.5353002E-07, 5.6514528E-07, *-4.8871388E-07, 4.2261921E-07,-3.6546333E-07, 3.1603732E-07, *-2.7329579E-07, 2.3633470E-07,-2.0437231E-07, 1.7673258E-07, *-1.5283091E-07, 1.3216174E-07,-1.1428792E-07, 9.8831386E-08, *-8.5465227E-08, 7.3906734E-08,-6.3911437E-08, 5.5267923E-08, *-4.7793376E-08, 4.1329702E-08,-3.5740189E-08, 3.0906612E-08, *-2.6726739E-08, 2.3112160E-08,-1.9986424E-08, 1.7283419E-08, *-1.4945974E-08, 1.2924650E-08,-1.1176694E-08, 9.6651347E-09/ DATA * WT1(253),WT1(254),WT1(255),WT1(256), * WT1(257),WT1(258),WT1(259),WT1(260), * WT1(261),WT1(262),WT1(263),WT1(264), * WT1(265),WT1(266),WT1(267),WT1(268), * WT1(269),WT1(270),WT1(271),WT1(272), * WT1(273),WT1(274),WT1(275),WT1(276), * WT1(277),WT1(278),WT1(279),WT1(280), * WT1(281),WT1(282),WT1(283)/ *-8.3580023E-09, 7.2276490E-09,-6.2501673E-09, 5.4048822E-09, *-4.6739154E-09, 4.0418061E-09,-3.4951847E-09, 3.0224895E-09, *-2.6137226E-09, 2.2602382E-09,-1.9545596E-09, 1.6902214E-09, *-1.4616324E-09, 1.2639577E-09,-1.0930164E-09, 9.4519327E-10, *-8.1736202E-10, 7.0681930E-10,-6.1122713E-10, 5.2856342E-10, *-4.5707937E-10, 3.9526267E-10,-3.4180569E-10, 2.9557785E-10, *-2.5560176E-10, 2.2103233E-10,-1.9113891E-10, 1.6528994E-10, *-1.4294012E-10, 1.2361991E-10,-8.2740936E-11/ C NOFUN1=0 C-----ERROR CHECKS IF(NB.LT.1.OR.NREL.LT.1.OR.BMAX.LE.0.0) GO TO 9999 Y=DBLE(BMAX)*ER**(NB-1) IF(Y.LE.0.0D0) GO TO 9999 IERR=0 C-----INITIALIZE RELATED CONVOLUTION WITHIN LAGGED CONVOLUTION LOOPS DO 10 I=1,283 10 KEY(I)=0 NB1=NB+1 LAG=-1 C-----PRESET INITIAL FILTER ABSCISSA FOR STARTING BMAX, GENERATED IN C DOUBLE-PRECISION (TO REDUCE ROUND-OFF), BUT USED IN SINGLE- C PRECISION IN THE COMPLEX FUNCTION FUN1(G). NOTE THE ABSCISSAS C ARE EQUALLY SPACED (E=DEXP(.2D0), ER=1.0D0/E) IN LOG-SPACE. Y1=ABSCIS/DBLE(BMAX) C-----LAGGED CONVOLUTION, OUTERMOST LOOP 1010 DO 1010 ILAG=1,NB LAG=LAG+1 ISTORE=NB1-ILAG IF(LAG.GT.0) Y1=Y1*E ARG(ISTORE)=ABSCIS/Y1 C-------RELATED CONVOLUTION, INNERMOST LOOP 1000 DO 1000 JREL=1,NREL C---------SPECIAL CASE FLAG NONE=1 IS SET IF FUN1(G)=0 FOR ALL G IN C FILTER FIXED RANGE (USING WEIGHTS 131-149). NONE=0 ITOL=NTOL ZSUM=ZERO CMAX=ZERO Y=Y1 C---------BEGIN RIGHT SIDE CONVOLUTION AT WEIGHT 131 (M=RETURN LABEL) ASSIGN 20 TO M I=131 Y=Y*E C---------CALL PSEUDO SUBROUTINE AT 100 (RETURN TO 20 VIA M ASSIGNED) GO TO 100 20 TMAX(1)=AMAX1(ABS(T(1)),TMAX(1)) TMAX(2)=AMAX1(ABS(T(2)),TMAX(2)) I=I+1 Y=Y*E C---------CALL PSEUDO SUBROUTINE AT 100 (RETURN TO 20 VIA M ASSIGNED) IF(I.LE.149) GO TO 100 IF(TMAX(1).EQ.0.0.AND.TMAX(2).EQ.0.0) NONE=1 C---------ESTABLISH TRUNCATION CRITERION (CMAX=CMPLX(TMAX(1),TMAX(2)) CMAX=TOL*CMAX ASSIGN 30 TO M C---------CALL PSEUDO SUBROUTINE AT 100 (RETURN TO 30 VIA M ASSIGNED) GO TO 100 C---------CHECK FOR FILTER TRUNCATION AT RIGHT END 30 IF(ABS(T(1)).LE.TMAX(1).AND.ABS(T(2)).LE.TMAX(2)) GO TO 50 ITOL=NTOL 40 I=I+1 Y=Y*E C---------CALL PSEUDO SUBROUTINE AT 100 (RETURN TO 30 VIA M ASSIGNED) IF(I.LE.283) GO TO 100 50 ITOL=ITOL-1 IF(ITOL.GT.0.AND.I.LT.283) GO TO 40 ITOL=NTOL Y=Y1 C---------CONTINUE WITH LEFT SIDE CONVOLUTION AT WEIGHT 130 ASSIGN 60 TO M I=130 C---------CALL PSEUDO SUBROUTINE AT 100 (RETURN TO 60 VIA M ASSIGNED) GO TO 100 C---------CHECK FOR FILTER TRUNCATION AT LEFT END 60 IF(ABS(T(1)).LE.TMAX(1).AND.ABS(T(2)).LE.TMAX(2).AND. * NONE.EQ.0) GO TO 80 ITOL=NTOL 70 I=I-1 Y=Y*ER C---------CALL PSEUDO SUBROUTINE AT 100 (RETURN TO 60 VIA M ASSIGNED) IF(I.GT.0) GO TO 100 80 ITOL=ITOL-1 IF(ITOL.GT.0.AND.I.GT.1) GO TO 70 C---------NORMALIZE ZSUM BY ARG(ISTORE) TO ACCOUNT FOR INTEGRATION C RANGE CHANGE, AND STORE IN ZANS(ISTORE,JREL) ZANS(ISTORE,JREL)=ZSUM/ARG(ISTORE) C---------SKIP OVER PSEUDO SUBROUTINE TO END OF DO 1000 INNERMOST LOOP GO TO 1000 C C======================================================================= C=====STORE/RETRIEVE PSEUDO SUBROUTINE FOR RELATED/LAGGED CONVOLUTION. C THE INTERNAL (PSEUDO) SUBROUTINE ENTRY IS LABEL 100, AND RETURNS C TO THE LABEL ASSIGNED TO M. THIS CALLING MECHANISM COULD OCCUR C A MAXIMUM OF 283*NB*NREL TIMES, WHERE PARAMETERS NB>0 AND NREL>0 C CAN BE ARBITRARILY LARGE. IF A MORE-STRUCTURED STANDARD FORTRAN C SUBROUTINE CALL WAS USED, THEN THE USUAL COMPILER LINKAGE C CONVENTION COULD GENERATE A MAXIMUM OF 283*NB*NREL MACHINE- C LANGUAGE INSTRUCTIONS FOR REGISTER SAVES/RESTORES AND OTHER C MEMORY REFERENCES. FOR MOST COMPILERS, TIMING TESTS REVEAL THAT C THE PSEUDO-CALL METHOD USED HERE GENERATED FASTER MACHINE CODE C THAN WITH USING EXTERNAL SUBROUTINE CALLS (E.G., CALL LINKAGE C VERSUS PSEUDO-CALL RATIO WAS 2.6:1 ON A VAX-11/780 USING C NB=50,NREL=61, AND NOFUN1=199). C C=========PSEUDO-CALL ENTRY POINT AT 100 (RETURNS VIA GO TO M BELOW) 100 LOOK=I+LAG IQ=LOOK/284 IR=MOD(LOOK,284) IF(IR.EQ.0) IR=1 IROLL=IQ*283 IF(KEY(IR).LE.IROLL) GO TO 150 C=========USE EXISTING SAVED FUNCTIONAL VALUES IN ZWORK(IR,JREL) 110 IF(NORD(JREL)) 130,120,130 120 C=ZWORK(IR,JREL)*WT0(I) GO TO 140 130 C=ZWORK(IR,JREL)*WT1(I) 140 ZSUM=ZSUM+C C=========RETURN CONVOLUTION CONTROL VIA ASSIGNED M VALUE, AND WITH C THE LAST CONVOLUTION PRODUCT C=CMPLX(T(1),T(2)). GO TO M,(20,30,60) C=========COMPUTE EXTERNAL FUN1 DIRECTLY ONLY WHEN NECESSARY 150 KEY(IR)=IROLL+IR G=Y ZWORK(IR,1)=FUN1(G) NOFUN1=NOFUN1+1 IF(NREL.EQ.1) GO TO 110 C=========FILL-IN REMAINING RELATED ZWORK(IR,J),J=2,NREL FOR THIS IR DO 160 J=2,NREL C***********FOR OTHER THAN SIMPLE RELATIONS, THE FOLLOWING STATEMENT C COULD BE CHANGED (AND ALSO THE MEANING OF IJREL(2,NREL)). 160 ZWORK(IR,J)=CMPLX(G**IJREL(1,J),0.0)*ZWORK(IR,1)**IJREL(2,J) GO TO 110 C=========END OF PSEUDO SUBROUTINE (ENTRY 100, RETURN GO TO M ABOVE) C======================================================================= C C-------END LOOP 1000 (GET REMAINING RELATED CONVOLUTIONS FOR THIS ARG) 1000 CONTINUE C-----END LOOP 1010 (GET REMAINING LAGGED CONVOLUTIONS FOR NEXT ARG) 1010 CONTINUE C-----EXIT WITH ZANS(NB,NREL),ARG(NB) COMPLETED WITH MINIMAL FUN1 CALLS RETURN 9999 IERR=1 RETURN END C=======================================================================HT1 10 C HANKEL TEST 1 (DRIVER PROGRAM 1 TO TEST SUBPROGRAM HANKEL). HT1 20 C=======================================================================HT1 30 C THIS PROGRAM USES ONLY A PRINTER OUTPUT FILE ON FORTRAN UNIT 06. HT1 40 C HT1 50 C TEST DATA ARE PRESTORED IN DATA STATEMENTS FOR EVALUATING HANKEL HT1 60 C TRANSFORMS OF ORDERS N=0 OR 1 OF THE FORM-- HT1 70 C INTEGRAL FROM 0 TO INFINITY OF FUN(G)*JN(G*B)*DG, B.GT.0. HT1 80 C HT1 90 C THE METHOD IS BY ADAPTIVE RELATED AND LAGGED CONVOLUTION AS HT1 100 C DESCRIBED IN SUBROUTINE HANKEL (CASE 4). HT1 110 C HT1 120 C THE FOLLOWING (REAL) TEST INTEGRALS ARE EVALUATED FOR HT1 130 C BMAX=1000.0,NB=50,NREL=3,NTOL=1, AND TOL=0.0 (SEE DATA STATEMENTS). HT1 140 C HT1 150 C INTEGRAL N INPUT FUNCTION RELATED INPUT EXACT RESULT OF INTEGRAL HT1 160 C ======== = ================= ============== ======================== HT1 170 C HT1 180 C 1 1 K1=EXP(-G) (NONE) (R-1.)/(B*R),R=SQRT(1.+B*B)HT1 190 C 2 1 K2=G*EXP(-3.*G) K2=G*K1**3 B/(9.+B*B)**1.5 HT1 200 C 3 0 K3=G*G*EXP(-3.*G) K3=G**2*K1**3 (18.-B*B)/(9.+B*B)**2.5 HT1 210 C HT1 220 C SUBPROGRAMS CALLED ARE HANKEL AND FUNT1 (WHICH CALLS EXPM). HT1 230 C HT1 240 C NOTE(1). THE USE OF DIFFERENT COMPUTERS AND WORD LENGTHS MAY PRODUCE HT1 250 C DIFFERENT ROUND-OFF, RESULTING IN A DIFFERENT NUMBER OF HT1 260 C FUNT1 CALLS NEEDED FOR THE GIVEN TOLERANCE (0. IN THIS CASE)HT1 270 C HT1 280 C NOTE(2). THE USER SHOULD INSERT A CALL TO SUPPRESS EXPONENT UNDERFLOWHT1 290 C MESSAGES (AND TO SET THE RESULT TO 0.0) FOR THE MACHINE HT1 300 C SYSTEM BEING USED. SEE ERROR CONDITION(2) IN SUBPROGRAM HT1 310 C HANKEL. HT1 320 C=======================================================================HT1 330 C HT1 340 C-----STORAGE FOR NB=50, NREL=3 HT1 350 COMPLEX ZANS(50,3),ZWORK(283,3) HT1 360 REAL ARG(50) HT1 370 INTEGER NORD(3),IJREL(2,3) HT1 380 C-----THE FOLLOWING VARIABLES ARE USED TO COMPUTE EXACT VALUES AND HT1 390 C RELATIVE ERRORS (NOTE THAT SINGLE-PRECISION COMPLEX IS HT1 400 C USED IN SUBPROGRAM HANKEL). HT1 410 DOUBLE PRECISION BB,DB,DROOT HT1 420 C-----NAME OF EXTERNAL COMPLEX FUNCTION FUNT1(G) FOR THIS EXAMPLE HT1 430 EXTERNAL FUNT1 HT1 440 C-----THE FOLLOWING DATA STATEMENTS ARE USED TO PRESET SPECIFIC HT1 450 C PARAMETERS USED IN CALLING SUBROUTINE HANKEL FOR THIS EXAMPLE. HT1 460 DATA NORD(1),NORD(2),NORD(3)/1,1,0/, HT1 470 * IJREL(1,1),IJREL(2,1)/0,0/, HT1 480 * IJREL(1,2),IJREL(2,2)/1,3/, HT1 490 * IJREL(1,3),IJREL(2,3)/2,3/, HT1 500 * TOL/0.0/,NTOL/1/,BMAX/1000.0/,NB/50/,NREL/3/ HT1 510 C-----GET ALL NB*NREL HANKEL TRANSFORMS VIA CALL HANKEL HT1 520 CALL HANKEL(BMAX,NB,NREL,TOL,NTOL,NORD,FUNT1,IJREL,ZWORK,ZANS, HT1 530 * ARG,NOFUN1,IERR) HT1 540 C-----CHECK IERR RETURNED BEFORE PROCEEDING HT1 550 IF(IERR.EQ.1) STOP HT1 560 C-----OUTPUT TEST DATA AND RESULTS TO UNIT 06 (PRINT FILE) HT1 570 WRITE(6,1) BMAX,NB,NREL,TOL,NTOL,NOFUN1,IERR, HT1 580 * (J,NORD(J),IJREL(1,J),IJREL(2,J),J=1,NREL) HT1 590 1 FORMAT(1H1,48X,25HH A N K E L T E S T 1// HT1 600 * 7H BMAX=,E16.8,5H NB=,I4,7H NREL=,I4,6H TOL=,E16.8,7H NTOL=,HT1 610 * I4,23X,9H NOFUN1=,I6,7H IERR=,I1// HT1 620 * 3X,34HJ NORD(J) IJREL(1,J) IJREL(2,J)/3(2X,I2,5X,I1,7X,I3,9X, HT1 630 * I3/),24X,9HREAL-PART,2(25X,9HREAL-PART)/3X,1HI,4X,6HARG(I),10X, HT1 640 * 9HZANS(I,1),4X,17H(RELATIVE ERROR ),4X,9HZANS(I,2),4X, HT1 650 * 17H(RELATIVE ERROR ),4X,9HZANS(I,3),4X,17H(RELATIVE ERROR )/) HT1 660 C-----COMPUTE EXACT VALUES AND TEMPORARY STORE IN ZWORK(1,I),I=1,3 HT1 670 DO 4 I=1,NB HT1 680 DB=DBLE(ARG(I)) HT1 690 BB=DB*DB HT1 700 ZWORK(1,1)=CMPLX(SNGL((1.0D0-1.0D0/DSQRT(1.0D0+BB))/DB),0.0) HT1 710 DROOT=DSQRT(9.0D0+BB) HT1 720 ZWORK(1,2)=CMPLX(SNGL(DB/DROOT**3),0.0) HT1 730 ZWORK(1,3)=CMPLX(SNGL((18.0D0-BB)/DROOT**5),0.0) HT1 740 C-------COMPUTE RESPECTIVE RELATIVE ERRORS AND STORE IN AIMAG(ZANS(I,J))HT1 750 DO 2 J=1,NREL HT1 760 EXACT=REAL(ZWORK(1,J)) HT1 770 2 ZANS(I,J)=CMPLX(REAL(ZANS(I,J)),ABS(REAL(ZANS(I,J))-EXACT)/ HT1 780 * EXACT) HT1 790 WRITE(6,3) I,ARG(I),(ZANS(I,J),J=1,3) HT1 800 3 FORMAT(1X,I3,E16.8,3(E16.8,2H (,E15.8,1H))) HT1 810 4 CONTINUE HT1 820 STOP HT1 830 END HT1 840 COMPLEX FUNCTION FUNT1(G) FU1 10 C-----EXTERNAL FUNCTION USED IN HANKEL TEST 1. FUNT1 CALLS EXPM, C A MACHINE DEPENDENT EXP FUNCTION TO AVOID UNDERFLOW. FUNT1=CMPLX(EXPM(-G),0.0) RETURN END FUNCTION EXPM(X) EXM 10 C-----EXPM(X) IS A MACHINE-DEPENDENT EXP-FUNCTION TO AVOID UNDERFLOW. C XMIN SHOULD BE CHANGED FOR THE MACHINE BEING USED. FOR EXAMPLE, C MACHINE XMIN C ----------------------- C VAX-11 -89.415999 C DEC-10 -88.028 C IBM/360 -180.218 C CDC-6600 -675.84 C DATA XMIN/-89.415999/ IF(X.LT.XMIN) GO TO 20 EXPM=EXP(X) 10 RETURN 20 EXPM=0.0E0 GO TO 10 END C=======================================================================HT2 10 C HANKEL TEST 2 (DRIVER PROGRAM 2 TO TEST SUBPROGRAM HANKEL). HT2 20 C=======================================================================HT2 30 C THIS PROGRAM USES ONLY A PRINTER OUTPUT FILE ON FORTRAN UNIT 06. HT2 40 C HT2 50 C TEST DATA ARE PRESTORED IN DATA STATEMENTS FOR EVALUATING HANKEL HT2 60 C TRANSFORMS OF ORDER N=0 OF THE FORM-- HT2 70 C INTEGRAL FROM 0 TO INFINITY OF FUN(G)*JN(G*B)*DG, B.GT.0. HT2 80 C HT2 90 C THE METHOD IS BY ADAPTIVE LAGGED CONVOLUTION AS HT2 100 C DESCRIBED IN SUBROUTINE HANKEL (CASE 3). HT2 110 C HT2 120 C THE FOLLOWING (COMPLEX) TEST INTEGRALS ARE EVALUATED FOR HT2 130 C BMAX=5,NB=10,NREL=1,NORD=0,NTOL=1, AND TOL=0.0 (SEE DATA STATEMENTS).HT2 140 C HT2 150 C COMPLEX INPUT FUNCTION EXACT RESULT OF INTEGRAL HT2 160 C ============================ ======================================= HT2 170 C HT2 180 C CMPLX(G/(A*A+G*G)**1.5, CMPLX(EXP(-A*B)/A, HT2 190 C EXP(-A*G)*SINH(A*G/2)) A*SQRT((R2-R1)/(2.*(R2+R1)))/(R1*R2)) HT2 200 C HT2 210 C WHERE R1=SQRT(B*B+A*A/4.), AND HT2 220 C R2=SQRT(B*B+9.*A*A/4.). HT2 230 C HT2 240 C SUBPROGRAMS CALLED ARE HANKEL AND FUNT2 (WHICH CALLS EXPM AND SINHM).HT2 250 C HT2 260 C NOTE(1). THE USE OF DIFFERENT COMPUTERS AND WORD LENGTHS MAY PRODUCE HT2 270 C DIFFERENT ROUND-OFF, RESULTING IN A DIFFERENT NUMBER OF HT2 280 C FUNT2 CALLS NEEDED FOR THE GIVEN TOLERANCE (0. IN THIS CASE)HT2 290 C HT2 300 C NOTE(2). THE USER SHOULD INSERT A CALL TO SUPPRESS EXPONENT UNDERFLOWHT2 310 C MESSAGES (AND TO SET THE RESULT TO 0.0) FOR THE MACHINE HT2 320 C SYSTEM BEING USED. SEE ERROR CONDITION(2) IN SUBPROGRAM HT2 330 C HANKEL. HT2 340 C HT2 350 C NOTE(3). COMMON/PASS/A IS USED TO PASS THE CURRENT VALUE OF A TO HT2 360 C THE EXTERNAL COMPLEX FUNCTION FUNT2(G). HT2 370 C=======================================================================HT2 380 C HT2 390 C-----STORAGE FOR NB=10, NREL=1 HT2 400 COMPLEX ZANS(10),ZWORK(283) HT2 410 REAL ARG(10),ASET(3) HT2 420 DIMENSION NORD(1),IJDUM(1) HT2 430 C-----THE FOLLOWING VARIABLES ARE USED TO COMPUTE EXACT VALUES, ABSOLUTEHT2 440 C AND RELATIVE ERRORS (NOTE THAT SINGLE-PRECISION COMPLEX IS HT2 450 C USED IN SUBPROGRAM HANKEL). HT2 460 DOUBLE PRECISION R1,R2,AA,BB,DA,DB HT2 470 COMMON/PASS/A HT2 480 C-----NAME OF EXTERNAL COMPLEX FUNCTION FUNT2(G) FOR THIS EXAMPLE HT2 490 EXTERNAL FUNT2 HT2 500 C-----THE FOLLOWING DATA STATEMENTS ARE USED TO PRESET SPECIFIC HT2 510 C PARAMETERS USED IN CALLING SUBROUTINE HANKEL FOR THIS EXAMPLE. HT2 520 DATA ASET(1),ASET(2),ASET(3)/.05,.1,3./, HT2 530 * NORD(1)/0/,TOL/0.0/,NTOL/1/,BMAX/5.0/,NB/10/,NREL/1/ HT2 540 C-----LOOP ON A=ASET(K),K=1,3 HT2 550 DO 5 K=1,3 HT2 560 A=ASET(K) HT2 570 DA=DBLE(A) HT2 580 AA=DA*DA HT2 590 C-------GET ALL NB HANKEL TRANSFORMS FOR THIS VALUE OF A IN COMMON HT2 600 CALL HANKEL(BMAX,NB,NREL,TOL,NTOL,NORD,FUNT2,IJDUM,ZWORK,ZANS, HT2 610 * ARG,NOFUN1,IERR) HT2 620 C-------CHECK IERR RETURNED BEFORE PROCEEDING HT2 630 IF(IERR.EQ.1) STOP HT2 640 C-------OUTPUT TEST DATA AND RESULTS TO UNIT 06 (PRINT FILE) HT2 650 IF(K.EQ.1) WRITE(6,1) BMAX,NB,NREL,TOL,NTOL,NORD HT2 660 1 FORMAT(1H1,48X,25HH A N K E L T E S T 2// HT2 670 * 7H BMAX=,E16.8,5H NB=,I4,7H NREL=,I4,6H TOL=,E16.8, HT2 680 * 7H NTOL=,I4,7H NORD=,I2// HT2 690 * 29X,9HREAL-PART,43X,9HIMAG-PART/3X,1HA,4X,1HI,4X,6HARG(I), HT2 700 * 10X,2(7HZANS(I),6X,17H(ABSOLUTE ERROR ),1X, HT2 710 * 17H(RELATIVE ERROR ),4X)/) HT2 720 C-------COMPUTE ABSOLUTE AND RELATIVE ERRORS BASED ON EXACT VALUES HT2 730 DO 3 I=1,NB HT2 740 DB=DBLE(ARG(I)) HT2 750 BB=DB*DB HT2 760 EXACT=(DEXP(-DA*DB))/DA HT2 770 ANS1=REAL(ZANS(I)) HT2 780 AERR1=ABS(ANS1-EXACT) HT2 790 RERR1=AERR1/EXACT HT2 800 R1=DSQRT(BB+.25D0*AA) HT2 810 R2=DSQRT(BB+2.25D0*AA) HT2 820 EXACT=DA*DSQRT(0.5D0*(R2-R1)/(R2+R1))/(R1*R2) HT2 830 ANS2=AIMAG(ZANS(I)) HT2 840 AERR2=ABS(ANS2-EXACT) HT2 850 RERR2=AERR2/EXACT HT2 860 WRITE(6,2) A,I,ARG(I),ANS1,AERR1,RERR1,ANS2,AERR2,RERR2 HT2 870 2 FORMAT(1X,F4.2,I4,2E16.8,2(2H (,E15.8,1H)),E16.8, HT2 880 * 2(2H (,E15.8,1H))) HT2 890 3 CONTINUE HT2 900 WRITE(6,4) HT2 910 4 FORMAT(1X) HT2 920 5 CONTINUE HT2 930 STOP HT2 940 END HT2 950 COMPLEX FUNCTION FUNT2(G) FU2 10 C-----EXTERNAL FUNCTION USED IN HANKEL TEST 2, WITH CURRENT VALUE C OF A IN COMMON. FUNT2 CALLS SINHM AND EXPM (MACHINE DEPENDENT C SINH AND EXP FUNCTIONS, RESPECTIVELY, TO AVOID UNDERFLOW). COMMON/PASS/A AG=A*G E=EXPM(-AG) ES=0.0 IF(E.GT.0.0) ES=E*SINHM(0.5*AG) FUNT2=CMPLX(G/SQRT(A*A+G*G)**3, ES) RETURN END FUNCTION SINHM(X) SHM 10 C-----SINHM(X) IS A MACHINE DEPENDENT SINH FUNCTION FOR X IN THE RANGE C XMIN<=X<=ABS(XMIN), WHERE XMIN DEPENDS ON THE MACHINE BEING USED. C XMIN IS ASSUMED THE SAME VALUE AS USED IN FUNCTION EXPM. C NOTE-- IN HANKEL TEST 2, SINHM(X/2.) IS CALLED ONLY BY C FUNCTION FUNT2 WHENEVER EXPM(-X)>0 AND X>0. C IF(ABS(X).LT.0.1) GO TO 20 X2=EXPM(X) SINHM=(X2-1./X2)/2. 10 RETURN 20 X2=X*X SINHM=((X2/120.+.16666667)*X2+1.)*X GO TO 10 END C=======================================================================HT3 10 C HANKEL TEST 3 (DRIVER PROGRAM 3 TO TEST SUBPROGRAM HANKEL). HT3 20 C=======================================================================HT3 30 C THIS PROGRAM USES ONLY A PRINTER OUTPUT FILE ON FORTRAN UNIT 06. HT3 40 C HT3 50 C TEST DATA ARE PRESTORED IN DATA STATEMENTS FOR EVALUATING HANKEL HT3 60 C TRANSFORMS OF ORDERS N=0 OR 1 OF THE FORM-- HT3 70 C INTEGRAL FROM 0 TO INFINITY OF FUN(G)*JN(G*B)*DG, B.GT.0. HT3 80 C HT3 90 C THE METHOD IS BY ADAPTIVE RELATED CONVOLUTION AS HT3 100 C DESCRIBED IN SUBROUTINE HANKEL (CASE 2). HT3 110 C HT3 120 C THE FOLLOWING (COMPLEX) TEST INTEGRALS ARE EVALUATED FOR HT3 130 C BMAX=2.0,NB=1,NREL=3,NTOL=1, AND TOL=.1E-7 (SEE DATA STATEMENTS). HT3 140 C HT3 150 C INTEGRAL N COMPLEX INPUT FUNCTION HT3 160 C ======== = ================================================== HT3 170 C HT3 180 C 1 0 K1=G*G*EXP(-G*A)*(Z-G)/(Z+G), WHERE Z=CSQRT(CMPLX(G*G,2.))HT3 190 C 2 1 K2=K1 (RELATED INPUT IS K2=G**0 *K1**1) HT3 200 C 3 1 K3=K1/G (RELATED INPUT IS K3=G**-1 *K1**1) HT3 210 C HT3 220 C SUBPROGRAMS CALLED ARE HANKEL AND FUNT3 (WHICH CALLS EXPM). HT3 230 C HT3 240 C NOTE(1). THE USE OF DIFFERENT COMPUTERS AND WORD LENGTHS MAY PRODUCE HT3 250 C DIFFERENT ROUND-OFF, RESULTING IN A DIFFERENT NUMBER OF HT3 260 C FUNT3 CALLS NEEDED FOR THE GIVEN TOLERANCE (.1E-7). HT3 270 C HT3 280 C NOTE(2). THE USER SHOULD INSERT A CALL TO SUPPRESS EXPONENT UNDERFLOWHT3 290 C MESSAGES (AND TO SET THE RESULT TO 0.0) FOR THE MACHINE HT3 300 C SYSTEM BEING USED. SEE ERROR CONDITION(2) IN SUBPROGRAM HT3 310 C HANKEL. HT3 320 C HT3 330 C NOTE(3). COMMON/PASS/A IS USED TO PASS THE ASSIGNED VALUE OF A TO HT3 340 C THE EXTERNAL COMPLEX FUNCTION FUNT3(G). HT3 350 C=======================================================================HT3 360 C HT3 370 C-----STORAGE FOR NB=1, NREL=3 HT3 380 COMPLEX ZANS(3),ZWORK(283,3) HT3 390 DIMENSION ARG(1),NORD(3),IJREL(2,3) HT3 400 COMMON/PASS/A HT3 410 C-----NAME OF EXTERNAL COMPLEX FUNCTION FUNT3(G) FOR THIS EXAMPLE HT3 420 EXTERNAL FUNT3 HT3 430 C-----THE FOLLOWING DATA STATEMENTS ARE USED TO PRESET SPECIFIC HT3 440 C PARAMETERS USED IN CALLING SUBROUTINE HANKEL FOR THIS EXAMPLE. HT3 450 DATA NORD(1),NORD(2),NORD(3)/0,1,1/, HT3 460 * IJREL(1,1),IJREL(2,1)/0,0/, HT3 470 * IJREL(1,2),IJREL(2,2)/0,1/, HT3 480 * IJREL(1,3),IJREL(2,3)/-1,1/, HT3 490 * TOL/.1E-7/,NTOL/1/,BMAX/2.0/,NB/1/,NREL/3/ HT3 500 C-----ASSIGN VALUE TO A IN COMMON HT3 510 A=.5 HT3 520 C-----GET ALL NREL HANKEL TRANSFORMS VIA CALL HANKEL HT3 530 CALL HANKEL(BMAX,NB,NREL,TOL,NTOL,NORD,FUNT3,IJREL,ZWORK,ZANS, HT3 540 * ARG,NOFUN1,IERR) HT3 550 C-----CHECK IERR RETURNED BEFORE PROCEEDING HT3 560 IF(IERR.EQ.1) STOP HT3 570 C-----OUTPUT TEST DATA AND RESULTS TO UNIT 06 (PRINT FILE) HT3 580 WRITE(6,1) BMAX,NB,NREL,TOL,NTOL,NOFUN1,IERR,A, HT3 590 * (J,NORD(J),IJREL(1,J),IJREL(2,J),J=1,NREL) HT3 600 1 FORMAT(1H1,48X,25HH A N K E L T E S T 3// HT3 610 * 7H BMAX=,E16.8,5H NB=,I4,7H NREL=,I4,6H TOL=,E16.8,7H NTOL=,HT3 620 * I4,23X,9H NOFUN1=,I6,7H IERR=,I1// HT3 630 * 3X,34HJ NORD(J) IJREL(1,J) IJREL(2,J),10X,2HA=,E16.8// HT3 640 * 3(2X,I2,5X,I1,7X,I3,9X,I3/)/ HT3 650 * 16X,3(8X,9HREAL-PART,8X,9HIMAG-PART)/3X,1HI,4X,6HARG(I),10X, HT3 660 * 9HZANS(I,1),8X,9HZANS(I,1),8X,9HZANS(I,2),8X,9HZANS(I,2), HT3 670 * 8X,9HZANS(I,3),8X,9HZANS(I,3)/) HT3 680 WRITE(6,2) ARG(1),(ZANS(J),J=1,3) HT3 690 2 FORMAT(3X,1H1,2E16.8,5E17.8) HT3 700 STOP HT3 710 END HT3 720 COMPLEX FUNCTION FUNT3(G) FU3 10 C-----EXTERNAL FUNCTION USED IN HANKEL TEST 3, WITH ASSIGNED VALUE C OF A IN COMMON. FUNT3 CALLS EXPM, A MACHINE DEPENDENT C EXP FUNCTION TO AVOID UNDERFLOW. COMPLEX Z,C COMMON/PASS/A C=CMPLX(G,0.0) GG=G*G Z=CSQRT(CMPLX(GG,2.0)) FUNT3=CMPLX(GG*EXPM(-G*A),0.0)*(Z-C)/(Z+C) RETURN END SUBROUTINE DHANKL(BMAX,NB,NREL,TOL,NTOL,NORD,FUN1,IJREL,DWORK, DHA 10 * DANS,ARG,NOFUN1,IERR) C======================================================================= INTEGER NB,NREL,NTOL,NORD(NREL),IJREL(2,NREL),NOFUN1,IERR DOUBLE PRECISION BMAX,TOL,DWORK(801,NREL),DANS(NB,NREL),ARG(NB) C======================================================================= C C PURPOSE C C THE PURPOSE OF SUBPROGRAM DHANKL IS TO PROVIDE IN DOUBLE PRECISION C A GENERAL ALGORITHM FOR FAST REAL HANKEL TRANSFORMS OF ORDERS C 0 AND 1 USING RELATED AND LAGGED CONVOLUTIONS. C C AUTHOR C C ANDERSON, W.L., U.S. GEOLOGICAL SURVEY, DENVER, COLORADO. C C REFERENCES C C 1. ANDERSON, W.L., IMPROVED DIGITAL FILTERS FOR EVALUATING C FOURIER AND HANKEL TRANSFORM INTEGRALS. N.T.I.S REPT. C PB-242-800, SPRINGFIELD, VA., 1975. C C 2. ANDERSON, W.L., NUMERICAL INTEGRATION OF RELATED HANKEL C TRANSFORMS OF ORDERS 0 AND 1 BY ADAPTIVE DIGITAL FILTERING. C GEOPHYSICS 44 (JULY 1979), 1287-1305. C C LANGUAGE C C ANS-FORTRAN (X3.9-1966) IS USED, WITH THE EXCEPTION OF THE C CHARACTERS <,[,&,:,],> APPEARING IN SOME COMMENT STATEMENTS. C C ABSTRACT C C BY COMBINING BOTH ADAPTIVE LAGGED CONVOLUTION (SEE [1]) AND C ADAPTIVE RELATED CONVOLUTION (SEE [2]), SUBPROGRAM DHANKL C MINIMIZES EXTERNAL FUN1 CALLS (NOFUN1 AT EXIT) IN EVALUATING A C TOTAL OF NB*NREL REAL HANKEL TRANSFORMS OF ORDERS 0 AND (OR) 1, C WHERE NB IS THE NUMBER OF LAGGED CONVOLUTIONS, AND NREL IS THE C NUMBER OF RELATED CONVOLUTIONS. C DIRECT CONVOLUTION METHODS (SEE [1],[2]) DO NOT REQUIRE BESSEL C FUNCTION EVALUATIONS, AND HENCE ARE GENERALLY AN ORDER OF C MAGNITUDE FASTER TO COMPUTE THAN MOST DIRECT NUMERICAL C INTEGRATION METHODS. BY USING PREVIOUSLY SAVED TRANSFORM INPUT C FUNCTION EVALUATIONS, BOTH LAGGED CONVOLUTION AND RELATED C CONVOLUTION FURTHER REDUCE SIGNIFICANTLY THE NUMBER OF TRANSFORM C INPUT FUNCTION EVALUATIONS REQUIRED OVER DIRECT CONVOLUTION. C LAGGED CONVOLUTION IS SELECTED WHEN NB>1, WHICH DEFINES ARG(NB) C OVER ANY DESIRED TRANSFORM ARGUMENT RANGE (BMIN,BMAX). RESULTS ARE C STORED AT THE FILTER SPACING IN ARRAYS ARG(NB) AND DANS(NB,NREL) C FOR LATER USE IN SPLINE INTERPOLATION, ETC. GIVEN BMAX,NB, THE C VALUE OF BMIN (NOT GIVEN) CAN BE COMPUTED FROM THE EXPRESSION C BMIN=BMAX*DEXP(-.1D0*(NB-1)), WHICH MUST BE .GT. 0.0D0 FOR THE C GIVEN MACHINE EXPONENT RANGE. C RELATED CONVOLUTION IS SELECTED WHEN NREL>1, AND BY GIVEN C SIMPLE ALGEBRAIC RELATIONSHIPS BETWEEN FUN1 AND EACH NREL RELATED C TRANSFORM INPUT FUNCTION, DEFINED AS G**I * FUN1(G)**J, WHERE C FUN1(G) IS THE FIRST TRANSFORM INPUT FUNCTION, AND ARRAY C IJREL(2,NREL)= PAIRS OF I,J INTEGERS (NEGATIVE, 0, OR POSITIVE). C THE ORDER OF ALL RELATED CONVOLUTIONS MUST BE GIVEN IN NORD(NREL), C AND MUST BE EITHER 0 OR 1, BUT CAN BE IN ANY DESIRED SEQUENCE. C HIGHER INTEGER ORDERS MAY BE EXPRESSED IN TERMS OF ORDERS 0 AND 1 C BY USING THE RECURRENCE RELATION JN-1(X)+JN+1(X)=2*N*JN(X)/X. C THE EQUALLY-SPACED J0,J1 FILTER ABSCISSAS ARE GENERATED IN C DOUBLE-PRECISION (TO CONSERVE STORAGE) AND ARE USED AS ARGUMENTS C IN THE EXTERNAL DOUBLE PRECISION FUNCTION FUN1. C BOTH J0 AND J1 FILTER RESPONSE FUNCTIONS (WEIGHTS) WERE C DESIGNED TO HAVE IDENTICAL ABSCISSA VALUES AS IN [2]. THE J0,J1 C DOUBLE-PRECISION FILTER WEIGHTS USED IN SUBPROGRAM DHANKL WERE C REDESIGNED FROM [2] IN QUADRUPLE-PRECISION USING A VAX-11/780 IN C H-FLOATING ARITHMETIC. MUCH OF THE LOGIC USED IN DHANKL FOLLOWS C THE CODING USED IN [1] AND [2]. THE MAJOR DIFFERENCES ARE IN THE C DEFINITION OF RELATED INPUT FUNCTIONS (SEE IJREL,DWORK), AND C FOR HANDLING OSCILLATING FUNCTIONS (SEE NTOL,ITOL). C C FOUR GENERAL CASES ARE POSSIBLE USING SUBPROGRAM DHANKL. C C CASE 1. SINGLE DIRECT CONVOLUTION AT B=BMAX=BMIN (NB=1,NREL=1). C CASE 2. RELATED CONVOLUTIONS AT A CONSTANT B=BMAX (NB=1,NREL>1). C CASE 3. LAGGED CONVOLUTIONS IN (BMIN,BMAX) (NB>1,NREL=1). C CASE 4. BOTH RELATED AND LAGGED CONVOLUTIONS (NB>1,NREL>1). C C MACHINE DEPENDENT REMARKS C C THIS SUBPROGRAM WAS IMPLEMENTED AND TESTED ON A 64-BIT DOUBLE- C WORD MACHINE WITH EXP-RANGE APPROXIMATELY 10**-38 TO 10**+38 AND C 56-BIT MANTISSA (ABOUT 16-DECIMAL DIGITS). ONLY DOUBLE-PRECISION C AND INTEGER OPERATIONS ARE USED. C FOR MACHINES WITH OTHER DOUBLE-WORD SIZES, CHANGES IN THE NUMBER OF C DIGITS RETAINED IN SOME DATA STATEMENTS MAY BE REQUIRED. C C DESCRIPTION OF PARAMETERS C C INPUT C C BMAX - INITIAL HANKEL TRANSFORM ARGUMENT B=BMAX>0.D0 (ANY CASE), C USED IN INTEGRAL FROM 0 TO INFINITY OF C FUN1(G)*JN(G*B)*DG, WHERE JN=BESSEL FUNCTION OF ORDER N, C N=0 OR 1, AND B>0.0D0. (SEE FUN1 DEFINITION BELOW). C NB - NUMBER OF LAGGED CONVOLUTIONS DESIRED (NB.GE.1). USE C NB=1 IF B=BMIN=BMAX (I.E., CASE 1 OR 2). USE C NB>1 IF B IS LAGGED IN (BMIN,BMAX), WHERE C BMIN=BMAX*DEXP(-.1D0*(NB-1)) DOES NOT UNDERFLOW THE DEXP C RANGE. THE B-LAGGED SPACING IS .1D0 IN LOG-SPACE. FOR C CONVENIENCE IN SPLINE INTERPOLATION LATER, EACH B IN C (BMIN,BMAX) IS RETURNED IN ARRAY ARG(I),I=1,NB, WHERE C ARG(I+1)/ARG(I)=DEXP(.1D0) FOR ALL I. IF BMAX>BMIN>0 IS C GIVEN, THEN AN EFFECTIVE VALUE OF NB IS DETERMINED AS C NB=DINT(10.*DLOG(BMAX/BMIN))+I, WHERE I>1 IS RECOMMENDED, C PARTICULARLY IF USING SUBSEQUENT SPLINE INTERPOLATION FOR C A DIFFERENT B-SPACING THAN USED IN THE SAMPLED FILTERS. IF C SPLINE INTERPOLATION IS TO BE USED LATER, IT IS GENERALLY C BEST TO USE DLOG(ARG(I)) INSTEAD OF ARG(I) -VS- DANS(I,J), C FOR I=1,NB, AND FOR ANY GIVEN J BETWEEN 1 AND NREL. NOTE C NB IS USED AS AN ADJUSTABLE DIMENSION IN DANS(NB,NREL). C NREL - NUMBER OF RELATED CONVOLUTIONS DESIRED (NREL.GE.1). USE C NREL=1 IF ONLY A SINGLE HANKEL TRANSFORM IS USED. C NREL>1 REQUIRES ARRAY IJREL(2,NREL) (SEE BELOW). C NOTE NREL IS USED AS ADJUSTABLE DIMENSIONS IN ARRAYS C DANS(NB,NREL),DWORK(801,NREL),NORD(NREL),IJREL(2,NREL). C TOL - REQUESTED TRUNCATION TOLERANCE AT BOTH FILTER TAILS C FOR ADAPTIVE CONVOLUTION FOR ALL NB*NREL TRANSFORMS. THE C TRUNCATION CRITERION IS ESTABLISHED DURING CONVOLUTION IN C A FIXED ABSCISSA RANGE (USING WEIGHTS 299-339) OF EITHER C ORDER FILTER AS THE MAXIMUM ABSOLUTE CONVOLVED PRODUCT C TIMES TOL. THE CONVOLUTION SUMMATION IS TERMINATED C ON EITHER SIDE OF THE FIXED RANGE WHENEVER THE ABSOLUTE C PRODUCT .LE. THE TRUNCATION CRITERION. IN GENERAL, A C DECREASING TOLERANCE WILL PRODUCE HIGHER ACCURACY SINCE C MORE FILTER WEIGHTS ARE USED (UNLESS EXPONENT UNDERFLOW C OCCURS IN THE TRANSFORM INPUT FUNCTION EVALUATION). C ONE MAY SET TOL=0.D0 TO OBTAIN MAXIMUM ACCURACY FOR ALL C NB*NREL REAL HANKEL TRANSFORMS IN DANS(NB,NREL). C HOWEVER, THE ACTUAL RELATIVE ERRORS CANNOT BE EXPECTED TO C BE SMALLER THAN ABOUT .1D-13 REGARDLESS OF THE TOLERANCE C VALUE USED, SINCE DOUBLE-PRECISION FILTER WEIGHTS AND C DOUBLE-PRECISION FUNCTIONS ARE USED. IN ANY EVENT, C ONE SHOULD ALWAYS CHOOSE TOL<>TOL) MAY OCCUR. C NTOL - NUMBER OF CONSECUTIVE TIMES THE TRUNCATION CRITERION (TOL) C IS TO BE MET AT EITHER FILTER TAIL BEFORE FILTER C TRUNCATION OCCURS. NTOL=1 SHOULD BE USED FOR INPUT C FUNCTIONS THAT DO NOT HAVE MANY ZEROS IN (0,INFINITY). FOR C OSCILLATORY FUNCTIONS WITH MANY ZEROS, NTOL>1 MAY BE USED C TO INSURE A PREMATURE CUTOFF DOES NOT OCCUR FOR TRUNCATION C (SEE USE OF ITOL,NTOL,TOL IN THE CODE BELOW). C NORD - INTEGER ARRAY NORD(NREL) GIVING THE NREL ORDERS (0 OR 1) C OF EACH RELATED HANKEL TRANSFORM. IF ANY NORD(I),I=1,NREL, C IS NOT 0 OR 1, THEN ORDER 1 WILL BE ASSUMED. C FUN1 - NAME OF AN EXTERNAL DOUBLE PRECISION FUNCTION OF A REAL C ARGUMENT DEFINING THE 1ST TRANSFORM INPUT FUNCTION OF THE C SET OF RELATED TRANSFORMS TO BE EVALUATED. AN EXTERNAL C FUN1 STATEMENT MUST APPEAR IN THE CALLING PROGRAM. THE C DOUBLE PRECISION FUNCTION FUN1(G) MUST BE CODED BY THE C USER AND MUST BE A CONTINUOUS DECREASING REAL FUNCTION C FOR ALL REAL G>0.0D0. THE VALUE OF G MUST BE UNCHANGED C UPON RETURN FROM FUN1. A MULTIPLE-POLE OF FUN1(G) AT G=0.0 C CAN EXIST, PROVIDED THE HANKEL TRANSFORM CONVERGES (NOTE C FUN1(0D0) IS NOT USED). GENERALLY, FUN1(G) C IS DEFINED ANALYTICALLY FOR ALL G>0.D0. HOWEVER, C DISCRETELY DEFINED FUNCTIONS MAY BE USED IF FUN1(G) C RETURNS A SMOOTH INTERPOLATION VALUE (E.G., VIA CUBIC C SPLINES) WHICH SATISFIES THE CONTINUITY CONDITION FOR ALL C G>0, AND PROVIDED THE PROPER LIMITING VALUE OF FUN1(G) IS C GIVEN AS G TENDS TO INFINITY. PARAMETERS OTHER C THAN G NEEDED IN FUN1(G) MAY BE INCLUDED BY USING LABELED C COMMON IN FUN1 AND IN THE USERS CALLING PROGRAM. IF C FUN1(G) IS AN OSCILLATING FUNCTION, THEN THE HIGHEST C FREQUENCY COMPONENT (IN LOG-SPACE) SHOULD NOT EXCEED THE C FILTER NYQUIST FREQUENCY, 1/(2*0.1D0). IN GENERAL, C SUBPROGRAM DHANKL PERFORMS BEST WHEN USING SMOOTH, WELL- C BEHAVED FUNCTIONS FUN1(G), THAT ARE CHARACTERIZED AS C MONOTONICALLY DECREASING FUNCTIONS WITH RELATIVELY FEW C ZEROS FOR G>0. (SEE THE ACCURACY WARNING UNDER TOL, AND C ERROR CONDITION (4).) C IJREL - INTEGER ARRAY IJREL(2,NREL) USED WHEN NREL>1 TO DEFINE C THE PAIR OF I,J INTEGER EXPONENTS FOR EACH RELATED INPUT C FUNCTION. THE RELATED INPUT FUNCTIONS ARE ASSUMED C TO BE SIMPLY RELATED IN TERMS OF FUN1 VIA THE INTEGER C ARRAY IJREL(2,K),K=2,NREL. THAT IS, WE ASSUME THE K-TH C RELATED INPUT FUNCTION IS GIVEN (SEE STATEMENT 160) AS C FUNK(G)=G**IJREL(1,K) * FUN1(G)**IJREL(2,K), WHERE C THE INTEGER EXPONENTS MAY BE POSITIVE, ZERO, OR NEGATIVE. C IN THIS WAY, ONLY FUN1 NEED BE DECLARED AN EXTERNAL C FUNCTION. MORE COMPLICATED CODE COULD BE USED C FOR THE RELATED FUNCTIONS, PROVIDED THE MEANING OF IJREL C IS REDEFINED AND STATEMENT 160 IS CHANGED (ALSO, SEE C ERROR CONDITION (3) BELOW). WHEN NREL=1, ARRAY C IJREL IS A DUMMY NAME (I.E., NOT REFERENCED). C IF NREL>1, THEN THE STATEMENT AT LABEL 160 C IS DEFINED ONLY FOR K=J=2,...,NREL. THAT IS, C IJREL(1,1),IJREL(2,1) ARE NOT USED IN THIS VERSION. C DWORK - WORK ARRAY DWORK(801,NREL), WHICH IS USED TO C HOLD VARIOUS COMPUTED FUNCTIONAL VALUES DURING RELATED AND C LAGGED CONVOLUTIONS. A STORAGE ROLL FEATURE USING C DWORK(801,NREL) AND INTERNAL ARRAY KEY(801) ALLOWS FOR C ANY B RANGE (BMIN,BMAX) TO BE USED DURING CONVOLUTION. C C OUTPUT C C DANS - THE ARRAY DANS(NB,NREL) IS RETURNED GIVING THE C NB*NREL REAL HANKEL TRANSFORMS, WITH CORRESPONDING C B ARGUMENTS GIVEN IN ARRAY ARG(NB). C ARG - THE ARRAY ARG(NB) IS RETURNED GIVING THE RESULTING C B ARGUMENTS IN (BMIN,BMAX), WHERE ARG(I+1)/ARG(I)=EXP(.1), C I=1,NB-1 (THIS ARRAY COULD BE ELIMINATED TO SAVE STORAGE C AND REGENERATED AFTER THE CALL DHANKL, IF DESIRED). C NOFUN1 - NUMBER OF DIRECT FUN1 EVALUATIONS USED FOR ALL NB*NREL C REAL HANKEL TRANSFORMS. NOFUN1 IS USUALLY NOT MORE C THAN THE NUMBER OF WEIGHTS NEEDED FOR A SINGLE DIRECT C CONVOLUTION, FOR ANY NB AND NREL. C IERR - ERROR RETURN CODE. THE FOLLOWING CODES ARE POSSIBLE -- C = 0, NO ERROR IN INPUT PARAMETERS. DANS,ARG COMPUTED. C = 1, IMPROPER INPUT PARAMETERS (I.E., NB<1,NREL<1,BMAX<=0, C OR BMAX*DEXP(-.1D0*(NB-1))<=0.D0). DANS,ARG NOT COMPUTED. C C C ERROR CONDITIONS C C (1) IMPROPER INPUT PARAMETERS GIVEN (SEE IERR=1 ABOVE). C (2) UNDERFLOW CONDITIONS ARE POSSIBLE DURING CONVOLUTION, DUE TO C THE BEHAVIOR OF FUN1, VALUE OF B IN (BMIN,BMAX), TOL, AND C NTOL. EXPONENT AND (OR) ARITHMETIC UNDERFLOW TRAPS MUST RETURN C A VALUE OF 0.D0 FOR THE COMPUTER SYSTEM BEING USED. NOTE THAT C UNDERFLOW MAY ALSO OCCUR IN THE USERS EXTERNAL FUNCTION C FUN1(G) FOR ANY VALUE OF G AS SET BY SUBPROGRAM DHANKL. C (3) AN UNRECOVERABLE OVERFLOW CONDITION CAN OCCUR IN EXECUTING C STATEMENT 160, DEPENDING ON THE VALUE OF B IN (BMIN,BMAX), C TOL, OR THE INTEGER EXPONENTS USED IN IJREL(2,NREL),NREL>1. C IN GENERAL, EXTREMELY SMALL OR LARGE VALUES OF B SHOULD BE C AVOIDED (SEE ACCURACY WARNING UNDER TOL ABOVE). ALSO, IN MANY C CASES, EXPONENT OVERFLOW CAN BE AVOIDED BY PROPER CHOICE OF C FUN1 AND THE RELATED INPUT FUNCTION ORDERING DEFINED BY C THE IJREL SIGNED INTEGER EXPONENTS. C (4) UNDETECTED ERRORS ARE POSSIBLE IF FUN1 IS IMPROPERLY CODED, OR C DOES NOT YIELD DOUBLE-PRECISION ACCURACY, OR IS NOT C A CONTINUOUS DECREASING REAL FUNCTION FOR ALL G>0.D0. C C USAGE C C SUBPROGRAM DHANKL IS CALLED AS FOLLOWS (USE NUMERICAL VALUES FOR C , EXCLUDING < AND >, IN DECLARATIONS) -- C C DOUBLE PRECISION BMAX,TOL,DWORK(801,),DANS(,), C 1 ARG() C DIMENSION NORD(),IJREL(2,) C EXTERNAL DFUN1 CC-----READ/LOAD INPUT PARAMETERS FOR DHANKL AS REQUIRED C ... C CALL DHANKL(BMAX,NB,NREL,TOL,NTOL,NORD,DFUN1,IJREL,DWORK, C * DANS,ARG,NOFUN1,IERR) C IF(IERR.EQ.1) STOP C ... C END C DOUBLE PRECISION FUNCTION DFUN1(G) C DOUBLE PRECISION G CC-----INSERT USER SUPPLIED CODE FOR EVALUATION OF DFUN1(G),G>0.0D0 C END C C======================================================================= DOUBLE PRECISION ABSCIS,C,CMAX,DSUM,E,ER,FUN1,G,Y,Y1,WT0,WT1 DIMENSION KEY(801),WT0(801),WT1(801) C-----WE DEFINE C,CMAX FOR USE IN THE TRUNCATION CRITERION TESTS, C WHERE C IS ANY CONVOLUTION PRODUCT AND CMAX IS THE MAXIMUM C CONVOLVED PRODUCT IN THE FIXED ABSCISSA RANGE (SEE PARAMETER TOL). C-----ABSCIS=BASE CONSTANT FOR FILTER ABSCISSA GENERATION DATA ABSCIS/0.7059431685223780D0/ C-----E=DEXP(.1D0), ER=1.0D0/E (ALSO USED IN ABSCISSA GENERATION) DATA E/1.10517091807564762 D0/,ER/.904837418035959573 D0/ C-----WT0(I)=J0 HANKEL TRANSFORM FILTER WEIGHTS FOR I=1,801 DATA *WT0( 1)/ 2.103562053838982D-29/,WT0( 2)/-1.264469361608894D-14/, *WT0( 3)/ 4.615731256788567D-14/,WT0( 4)/-2.798703374257668D-14/, *WT0( 5)/ 5.465764965410841D-14/,WT0( 6)/-2.652933109928729D-14/, *WT0( 7)/ 5.674913434067321D-14/,WT0( 8)/-2.157276828977208D-14/, *WT0( 9)/ 5.831846086773976D-14/,WT0( 10)/-1.546589284868783D-14/, *WT0( 11)/ 6.057302455652974D-14/,WT0( 12)/-8.502531259083065D-15/, *WT0( 13)/ 6.388018061147645D-14/,WT0( 14)/-5.659657635010288D-16/, *WT0( 15)/ 6.848500604791407D-14/,WT0( 16)/ 8.572897732168277D-15/, *WT0( 17)/ 7.465068154681814D-14/,WT0( 18)/ 1.920837293261338D-14/, *WT0( 19)/ 8.269345428975771D-14/,WT0( 20)/ 3.170116562922900D-14/, *WT0( 21)/ 9.300004039695208D-14/,WT0( 22)/ 4.649069639417992D-14/, *WT0( 23)/ 1.060441944490564D-13/,WT0( 24)/ 6.411216589597457D-14/, *WT0( 25)/ 1.224060834001701D-13/,WT0( 26)/ 8.521776751507022D-14/, *WT0( 27)/ 1.427957940487172D-13/,WT0( 28)/ 1.106026606968463D-13/, *WT0( 29)/ 1.680820203098405D-13/,WT0( 30)/ 1.412367028159546D-13/, *WT0( 31)/ 1.993271011776308D-13/,WT0( 32)/ 1.783032042964119D-13/, *WT0( 33)/ 2.378298196799422D-13/,WT0( 34)/ 2.232462602765097D-13/, *WT0( 35)/ 2.851776817107034D-13/,WT0( 36)/ 2.778285575785995D-13/, *WT0( 37)/ 3.433107735233557D-13/,WT0( 38)/ 3.442019764139949D-13/ DATA *WT0( 39)/ 4.145997612327839D-13/,WT0( 40)/ 4.249938198224969D-13/, *WT0( 41)/ 5.019411631949951D-13/,WT0( 42)/ 5.234121310773422D-13/, *WT0( 43)/ 6.088737193247560D-13/,WT0( 44)/ 6.433743253810275D-13/, *WT0( 45)/ 7.397205280796933D-13/,WT0( 46)/ 7.896642978865920D-13/, *WT0( 47)/ 8.997626559623209D-13/,WT0( 48)/ 9.681243129571424D-13/, *WT0( 49)/ 1.095451187471558D-12/,WT0( 50)/ 1.185889375491455D-12/, *WT0( 51)/ 1.334666226164323D-12/,WT0( 52)/ 1.451673490118585D-12/, *WT0( 53)/ 1.627033241780647D-12/,WT0( 54)/ 1.776119296526221D-12/, *WT0( 55)/ 1.984309459865773D-12/,WT0( 56)/ 2.172225112712636D-12/, *WT0( 57)/ 2.420855801356264D-12/,WT0( 58)/ 2.655866524621122D-12/, *WT0( 59)/ 2.954213313000758D-12/,WT0( 60)/ 3.246433455110429D-12/, *WT0( 61)/ 3.605807223054322D-12/,WT0( 62)/ 3.967608279821300D-12/, *WT0( 63)/ 4.401806878720721D-12/,WT0( 64)/ 4.848316218220904D-12/, *WT0( 65)/ 5.374176077884770D-12/,WT0( 66)/ 5.923886142128417D-12/, *WT0( 67)/ 6.561955948855011D-12/,WT0( 68)/ 7.237468388830243D-12/, *WT0( 69)/ 8.012831864792648D-12/,WT0( 70)/ 8.841766480402105D-12/, *WT0( 71)/ 9.785047278800097D-12/,WT0( 72)/ 1.080115224902499D-11/, *WT0( 73)/ 1.194974128877562D-11/,WT0( 74)/ 1.319424925552153D-11/, *WT0( 75)/ 1.459380374689331D-11/,WT0( 76)/ 1.611708818260074D-11/ DATA *WT0( 77)/ 1.782336249944076D-11/,WT0( 78)/ 1.968696083966218D-11/, *WT0( 79)/ 2.176804271234846D-11/,WT0( 80)/ 2.404712745375440D-11/, *WT0( 81)/ 2.658616922424555D-11/,WT0( 82)/ 2.937256616666064D-11/, *WT0( 83)/ 3.247112071587450D-11/,WT0( 84)/ 3.587699548548411D-11/, *WT0( 85)/ 3.965909071112399D-11/,WT0( 86)/ 4.382145152220635D-11/, *WT0( 87)/ 4.843856688602439D-11/,WT0( 88)/ 5.352476425684008D-11/, *WT0( 89)/ 5.916190912377549D-11/,WT0( 90)/ 6.537635327328955D-11/, *WT0( 91)/ 7.225949098391667D-11/,WT0( 92)/ 7.985185650562155D-11/, *WT0( 93)/ 8.825697213255412D-11/,WT0( 94)/ 9.753221923111176D-11/, *WT0( 95)/ 1.077963949370144D-10/,WT0( 96)/ 1.191270094182892D-10/, *WT0( 97)/ 1.316619519054340D-10/,WT0( 98)/ 1.455028951566729D-10/, *WT0( 99)/ 1.608114581091983D-10/,WT0(100)/ 1.777184270673645D-10/, *WT0(101)/ 1.964147916871289D-10/,WT0(102)/ 2.170665216346822D-10/, *WT0(103)/ 2.399008451839042D-10/,WT0(104)/ 2.651263504640323D-10/, *WT0(105)/ 2.930148720448538D-10/,WT0(106)/ 3.238267179640594D-10/, *WT0(107)/ 3.578885297833856D-10/,WT0(108)/ 3.955234710219298D-10/, *WT0(109)/ 4.371254308993604D-10/,WT0(110)/ 4.830940473937580D-10/, *WT0(111)/ 5.339056350072159D-10/,WT0(112)/ 5.900529573690070D-10/, *WT0(113)/ 6.521132758098962D-10/,WT0(114)/ 7.206928333934838D-10/ DATA *WT0(115)/ 7.964924450372341D-10/,WT0(116)/ 8.802567084675067D-10/, *WT0(117)/ 9.728375895186283D-10/,WT0(118)/ 1.075148437456224D-09/, *WT0(119)/ 1.188226062693121D-09/,WT0(120)/ 1.313189706258061D-09/, *WT0(121)/ 1.451302163665563D-09/,WT0(122)/ 1.603933943511600D-09/, *WT0(123)/ 1.772624063293560D-09/,WT0(124)/ 1.959049733219870D-09/, *WT0(125)/ 2.165087540667258D-09/,WT0(126)/ 2.392789115986871D-09/, *WT0(127)/ 2.644443536014764D-09/,WT0(128)/ 2.922559573439235D-09/, *WT0(129)/ 3.229930291248597D-09/,WT0(130)/ 3.569622651576204D-09/, *WT0(131)/ 3.945045448172924D-09/,WT0(132)/ 4.359947261255963D-09/, *WT0(133)/ 4.818489091363688D-09/,WT0(134)/ 5.325251901762953D-09/, *WT0(135)/ 5.885315583343685D-09/,WT0(136)/ 6.504277635547376D-09/, *WT0(137)/ 7.188340419242570D-09/,WT0(138)/ 7.944342903082902D-09/, *WT0(139)/ 8.779858562959109D-09/,WT0(140)/ 9.703242578022093D-09/, *WT0(141)/ 1.072374322768940D-08/,WT0(142)/ 1.185156747840095D-08/, *WT0(143)/ 1.309800933225301D-08/,WT0(144)/ 1.447553742402158D-08/, *WT0(145)/ 1.599794451372024D-08/,WT0(146)/ 1.768046154055318D-08/, *WT0(147)/ 1.953993335487118D-08/,WT0(148)/ 2.159496468450500D-08/, *WT0(149)/ 2.386612830616206D-08/,WT0(150)/ 2.637614961034523D-08/, *WT0(151)/ 2.915015476269831D-08/,WT0(152)/ 3.221590205565798D-08/ DATA *WT0(153)/ 3.560407926098509D-08/,WT0(154)/ 3.934859178954436D-08/, *WT0(155)/ 4.348692045365787D-08/,WT0(156)/ 4.806047869438007D-08/, *WT0(157)/ 5.311504443749314D-08/,WT0(158)/ 5.870120138001748D-08/, *WT0(159)/ 6.487486163571268D-08/,WT0(160)/ 7.169780940885934D-08/, *WT0(161)/ 7.923833480505012D-08/,WT0(162)/ 8.757190229426675D-08/, *WT0(163)/ 9.678192055835553D-08/,WT0(164)/ 1.069605631204864D-07/, *WT0(165)/ 1.182097045925483D-07/,WT0(166)/ 1.306419269237675D-07/, *WT0(167)/ 1.443816591198488D-07/,WT0(168)/ 1.595664099835792D-07/, *WT0(169)/ 1.763481565722233D-07/,WT0(170)/ 1.948948533650376D-07/, *WT0(171)/ 2.153921247351847D-07/,WT0(172)/ 2.380451115468297D-07/, *WT0(173)/ 2.630805351444854D-07/,WT0(174)/ 2.907489558998551D-07/, *WT0(175)/ 3.213272911558462D-07/,WT0(176)/ 3.551215767529809D-07/, *WT0(177)/ 3.924700396067688D-07/,WT0(178)/ 4.337464734078393D-07/, *WT0(179)/ 4.793639887921159D-07/,WT0(180)/ 5.297791390370199D-07/, *WT0(181)/ 5.854964979982190D-07/,WT0(182)/ 6.470737017046583D-07/, *WT0(183)/ 7.151270374758372D-07/,WT0(184)/ 7.903376040582035D-07/, *WT0(185)/ 8.734581359370587D-07/,WT0(186)/ 9.653205295304359D-07/, *WT0(187)/ 1.066844176299330D-06/,WT0(188)/ 1.179045157323447D-06/, *WT0(189)/ 1.303046419382764D-06/,WT0(190)/ 1.440089007182073D-06/ DATA *WT0(191)/ 1.591544490556806D-06/,WT0(192)/ 1.758928685376697D-06/, *WT0(193)/ 1.943916830388476D-06/,WT0(194)/ 2.148360347694608D-06/, *WT0(195)/ 2.374305378111399D-06/,WT0(196)/ 2.624013254094558D-06/, *WT0(197)/ 2.899983137292810D-06/,WT0(198)/ 3.204977025773239D-06/, *WT0(199)/ 3.542047402097807D-06/,WT0(200)/ 3.914567778667102D-06/, *WT0(201)/ 4.326266465748067D-06/,WT0(202)/ 4.781263881007758D-06/, *WT0(203)/ 5.284113792545945D-06/,WT0(204)/ 5.839848890150422D-06/, *WT0(205)/ 6.454031158395685D-06/,WT0(206)/ 7.132807538712648D-06/, *WT0(207)/ 7.882971454044484D-06/,WT0(208)/ 8.712030795792633D-06/, *WT0(209)/ 9.628283069078871D-06/,WT0(210)/ 1.064089843325841D-05/, *WT0(211)/ 1.176001148348469D-05/,WT0(212)/ 1.299682267761921D-05/, *WT0(213)/ 1.436371043746991D-05/,WT0(214)/ 1.587435503282041D-05/, *WT0(215)/ 1.754387550120777D-05/,WT0(216)/ 1.938898096105121D-05/, *WT0(217)/ 2.142813784487508D-05/,WT0(218)/ 2.368175471430264D-05/, *WT0(219)/ 2.617238651818130D-05/,WT0(220)/ 2.892496032668667D-05/, *WT0(221)/ 3.196702481167932D-05/,WT0(222)/ 3.532902595927333D-05/, *WT0(223)/ 3.904461178455365D-05/,WT0(224)/ 4.315096908756330D-05/, *WT0(225)/ 4.768919563102351D-05/,WT0(226)/ 5.270471145419851D-05/, *WT0(227)/ 5.824771344935570D-05/,WT0(228)/ 6.437367773954276D-05/ DATA *WT0(229)/ 7.114391489568718D-05/,WT0(230)/ 7.862618353777022D-05/, *WT0(231)/ 8.689536847209423D-05/,WT0(232)/ 9.603423013681158D-05/, *WT0(233)/ 1.061342328695059D-04/,WT0(234)/ 1.172964602657162D-04/, *WT0(235)/ 1.296326268075215D-04/,WT0(236)/ 1.432661958546299D-04/, *WT0(237)/ 1.583336152150400D-04/,WT0(238)/ 1.749856826064412D-04/, *WT0(239)/ 1.933890547221590D-04/,WT0(240)/ 2.137279149064782D-04/, *WT0(241)/ 2.362058162174614D-04/,WT0(242)/ 2.610477181410775D-04/, *WT0(243)/ 2.885022375064333D-04/,WT0(244)/ 3.188441357870562D-04/, *WT0(245)/ 3.523770680013592D-04/,WT0(246)/ 3.894366200728159D-04/, *WT0(247)/ 4.303936656695837D-04/,WT0(248)/ 4.756580748770003D-04/, *WT0(249)/ 5.256828130316798D-04/,WT0(250)/ 5.809684683619367D-04/, *WT0(251)/ 6.420682561143772D-04/,WT0(252)/ 7.095935446942389D-04/, *WT0(253)/ 7.842199637491256D-04/,WT0(254)/ 8.666941465924691D-04/, *WT0(255)/ 9.578411834759010D-04/,WT0(256)/ 1.058572843543458D-03/, *WT0(257)/ 1.169896665384001D-03/,WT0(258)/ 1.292925974983324D-03/, *WT0(259)/ 1.428890965739396D-03/,WT0(260)/ 1.579150889627630D-03/, *WT0(261)/ 1.745207548623177D-03/,WT0(262)/ 1.928720102656342D-03/, *WT0(263)/ 2.131521473093367D-03/,WT0(264)/ 2.355636277673631D-03/, *WT0(265)/ 2.603300731229735D-03/,WT0(266)/ 2.876984272542283D-03/ DATA *WT0(267)/ 3.179413630050106D-03/,WT0(268)/ 3.513598723334281D-03/, *WT0(269)/ 3.882861625673649D-03/,WT0(270)/ 4.290867254031690D-03/, *WT0(271)/ 4.741657973486860D-03/,WT0(272)/ 5.239689338467119D-03/, *WT0(273)/ 5.789870985188969D-03/,WT0(274)/ 6.397607072000340D-03/, *WT0(275)/ 7.068843783102744D-03/,WT0(276)/ 7.810112796625723D-03/, *WT0(277)/ 8.628584975720666D-03/,WT0(278)/ 9.532112534855741D-03/, *WT0(279)/ 1.052928697105230D-02/,WT0(280)/ 1.162947042684567D-02/, *WT0(281)/ 1.284285301027502D-02/,WT0(282)/ 1.418045400408490D-02/, *WT0(283)/ 1.565416842684913D-02/,WT0(284)/ 1.727670025860997D-02/, *WT0(285)/ 1.906157878467033D-02/,WT0(286)/ 2.102295173845023D-02/, *WT0(287)/ 2.317553622087861D-02/,WT0(288)/ 2.553413681316817D-02/, *WT0(289)/ 2.811347056705691D-02/,WT0(290)/ 3.092716134472897D-02/, *WT0(291)/ 3.398734108220733D-02/,WT0(292)/ 3.730266904318316D-02/, *WT0(293)/ 4.087756584601726D-02/,WT0(294)/ 4.470845458227711D-02/, *WT0(295)/ 4.878245655564208D-02/,WT0(296)/ 5.307046388837388D-02/, *WT0(297)/ 5.752521479656082D-02/,WT0(298)/ 6.206888924914453D-02/, *WT0(299)/ 6.659098690582325D-02/,WT0(300)/ 7.092687097703928D-02/, *WT0(301)/ 7.485762155329997D-02/,WT0(302)/ 7.807466421172765D-02/, *WT0(303)/ 8.018887211338042D-02/,WT0(304)/ 8.067640670918657D-02/ DATA *WT0(305)/ 7.891767306422777D-02/,WT0(306)/ 7.412406301630496D-02/, *WT0(307)/ 6.545864753141331D-02/,WT0(308)/ 5.195771725733346D-02/, *WT0(309)/ 3.284797274184859D-02/,WT0(310)/ 7.497076325831270D-03/, *WT0(311)/-2.386612869894549D-02/,WT0(312)/-6.017494378476118D-02/, *WT0(313)/-9.817899798850670D-02/,WT0(314)/-1.328147797272611D-01/, *WT0(315)/-1.554628569772562D-01/,WT0(316)/-1.563982157987450D-01/, *WT0(317)/-1.243049866529050D-01/,WT0(318)/-5.486815986343697D-02/, *WT0(319)/ 4.686255899170307D-02/,WT0(320)/ 1.511218295806206D-01/, *WT0(321)/ 2.119315534410599D-01/,WT0(322)/ 1.695134135887796D-01/, *WT0(323)/ 1.386197420331480D-02/,WT0(324)/-1.869350451838135D-01/, *WT0(325)/-2.455889606925336D-01/,WT0(326)/-5.309269401899814D-02/, *WT0(327)/ 2.519998415798595D-01/,WT0(328)/ 1.968224876057428D-01/, *WT0(329)/-2.014333618969160D-01/,WT0(330)/-2.458450827258603D-01/, *WT0(331)/ 3.433559314076636D-01/,WT0(332)/-4.770066510626292D-02/, *WT0(333)/-2.096628473507452D-01/,WT0(334)/ 2.509085123794248D-01/, *WT0(335)/-1.676412661335192D-01/,WT0(336)/ 7.495199786896762D-02/, *WT0(337)/-1.695135102751146D-02/,WT0(338)/-8.828524201374996D-03/, *WT0(339)/ 1.616787356183550D-02/,WT0(340)/-1.556411755992529D-02/, *WT0(341)/ 1.251311125216370D-02/,WT0(342)/-9.299315246978098D-03/ DATA *WT0(343)/ 6.650525996779493D-03/,WT0(344)/-4.667707408671884D-03/, *WT0(345)/ 3.248885545556855D-03/,WT0(346)/-2.255529108544675D-03/, *WT0(347)/ 1.566875211100915D-03/,WT0(348)/-1.091132486368091D-03/, *WT0(349)/ 7.625383049040949D-04/,WT0(350)/-5.352540577820408D-04/, *WT0(351)/ 3.777104567214670D-04/,WT0(352)/-2.682528211535297D-04/, *WT0(353)/ 1.920265274996755D-04/,WT0(354)/-1.388213723208944D-04/, *WT0(355)/ 1.015998917810005D-04/,WT0(356)/-7.549725062631259D-05/, *WT0(357)/ 5.714172920052936D-05/,WT0(358)/-4.419160967680634D-05/, *WT0(359)/ 3.501776199578583D-05/,WT0(360)/-2.848496954139990D-05/, *WT0(361)/ 2.380104817324115D-05/,WT0(362)/-2.041274924032166D-05/, *WT0(363)/ 1.793363489791860D-05/,WT0(364)/-1.609367780777977D-05/, *WT0(365)/ 1.470394692017765D-05/,WT0(366)/-1.363208540087839D-05/, *WT0(367)/ 1.278540851480116D-05/,WT0(368)/-1.209910323276592D-05/, *WT0(369)/ 1.152780746372085D-05/,WT0(370)/-1.103964249967709D-05/, *WT0(371)/ 1.061214724478712D-05/,WT0(372)/-1.022954672255804D-05/, *WT0(373)/ 9.880801917269063D-06/,WT0(374)/-9.558136268373164D-06/, *WT0(375)/ 9.255989462874843D-06/,WT0(376)/-8.970368039834961D-06/, *WT0(377)/ 8.698439226217636D-06/,WT0(378)/-8.438199899378174D-06/, *WT0(379)/ 8.188185039708096D-06/,WT0(380)/-7.947275976752668D-06/ DATA *WT0(381)/ 7.714620489277084D-06/,WT0(382)/-7.489590334670121D-06/, *WT0(383)/ 7.271712845563131D-06/,WT0(384)/-7.060595202720040D-06/, *WT0(385)/ 6.855890958634290D-06/,WT0(386)/-6.657307826365352D-06/, *WT0(387)/ 6.464610635947412D-06/,WT0(388)/-6.277596705248834D-06/, *WT0(389)/ 6.096069004564178D-06/,WT0(390)/-5.919835014912806D-06/, *WT0(391)/ 5.748721389173238D-06/,WT0(392)/-5.582576428368341D-06/, *WT0(393)/ 5.421255729073172D-06/,WT0(394)/-5.264611483233620D-06/, *WT0(395)/ 5.112497827757443D-06/,WT0(396)/-4.964780650195476D-06/, *WT0(397)/ 4.821336526159266D-06/,WT0(398)/-4.682043530422997D-06/, *WT0(399)/ 4.546777587820041D-06/,WT0(400)/-4.415418000076004D-06/, *WT0(401)/ 4.287852503112911D-06/,WT0(402)/-4.163974668109847D-06/, *WT0(403)/ 4.043678407829827D-06/,WT0(404)/-3.926857526517075D-06/, *WT0(405)/ 3.813409851360361D-06/,WT0(406)/-3.703239239834851D-06/, *WT0(407)/ 3.596252927182967D-06/,WT0(408)/-3.492358600906126D-06/, *WT0(409)/ 3.391465179914198D-06/,WT0(410)/-3.293485431241940D-06/, *WT0(411)/ 3.198336356446399D-06/,WT0(412)/-3.105937110348406D-06/, *WT0(413)/ 3.016207679069661D-06/,WT0(414)/-2.929069911562291D-06/, *WT0(415)/ 2.844448954094881D-06/,WT0(416)/-2.762272935820411D-06/, *WT0(417)/ 2.682471568415877D-06/,WT0(418)/-2.604975709140556D-06/ DATA *WT0(419)/ 2.529718233664062D-06/,WT0(420)/-2.456634690985054D-06/, *WT0(421)/ 2.385662793855871D-06/,WT0(422)/-2.316741584624232D-06/, *WT0(423)/ 2.249811415880699D-06/,WT0(424)/-2.184814552602377D-06/, *WT0(425)/ 2.121695378987067D-06/,WT0(426)/-2.060399926949900D-06/, *WT0(427)/ 2.000875435893980D-06/,WT0(428)/-1.943070483347481D-06/, *WT0(429)/ 1.886935339579619D-06/,WT0(430)/-1.832421953831803D-06/, *WT0(431)/ 1.779483599068986D-06/,WT0(432)/-1.728074671861562D-06/, *WT0(433)/ 1.678150840818710D-06/,WT0(434)/-1.629669220867866D-06/, *WT0(435)/ 1.582588274939725D-06/,WT0(436)/-1.536867577717458D-06/, *WT0(437)/ 1.492467744182388D-06/,WT0(438)/-1.449350544031671D-06/, *WT0(439)/ 1.407478963215944D-06/,WT0(440)/-1.366817091697906D-06/, *WT0(441)/ 1.327329980403758D-06/,WT0(442)/-1.288983628354532D-06/, *WT0(443)/ 1.251745052743577D-06/,WT0(444)/-1.215582289623042D-06/, *WT0(445)/ 1.180464297731392D-06/,WT0(446)/-1.146360878232118D-06/, *WT0(447)/ 1.113242681755176D-06/,WT0(448)/-1.081081241360643D-06/, *WT0(449)/ 1.049848946307979D-06/,WT0(450)/-1.019518969919736D-06/, *WT0(451)/ 9.900652269648073D-07/,WT0(452)/-9.614623823829486D-07/, *WT0(453)/ 9.336858590396268D-07/,WT0(454)/-9.067118039187765D-07/, *WT0(455)/ 8.805170379415897D-07/,WT0(456)/-8.550790335506564D-07/ DATA *WT0(457)/ 8.303759185665738D-07/,WT0(458)/-8.063864695073603D-07/, *WT0(459)/ 7.830900795968434D-07/,WT0(460)/-7.604667251660013D-07/, *WT0(461)/ 7.384969528074763D-07/,WT0(462)/-7.171618775580271D-07/, *WT0(463)/ 6.964431695613518D-07/,WT0(464)/-6.763230273695452D-07/, *WT0(465)/ 6.567841555251206D-07/,WT0(466)/-6.378097555683096D-07/, *WT0(467)/ 6.193835199757372D-07/,WT0(468)/-6.014896169720738D-07/, *WT0(469)/ 5.841126695566173D-07/,WT0(470)/-5.672377400509635D-07/, *WT0(471)/ 5.508503223216395D-07/,WT0(472)/-5.349363333399711D-07/, *WT0(473)/ 5.194820986824491D-07/,WT0(474)/-5.044743364413132D-07/, *WT0(475)/ 4.899001458890472D-07/,WT0(476)/-4.757469999761242D-07/, *WT0(477)/ 4.620027360551677D-07/,WT0(478)/-4.486555431391317D-07/, *WT0(479)/ 4.356939495368206D-07/,WT0(480)/-4.231068139067277D-07/, *WT0(481)/ 4.108833178901058D-07/,WT0(482)/-3.990129570237777D-07/, *WT0(483)/ 3.874855299952715D-07/,WT0(484)/-3.762911289578004D-07/, *WT0(485)/ 3.654201320223786D-07/,WT0(486)/-3.548631961765860D-07/, *WT0(487)/ 3.446112489455190D-07/,WT0(488)/-3.346554794873414D-07/, *WT0(489)/ 3.249873307934947D-07/,WT0(490)/-3.155984931421240D-07/, *WT0(491)/ 3.064808974928670D-07/,WT0(492)/-2.976267081233949D-07/, *WT0(493)/ 2.890283152696976D-07/,WT0(494)/-2.806783286653362D-07/ DATA *WT0(495)/ 2.725695717362821D-07/,WT0(496)/-2.646950756050221D-07/, *WT0(497)/ 2.570480727284082D-07/,WT0(498)/-2.496219907786807D-07/, *WT0(499)/ 2.424104471687142D-07/,WT0(500)/-2.354072438896643D-07/, *WT0(501)/ 2.286063621819694D-07/,WT0(502)/-2.220019570969968D-07/, *WT0(503)/ 2.155883523600859D-07/,WT0(504)/-2.093600356601861D-07/, *WT0(505)/ 2.033116540781646D-07/,WT0(506)/-1.974380094205501D-07/, *WT0(507)/ 1.917340535876188D-07/,WT0(508)/-1.861948842172547D-07/, *WT0(509)/ 1.808157405985162D-07/,WT0(510)/-1.755919996494557D-07/, *WT0(511)/ 1.705191718700136D-07/,WT0(512)/-1.655928973946416D-07/, *WT0(513)/ 1.608089422670497D-07/,WT0(514)/-1.561631948835526D-07/, *WT0(515)/ 1.516516624771349D-07/,WT0(516)/-1.472704676262496D-07/, *WT0(517)/ 1.430158448819191D-07/,WT0(518)/-1.388841375627619D-07/, *WT0(519)/ 1.348717946589134D-07/,WT0(520)/-1.309753677747614D-07/, *WT0(521)/ 1.271915081246862D-07/,WT0(522)/-1.235169636417206D-07/, *WT0(523)/ 1.199485762099940D-07/,WT0(524)/-1.164832789732080D-07/, *WT0(525)/ 1.131180936862105D-07/,WT0(526)/-1.098501281312535D-07/, *WT0(527)/ 1.066765736321394D-07/,WT0(528)/-1.035947026599537D-07/, *WT0(529)/ 1.006018664975167D-07/,WT0(530)/-9.769549295058651D-08/, *WT0(531)/ 9.487308412474974D-08/,WT0(532)/-9.213221428331440D-08/ DATA *WT0(533)/ 8.947052777472484D-08/,WT0(534)/-8.688573700943115D-08/, *WT0(535)/ 8.437562048443172D-08/,WT0(536)/-8.193802086874367D-08/, *WT0(537)/ 7.957084315467929D-08/,WT0(538)/-7.727205286392824D-08/, *WT0(539)/ 7.503967429747869D-08/,WT0(540)/-7.287178883148888D-08/, *WT0(541)/ 7.076653326692979D-08/,WT0(542)/-6.872209823264986D-08/, *WT0(543)/ 6.673672663335082D-08/,WT0(544)/-6.480871213716780D-08/, *WT0(545)/ 6.293639770567428D-08/,WT0(546)/-6.111817417008917D-08/, *WT0(547)/ 5.935247885127626D-08/,WT0(548)/-5.763779421770836D-08/, *WT0(549)/ 5.597264657919956D-08/,WT0(550)/-5.435560481863042D-08/, *WT0(551)/ 5.278527916288309D-08/,WT0(552)/-5.126031999018991D-08/, *WT0(553)/ 4.977941667022704D-08/,WT0(554)/-4.834129643623350D-08/, *WT0(555)/ 4.694472329047102D-08/,WT0(556)/-4.558849694284832D-08/, *WT0(557)/ 4.427145178025873D-08/,WT0(558)/-4.299245586445184D-08/, *WT0(559)/ 4.175040995827635D-08/,WT0(560)/-4.054424658081963D-08/, *WT0(561)/ 3.937292909065092D-08/,WT0(562)/-3.823545079527342D-08/, *WT0(563)/ 3.713083408552377D-08/,WT0(564)/-3.605812959486601D-08/, *WT0(565)/ 3.501641538356351D-08/,WT0(566)/-3.400479614676831D-08/, *WT0(567)/ 3.302240244515663D-08/,WT0(568)/-3.206838995736202D-08/, *WT0(569)/ 3.114193875409117D-08/,WT0(570)/-3.024225259359901D-08/ DATA *WT0(571)/ 2.936855823761587D-08/,WT0(572)/-2.852010478676213D-08/, *WT0(573)/ 2.769616303496246D-08/,WT0(574)/-2.689602484264953D-08/, *WT0(575)/ 2.611900252829978D-08/,WT0(576)/-2.536442827753140D-08/, *WT0(577)/ 2.463165356908288D-08/,WT0(578)/-2.392004861730570D-08/, *WT0(579)/ 2.322900183088905D-08/,WT0(580)/-2.255791928733344D-08/, *WT0(581)/ 2.190622422255186D-08/,WT0(582)/-2.127335653510145D-08/, *WT0(583)/ 2.065877230473273D-08/,WT0(584)/-2.006194332493974D-08/, *WT0(585)/ 1.948235664905881D-08/,WT0(586)/-1.891951414942437D-08/, *WT0(587)/ 1.837293208920017D-08/,WT0(588)/-1.784214070660012D-08/, *WT0(589)/ 1.732668381117887D-08/,WT0(590)/-1.682611839179446D-08/, *WT0(591)/ 1.634001423585344D-08/,WT0(592)/-1.586795355952947D-08/, *WT0(593)/ 1.540953064868929D-08/,WT0(594)/-1.496435151022419D-08/, *WT0(595)/ 1.453203353344868D-08/,WT0(596)/-1.411220516125227D-08/, *WT0(597)/ 1.370450557074419D-08/,WT0(598)/-1.330858436314438D-08/, *WT0(599)/ 1.292410126264865D-08/,WT0(600)/-1.255072582398340D-08/, *WT0(601)/ 1.218813714839246D-08/,WT0(602)/-1.183602360782992D-08/, *WT0(603)/ 1.149408257713515D-08/,WT0(604)/-1.116202017395058D-08/, *WT0(605)/ 1.083955100614394D-08/,WT0(606)/-1.052639792651900D-08/, *WT0(607)/ 1.022229179461678D-08/,WT0(608)/-9.926971245406734D-09/ DATA *WT0(609)/ 9.640182464660921D-09/,WT0(610)/-9.361678970810806D-09/, *WT0(611)/ 9.091221403102823D-09/,WT0(612)/-8.828577315878212D-09/, *WT0(613)/ 8.573520978800615D-09/,WT0(614)/-8.325833182853652D-09/, *WT0(615)/ 8.085301051938885D-09/,WT0(616)/-7.851717859915976D-09/, *WT0(617)/ 7.624882852931747D-09/,WT0(618)/-7.404601076884107D-09/, *WT0(619)/ 7.190683209868762D-09/,WT0(620)/-6.982945399464102D-09/, *WT0(621)/ 6.781209104717332D-09/,WT0(622)/-6.585300942697731D-09/, *WT0(623)/ 6.395052539483568D-09/,WT0(624)/-6.210300385452473D-09/, *WT0(625)/ 6.030885694751333D-09/,WT0(626)/-5.856654268826800D-09/, *WT0(627)/ 5.687456363899640D-09/,WT0(628)/-5.523146562267662D-09/, *WT0(629)/ 5.363583647325650D-09/,WT0(630)/-5.208630482195534D-09/, *WT0(631)/ 5.058153891863612D-09/,WT0(632)/-4.912024548723426D-09/, *WT0(633)/ 4.770116861425010D-09/,WT0(634)/-4.632308866934630D-09/, *WT0(635)/ 4.498482125712853D-09/,WT0(636)/-4.368521619921419D-09/, *WT0(637)/ 4.242315654571151D-09/,WT0(638)/-4.119755761525383D-09/, *WT0(639)/ 4.000736606276379D-09/,WT0(640)/-3.885155897415073D-09/, *WT0(641)/ 3.772914298716528D-09/,WT0(642)/-3.663915343765296D-09/, *WT0(643)/ 3.558065353046999D-09/,WT0(644)/-3.455273353434971D-09/, *WT0(645)/ 3.355451000003056D-09/,WT0(646)/-3.258512500097394D-09/ DATA *WT0(647)/ 3.164374539601736D-09/,WT0(648)/-3.072956211332787D-09/, *WT0(649)/ 2.984178945504153D-09/,WT0(650)/-2.897966442199276D-09/, *WT0(651)/ 2.814244605795313D-09/,WT0(652)/-2.732941481281439D-09/, *WT0(653)/ 2.653987192416816D-09/,WT0(654)/-2.577313881675167D-09/, *WT0(655)/ 2.502855651924429D-09/,WT0(656)/-2.430548509791296D-09/, *WT0(657)/ 2.360330310661908D-09/,WT0(658)/-2.292140705271406D-09/, *WT0(659)/ 2.225921087836540D-09/,WT0(660)/-2.161614545686758D-09/, *WT0(661)/ 2.099165810350450D-09/,WT0(662)/-2.038521210054267D-09/, *WT0(663)/ 1.979628623594711D-09/,WT0(664)/-1.922437435542387D-09/, *WT0(665)/ 1.866898492740427D-09/,WT0(666)/-1.812964062059653D-09/, *WT0(667)/ 1.760587789374176D-09/,WT0(668)/-1.709724659722168D-09/, *WT0(669)/ 1.660330958617607D-09/,WT0(670)/-1.612364234479730D-09/, *WT0(671)/ 1.565783262147887D-09/,WT0(672)/-1.520548007450427D-09/, *WT0(673)/ 1.476619592797189D-09/,WT0(674)/-1.433960263766035D-09/, *WT0(675)/ 1.392533356654690D-09/,WT0(676)/-1.352303266970005D-09/, *WT0(677)/ 1.313235418827548D-09/,WT0(678)/-1.275296235235242D-09/, *WT0(679)/ 1.238453109235514D-09/,WT0(680)/-1.202674375881138D-09/, *WT0(681)/ 1.167929285020692D-09/,WT0(682)/-1.134187974870230D-09/, *WT0(683)/ 1.101421446348478D-09/,WT0(684)/-1.069601538153474D-09/ DATA *WT0(685)/ 1.038700902559248D-09/,WT0(686)/-1.008692981911727D-09/, *WT0(687)/ 9.795519858036667D-10/,WT0(688)/-9.512528689090021D-10/, *WT0(689)/ 9.237713094575600D-10/,WT0(690)/-8.970836883316330D-10/, *WT0(691)/ 8.711670687664494D-10/,WT0(692)/-8.459991766370928D-10/, *WT0(693)/ 8.215583813149323D-10/,WT0(694)/-7.978236770771082D-10/, *WT0(695)/ 7.747746650530930D-10/,WT0(696)/-7.523915356928136D-10/, *WT0(697)/ 7.306550517412669D-10/,WT0(698)/-7.095465317049981D-10/, *WT0(699)/ 6.890478337962292D-10/,WT0(700)/-6.691413403408390D-10/, *WT0(701)/ 6.498099426367938D-10/,WT0(702)/-6.310370262500165D-10/, *WT0(703)/ 6.128064567350563D-10/,WT0(704)/-5.951025657682865D-10/, *WT0(705)/ 5.779101376817111D-10/,WT0(706)/-5.612143963858077D-10/, *WT0(707)/ 5.450009926701687D-10/,WT0(708)/-5.292559918710250D-10/, *WT0(709)/ 5.139658618950525D-10/,WT0(710)/-4.991174615891697D-10/, *WT0(711)/ 4.846980294463296D-10/,WT0(712)/-4.706951726376001D-10/, *WT0(713)/ 4.570968563611062D-10/,WT0(714)/-4.438913934986793D-10/, *WT0(715)/ 4.310674345713248D-10/,WT0(716)/-4.186139579848742D-10/, *WT0(717)/ 4.065202605574395D-10/,WT0(718)/-3.947759483205284D-10/, *WT0(719)/ 3.833709275859127D-10/,WT0(720)/-3.722953962705749D-10/, *WT0(721)/ 3.615398354722752D-10/,WT0(722)/-3.510950012884991D-10/ DATA *WT0(723)/ 3.409519168717552D-10/,WT0(724)/-3.311018647143929D-10/, *WT0(725)/ 3.215363791563124D-10/,WT0(726)/-3.122472391091240D-10/, *WT0(727)/ 3.032264609905071D-10/,WT0(728)/-2.944662918626933D-10/, *WT0(729)/ 2.859592027691788D-10/,WT0(730)/-2.776978822639370D-10/, *WT0(731)/ 2.696752301275724D-10/,WT0(732)/-2.618843512650130D-10/, *WT0(733)/ 2.543185497794985D-10/,WT0(734)/-2.469713232177689D-10/, *WT0(735)/ 2.398363569815098D-10/,WT0(736)/-2.329075189002498D-10/, *WT0(737)/ 2.261788539610461D-10/,WT0(738)/-2.196445791904288D-10/, *WT0(739)/ 2.132990786842053D-10/,WT0(740)/-2.071368987808525D-10/, *WT0(741)/ 2.011527433743496D-10/,WT0(742)/-1.953414693624216D-10/, *WT0(743)/ 1.896980822262837D-10/,WT0(744)/-1.842177317380848D-10/, *WT0(745)/ 1.788957077923634D-10/,WT0(746)/-1.737274363579317D-10/, *WT0(747)/ 1.687084755467094D-10/,WT0(748)/-1.638345117961281D-10/, *WT0(749)/ 1.591013561618254D-10/,WT0(750)/-1.545049407174433D-10/, *WT0(751)/ 1.500413150584345D-10/,WT0(752)/-1.457066429068751D-10/, *WT0(753)/ 1.414971988143619D-10/,WT0(754)/-1.374093649601637D-10/, *WT0(755)/ 1.334396280418735D-10/,WT0(756)/-1.295845762558885D-10/, *WT0(757)/ 1.258408963651246D-10/,WT0(758)/-1.222053708514437D-10/, *WT0(759)/ 1.186748751503467D-10/,WT0(760)/-1.152463749655566D-10/ DATA *WT0(761)/ 1.119169236611821D-10/,WT0(762)/-1.086836597292220D-10/, *WT0(763)/ 1.055438043302322D-10/,WT0(764)/-1.024946589050432D-10/, *WT0(765)/ 9.953360285547502D-11/,WT0(766)/-9.665809129205519D-11/, *WT0(767)/ 9.386565284680683D-11/,WT0(768)/-9.115388754922578D-11/, *WT0(769)/ 8.852046476362457D-11/,WT0(770)/-8.596312118607507D-11/, *WT0(771)/ 8.347965889923978D-11/,WT0(772)/-8.106794348344660D-11/, *WT0(773)/ 7.872590218244558D-11/,WT0(774)/-7.645152212241484D-11/, *WT0(775)/ 7.424284858301879D-11/,WT0(776)/-7.209798331980772D-11/, *WT0(777)/ 7.001508293831718D-11/,WT0(778)/-6.799235732265070D-11/, *WT0(779)/ 6.602806812690510D-11/,WT0(780)/-6.412052735069306D-11/, *WT0(781)/ 6.226809604991307D-11/,WT0(782)/-6.046918330329692D-11/, *WT0(783)/ 5.872224571634798D-11/,WT0(784)/-5.702578811834639D-11/, *WT0(785)/ 5.537836697680089D-11/,WT0(786)/-5.377860007122251D-11/, *WT0(787)/ 5.222519065363231D-11/,WT0(788)/-5.071698520520750D-11/, *WT0(789)/ 4.925310917157278D-11/,WT0(790)/-4.783328375532226D-11/, *WT0(791)/ 4.645856316442775D-11/,WT0(792)/-4.513304831495452D-11/, *WT0(793)/ 4.386786828115582D-11/,WT0(794)/-4.269042848860555D-11/, *WT0(795)/ 4.166589074066043D-11/,WT0(796)/-4.094706131972530D-11/, *WT0(797)/ 4.089025606285087D-11/,WT0(798)/-4.232439520086882D-11/ DATA *WT0(799)/ 4.717597028661840D-11/,WT0(800)/-5.992051472297203D-11/, *WT0(801)/ 9.095360729014628D-11/ C-----WT1(I)=J1 HANKEL TRANSFORM FILTER WEIGHTS FOR I=1,801 DATA *WT1( 1)/-2.377900110058238D-29/,WT1( 2)/ 7.972119293423644D-28/, *WT1( 3)/ 3.832566186338494D-28/,WT1( 4)/ 8.493403321392027D-28/, *WT1( 5)/ 8.232164371695149D-28/,WT1( 6)/ 1.100368717019849D-27/, *WT1( 7)/ 1.325428732821688D-27/,WT1( 8)/ 1.592246428628784D-27/, *WT1( 9)/ 1.998601965098251D-27/,WT1( 10)/ 2.368546581454427D-27/, *WT1( 11)/ 2.979879339217500D-27/,WT1( 12)/ 3.543101964370716D-27/, *WT1( 13)/ 4.425741130789444D-27/,WT1( 14)/ 5.318079447058835D-27/, *WT1( 15)/ 6.555619006665152D-27/,WT1( 16)/ 7.994776219905923D-27/, *WT1( 17)/ 9.707158322300619D-27/,WT1( 18)/ 1.200497993577129D-26/, *WT1( 19)/ 1.440665350963159D-26/,WT1( 20)/ 1.797046711269925D-26/, *WT1( 21)/ 2.145390397713542D-26/,WT1( 22)/ 2.681614737113612D-26/, *WT1( 23)/ 3.203783629081399D-26/,WT1( 24)/ 3.992219752668547D-26/, *WT1( 25)/ 4.793780377063212D-26/,WT1( 26)/ 5.935124745092138D-26/, *WT1( 27)/ 7.177334354418767D-26/,WT1( 28)/ 8.825226769587027D-26/, *WT1( 29)/ 1.073646008000832D-25/,WT1( 30)/ 1.313923424181352D-25/, *WT1( 31)/ 1.603838995307793D-25/,WT1( 32)/ 1.958633055912045D-25/, *WT1( 33)/ 2.393489595056268D-25/,WT1( 34)/ 2.921690713642289D-25/, *WT1( 35)/ 3.570455561097498D-25/,WT1( 36)/ 4.359157800465477D-25/, *WT1( 37)/ 5.325840709133780D-25/,WT1( 38)/ 6.503774912184682D-25/ DATA *WT1( 39)/ 7.944611784834684D-25/,WT1( 40)/ 9.702980761516990D-25/, *WT1( 41)/ 1.185162186264197D-24/,WT1( 42)/ 1.447534903673577D-24/, *WT1( 43)/ 1.768047044621983D-24/,WT1( 44)/ 2.159464672432506D-24/, *WT1( 45)/ 2.637627922624120D-24/,WT1( 46)/ 3.221525590342443D-24/, *WT1( 47)/ 3.934898912364447D-24/,WT1( 48)/ 4.805930563105760D-24/, *WT1( 49)/ 5.870195744781909D-24/,WT1( 50)/ 7.169601400607034D-24/, *WT1( 51)/ 8.757287433857846D-24/,WT1( 52)/ 1.069583032926807D-23/, *WT1( 53)/ 1.306426797568440D-23/,WT1( 54)/ 1.595639689868334D-23/, *WT1( 55)/ 1.948949017485241D-23/,WT1( 56)/ 2.380425857645875D-23/, *WT1( 57)/ 2.907479573699533D-23/,WT1( 58)/ 3.551187751264232D-23/, *WT1( 59)/ 4.337441481530691D-23/,WT1( 60)/ 5.297756660121858D-23/, *WT1( 61)/ 6.470696377141974D-23/,WT1( 62)/ 7.903329008477021D-23/, *WT1( 63)/ 9.653141660115531D-23/,WT1( 64)/ 1.179038165380973D-22/, *WT1( 65)/ 1.440079827014168D-22/,WT1( 66)/ 1.758917653247009D-22/, *WT1( 67)/ 2.148347376559587D-22/,WT1( 68)/ 2.623996157283884D-22/, *WT1( 69)/ 3.204958075285148D-22/,WT1( 70)/ 3.914542160210567D-22/, *WT1( 71)/ 4.781235486108842D-22/,WT1( 72)/ 5.839810952393910D-22/, *WT1( 73)/ 7.132764830587759D-22/,WT1( 74)/ 8.711974589175415D-22/, *WT1( 75)/ 1.064083434862305D-21/,WT1( 76)/ 1.299673924385260D-21/ DATA *WT1( 77)/ 1.587425911126261D-21/,WT1( 78)/ 1.938885693339251D-21/, *WT1( 79)/ 2.368161151141687D-21/,WT1( 80)/ 2.892477586360832D-21/, *WT1( 81)/ 3.532881273577120D-21/,WT1( 82)/ 4.315069519949315D-21/, *WT1( 83)/ 5.270439518682773D-21/,WT1( 84)/ 6.437327295395713D-21/, *WT1( 85)/ 7.862571844418139D-21/,WT1( 86)/ 9.603363814287760D-21/, *WT1( 87)/ 1.172957893208765D-20/,WT1( 88)/ 1.432653521781635D-20/, *WT1( 89)/ 1.749847566646075D-20/,WT1( 90)/ 2.137267893871469D-20/, *WT1( 91)/ 2.610465830070486D-20/,WT1( 92)/ 3.188429016442547D-20/, *WT1( 93)/ 3.894357412134842D-20/,WT1( 94)/ 4.756577134959383D-20/, *WT1( 95)/ 5.809698595129943D-20/,WT1( 96)/ 7.095979207053098D-20/, *WT1( 97)/ 8.667051908059619D-20/,WT1( 98)/ 1.058595695124327D-19/, *WT1( 99)/ 1.292972220966051D-19/,WT1(100)/ 1.579239186764568D-19/, *WT1(101)/ 1.928887914036691D-19/,WT1(102)/ 2.355947994119052D-19/, *WT1(103)/ 2.877562665708650D-19/,WT1(104)/ 3.514661357021616D-19/, *WT1(105)/ 4.292819113549590D-19/,WT1(106)/ 5.243258540458620D-19/, *WT1(107)/ 6.404133671732880D-19/,WT1(108)/ 7.822022466379286D-19/, *WT1(109)/ 9.553844929891425D-19/,WT1(110)/ 1.166908611051965D-18/, *WT1(111)/ 1.425266206309626D-18/,WT1(112)/ 1.740823055783105D-18/, *WT1(113)/ 2.126247365091890D-18/,WT1(114)/ 2.597002781312310D-18/ DATA *WT1(115)/ 3.171988392298073D-18/,WT1(116)/ 3.874272813855638D-18/, *WT1(117)/ 4.732050718776532D-18/,WT1(118)/ 5.779735750225090D-18/, *WT1(119)/ 7.059390282316958D-18/,WT1(120)/ 8.622352349869446D-18/, *WT1(121)/ 1.053137301019041D-17/,WT1(122)/ 1.286303788941302D-17/, *WT1(123)/ 1.571096273151045D-17/,WT1(124)/ 1.918939713846172D-17/, *WT1(125)/ 2.343800282007509D-17/,WT1(126)/ 2.862721583723883D-17/, *WT1(127)/ 3.496539240998871D-17/,WT1(128)/ 4.270678642844850D-17/, *WT1(129)/ 5.216223744747131D-17/,WT1(130)/ 6.371103687921334D-17/, *WT1(131)/ 7.781691646330707D-17/,WT1(132)/ 9.504569536565720D-17/, *WT1(133)/ 1.160892016025935D-16/,WT1(134)/ 1.417915110596655D-16/, *WT1(135)/ 1.731847439832610D-16/,WT1(136)/ 2.115280706868521D-16/, *WT1(137)/ 2.583612876753947D-16/,WT1(138)/ 3.155627883343085D-16/, *WT1(139)/ 3.854297646671823D-16/,WT1(140)/ 4.707643426724462D-16/, *WT1(141)/ 5.749936655677889D-16/,WT1(142)/ 7.022978436839158D-16/, *WT1(143)/ 8.577897883808816D-16/,WT1(144)/ 1.047705221625211D-15/, *WT1(145)/ 1.279672050432180D-15/,WT1(146)/ 1.562992451553929D-15/, *WT1(147)/ 1.909046462722709D-15/,WT1(148)/ 2.331710624424154D-15/, *WT1(149)/ 2.847962809294981D-15/,WT1(150)/ 3.478503311969800D-15/, *WT1(151)/ 4.248661490032314D-15/,WT1(152)/ 5.189316858234294D-15/ DATA *WT1(153)/ 6.338258511920505D-15/,WT1(154)/ 7.741550588468052D-15/, *WT1(155)/ 9.455571172640662D-15/,WT1(156)/ 1.154903563040828D-14/, *WT1(157)/ 1.410605553114248D-14/,WT1(158)/ 1.722913542283047D-14/, *WT1(159)/ 2.104376349301754D-14/,WT1(160)/ 2.570284789891445D-14/, *WT1(161)/ 3.139360843035402D-14/,WT1(162)/ 3.834414037586157D-14/, *WT1(163)/ 4.683376407804295D-14/,WT1(164)/ 5.720273100006960D-14/, *WT1(165)/ 6.986777175159004D-14/,WT1(166)/ 8.533643955954289D-14/, *WT1(167)/ 1.042304766775628D-13/,WT1(168)/ 1.273069965554705D-13/, *WT1(169)/ 1.554936139359936D-13/,WT1(170)/ 1.899197032959808D-13/, *WT1(171)/ 2.319692366825060D-13/,WT1(172)/ 2.833268748946759D-13/, *WT1(173)/ 3.460574729307441D-13/,WT1(174)/ 4.226739834760657D-13/, *WT1(175)/ 5.162571427996572D-13/,WT1(176)/ 6.305554147709428D-13/, *WT1(177)/ 7.701652476024983D-13/,WT1(178)/ 9.406780256740293D-13/, *WT1(179)/ 1.148951682734905D-12/,WT1(180)/ 1.403326528650366D-12/, *WT1(181)/ 1.714034726435434D-12/,WT1(182)/ 2.093516885212530D-12/, *WT1(183)/ 2.557039701256063D-12/,WT1(184)/ 3.123159736572392D-12/, *WT1(185)/ 3.814655555107956D-12/,WT1(186)/ 4.659206104975550D-12/, *WT1(187)/ 5.690798281976283D-12/,WT1(188)/ 6.950717591317659D-12/, *WT1(189)/ 8.489674870123959D-12/,WT1(190)/ 1.036925035218241D-11/ DATA *WT1(191)/ 1.266510893213373D-11/,WT1(192)/ 1.546910089464080D-11/, *WT1(193)/ 1.889412592258518D-11/,WT1(194)/ 2.307718220992490D-11/, *WT1(195)/ 2.818672942203327D-11/,WT1(196)/ 3.442710316037366D-11/, *WT1(197)/ 4.204966817018048D-11/,WT1(198)/ 5.135919134271227D-11/, *WT1(199)/ 6.273074786797763D-11/,WT1(200)/ 7.661889201263122D-11/, *WT1(201)/ 9.358330171196327D-11/,WT1(202)/ 1.143019267753882D-10/, *WT1(203)/ 1.396099167826153D-10/,WT1(204)/ 1.705183920059801D-10/, *WT1(205)/ 2.082735788845278D-10/,WT1(206)/ 2.543834767842491D-10/, *WT1(207)/ 3.107077590612055D-10/,WT1(208)/ 3.794954396016648D-10/, *WT1(209)/ 4.635216515055463D-10/,WT1(210)/ 5.661404892806104D-10/, *WT1(211)/ 6.914932735763221D-10/,WT1(212)/ 8.445820788220271D-10/, *WT1(213)/ 1.031587101304291D-09/,WT1(214)/ 1.259967952077770D-09/, *WT1(215)/ 1.538947681019300D-09/,WT1(216)/ 1.879650592174711D-09/, *WT1(217)/ 2.295841053082368D-09/,WT1(218)/ 2.804108039269473D-09/, *WT1(219)/ 3.424993797807946D-09/,WT1(220)/ 4.183235823312564D-09/, *WT1(221)/ 5.109492567813164D-09/,WT1(222)/ 6.240651650854630D-09/, *WT1(223)/ 7.622470723630660D-09/,WT1(224)/ 9.309953703014609D-09/, *WT1(225)/ 1.137139562283767D-08/,WT1(226)/ 1.388881160360346D-08/, *WT1(227)/ 1.696413754044688D-08/,WT1(228)/ 2.071966056701105D-08/ DATA *WT1(229)/ 2.530753298545001D-08/,WT1(230)/ 3.091008276019684D-08/, *WT1(231)/ 3.775442398336976D-08/,WT1(232)/ 4.611239491146397D-08/, *WT1(233)/ 5.632301501798812D-08/,WT1(234)/ 6.879156104001002D-08/, *WT1(235)/ 8.402411522137500D-08/,WT1(236)/ 1.026248703632157D-07/, *WT1(237)/ 1.253493263032310D-07/,WT1(238)/ 1.530981849317344D-07/, *WT1(239)/ 1.869993328577540D-07/,WT1(240)/ 2.283954331971998D-07/, *WT1(241)/ 2.789703820965002D-07/,WT1(242)/ 3.407255717347445D-07/, *WT1(243)/ 4.161751163160901D-07/,WT1(244)/ 5.083021657140526D-07/, *WT1(245)/ 6.208605585127383D-07/,WT1(246)/ 7.582965471628845D-07/, *WT1(247)/ 9.262152932479593D-07/,WT1(248)/ 1.131243348429578D-06/, *WT1(249)/ 1.381750677989317D-06/,WT1(250)/ 1.687612654971312D-06/, *WT1(251)/ 2.061328504830195D-06/,WT1(252)/ 2.517614221705925D-06/, *WT1(253)/ 3.075136493715169D-06/,WT1(254)/ 3.755823026355034D-06/, *WT1(255)/ 4.587552788474290D-06/,WT1(256)/ 5.602996673366901D-06/, *WT1(257)/ 6.843794758360242D-06/,WT1(258)/ 8.358620144706847D-06/, *WT1(259)/ 1.020967008292656D-05/,WT1(260)/ 1.246945025422475D-05/, *WT1(261)/ 1.523086887102219D-05/,WT1(262)/ 1.860192083272764D-05/, *WT1(263)/ 2.272139580071132D-05/,WT1(264)/ 2.775012613215501D-05/, *WT1(265)/ 3.389544779882663D-05/,WT1(266)/ 4.139684113647092D-05/ DATA *WT1(267)/ 5.056404631634212D-05/,WT1(268)/ 6.175357572143610D-05/, *WT1(269)/ 7.542814171915086D-05/,WT1(270)/ 9.211833800758343D-05/, *WT1(271)/ 1.125153468149895D-04/,WT1(272)/ 1.374085645976000D-04/, *WT1(273)/ 1.678302935465055D-04/,WT1(274)/ 2.049544027080777D-04/, *WT1(275)/ 2.503222397064943D-04/,WT1(276)/ 3.056782429102864D-04/, *WT1(277)/ 3.733227575027256D-04/,WT1(278)/ 4.558456931739724D-04/, *WT1(279)/ 5.566775872841220D-04/,WT1(280)/ 6.796584276296773D-04/, *WT1(281)/ 8.298982533418059D-04/,WT1(282)/ 1.013079388381259D-03/, *WT1(283)/ 1.236799879071809D-03/,WT1(284)/ 1.509444128879166D-03/, *WT1(285)/ 1.842278291863989D-03/,WT1(286)/ 2.247620855799141D-03/, *WT1(287)/ 2.742106207595588D-03/,WT1(288)/ 3.343716405309918D-03/, *WT1(289)/ 4.076852784788600D-03/,WT1(290)/ 4.967507347193811D-03/, *WT1(291)/ 6.051117627655160D-03/,WT1(292)/ 7.364681573940744D-03/, *WT1(293)/ 8.958863753805689D-03/,WT1(294)/ 1.088505212285743D-02/, *WT1(295)/ 1.321388763870185D-02/,WT1(296)/ 1.601387913655473D-02/, *WT1(297)/ 1.937949548174205D-02/,WT1(298)/ 2.339556612555552D-02/, *WT1(299)/ 2.817934173583488D-02/,WT1(300)/ 3.382079060619734D-02/, *WT1(301)/ 4.044464120111045D-02/,WT1(302)/ 4.810974644754662D-02/, *WT1(303)/ 5.689934182811928D-02/,WT1(304)/ 6.675168423575902D-02/ DATA *WT1(305)/ 7.759114407311523D-02/,WT1(306)/ 8.904761297446566D-02/, *WT1(307)/ 1.006540591855666D-01/,WT1(308)/ 1.114010542073269D-01/, *WT1(309)/ 1.200693293287907D-01/,WT1(310)/ 1.245859746888521D-01/, *WT1(311)/ 1.226876554954843D-01/,WT1(312)/ 1.111594205067191D-01/, *WT1(313)/ 8.731995478664586D-02/,WT1(314)/ 4.846500030224664D-02/, *WT1(315)/-4.956156637375708D-03/,WT1(316)/-6.947108182097863D-02/, *WT1(317)/-1.335126953345830D-01/,WT1(318)/-1.795750728565332D-01/, *WT1(319)/-1.819110629504884D-01/,WT1(320)/-1.209847646201776D-01/, *WT1(321)/ 5.791427226916448D-03/,WT1(322)/ 1.534812881363312D-01/, *WT1(323)/ 2.352209731069856D-01/,WT1(324)/ 1.515040026640386D-01/, *WT1(325)/-8.279085782145131D-02/,WT1(326)/-2.711543104015952D-01/, *WT1(327)/-1.331279806376289D-01/,WT1(328)/ 2.242058279665979D-01/, *WT1(329)/ 2.304292248782090D-01/,WT1(330)/-2.572813803130152D-01/, *WT1(331)/-1.475549438192476D-01/,WT1(332)/ 3.611935526731244D-01/, *WT1(333)/-2.435371552288723D-01/,WT1(334)/ 3.811454725614711D-02/, *WT1(335)/ 8.273650321459338D-02/,WT1(336)/-1.091467781119748D-01/, *WT1(337)/ 8.964328522861212D-02/,WT1(338)/-6.097788815932206D-02/, *WT1(339)/ 3.780123181837066D-02/,WT1(340)/-2.243862121105374D-02/, *WT1(341)/ 1.315627818991557D-02/,WT1(342)/-7.789693311677149D-03/ DATA *WT1(343)/ 4.737032461705975D-03/,WT1(344)/-2.996529369596568D-03/, *WT1(345)/ 1.987854486046977D-03/,WT1(346)/-1.386982713556120D-03/, *WT1(347)/ 1.015740041573320D-03/,WT1(348)/-7.763183089745113D-04/, *WT1(349)/ 6.146040263274792D-04/,WT1(350)/-5.002069052247894D-04/, *WT1(351)/ 4.157061680153099D-04/,WT1(352)/-3.508644775971589D-04/, *WT1(353)/ 2.994936403367197D-04/,WT1(354)/-2.577357341490762D-04/, *WT1(355)/ 2.231048844827660D-04/,WT1(356)/-1.939428674265101D-04/, *WT1(357)/ 1.691035669098717D-04/,WT1(358)/-1.477663053511028D-04/, *WT1(359)/ 1.293230643516167D-04/,WT1(360)/-1.133088634015300D-04/, *WT1(361)/ 9.935787087369453D-05/,WT1(362)/-8.717517169548774D-05/, *WT1(363)/ 7.651820346514748D-05/,WT1(364)/-6.718422692060818D-05/, *WT1(365)/ 5.900162548547053D-05/,WT1(366)/-5.182370043717230D-05/, *WT1(367)/ 4.552413144789780D-05/,WT1(368)/-3.999355821930881D-05/, *WT1(369)/ 3.513692405823457D-05/,WT1(370)/-3.087135626461035D-05/, *WT1(371)/ 2.712444449271282D-05/,WT1(372)/-2.383282162264958D-05/, *WT1(373)/ 2.094097402272335D-05/,WT1(374)/-1.840022834334601D-05/, *WT1(375)/ 1.616788131114735D-05/,WT1(376)/-1.420645034584182D-05/, *WT1(377)/ 1.248302592309649D-05/,WT1(378)/-1.096870811434504D-05/, *WT1(379)/ 9.638113747637144D-06/,WT1(380)/-8.468945120923146D-06/ DATA *WT1(381)/ 7.441613142631071D-06/,WT1(382)/-6.538907689594796D-06/, *WT1(383)/ 5.745708304710312D-06/,WT1(384)/-5.048729864716120D-06/, *WT1(385)/ 4.436299286415519D-06/,WT1(386)/-3.898159774165185D-06/, *WT1(387)/ 3.425299055300640D-06/,WT1(388)/-3.009798361246221D-06/, *WT1(389)/ 2.644699605727544D-06/,WT1(390)/-2.323888735130234D-06/, *WT1(391)/ 2.041993364758909D-06/,WT1(392)/-1.794292864274530D-06/, *WT1(393)/ 1.576639283761010D-06/,WT1(394)/-1.385387831873578D-06/, *WT1(395)/ 1.217335820899756D-06/,WT1(396)/-1.069669061011715D-06/, *WT1(397)/ 9.399147533431300D-07/,WT1(398)/-8.259000682217990D-07/, *WT1(399)/ 7.257157398665060D-07/,WT1(400)/-6.376840939530841D-07/, *WT1(401)/ 5.603309658957991D-07/,WT1(402)/-4.923610193285461D-07/, *WT1(403)/ 4.326360479415582D-07/,WT1(404)/-3.801559094539231D-07/, *WT1(405)/ 3.340417795380239D-07/,WT1(406)/-2.935214398955969D-07/, *WT1(407)/ 2.579163472426386D-07/,WT1(408)/-2.266302675538730D-07/, *WT1(409)/ 1.991392901933410D-07/,WT1(410)/-1.749830560542944D-07/, *WT1(411)/ 1.537570500204901D-07/,WT1(412)/-1.351058266793548D-07/, *WT1(413)/ 1.187170569339987D-07/,WT1(414)/-1.043162975874935D-07/, *WT1(415)/ 9.166239627647569D-08/,WT1(416)/-8.054345360702865D-08/, *WT1(417)/ 7.077327442848185D-08/,WT1(418)/-6.218824944698919D-08/ DATA *WT1(419)/ 5.464461550533503D-08/,WT1(420)/-4.801604844364623D-08/, *WT1(421)/ 4.219154778426137D-08/,WT1(422)/-3.707357778095240D-08/, *WT1(423)/ 3.257643398813585D-08/,WT1(424)/-2.862480813390940D-08/, *WT1(425)/ 2.515252712714758D-08/,WT1(426)/-2.210144493659511D-08/, *WT1(427)/ 1.942046882050334D-08/,WT1(428)/-1.706470371165871D-08/, *WT1(429)/ 1.499470045020363D-08/,WT1(430)/-1.317579520863365D-08/, *WT1(431)/ 1.157752900730261D-08/,WT1(432)/-1.017313762883149D-08/, *WT1(433)/ 8.939103427741988D-09/,WT1(434)/-7.854761525494339D-09/, *WT1(435)/ 6.901953769038680D-09/,WT1(436)/-6.064724650448546D-09/, *WT1(437)/ 5.329054110861765D-09/,WT1(438)/-4.682622765482983D-09/, *WT1(439)/ 4.114605612289784D-09/,WT1(440)/-3.615490760147216D-09/, *WT1(441)/ 3.176920140880805D-09/,WT1(442)/-2.791549544501460D-09/, *WT1(443)/ 2.452925636291220D-09/,WT1(444)/-2.155377892876758D-09/, *WT1(445)/ 1.893923644634260D-09/,WT1(446)/-1.664184635389759D-09/, *WT1(447)/ 1.462313704613378D-09/,WT1(448)/-1.284930364574083D-09/, *WT1(449)/ 1.129064192077534D-09/,WT1(450)/-9.921050860675488D-10/, *WT1(451)/ 8.717595588633507D-10/,WT1(452)/-7.660123299045589D-10/, *WT1(453)/ 6.730925786777026D-10/,WT1(454)/-5.914442910883912D-10/, *WT1(455)/ 5.197002025874266D-10/,WT1(456)/-4.566589020735369D-10/ DATA *WT1(457)/ 4.012647133825055D-10/,WT1(458)/-3.525900173049568D-10/, *WT1(459)/ 3.098197178898629D-10/,WT1(460)/-2.722375929324441D-10/, *WT1(461)/ 2.392143002251476D-10/,WT1(462)/-2.101968387708856D-10/, *WT1(463)/ 1.846992883946521D-10/,WT1(464)/-1.622946726187645D-10/, *WT1(465)/ 1.426078085707891D-10/,WT1(466)/-1.253090242443995D-10/, *WT1(467)/ 1.101086379038488D-10/,WT1(468)/-9.675210714907983D-11/, *WT1(469)/ 8.501576639446501D-11/,WT1(470)/-7.470308140061063D-11/, *WT1(471)/ 6.564135815534322D-11/,WT1(472)/-5.767885098561786D-11/, *WT1(473)/ 5.068222145975428D-11/,WT1(474)/-4.453430552590912D-11/, *WT1(475)/ 3.913215150436401D-11/,WT1(476)/-3.438529608259476D-11/, *WT1(477)/ 3.021424943923932D-11/,WT1(478)/-2.654916412468056D-11/, *WT1(479)/ 2.332866540856460D-11/,WT1(480)/-2.049882351089608D-11/, *WT1(481)/ 1.801225050660065D-11/,WT1(482)/-1.582730677850963D-11/, *WT1(483)/ 1.390740372895185D-11/,WT1(484)/-1.222039107416370D-11/, *WT1(485)/ 1.073801846245205D-11/,WT1(486)/-9.435462400371624D-12/, *WT1(487)/ 8.290910564095319D-12/,WT1(488)/-7.285196534694753D-12/, *WT1(489)/ 6.401478841143664D-12/,WT1(490)/-5.624958936714699D-12/, *WT1(491)/ 4.942633385892820D-12/,WT1(492)/-4.343076111680976D-12/, *WT1(493)/ 3.816247056854583D-12/,WT1(494)/-3.353324055246731D-12/ DATA *WT1(495)/ 2.946555097697522D-12/,WT1(496)/-2.589128518642891D-12/, *WT1(497)/ 2.275058929421262D-12/,WT1(498)/-1.999086988193079D-12/, *WT1(499)/ 1.756591328117270D-12/,WT1(500)/-1.543511168961402D-12/, *WT1(501)/ 1.356278316168970D-12/,WT1(502)/-1.191757408630524D-12/, *WT1(503)/ 1.047193414582761D-12/,WT1(504)/-9.201654964381461D-13/, *WT1(505)/ 8.085464719703853D-13/,WT1(506)/-7.104671929827940D-13/, *WT1(507)/ 6.242852449483966D-13/,WT1(508)/-5.485574434836370D-13/, *WT1(509)/ 4.820156670945356D-13/,WT1(510)/-4.235456214910329D-13/, *WT1(511)/ 3.721681798548054D-13/,WT1(512)/-3.270229865892332D-13/, *WT1(513)/ 2.873540499880031D-13/,WT1(514)/-2.524970825616983D-13/, *WT1(515)/ 2.218683770237039D-13/,WT1(516)/-1.949550316531413D-13/, *WT1(517)/ 1.713063613517743D-13/,WT1(518)/-1.505263505679493D-13/, *WT1(519)/ 1.322670217058939D-13/,WT1(520)/-1.162226079680830D-13/, *WT1(521)/ 1.021244330498886D-13/,WT1(522)/-8.973641194353509D-14/, *WT1(523)/ 7.885109750931469D-14/,WT1(524)/-6.928620661062564D-14/, *WT1(525)/ 6.088156763982168D-14/,WT1(526)/-5.349643831874401D-14/, *WT1(527)/ 4.700714885865928D-14/,WT1(528)/-4.130503101260246D-14/, *WT1(529)/ 3.629459834036019D-14/,WT1(530)/-3.189194721306437D-14/, *WT1(531)/ 2.802335178098858D-14/,WT1(532)/-2.462402937628328D-14/ DATA *WT1(533)/ 2.163705567637205D-14/,WT1(534)/-1.901241146150821D-14/, *WT1(535)/ 1.670614500365970D-14/,WT1(536)/-1.467963606029139D-14/, *WT1(537)/ 1.289894914807883D-14/,WT1(538)/-1.133426526661138D-14/, *WT1(539)/ 9.959382555826870D-15/,WT1(540)/-8.751277525286314D-15/, *WT1(541)/ 7.689719507742115D-15/,WT1(542)/-6.756931880732829D-15/, *WT1(543)/ 5.937294383089198D-15/,WT1(544)/-5.217081541398457D-15/, *WT1(545)/ 4.584232826172386D-15/,WT1(546)/-4.028150688809716D-15/, *WT1(547)/ 3.539523097325829D-15/,WT1(548)/-3.110167599068186D-15/, *WT1(549)/ 2.732894299122300D-15/,WT1(550)/-2.401385459874979D-15/, *WT1(551)/ 2.110089705537303D-15/,WT1(552)/-1.854129059999304D-15/, *WT1(553)/ 1.629217261290832D-15/,WT1(554)/-1.431587984759346D-15/, *WT1(555)/ 1.257931773006046D-15/,WT1(556)/-1.105340616423372D-15/, *WT1(557)/ 9.712592562913251D-16/,WT1(558)/-8.534423949641643D-16/, *WT1(559)/ 7.499170965983152D-16/,WT1(560)/-6.589497487925016D-16/, *WT1(561)/ 5.790170318870357D-16/,WT1(562)/-5.087804097802586D-16/, *WT1(563)/ 4.470637150906226D-16/,WT1(564)/-3.928334533103688D-16/, *WT1(565)/ 3.451814961285280D-16/,WT1(566)/-3.033098741093958D-16/, *WT1(567)/ 2.665174140678718D-16/,WT1(568)/-2.341879973739602D-16/, *WT1(569)/ 2.057802425625493D-16/,WT1(570)/-1.808184394757190D-16/ DATA *WT1(571)/ 1.588845831226758D-16/,WT1(572)/-1.396113738580090D-16/, *WT1(573)/ 1.226760666607451D-16/,WT1(574)/-1.077950665155628D-16/, *WT1(575)/ 9.471917939160380D-17/,WT1(576)/-8.322943929278698D-17/, *WT1(577)/ 7.313344150029316D-17/,WT1(578)/-6.426212060448496D-17/, *WT1(579)/ 5.646691937188211D-17/,WT1(580)/-4.961730103765172D-17/, *WT1(581)/ 4.359856336499476D-17/,WT1(582)/-3.830991786613391D-17/, *WT1(583)/ 3.366280201995165D-17/,WT1(584)/-2.957939622304163D-17/, *WT1(585)/ 2.599132063935437D-17/,WT1(586)/-2.283849012615860D-17/, *WT1(587)/ 2.006810806115271D-17/,WT1(588)/-1.763378222157133D-17/, *WT1(589)/ 1.549474790998944D-17/,WT1(590)/-1.361518531745643D-17/, *WT1(591)/ 1.196361969267083D-17/,WT1(592)/-1.051239427255871D-17/, *WT1(593)/ 9.237207148064648D-18/,WT1(594)/-8.116704309607398D-18/, *WT1(595)/ 7.132122057424711D-18/,WT1(596)/-6.266972788687375D-18/, *WT1(597)/ 5.506768899643017D-18/,WT1(598)/-4.838780179316216D-18/, *WT1(599)/ 4.251820632131413D-18/,WT1(600)/-3.736061159634172D-18/, *WT1(601)/ 3.282864964518770D-18/,WT1(602)/-2.884642920675208D-18/, *WT1(603)/ 2.534726487315339D-18/,WT1(604)/-2.227256039024718D-18/, *WT1(605)/ 1.957082741736910D-18/,WT1(606)/-1.719682331465223D-18/, *WT1(607)/ 1.511079351949921D-18/,WT1(608)/-1.327780582522198D-18/ DATA *WT1(609)/ 1.166716541382233D-18/,WT1(610)/-1.025190084716866D-18/, *WT1(611)/ 9.008312409083032D-19/,WT1(612)/-7.915575234972099D-19/, *WT1(613)/ 6.955390583093758D-19/,WT1(614)/-6.111679407722684D-19/, *WT1(615)/ 5.370313102870695D-19/,WT1(616)/-4.718876907676534D-19/, *WT1(617)/ 4.146462011511975D-19/,WT1(618)/-3.643482877427443D-19/, *WT1(619)/ 3.201516724850009D-19/,WT1(620)/-2.813162483527929D-19/, *WT1(621)/ 2.471916856791182D-19/,WT1(622)/-2.172065418717432D-19/, *WT1(623)/ 1.908586921555019D-19/,WT1(624)/-1.677069210972190D-19/, *WT1(625)/ 1.473635341074691D-19/,WT1(626)/-1.294878651921690D-19/, *WT1(627)/ 1.137805722345515D-19/,WT1(628)/-9.997862427642855D-20/, *WT1(629)/ 8.785089685693581D-20/,WT1(630)/-7.719430165048124D-20/, *WT1(631)/ 6.783038559324186D-20/,WT1(632)/-5.960234254861157D-20/, *WT1(633)/ 5.237238746867620D-20/,WT1(634)/-4.601944907799879D-20/, *WT1(635)/ 4.043714244041481D-20/,WT1(636)/-3.553198745789200D-20/, *WT1(637)/ 3.122184346997662D-20/,WT1(638)/-2.743453374142427D-20/, *WT1(639)/ 2.410663680492846D-20/,WT1(640)/-2.118242441910240D-20/, *WT1(641)/ 1.861292835641397D-20/,WT1(642)/-1.635512039302220D-20/, *WT1(643)/ 1.437119176831859D-20/,WT1(644)/-1.262792004764438D-20/, *WT1(645)/ 1.109611278531706D-20/,WT1(646)/-9.750118671903616D-21/ DATA *WT1(647)/ 8.567397980805881D-21/,WT1(648)/-7.528145122423124D-21/, *WT1(649)/ 6.614956985587211D-21/,WT1(650)/-5.812541511365789D-21/, *WT1(651)/ 5.107461617652140D-21/,WT1(652)/-4.487910185482492D-21/, *WT1(653)/ 3.943512339081440D-21/,WT1(654)/-3.465151709308229D-21/, *WT1(655)/ 3.044817771736880D-21/,WT1(656)/-2.675471703023044D-21/, *WT1(657)/ 2.350928509369901D-21/,WT1(658)/-2.065753454081455D-21/, *WT1(659)/ 1.815171050414263D-21/,WT1(660)/-1.594985094847466D-21/, *WT1(661)/ 1.401508399670877D-21/,WT1(662)/-1.231501046949432D-21/, *WT1(663)/ 1.082116130537259D-21/,WT1(664)/-9.508520796066248D-22/, *WT1(665)/ 8.355107675059663D-22/,WT1(666)/-7.341607053512435D-22/, *WT1(667)/ 6.451047024956878D-22/,WT1(668)/-5.668514489455267D-22/, *WT1(669)/ 4.980905412312518D-22/,WT1(670)/-4.376705343564336D-22/, *WT1(671)/ 3.845796559678223D-22/,WT1(672)/-3.379288625754182D-22/, *WT1(673)/ 2.969369534739024D-22/,WT1(674)/-2.609174906141295D-22/, *WT1(675)/ 2.292673041856001D-22/,WT1(676)/-2.014563919875952D-22/, *WT1(677)/ 1.770190438740656D-22/,WT1(678)/-1.555460422525817D-22/, *WT1(679)/ 1.366778079672955D-22/,WT1(680)/-1.200983777985825D-22/, *WT1(681)/ 1.055301137906078D-22/,WT1(682)/-9.272905558580399D-23/, *WT1(683)/ 8.148083664639517D-23/,WT1(684)/-7.159709489187570D-23/ DATA *WT1(685)/ 6.291231754727859D-23/,WT1(686)/-5.528106802589832D-23/, *WT1(687)/ 4.857554932085610D-23/,WT1(688)/-4.268346388064600D-23/, *WT1(689)/ 3.750613425528731D-23/,WT1(690)/-3.295685226039235D-23/, *WT1(691)/ 2.895942787876105D-23/,WT1(692)/-2.544691315369192D-23/, *WT1(693)/ 2.236048039475426D-23/,WT1(694)/-1.964843688844607D-23/, *WT1(695)/ 1.726535979915737D-23/,WT1(696)/-1.517133602902566D-23/, *WT1(697)/ 1.333129356639782D-23/,WT1(698)/-1.171441336528463D-23/, *WT1(699)/ 1.029361299133160D-23/,WT1(700)/-9.045094266181886D-24/, *WT1(701)/ 7.947947207266389D-24/,WT1(702)/-6.983802597398395D-24/, *WT1(703)/ 6.136526075969871D-24/,WT1(704)/-5.391947793289710D-24/, *WT1(705)/ 4.737623457434066D-24/,WT1(706)/-4.162624052945447D-24/, *WT1(707)/ 3.657351341563861D-24/,WT1(708)/-3.213375054547230D-24/, *WT1(709)/ 2.823287629843971D-24/,WT1(710)/-2.480574676640252D-24/, *WT1(711)/ 2.179502108849238D-24/,WT1(712)/-1.915020796639139D-24/, *WT1(713)/ 1.682686753114865D-24/,WT1(714)/-1.478592609598710D-24/, *WT1(715)/ 1.299306570857684D-24/,WT1(716)/-1.141816901768704D-24/, *WT1(717)/ 1.003481245022785D-24/,WT1(718)/-8.819804660957208D-25/, *WT1(719)/ 7.752768477813106D-25/,WT1(720)/-6.815767858002522D-25/, *WT1(721)/ 5.992985900665248D-25/,WT1(722)/-5.270459063734392D-25/ DATA *WT1(723)/ 4.635862411179793D-25/,WT1(724)/-4.078328923510551D-25/, *WT1(725)/ 3.588287019442058D-25/,WT1(726)/-3.157312905756895D-25/, *WT1(727)/ 2.778003181153750D-25/,WT1(728)/-2.443872105993099D-25/, *WT1(729)/ 2.149270912330287D-25/,WT1(730)/-1.889318548953116D-25/, *WT1(731)/ 1.659828344765530D-25/,WT1(732)/-1.457219798327836D-25/, *WT1(733)/ 1.278418979568063D-25/,WT1(734)/-1.120761165538443D-25/, *WT1(735)/ 9.819063583398694D-26/,WT1(736)/-8.597706957547351D-26/, *WT1(737)/ 7.524761802539771D-26/,WT1(738)/-6.583229692872437D-26/, *WT1(739)/ 5.757815308418353D-26/,WT1(740)/-5.034908817517119D-26/, *WT1(741)/ 4.402475606598968D-26/,WT1(742)/-3.849819197101101D-26/, *WT1(743)/ 3.367329111558304D-26/,WT1(744)/-2.946341179122434D-26/, *WT1(745)/ 2.579121784723996D-26/,WT1(746)/-2.258873118181162D-26/, *WT1(747)/ 1.979667076757990D-26/,WT1(748)/-1.736329567227616D-26/, *WT1(749)/ 1.524356928842631D-26/,WT1(750)/-1.339878795333426D-26/, *WT1(751)/ 1.179604582048012D-26/,WT1(752)/-1.040714749090827D-26/, *WT1(753)/ 9.207194488904074D-27/,WT1(754)/-8.173124929559144D-27/, *WT1(755)/ 7.282515970348745D-27/,WT1(756)/-6.513100644712918D-27/, *WT1(757)/ 5.843030126248539D-27/,WT1(758)/-5.251393008101120D-27/, *WT1(759)/ 4.718791967930222D-27/,WT1(760)/-4.228406914229241D-27/ DATA *WT1(761)/ 3.767695474750273D-27/,WT1(762)/-3.329913400113583D-27/, *WT1(763)/ 2.914300433863011D-27/,WT1(764)/-2.524366823406565D-27/, *WT1(765)/ 2.164690315762398D-27/,WT1(766)/-1.837673402805216D-27/, *WT1(767)/ 1.542301736687901D-27/,WT1(768)/-1.275894419058812D-27/, *WT1(769)/ 1.037166283039543D-27/,WT1(770)/-8.274817350070647D-28/, *WT1(771)/ 6.490942784063843D-28/,WT1(772)/-5.023466637656253D-28/, *WT1(773)/ 3.845211097313078D-28/,WT1(774)/-2.909163620505845D-28/, *WT1(775)/ 2.167800946716682D-28/,WT1(776)/-1.587457861911164D-28/, *WT1(777)/ 1.153739423502031D-28/,WT1(778)/-8.690036418978894D-29/, *WT1(779)/ 7.435572366263697D-29/,WT1(780)/-7.847142831542739D-29/, *WT1(781)/ 9.894985212873060D-29/,WT1(782)/-1.342720280592225D-28/, *WT1(783)/ 1.817424273402145D-28/,WT1(784)/-2.376361960950870D-28/, *WT1(785)/ 2.977819810711053D-28/,WT1(786)/-3.586836968065507D-28/, *WT1(787)/ 4.184476666502118D-28/,WT1(788)/-4.766085106688037D-28/, *WT1(789)/ 5.328777445258146D-28/,WT1(790)/-5.858824985834212D-28/, *WT1(791)/ 6.329409859706737D-28/,WT1(792)/-6.709268971860476D-28/, *WT1(793)/ 6.975416172179417D-28/,WT1(794)/-7.122929261229363D-28/, *WT1(795)/ 7.167821355397955D-28/,WT1(796)/-7.142209321177599D-28/, *WT1(797)/ 7.084785743816030D-28/,WT1(798)/-7.032486471839363D-28/ DATA *WT1(799)/ 7.017650479151096D-28/,WT1(800)/-7.069608472164614D-28/, *WT1(801)/ 7.214920505613761D-28/ C NOFUN1=0 C-----ERROR CHECKS IF(NB.LT.1.OR.NREL.LT.1.OR.BMAX.LE.0.0D0) GO TO 9999 Y=BMAX*ER**(NB-1) IF(Y.LE.0.0D0) GO TO 9999 IERR=0 C-----INITIALIZE RELATED CONVOLUTION WITHIN LAGGED CONVOLUTION LOOPS DO 10 I=1,801 10 KEY(I)=0 NB1=NB+1 LAG=-1 C-----PRESET INITIAL FILTER ABSCISSA FOR STARTING BMAX, THE ARGUMENT C USED IN THE EXTERNAL FUNCTION FUN1(G). NOTE THE ABSCISSAS C ARE EQUALLY SPACED (E=DEXP(.1D0), ER=1.0D0/E) IN LOG-SPACE. Y1=ABSCIS/BMAX C-----LAGGED CONVOLUTION, OUTERMOST LOOP 1010 DO 1010 ILAG=1,NB LAG=LAG+1 ISTORE=NB1-ILAG IF(LAG.GT.0) Y1=Y1*E ARG(ISTORE)=ABSCIS/Y1 C-------RELATED CONVOLUTION, INNERMOST LOOP 1000 DO 1000 JREL=1,NREL C---------SPECIAL CASE FLAG NONE=1 IS SET IF FUN1(G)=0 FOR ALL G IN C FILTER FIXED RANGE (USING WEIGHTS 229-339). NONE=0 ITOL=NTOL DSUM=0.0D0 CMAX=0.0D0 Y=Y1 C---------BEGIN RIGHT SIDE CONVOLUTION AT WEIGHT 299 (M=RETURN LABEL) ASSIGN 20 TO M I=299 Y=Y*E C---------CALL PSEUDO SUBROUTINE AT 100 (RETURN TO 20 VIA M ASSIGNED) GO TO 100 20 CMAX=DMAX1(DABS(C),CMAX) I=I+1 Y=Y*E C---------CALL PSEUDO SUBROUTINE AT 100 (RETURN TO 20 VIA M ASSIGNED) IF(I.LE.339) GO TO 100 IF(CMAX.EQ.0.0D0) NONE=1 C---------ESTABLISH TRUNCATION CRITERION CMAX=TOL*CMAX ASSIGN 30 TO M C---------CALL PSEUDO SUBROUTINE AT 100 (RETURN TO 30 VIA M ASSIGNED) GO TO 100 C---------CHECK FOR FILTER TRUNCATION AT RIGHT END 30 IF(DABS(C).LE.CMAX) GO TO 50 ITOL=NTOL 40 I=I+1 Y=Y*E C---------CALL PSEUDO SUBROUTINE AT 100 (RETURN TO 30 VIA M ASSIGNED) IF(I.LE.801) GO TO 100 50 ITOL=ITOL-1 IF(ITOL.GT.0.AND.I.LT.801) GO TO 40 ITOL=NTOL Y=Y1 C---------CONTINUE WITH LEFT SIDE CONVOLUTION AT WEIGHT 298 ASSIGN 60 TO M I=298 C---------CALL PSEUDO SUBROUTINE AT 100 (RETURN TO 60 VIA M ASSIGNED) GO TO 100 C---------CHECK FOR FILTER TRUNCATION AT LEFT END 60 IF(DABS(C).LE.CMAX.AND.NONE.EQ.0) GO TO 80 ITOL=NTOL 70 I=I-1 Y=Y*ER C---------CALL PSEUDO SUBROUTINE AT 100 (RETURN TO 60 VIA M ASSIGNED) IF(I.GT.0) GO TO 100 80 ITOL=ITOL-1 IF(ITOL.GT.0.AND.I.GT.1) GO TO 70 C---------NORMALIZE DSUM BY ARG(ISTORE) TO ACCOUNT FOR INTEGRATION C RANGE CHANGE, AND STORE IN DANS(ISTORE,JREL) DANS(ISTORE,JREL)=DSUM/ARG(ISTORE) C---------SKIP OVER PSEUDO SUBROUTINE TO END OF DO 1000 INNERMOST LOOP GO TO 1000 C C======================================================================= C=====STORE/RETRIEVE PSEUDO SUBROUTINE FOR RELATED/LAGGED CONVOLUTION. C THE INTERNAL (PSEUDO) SUBROUTINE ENTRY IS LABEL 100, AND RETURNS C TO THE LABEL ASSIGNED TO M. THIS CALLING MECHANISM COULD OCCUR C A MAXIMUM OF 801*NB*NREL TIMES, WHERE PARAMETERS NB>0 AND NREL>0 C CAN BE ARBITRARILY LARGE. IF A MORE-STRUCTURED STANDARD FORTRAN C SUBROUTINE CALL WAS USED, THEN THE USUAL COMPILER LINKAGE C CONVENTION COULD GENERATE A MAXIMUM OF 801*NB*NREL MACHINE- C LANGUAGE INSTRUCTIONS FOR REGISTER SAVES/RESTORES AND OTHER C MEMORY REFERENCES. FOR MOST COMPILERS, TIMING TESTS REVEAL THAT C THE PSEUDO-CALL METHOD USED HERE GENERATED FASTER MACHINE CODE C THAN WITH USING EXTERNAL SUBROUTINE CALLS (E.G., CALL LINKAGE C VERSUS PSEUDO-CALL RATIO WAS 2.6:1 ON A VAX-11/780 USING C NB=50,NREL=61, AND NOFUN1=199). C C=========PSEUDO-CALL ENTRY POINT AT 100 (RETURNS VIA GO TO M BELOW) 100 LOOK=I+LAG IQ=LOOK/802 IR=MOD(LOOK,802) IF(IR.EQ.0) IR=1 IROLL=IQ*801 IF(KEY(IR).LE.IROLL) GO TO 150 C=========USE EXISTING SAVED FUNCTIONAL VALUES IN DWORK(IR,JREL) 110 IF(NORD(JREL)) 130,120,130 120 C=DWORK(IR,JREL)*WT0(I) GO TO 140 130 C=DWORK(IR,JREL)*WT1(I) 140 DSUM=DSUM+C C=========RETURN CONVOLUTION CONTROL VIA ASSIGNED M VALUE, AND WITH C THE LAST CONVOLUTION PRODUCT (C) GO TO M,(20,30,60) C=========COMPUTE EXTERNAL FUN1 DIRECTLY ONLY WHEN NECESSARY 150 KEY(IR)=IROLL+IR G=Y DWORK(IR,1)=FUN1(G) NOFUN1=NOFUN1+1 IF(NREL.EQ.1) GO TO 110 C=========FILL-IN REMAINING RELATED DWORK(IR,J),J=2,NREL FOR THIS IR DO 160 J=2,NREL C***********FOR OTHER THAN SIMPLE RELATIONS, THE FOLLOWING STATEMENT C COULD BE CHANGED (AND ALSO THE MEANING OF IJREL(2,NREL)). 160 DWORK(IR,J)=(G**IJREL(1,J))*DWORK(IR,1)**IJREL(2,J) GO TO 110 C=========END OF PSEUDO SUBROUTINE (ENTRY 100, RETURN GO TO M ABOVE) C======================================================================= C C-------END LOOP 1000 (GET REMAINING RELATED CONVOLUTIONS FOR THIS ARG) 1000 CONTINUE C-----END LOOP 1010 (GET REMAINING LAGGED CONVOLUTIONS FOR NEXT ARG) 1010 CONTINUE C-----EXIT WITH DANS(NB,NREL),ARG(NB) COMPLETED WITH MINIMAL FUN1 CALLS RETURN 9999 IERR=1 RETURN END C=======================================================================DHT1 10 C DHANKL TEST 1D (DRIVER PROGRAM 1D TO TEST SUBPROGRAM DHANKL). DHT1 20 C=======================================================================DHT1 30 C THIS PROGRAM USES ONLY A PRINTER OUTPUT FILE ON FORTRAN UNIT 06. DHT1 40 C DHT1 50 C TEST DATA ARE PRESTORED IN DATA STATEMENTS FOR EVALUATING HANKEL DHT1 60 C TRANSFORMS OF ORDERS N=0 OR 1 OF THE FORM-- DHT1 70 C INTEGRAL FROM 0 TO INFINITY OF FUN(G)*JN(G*B)*DG, B.GT.0.0D0 DHT1 80 C DHT1 90 C THE METHOD IS BY ADAPTIVE RELATED AND LAGGED CONVOLUTION AS DHT1 100 C DESCRIBED IN SUBROUTINE DHANKL (CASE 4). DHT1 110 C DHT1 120 C THE FOLLOWING (DOUBLE PRECISION) TEST INTEGRALS ARE EVALUATED FOR DHT1 130 C BMAX=1000.D0,NB=50,NREL=3,NTOL=1, AND TOL=0.D0 (SEE DATA STATEMENTS).DHT1 140 C DHT1 150 C INTEGRAL N INPUT FUNCTION RELATED INPUT EXACT RESULT OF INTEGRAL DHT1 160 C ======== = ================= ============== ======================== DHT1 170 C DHT1 180 C 1 1 K1=EXP(-G) (NONE) (R-1.)/(B*R),R=SQRT(1.+B*B)DHT1 190 C 2 1 K2=G*EXP(-3.*G) K2=G*K1**3 B/(9.+B*B)**1.5 DHT1 200 C 3 0 K3=G*G*EXP(-3.*G) K3=G**2*K1**3 (18.-B*B)/(9.+B*B)**2.5 DHT1 210 C DHT1 220 C SUBPROGRAMS CALLED ARE DHANKL AND DFUNT1 (WHICH CALLS DEXPM). DHT1 230 C DHT1 240 C NOTE(1). THE USE OF DIFFERENT COMPUTERS AND WORD LENGTHS MAY PRODUCE DHT1 250 C DIFFERENT ROUND-OFF, RESULTING IN A DIFFERENT NUMBER OF DHT1 260 C DFUNT1 CALLS NEEDED FOR THE GIVEN TOLERANCE (0 IN THIS CASE)DHT1 270 C DHT1 280 C NOTE(2). THE USER SHOULD INSERT A CALL TO SUPPRESS EXPONENT UNDERFLOWDHT1 290 C MESSAGES (AND TO SET THE RESULT TO 0.0D0) FOR THE MACHINE DHT1 300 C SYSTEM BEING USED. SEE ERROR CONDITION(2) IN SUBPROGRAM DHT1 310 C DHANKL. DHT1 320 C DHT1 330 C NOTE(3). BECAUSE DHANKL USES DIGITAL FILTERS SAMPLED AT 0.1D0 (AND DHT1 340 C ******* HANKEL AT 0.2) IN LOG-SPACE, THE RESULTS FROM DHANKL TEST 1DDHT1 350 C AND HANKEL TEST 1 ARE SPACED DIFFERENTLY IN ARG(I),I=1,NB. DHT1 360 C HOWEVER, THE RESULTS CAN BE COMPARED EVERY OTHER LINE GOING DHT1 370 C BACKWARDS FROM ARG(NB)=BMAX=1000.D0 IN DHANKL TEST 1D. DHT1 380 C=======================================================================DHT1 390 C DHT1 400 C-----STORAGE FOR NB=50, NREL=3 DHT1 410 DOUBLE PRECISION BMAX,TOL,DWORK(801,3),DANS(50,3),ARG(50), DHT1 420 1 DB,BB,DROOT,EXACT,RELERR(3) DHT1 430 INTEGER NORD(3),IJREL(2,3) DHT1 440 C-----NAME OF EXTERNAL DOUBLE PRECISION FUNCTION DFUNT1(G) USED HERE. DHT1 450 EXTERNAL DFUNT1 DHT1 460 C-----THE FOLLOWING DATA STATEMENTS ARE USED TO PRESET SPECIFIC DHT1 470 C PARAMETERS USED IN CALLING SUBROUTINE DHANKL FOR THIS EXAMPLE. DHT1 480 DATA NORD(1),NORD(2),NORD(3)/1,1,0/, DHT1 490 * IJREL(1,1),IJREL(2,1)/0,0/, DHT1 500 * IJREL(1,2),IJREL(2,2)/1,3/, DHT1 510 * IJREL(1,3),IJREL(2,3)/2,3/, DHT1 520 * TOL/0.0D0/,NTOL/1/,BMAX/1000.0D0/,NB/50/,NREL/3/ DHT1 530 C-----GET ALL NB*NREL HANKEL TRANSFORMS VIA CALL DHANKL DHT1 540 CALL DHANKL(BMAX,NB,NREL,TOL,NTOL,NORD,DFUNT1,IJREL,DWORK,DANS, DHT1 550 * ARG,NOFUN1,IERR) DHT1 560 C-----CHECK IERR RETURNED BEFORE PROCEEDING DHT1 570 IF(IERR.EQ.1) STOP DHT1 580 C-----OUTPUT TEST DATA AND RESULTS TO UNIT 06 (PRINT FILE) DHT1 590 WRITE(6,1) BMAX,NB,NREL,TOL,NTOL,NOFUN1,IERR, DHT1 600 * (J,NORD(J),IJREL(1,J),IJREL(2,J),J=1,NREL) DHT1 610 1 FORMAT(1H1,48X,27HD H A N K L T E S T 1 D// DHT1 620 * 7H BMAX=,D16.8,5H NB=,I4,7H NREL=,I4,6H TOL=,D16.8,7H NTOL=,DHT1 630 * I4,23X,9H NOFUN1=,I6,7H IERR=,I1// DHT1 640 * 3X,34HJ NORD(J) IJREL(1,J) IJREL(2,J)/3(2X,I2,5X,I1,7X,I3,9X, DHT1 650 * I3/),3X,1HI,4X,6HARG(I),10X, DHT1 660 * 9HDANS(I,1),4X,17H(RELATIVE ERROR ),4X,9HDANS(I,2),4X, DHT1 670 * 17H(RELATIVE ERROR ),4X,9HDANS(I,3),4X,17H(RELATIVE ERROR )/) DHT1 680 C-----COMPUTE EXACT VALUES AND TEMPORARY STORE IN DWORK(1,I),I=1,3 DHT1 690 DO 4 I=1,NB DHT1 700 DB=ARG(I) DHT1 710 BB=DB*DB DHT1 720 DWORK(1,1)=(1.0D0-1.0D0/DSQRT(1.0D0+BB))/DB DHT1 730 DROOT=DSQRT(9.0D0+BB) DHT1 740 DWORK(1,2)=DB/DROOT**3 DHT1 750 DWORK(1,3)=(18.0D0-BB)/DROOT**5 DHT1 760 C-------COMPUTE RESPECTIVE RELATIVE ERRORS AND STORE IN RELERR(J) DHT1 770 DO 2 J=1,NREL DHT1 780 EXACT=DWORK(1,J) DHT1 790 2 RELERR(J)=DABS(DANS(I,J)-EXACT)/EXACT DHT1 800 WRITE(6,3) I,ARG(I),(DANS(I,J),RELERR(J),J=1,3) DHT1 810 3 FORMAT(1X,I3,D16.8,3(D16.8,2H (,D15.8,1H))) DHT1 820 4 CONTINUE DHT1 830 STOP DHT1 840 END DHT1 850 DOUBLE PRECISION FUNCTION DFUNT1(G) DFU1 10 C-----EXTERNAL FUNCTION USED IN DHANKL TEST 1D. DFUNT1 CALLS DEXPM, C A MACHINE DEPENDENT DEXP FUNCTION TO AVOID UNDERFLOW. DOUBLE PRECISION G,DEXPM DFUNT1=DEXPM(-G) RETURN END DOUBLE PRECISION FUNCTION DEXPM(X) DEXM 10 C-----DEXPM(X) IS A MACHINE-DEPENDENT DEXP-FUNCTION TO AVOID UNDERFLOW. C XMIN SHOULD BE CHANGED FOR THE MACHINE BEING USED. FOR EXAMPLE, C MACHINE XMIN C ----------------------- C VAX-11 -89.416 C DEC-10 -88.028 C IBM/360 -180.218 C CDC-6600 -675.84 C DOUBLE PRECISION X,XMIN DATA XMIN/-89.416D0/ IF(X.LE.XMIN) GO TO 20 DEXPM=DEXP(X) 10 RETURN 20 DEXPM=0.0D0 GO TO 10 END