C ALGORITHM 757, COLLECTED ALGORITHMS FROM ACM. C THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE, C VOL. 22, NO. 3, September, 1996, P. 288--301. C #! /bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #! /bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create the files: # Doc # Drivers # Src # This archive created: Wed Sep 25 11:38:43 1996 export PATH; PATH=/bin:$PATH if test ! -d 'Doc' then mkdir 'Doc' fi cd 'Doc' if test -f 'machcon.txt' then echo shar: will not over-write existing file "'machcon.txt'" else cat << \SHAR_EOF > 'machcon.txt' This file contains specimen values for the parameters EPS, EPSNEG, XMAX, and XMIN which are used to define the machine-dependent parameters in MISCFUN. The values are all taken from the paper "MACHAR: A Subroutine to Dynamically Determine Machine Parameters", by W.J. Cody, ACM Trans. Math. Soft., vol. 14, 1988, pp 303-311. MACHINE EPS EPSNEG XMIN XMAX AD100 1.82E-12 9.09E-13 6.19E-617 8.07E+615 ALLIANT FX/8 1.19E-7 5.96E-8 1.18E-38 3.40E+38 2.22D-16 1.11D-16 2.23D-308 1.79D+308 BBN BUTTERFLY As ALLIANT FX/8 CRAY 1,CRAY X-MT 7.11E-15 7.11E-15 4.58E-2467 5.45E+2465 (CIVIC compiler) 2.52D-29 2.52D-29 4.58D-2467 5.45D+2465 CYBER 180/855 3.55E-15 7.11E-15 3.14E-294 1.26E+322 DAP-510-8 9.54E-7 5.96E-8 5.40E-79 7.23E+75 ELXSI 6400 1.19E-7 5.96E-8 1.18E-38 3.40E+38 (EMBOS) 2.22D-16 1.11D-16 2.23D-308 1.79D+308 ENCORE MULTIMAX as ELSXI IBM 3033 9.54E-7 5.96E-8 5.40E-79 7.23E+75 2.22D-16 1.39D-17 5.40D-79 7.23D+75 3.08Q-33 1.93Q-34 5.40Q-79 7.23Q+75 IEEE machines as ELXSI INTEL iPSC as ELXSI HYPERCUBE MACINTOSH 2 as ELXSI SEQUENT BALANCE as ELXSI SUN machines as ELXSI VAX 11/780 5.96E-8 5.96E-8 2.94E-39 1.70E+38 1.39D-17 1.39D-17 2.94D-39 1.70D+38 (G-FORMAT) 1.11D-16 1.11D-16 5.57D-309 8.98D+307 SHAR_EOF fi # end of overwriting check cd .. if test ! -d 'Drivers' then mkdir 'Drivers' fi cd 'Drivers' if test ! -d 'Dp' then mkdir 'Dp' fi cd 'Dp' if test -f 'driver.f' then echo shar: will not over-write existing file "'driver.f'" else cat << \SHAR_EOF > 'driver.f' PROGRAM TEST C C This program tests the 37 functions in the file MISCFUN. C It is a fairly simple code with each function being tested C at 20 different arguments. The code compares the value C from the function with a pre-computed value, and produces C the absolute and relative errors. C C The function codes are contained in he file MISCFUN.F. These C MUST be changed to double precision form, appended to this C file, and the complete program compiled. C C The program is written in double-precision Fortran 77. For C single-precision tests use the file MSCTSTSP.F C C The variable IOUT is used to direct the program output C and is set to the standard value 6. For other output streams C change the data statement. C C Author: Allan MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C INTEGER I,IOUT DOUBLE PRECISION ABSERR,COMP,DEN,NUM,PT,RELERR,RES DOUBLE PRECISION AB0DAT(3,20),AB1DAT(3,20), & AB2DAT(3,20),AIIDAT(3,20),AGIDAT(3,20), & AHIDAT(3,20),ATNDAT(3,20),BIIDAT(3,20),CLNDAT(3,20), & DB1DAT(3,20),DB2DAT(3,20),DB3DAT(3,20),DB4DAT(3,20), & EX3DAT(3,20),GSTDAT(3,20),I0IDAT(3,20),IL0DAT(3,20), & IL1DAT(3,20),J0IDAT(3,20),K0IDAT(3,20),LOBDAT(3,20), & STRDAT(3,20),SH0DAT(3,20),SH1DAT(3,20),SL0DAT(3,20), & SL1DAT(3,20),SY1DAT(3,20),SY2DAT(3,20),TR2DAT(3,20), & TR3DAT(3,20),TR4DAT(3,20),TR5DAT(3,20),TR6DAT(3,20), & TR7DAT(3,20),TR8DAT(3,20),TR9DAT(3,20),Y0IDAT(3,20) DOUBLE PRECISION ABRAM0,ABRAM1,ABRAM2,AIRINT,AIRYGI,AIRYHI, & ATNINT,BIRINT,CLAUSN,DEBYE1,DEBYE2,DEBYE3,DEBYE4, & EXP3,GOODST,I0INT,I0ML0,I1ML1,J0INT,K0INT,LOBACH, & STROM,STRVH0,STRVH1,STRVL0,STRVL1,SYNCH1,SYNCH2, & TRAN02,TRAN03,TRAN04,TRAN05,TRAN06,TRAN07,TRAN08, & TRAN09,Y0INT CHARACTER*6 FNAME DATA IOUT/6/ DATA AB0DAT/1.0D0, 512.0D0, 0.87377726306985360531D0, & 1.0D0, 128.0D0, 0.84721859650456925922D0, & 1.0D0, 32.0D0, 0.77288934483988301615D0, & 1.0D0, 8.0D0, 0.59684345853450151603D0, & 1.0D0, 2.0D0, 0.29871735283675888392D0, & 1.0D0, 1.0D0, 0.15004596450516388138D0, & 5.0D0, 4.0D0, 0.11114662419157955096D0, & 3.0D0, 2.0D0, 0.83909567153151897766D-1, & 15.0D0, 8.0D0, 0.56552321717943417515D-1, & 2.0D0, 1.0D0, 0.49876496603033790206D-1, & 17.0D0, 8.0D0, 0.44100889219762791328D-1, & 3.0D0, 1.0D0, 0.19738535180254062496D-1, & 4.0D0, 1.0D0, 0.86193088287161479900D-2, & 5.0D0, 1.0D0, 0.40224788162540127227D-2, & 6.0D0, 1.0D0, 0.19718658458164884826D-2, & 7.0D0, 1.0D0, 0.10045868340133538505D-2, & 10.0D0, 1.0D0, 0.15726917263304498649D-3, & 15.0D0, 1.0D0, 0.10352666912350263437D-4, & 20.0D0, 1.0D0, 0.91229759190956745069D-6, & 40.0D0, 1.0D0, 0.25628287737952698742D-9/ DATA AB1DAT/1.0D0, 512.0D0, 0.49828219848799921792D0, & 1.0D0, 128.0D0, 0.49324391773047288556D0, & 1.0D0, 32.0D0, 0.47431612784691234649D0, & 1.0D0, 8.0D0, 0.41095983258760410149D0, & 1.0D0, 2.0D0, 0.25317617388227035867D0, & 1.0D0, 1.0D0, 0.14656338138597777543D0, & 5.0D0, 4.0D0, 0.11421547056018366587D0, & 3.0D0, 2.0D0, 0.90026307383483764795D-1, & 15.0D0, 8.0D0, 0.64088214170742303375D-1, & 2.0D0, 1.0D0, 0.57446614314166191085D-1, & 17.0D0, 8.0D0, 0.51581624564800730959D-1, & 3.0D0, 1.0D0, 0.25263719555776416016D-1, & 4.0D0, 1.0D0, 0.11930803330196594536D-1, & 5.0D0, 1.0D0, 0.59270542280915272465D-2, & 6.0D0, 1.0D0, 0.30609215358017829567D-2, & 7.0D0, 1.0D0, 0.16307382136979552833D-2, & 10.0D0, 1.0D0, 0.28371851916959455295D-3, & 15.0D0, 1.0D0, 0.21122150121323238154D-4, & 20.0D0, 1.0D0, 0.20344578892601627337D-5, & 40.0D0, 1.0D0, 0.71116517236209642290D-9/ DATA AB2DAT/1.0D0, 512.0D0, 0.44213858162107913430D0, & 1.0D0, 128.0D0, 0.43923379545684026308D0, & 1.0D0, 32.0D0, 0.42789857297092602234D0, & 1.0D0, 8.0D0, 0.38652825661854504406D0, & 1.0D0, 2.0D0, 0.26538204413231368110D0, & 1.0D0, 1.0D0, 0.16848734838334595000D0, & 5.0D0, 4.0D0, 0.13609200032513227112D0, & 3.0D0, 2.0D0, 0.11070330027727917352D0, & 15.0D0, 8.0D0, 0.82126019995530382267D-1, & 2.0D0, 1.0D0, 0.74538781999594581763D-1, & 17.0D0, 8.0D0, 0.67732034377612811390D-1, & 3.0D0, 1.0D0, 0.35641808698811851022D-1, & 4.0D0, 1.0D0, 0.17956589956618269083D-1, & 5.0D0, 1.0D0, 0.94058737143575370625D-2, & 6.0D0, 1.0D0, 0.50809356204299213556D-2, & 7.0D0, 1.0D0, 0.28149565414209719359D-2, & 10.0D0, 1.0D0, 0.53808696422559303431D-3, & 15.0D0, 1.0D0, 0.44821756380146327259D-4, & 20.0D0, 1.0D0, 0.46890678427324100410D-5, & 40.0D0, 1.0D0, 0.20161544850996420504D-8/ DATA AIIDAT/-12.0D0, 1.0D0, -0.75228838916610124300D0, & -11.0D0, 1.0D0, -0.57348350185854889466D0, & -10.0D0, 1.0D0, -0.76569840313421291743D0, & -19.0D0, 2.0D0, -0.65181015505382467421D0, & -9.0D0, 1.0D0, -0.55881974894471876922D0, & -13.0D0, 2.0D0, -0.56902352870716815309D0, & -4.0D0, 1.0D0, -0.47800749642926168100D0, & -1.0D0, 1.0D0, -0.46567398346706861416D0, & -1.0D0, 4.0D0, -0.96783140945618013679D-1, & -1.0D0, 1024.0D0, -0.34683049857035607494D-3, & 1.0D0, 1024.0D0, 0.34658366917927930790D-3, & 1.0D0, 128.0D0, 0.27657581846051227124D-2, & 1.0D0, 2.0D0, 0.14595330491185717833D0, & 1.0D0, 1.0D0, 0.23631734191710977960D0, & 4.0D0, 1.0D0, 0.33289264538612212697D0, & 9.0D0, 2.0D0, 0.33318759129779422976D0, & 6.0D0, 1.0D0, 0.33332945170523851439D0, & 8.0D0, 1.0D0, 0.33333331724248357420D0, & 10.0D0, 1.0D0, 0.33333333329916901594D0, & 12.0D0, 1.0D0, 0.33333333333329380187D0/ DATA AGIDAT/-1.0D0, 512.0D0, 0.20468308070040542435D0, & -1.0D0, 8.0D0, 0.18374662832557904078D0, & -1.0D0, 1.0D0, -0.11667221729601528265D0, & -4.0D0, 1.0D0, 0.31466934902729557596D0, & -8.0D0, 1.0D0, -0.37089040722426257729D0, & -33.0D0, 4.0D0, -0.25293059772424019694D0, & -9.0D0, 1.0D0, 0.28967410658692701936D0, & -10.0D0, 1.0D0, -0.34644836492634090590D0, & -11.0D0, 1.0D0, 0.28076035913873049496D0, & -13.0D0, 1.0D0, 0.21814994508094865815D0, & 1.0D0, 512.0D0, 0.20526679000810503329D0, & 1.0D0, 8.0D0, 0.22123695363784773258D0, & 1.0D0, 1.0D0, 0.23521843981043793760D0, & 4.0D0, 1.0D0, 0.82834303363768729338D-1, & 7.0D0, 1.0D0, 0.45757385490989281893D-1, & 29.0D0, 4.0D0, 0.44150012014605159922D-1, & 8.0D0, 1.0D0, 0.39951133719508907541D-1, & 9.0D0, 1.0D0, 0.35467706833949671483D-1, & 10.0D0, 1.0D0, 0.31896005100679587981D-1, & 12.0D0, 1.0D0, 0.26556892713512410405D-1/ DATA AHIDAT/-1.0D0, 512.0D0, 0.40936798278458884024D0, & -1.0D0, 8.0D0, 0.37495291608048868619D0, & -1.0D0, 1.0D0, 0.22066960679295989454D0, & -4.0D0, 1.0D0, 0.77565356679703713590D-1, & -8.0D0, 1.0D0, 0.39638826473124717315D-1, & -33.0D0, 4.0D0, 0.38450072575004151871D-1, & -9.0D0, 1.0D0, 0.35273216868317898556D-1, & -10.0D0, 1.0D0, 0.31768535282502272742D-1, & -11.0D0, 1.0D0, 0.28894408288051391369D-1, & -13.0D0, 1.0D0, 0.24463284011678541180D-1, & 1.0D0, 512.0D0, 0.41053540139998941517D0, & 1.0D0, 8.0D0, 0.44993502381204990817D0, & 1.0D0, 1.0D0, 0.97220515514243332184D0, & 4.0D0, 1.0D0, 0.83764237105104371193D2, & 7.0D0, 1.0D0, 0.80327744952044756016D5, & 29.0D0, 4.0D0, 0.15514138847749108298D6, & 8.0D0, 1.0D0, 0.11995859641733262114D7, & 9.0D0, 1.0D0, 0.21472868855967642259D8, & 10.0D0, 1.0D0, 0.45564115351632913590D9, & 12.0D0, 1.0D0, 0.32980722582904761929D12/ DATA ATNDAT/1.0D0, 512.0D0, 0.19531241721588483191D-2, & -1.0D0, 256.0D0, -0.39062433772980711281D-2, & 1.0D0, 128.0D0, 0.78124470192576499535D-2, & 1.0D0, 64.0D0, 0.15624576181996527280D-1, & -1.0D0, 32.0D0, -0.31246610349485401551D-1, & 1.0D0, 16.0D0, 0.62472911335014397321D-1, & 1.0D0, 8.0D0, 0.12478419717389654039D0, & -1.0D0, 4.0D0, -0.24830175098230686908D0, & 1.0D0, 2.0D0, 0.48722235829452235711D0, & 1.0D0, 1.0D0, 0.91596559417721901505D0, & 3.0D0, 2.0D0, 0.12749694484943800618D1, & -2.0D0, 1.0D0, -0.15760154034463234224D1, & 4.0D0, 1.0D0, 0.24258878412859089996D1, & 8.0D0, 1.0D0, 0.33911633326292997361D1, & 16.0D0, 1.0D0, 0.44176450919422186583D1, & -20.0D0, 1.0D0, -0.47556713749547247774D1, & 25.0D0, 1.0D0, 0.50961912150934111303D1, & 30.0D0, 1.0D0, 0.53759175735714876256D1, & -50.0D0, 1.0D0, -0.61649904785027487422D1, & 100.0D0, 1.0D0, 0.72437843013083534973D1/ DATA BIIDAT/-12.0D0, 1.0D0, 0.17660819031554631869D-1, & -10.0D0, 1.0D0, -0.15040424806140020451D-1, & -8.0D0, 1.0D0, 0.14756446293227661920D-1, & -15.0D0, 2.0D0, -0.11847304264848446271D0, & -7.0D0, 1.0D0, -0.64916741266165856037D-1, & -13.0D0, 2.0D0, 0.97260832464381044540D-1, & -4.0D0, 1.0D0, 0.50760058495287539119D-1, & -1.0D0, 1.0D0, -0.37300500963429492179D0, & -1.0D0, 4.0D0, -0.13962988442666578531D0, & -1.0D0, 512.0D0, -0.12001735266723296160D-2, & 1.0D0, 512.0D0, 0.12018836117890354598D-2, & 1.0D0, 2.0D0, 0.36533846550952011043D0, & 1.0D0, 1.0D0, 0.87276911673800812196D0, & 4.0D0, 1.0D0, 0.48219475263803429675D2, & 8.0D0, 1.0D0, 0.44006525804904178439D6, & 17.0D0, 2.0D0, 0.17608153976228301458D7, & 9.0D0, 1.0D0, 0.73779211705220007228D7, & 10.0D0, 1.0D0, 0.14780980310740671617D9, & 12.0D0, 1.0D0, 0.97037614223613433849D11, & 14.0D0, 1.0D0, 0.11632737638809878460D15/ DATA CLNDAT/1.0D0, 512.0D0, 0.14137352886760576684D-1, & 1.0D0, 32.0D0, 0.13955467081981281934D0, & -1.0D0, 8.0D0, -0.38495732156574238507D0, & 1.0D0, 2.0D0, 0.84831187770367927099D0, & 1.0D0, 1.0D0, 0.10139591323607685043D1, & -3.0D0, 2.0D0, -0.93921859275409211003D0, & 2.0D0, 1.0D0, 0.72714605086327924743D0, & 5.0D0, 2.0D0, 0.43359820323553277936D0, & -3.0D0, 1.0D0, -0.98026209391301421161D-1, & 4.0D0, 1.0D0, -0.56814394442986978080D0, & 17.0D0, 4.0D0, -0.70969701784448921625D0, & -5.0D0, 1.0D0, 0.99282013254695671871D0, & 11.0D0, 2.0D0, -0.98127747477447367875D0, & 6.0D0, 1.0D0, -0.64078266570172320959D0, & 8.0D0, 1.0D0, 0.86027963733231192456D0, & -10.0D0, 1.0D0, 0.39071647608680211043D0, & 15.0D0, 1.0D0, 0.47574793926539191502D0, & 20.0D0, 1.0D0, 0.10105014481412878253D1, & -30.0D0, 1.0D0, 0.96332089044363075154D0, & 50.0D0, 1.0D0, -0.61782699481929311757D0/ DATA DB1DAT/1.0D0, 512.0D0, 0.99951182471380889183D0, & 1.0D0, 32.0D0, 0.99221462647120597836D0, & 1.0D0, 8.0D0, 0.96918395997895308324D0, & 1.0D0, 2.0D0, 0.88192715679060552968D0, & 1.0D0, 1.0D0, 0.77750463411224827642D0, & 3.0D0, 2.0D0, 0.68614531078940204342D0, & 2.0D0, 1.0D0, 0.60694728460981007205D0, & 5.0D0, 2.0D0, 0.53878956907785587703D0, & 3.0D0, 1.0D0, 0.48043521957304283829D0, & 4.0D0, 1.0D0, 0.38814802129793784501D0, & 17.0D0, 4.0D0, 0.36930802829242526815D0, & 5.0D0, 1.0D0, 0.32087619770014612104D0, & 11.0D0, 2.0D0, 0.29423996623154246701D0, & 6.0D0, 1.0D0, 0.27126046678502189985D0, & 8.0D0, 1.0D0, 0.20523930310221503723D0, & 10.0D0, 1.0D0, 0.16444346567994602563D0, & 15.0D0, 1.0D0, 0.10966194482735821276D0, & 20.0D0, 1.0D0, 0.82246701178200016086D-1, & 30.0D0, 1.0D0, 0.54831135561510852445D-1, & 50.0D0, 1.0D0, 0.32898681336964528729D-1/ DATA DB2DAT/1.0D0, 512.0D0, 0.99934911727904599738D0, & 1.0D0, 32.0D0, 0.98962402299599181205D0, & 1.0D0, 8.0D0, 0.95898426200345986743D0, & 1.0D0, 2.0D0, 0.84372119334725358934D0, & 1.0D0, 1.0D0, 0.70787847562782928288D0, & 3.0D0, 2.0D0, 0.59149637225671282917D0, & 2.0D0, 1.0D0, 0.49308264399053185014D0, & 5.0D0, 2.0D0, 0.41079413579749669069D0, & 3.0D0, 1.0D0, 0.34261396060786351671D0, & 4.0D0, 1.0D0, 0.24055368752127897660D0, & 17.0D0, 4.0D0, 0.22082770061202308232D0, & 5.0D0, 1.0D0, 0.17232915939014138975D0, & 11.0D0, 2.0D0, 0.14724346738730182894D0, & 6.0D0, 1.0D0, 0.12666919046715789982D0, & 8.0D0, 1.0D0, 0.74268805954862854626D-1, & 10.0D0, 1.0D0, 0.47971498020121871622D-1, & 15.0D0, 1.0D0, 0.21369201683658373846D-1, & 20.0D0, 1.0D0, 0.12020564476446432799D-1, & 30.0D0, 1.0D0, 0.53424751249537071952D-2, & 50.0D0, 1.0D0, 0.19232910450553508562D-2/ DATA DB3DAT/1.0D0, 512.0D0, 0.99926776885985461940D0, & 1.0D0, 32.0D0, 0.98833007755734698212D0, & 1.0D0, 8.0D0, 0.95390610472023510237D0, & 1.0D0, 2.0D0, 0.82496296897623372315D0, & 1.0D0, 1.0D0, 0.67441556407781468010D0, & 3.0D0, 2.0D0, 0.54710665141286285468D0, & 2.0D0, 1.0D0, 0.44112847372762418113D0, & 5.0D0, 2.0D0, 0.35413603481042394211D0, & 3.0D0, 1.0D0, 0.28357982814342246206D0, & 4.0D0, 1.0D0, 0.18173691382177474795D0, & 17.0D0, 4.0D0, 0.16277924385112436877D0, & 5.0D0, 1.0D0, 0.11759741179993396450D0, & 11.0D0, 2.0D0, 0.95240802723158889887D-1, & 6.0D0, 1.0D0, 0.77581324733763020269D-1, & 8.0D0, 1.0D0, 0.36560295673194845002D-1, & 10.0D0, 1.0D0, 0.19295765690345489563D-1, & 15.0D0, 1.0D0, 0.57712632276188798621D-2, & 20.0D0, 1.0D0, 0.24352200674805479827D-2, & 30.0D0, 1.0D0, 0.72154882216335666096D-3, & 50.0D0, 1.0D0, 0.15585454565440389896D-3/ DATA DB4DAT/1.0D0, 512.0D0, 0.99921896192761576256D0, & 1.0D0, 32.0D0, 0.98755425280996071022D0, & 1.0D0, 8.0D0, 0.95086788606389739976D0, & 1.0D0, 2.0D0, 0.81384569172034042516D0, & 1.0D0, 1.0D0, 0.65487406888673697092D0, & 3.0D0, 2.0D0, 0.52162830964878715188D0, & 2.0D0, 1.0D0, 0.41189273671788528876D0, & 5.0D0, 2.0D0, 0.32295434858707304628D0, & 3.0D0, 1.0D0, 0.25187863642883314410D0, & 4.0D0, 1.0D0, 0.15185461258672022043D0, & 17.0D0, 4.0D0, 0.13372661145921413299D0, & 5.0D0, 1.0D0, 0.91471377664481164749D-1, & 11.0D0, 2.0D0, 0.71227828197462523663D-1, & 6.0D0, 1.0D0, 0.55676547822738862783D-1, & 8.0D0, 1.0D0, 0.21967566525574960096D-1, & 10.0D0, 1.0D0, 0.96736755602711590082D-2, & 15.0D0, 1.0D0, 0.19646978158351837850D-2, & 20.0D0, 1.0D0, 0.62214648623965450200D-3, & 30.0D0, 1.0D0, 0.12289514092077854510D-3, & 50.0D0, 1.0D0, 0.15927210319002161231D-4/ DATA EX3DAT/1.0D0, 512.0D0, 0.19531249963620212007D-2, & 1.0D0, 128.0D0, 0.78124990686775522671D-2, & 1.0D0, 32.0D0, 0.31249761583499728667D-1, & 1.0D0, 8.0D0, 0.12493899888803079984D0, & 1.0D0, 2.0D0, 0.48491714311363971332D0, & 1.0D0, 1.0D0, 0.80751118213967145286D0, & 5.0D0, 4.0D0, 0.86889265412623270696D0, & 3.0D0, 2.0D0, 0.88861722235357162648D0, & 15.0D0, 8.0D0, 0.89286018500218176869D0, & 2.0D0, 1.0D0, 0.89295351429387631138D0, & 17.0D0, 8.0D0, 0.89297479112737843939D0, & 18.0D0, 8.0D0, 0.89297880579798112220D0, & 5.0D0, 2.0D0, 0.89297950317496621294D0, & 11.0D0, 4.0D0, 0.89297951152951902903D0, & 3.0D0, 1.0D0, 0.89297951156918122102D0, & 25.0D0, 8.0D0, 0.89297951156924734716D0, & 13.0D0, 4.0D0, 0.89297951156924917298D0, & 7.0D0, 2.0D0, 0.89297951156924921121D0, & 15.0D0, 4.0D0, 0.89297951156924921122D0, & 4.0D0, 1.0D0, 0.89297951156924921122D0/ DATA GSTDAT/1.0D0, 512.0D0, 0.59531540040441651584D1, & 1.0D0, 128.0D0, 0.45769601268624494109D1, & 1.0D0, 32.0D0, 0.32288921331902217638D1, & 1.0D0, 8.0D0, 0.19746110873568719362D1, & 1.0D0, 2.0D0, 0.96356046208697728563D0, & 1.0D0, 1.0D0, 0.60513365250334458174D0, & 5.0D0, 4.0D0, 0.51305506459532198016D0, & 3.0D0, 2.0D0, 0.44598602820946133091D0, & 15.0D0, 8.0D0, 0.37344458206879749357D0, & 2.0D0, 1.0D0, 0.35433592884953063055D0, & 17.0D0, 8.0D0, 0.33712156518881920994D0, & 5.0D0, 2.0D0, 0.29436170729362979176D0, & 3.0D0, 1.0D0, 0.25193499644897222840D0, & 7.0D0, 2.0D0, 0.22028778222123939276D0, & 4.0D0, 1.0D0, 0.19575258237698917033D0, & 9.0D0, 2.0D0, 0.17616303166670699424D0, & 5.0D0, 1.0D0, 0.16015469479664778673D0, & 23.0D0, 4.0D0, 0.14096116876193391066D0, & 6.0D0, 1.0D0, 0.13554987191049066274D0, & 7.0D0, 1.0D0, 0.11751605060085098084D0/ DATA I0IDAT/1.0D0, 512.0D0, 0.19531256208818052282D-2, & -1.0D0, 256.0D0, -0.39062549670565734544D-2, & 1.0D0, 16.0D0, 0.62520348032546565850D-1, & 1.0D0, 8.0D0, 0.12516285581366971819D0, & -1.0D0, 2.0D0, -0.51051480879740303760D0, & 1.0D0, 1.0D0, 0.10865210970235898158D1, & 2.0D0, 1.0D0, 0.27750019054282535299D1, & -4.0D0, 1.0D0, -0.13775208868039716639D2, & 8.0D0, 1.0D0, 0.46424372058106108576D3, & 18.0D0, 1.0D0, 0.64111867658021584522D7, & -37.0D0, 2.0D0, -0.10414860803175857953D8, & 20.0D0, 1.0D0, 0.44758598913855743089D8, & -21.0D0, 1.0D0, -0.11852985311558287888D9, & 22.0D0, 1.0D0, 0.31430078220715992752D9, & -23.0D0, 1.0D0, -0.83440212900794309620D9, & 24.0D0, 1.0D0, 0.22175367579074298261D10, & 25.0D0, 1.0D0, 0.58991731842803636487D10, & -27.0D0, 1.0D0, -0.41857073244691522147D11, & 30.0D0, 1.0D0, 0.79553885818472357663D12, & 40.0D0, 1.0D0, 0.15089715082719201025D17/ DATA IL0DAT/1.0D0, 512.0D0, 0.99875755515461749793D0, & 1.0D0, 64.0D0, 0.99011358230706643807D0, & 1.0D0, 8.0D0, 0.92419435310023947018D0, & 1.0D0, 2.0D0, 0.73624267134714273902D0, & 1.0D0, 1.0D0, 0.55582269181411744686D0, & 2.0D0, 1.0D0, 0.34215154434462160628D0, & 4.0D0, 1.0D0, 0.17087174888774706539D0, & 8.0D0, 1.0D0, 0.81081008709219208918D-1, & 12.0D0, 1.0D0, 0.53449421441089580702D-1, & 16.0D0, 1.0D0, 0.39950321008923244846D-1, & 65.0D0, 4.0D0, 0.39330637437584921392D-1, & 17.0D0, 1.0D0, 0.37582274342808670750D-1, & 20.0D0, 1.0D0, 0.31912486554480390343D-1, & 25.0D0, 1.0D0, 0.25506146883504738403D-1, & 30.0D0, 1.0D0, 0.21244480317825292412D-1, & 40.0D0, 1.0D0, 0.15925498348551684335D-1, & 50.0D0, 1.0D0, 0.12737506927242585015D-1, & 75.0D0, 1.0D0, 0.84897750814784916847D-2, & 100.0D0, 1.0D0, 0.63668349178454469153D-2, & 125.0D0, 1.0D0, 0.50932843163122551114D-2/ DATA IL1DAT/1.0D0, 512.0D0, 0.97575346155386267134D-3, & 1.0D0, 64.0D0, 0.77609293280609272733D-2, & 1.0D0, 8.0D0, 0.59302966404545373770D-1, & 1.0D0, 2.0D0, 0.20395212276737365307D0, & 1.0D0, 1.0D0, 0.33839472293667639038D0, & 2.0D0, 1.0D0, 0.48787706726961324579D0, & 4.0D0, 1.0D0, 0.59018734196576517506D0, & 8.0D0, 1.0D0, 0.62604539530312149476D0, & 12.0D0, 1.0D0, 0.63209315274909764698D0, & 16.0D0, 1.0D0, 0.63410179313235359215D0, & 65.0D0, 4.0D0, 0.63417966797578128188D0, & 17.0D0, 1.0D0, 0.63439268632392089434D0, & 20.0D0, 1.0D0, 0.63501579073257770690D0, & 25.0D0, 1.0D0, 0.63559616677359459337D0, & 30.0D0, 1.0D0, 0.63591001826697110312D0, & 40.0D0, 1.0D0, 0.63622113181751073643D0, & 50.0D0, 1.0D0, 0.63636481702133606597D0, & 75.0D0, 1.0D0, 0.63650653499619902120D0, & 100.0D0, 1.0D0, 0.63655609126300261851D0, & 125.0D0, 1.0D0, 0.63657902087183929223D0/ DATA J0IDAT/1.0D0, 1024.0D0, 0.97656242238978822427D-3, & 1.0D0, 256.0D0, 0.39062450329491108875D-2, & -1.0D0, 16.0D0, -0.62479657927917933620D-1, & 1.0D0, 8.0D0, 0.12483733492120479139D0, & -1.0D0, 2.0D0, -0.48968050664604505505D0, & 1.0D0, 1.0D0, 0.91973041008976023931D0, & -2.0D0, 1.0D0, -0.14257702931970265690D1, & 4.0D0, 1.0D0, 0.10247341594606064818D1, & -8.0D0, 1.0D0, -0.12107468348304501655D1, & 16.0D0, 1.0D0, 0.11008652032736190799D1, & -33.0D0, 2.0D0, -0.10060334829904124192D1, & 18.0D0, 1.0D0, 0.81330572662485953519D0, & -20.0D0, 1.0D0, -0.10583788214211277585D1, & 25.0D0, 1.0D0, 0.87101492116545875169D0, & -30.0D0, 1.0D0, -0.88424908882547488420D0, & 40.0D0, 1.0D0, 0.11257761503599914603D1, & -50.0D0, 1.0D0, -0.90141212258183461184D0, & 75.0D0, 1.0D0, 0.91441344369647797803D0, & -80.0D0, 1.0D0, -0.94482281938334394886D0, & 100.0D0, 1.0D0, 0.92266255696016607257D0/ DATA K0IDAT/1.0D0, 1024.0D0, 0.78587929563466784589D-2, & 1.0D0, 256.0D0, 0.26019991617330578111D-1, & 1.0D0, 16.0D0, 0.24311842237541167904D0, & 1.0D0, 8.0D0, 0.39999633750480508861D0, & 1.0D0, 2.0D0, 0.92710252093114907345D0, & 1.0D0, 1.0D0, 0.12425098486237782662D1, & 2.0D0, 1.0D0, 0.14736757343168286825D1, & 4.0D0, 1.0D0, 0.15606495706051741364D1, & 5.0D0, 1.0D0, 0.15673873907283660493D1, & 6.0D0, 1.0D0, 0.15696345532693743714D1, & 13.0D0, 2.0D0, 0.15701153443250786355D1, & 8.0D0, 1.0D0, 0.15706574852894436220D1, & 10.0D0, 1.0D0, 0.15707793116159788598D1, & 12.0D0, 1.0D0, 0.15707942066465767196D1, & 15.0D0, 1.0D0, 0.15707962315469192247D1, & 20.0D0, 1.0D0, 0.15707963262340149876D1, & 30.0D0, 1.0D0, 0.15707963267948756308D1, & 50.0D0, 1.0D0, 0.15707963267948966192D1, & 80.0D0, 1.0D0, 0.15707963267948966192D1, & 100.0D0, 1.0D0, 0.15707963267948966192D1/ DATA LOBDAT/1.0D0, 512.0D0, 0.12417639065161393857D-8, & 1.0D0, 128.0D0, 0.79473344770001088225D-7, & 1.0D0, 32.0D0, 0.50867598186208834198D-5, & 1.0D0, 8.0D0, 0.32603097901207200319D-3, & 1.0D0, 2.0D0, 0.21380536815408214419D-1, & 1.0D0, 1.0D0, 0.18753816902083824050D0, & 3.0D0, 2.0D0, 0.83051199971883645115D0, & 2.0D0, 1.0D0, 0.18854362426679034904D1, & 5.0D0, 2.0D0, 0.21315988986516411053D1, & 3.0D0, 1.0D0, 0.21771120185613427221D1, & 4.0D0, 1.0D0, 0.22921027921896650849D1, & 5.0D0, 1.0D0, 0.39137195028784495586D1, & 6.0D0, 1.0D0, 0.43513563983836427904D1, & 7.0D0, 1.0D0, 0.44200644968478185898D1, & 10.0D0, 1.0D0, 0.65656013133623829156D1, & 15.0D0, 1.0D0, 0.10825504661504599479D2, & 20.0D0, 1.0D0, 0.13365512855474227325D2, & 30.0D0, 1.0D0, 0.21131002685639959927D2, & 50.0D0, 1.0D0, 0.34838236589449117389D2, & 100.0D0, 1.0D0, 0.69657062437837394278D2/ DATA STRDAT/1.0D0, 512.0D0, 0.21901065985698662316D-15, & 1.0D0, 128.0D0, 0.22481399438625244761D-12, & 1.0D0, 32.0D0, 0.23245019579558857124D-9, & 1.0D0, 8.0D0, 0.24719561475975007037D-6, & 1.0D0, 2.0D0, 0.28992610989833245669D-3, & 1.0D0, 1.0D0, 0.10698146390809715091D-1, & 3.0D0, 2.0D0, 0.89707650964424730705D-1, & 2.0D0, 1.0D0, 0.40049605719592888440D0, & 3.0D0, 1.0D0, 0.30504104398079096598D1, & 4.0D0, 1.0D0, 0.11367704858439426431D2, & 33.0D0, 8.0D0, 0.12960679405324786954D2, & 9.0D0, 2.0D0, 0.18548713944748505675D2, & 5.0D0, 1.0D0, 0.27866273821903121400D2, & 6.0D0, 1.0D0, 0.51963334071699323351D2, & 8.0D0, 1.0D0, 0.10861016747891228129D3, & 10.0D0, 1.0D0, 0.15378903316556621624D3, & 15.0D0, 1.0D0, 0.19302665532558721516D3, & 20.0D0, 1.0D0, 0.19636850166006541482D3, & 30.0D0, 1.0D0, 0.19651946766008214217D3, & 50.0D0, 1.0D0, 0.19651956920868316152D3/ DATA SH0DAT/1.0D0, 512.0D0, 0.12433974658847434366D-2, & -1.0D0, 128.0D0, -0.49735582423748415045D-2, & 1.0D0, 16.0D0, 0.39771469054536941564D-1, & -1.0D0, 4.0D0, -0.15805246001653314198D0, & 1.0D0, 1.0D0, 0.56865662704828795099D0, & 5.0D0, 4.0D0, 0.66598399314899916605D0, & 2.0D0, 1.0D0, 0.79085884950809589255D0, & -4.0D0, 1.0D0, -0.13501457342248639716D0, & 15.0D0, 2.0D0, 0.20086479668164503137D0, & 11.0D0, 1.0D0, -0.11142097800261991552D0, & 23.0D0, 2.0D0, -0.17026804865989885869D0, & -16.0D0, 1.0D0, -0.13544931808186467594D0, & 20.0D0, 1.0D0, 0.94393698081323450897D-1, & 25.0D0, 1.0D0, -0.10182482016001510271D0, & -30.0D0, 1.0D0, 0.96098421554162110012D-1, & 50.0D0, 1.0D0, -0.85337674826118998952D-1, & 75.0D0, 1.0D0, -0.76882290637052720045D-1, & -80.0D0, 1.0D0, 0.47663833591418256339D-1, & 100.0D0, 1.0D0, -0.70878751689647343204D-1, & -125.0D0, 1.0D0, 0.65752908073352785368D-1/ DATA SH1DAT/1.0D0, 512.0D0, 0.80950369576367526071D-6, & -1.0D0, 128.0D0, 0.12952009724113229165D-4, & 1.0D0, 16.0D0, 0.82871615165407083021D-3, & -1.0D0, 4.0D0, 0.13207748375849572564D-1, & 1.0D0, 1.0D0, 0.19845733620194439894D0, & 5.0D0, 4.0D0, 0.29853823231804706294D0, & 2.0D0, 1.0D0, 0.64676372828356211712D0, & -4.0D0, 1.0D0, 0.10697266613089193593D1, & 15.0D0, 2.0D0, 0.38831308000420560970D0, & 9.0D0, 1.0D0, 0.74854243745107710333D0, & 19.0D0, 2.0D0, 0.84664854642567359993D0, & -12.0D0, 1.0D0, 0.58385732464244384564D0, & 17.0D0, 1.0D0, 0.80600584524215772824D0, & 25.0D0, 1.0D0, 0.53880362132692947616D0, & -30.0D0, 1.0D0, 0.72175037834698998506D0, & 50.0D0, 1.0D0, 0.58007844794544189900D0, & 75.0D0, 1.0D0, 0.60151910385440804463D0, & -80.0D0, 1.0D0, 0.70611511147286827018D0, & 100.0D0, 1.0D0, 0.61631110327201338454D0, & -125.0D0, 1.0D0, 0.62778480765443656489D0/ DATA SL0DAT/1.0D0, 512.0D0, 0.12433985199262820188D-2, & -1.0D0, 32.0D0, -0.19896526647882937004D-1, & 1.0D0, 8.0D0, 0.79715713253115014945D-1, & -1.0D0, 2.0D0, -0.32724069939418078025D0, & 1.0D0, 1.0D0, 0.71024318593789088874D0, & 2.0D0, 1.0D0, 0.19374337579914456612D1, & -4.0D0, 1.0D0, -0.11131050203248583431D2, & 7.0D0, 1.0D0, 0.16850062034703267148D3, & -10.0D0, 1.0D0, -0.28156522493745948555D4, & 16.0D0, 1.0D0, 0.89344618796978400815D6, & 65.0D0, 4.0D0, 0.11382025002851451057D7, & -17.0D0, 1.0D0, -0.23549701855860190304D7, & 20.0D0, 1.0D0, 0.43558282527641046718D8, & 45.0D0, 2.0D0, 0.49993516476037957165D9, & -25.0D0, 1.0D0, -0.57745606064408041689D10, & 30.0D0, 1.0D0, 0.78167229782395624524D12, & -40.0D0, 1.0D0, -0.14894774793419899908D17, & 50.0D0, 1.0D0, 0.29325537838493363267D21, & 60.0D0, 1.0D0, 0.58940770556098011683D25, & -70.0D0, 1.0D0, -0.12015889579125463605D30/ DATA SL1DAT/1.0D0, 512.0D0, 0.80950410749865126939D-6, & -1.0D0, 32.0D0, 0.20724649092571514607D-3, & 1.0D0, 8.0D0, 0.33191834066894516744D-2, & -1.0D0, 2.0D0, 0.53942182623522663292D-1, & 1.0D0, 1.0D0, 0.22676438105580863683D0, & 2.0D0, 1.0D0, 0.11027597873677158176D1, & -4.0D0, 1.0D0, 0.91692778117386847344D1, & 7.0D0, 1.0D0, 0.15541656652426660966D3, & -10.0D0, 1.0D0, 0.26703582852084829694D4, & 16.0D0, 1.0D0, 0.86505880175304633906D6, & 65.0D0, 4.0D0, 0.11026046613094942620D7, & -17.0D0, 1.0D0, 0.22846209494153934787D7, & 20.0D0, 1.0D0, 0.42454972750111979449D8, & 45.0D0, 2.0D0, 0.48869614587997695539D9, & -25.0D0, 1.0D0, 0.56578651292431051863D10, & 30.0D0, 1.0D0, 0.76853203893832108948D12, & -40.0D0, 1.0D0, 0.14707396163259352103D17, & 50.0D0, 1.0D0, 0.29030785901035567967D21, & 60.0D0, 1.0D0, 0.58447515883904682813D25, & -70.0D0, 1.0D0, 0.11929750788892311875D30/ DATA SY1DAT/1.0D0, 512.0D0, 0.26514864547487397044D0, & 1.0D0, 32.0D0, 0.62050129979079045645D0, & 1.0D0, 8.0D0, 0.85112572132368011206D0, & 1.0D0, 2.0D0, 0.87081914687546885094D0, & 1.0D0, 1.0D0, 0.65142281535536396975D0, & 3.0D0, 2.0D0, 0.45064040920322354579D0, & 2.0D0, 1.0D0, 0.30163590285073940285D0, & 5.0D0, 2.0D0, 0.19814490804441305867D0, & 3.0D0, 1.0D0, 0.12856571000906381300D0, & 4.0D0, 1.0D0, 0.52827396697866818297D-1, & 17.0D0, 4.0D0, 0.42139298471720305542D-1, & 5.0D0, 1.0D0, 0.21248129774981984268D-1, & 11.0D0, 2.0D0, 0.13400258907505536491D-1, & 6.0D0, 1.0D0, 0.84260797314108699935D-2, & 8.0D0, 1.0D0, 0.12884516186754671469D-2, & 10.0D0, 1.0D0, 0.19223826430086897418D-3, & 12.0D0, 1.0D0, 0.28221070834007689394D-4, & 15.0D0, 1.0D0, 0.15548757973038189372D-5, & 20.0D0, 1.0D0, 0.11968634456097453636D-7, & 25.0D0, 1.0D0, 0.89564246772237127742D-10/ DATA SY2DAT/1.0D0, 512.0D0, 0.13430727275667378338D0, & 1.0D0, 32.0D0, 0.33485265272424176976D0, & 1.0D0, 8.0D0, 0.50404224110911078651D0, & 1.0D0, 2.0D0, 0.60296523236016785113D0, & 1.0D0, 1.0D0, 0.49447506210420826699D0, & 3.0D0, 2.0D0, 0.36036067860473360389D0, & 2.0D0, 1.0D0, 0.24967785497625662113D0, & 5.0D0, 2.0D0, 0.16813830542905833533D0, & 3.0D0, 1.0D0, 0.11117122348556549832D0, & 4.0D0, 1.0D0, 0.46923205826101330711D-1, & 17.0D0, 4.0D0, 0.37624545861980001482D-1, & 5.0D0, 1.0D0, 0.19222123172484106436D-1, & 11.0D0, 2.0D0, 0.12209535343654701398D-1, & 6.0D0, 1.0D0, 0.77249644268525771866D-2, & 8.0D0, 1.0D0, 0.12029044213679269639D-2, & 10.0D0, 1.0D0, 0.18161187569530204281D-3, & 12.0D0, 1.0D0, 0.26884338006629353506D-4, & 15.0D0, 1.0D0, 0.14942212731345828759D-5, & 20.0D0, 1.0D0, 0.11607696854385161390D-7, & 25.0D0, 1.0D0, 0.87362343746221526073D-10/ DATA TR2DAT/1.0D0, 512.0D0, 0.19531247930394515480D-2, & 1.0D0, 32.0D0, 0.31249152314331109004D-1, & 1.0D0, 8.0D0, 0.12494577194783451032D0, & 1.0D0, 2.0D0, 0.49655363615640595865D0, & 1.0D0, 1.0D0, 0.97303256135517012845D0, & 3.0D0, 2.0D0, 0.14121978695932525805D1, & 2.0D0, 1.0D0, 0.18017185674405776809D1, & 5.0D0, 2.0D0, 0.21350385339277043015D1, & 3.0D0, 1.0D0, 0.24110500490169534620D1, & 4.0D0, 1.0D0, 0.28066664045631179931D1, & 17.0D0, 4.0D0, 0.28777421863296234131D1, & 5.0D0, 1.0D0, 0.30391706043438554330D1, & 11.0D0, 2.0D0, 0.31125074928667355940D1, & 6.0D0, 1.0D0, 0.31656687817738577185D1, & 8.0D0, 1.0D0, 0.32623520367816009184D1, & 10.0D0, 1.0D0, 0.32843291144979517358D1, & 15.0D0, 1.0D0, 0.32897895167775788137D1, & 20.0D0, 1.0D0, 0.32898672226665499687D1, & 30.0D0, 1.0D0, 0.32898681336064325400D1, & 50.0D0, 1.0D0, 0.32898681336964528724D1/ DATA TR3DAT/1.0D0, 512.0D0, 0.19073483296476379584D-5, & 1.0D0, 32.0D0, 0.48826138243180786081D-3, & 1.0D0, 8.0D0, 0.78074163848431205820D-2, & 1.0D0, 2.0D0, 0.12370868718812031049D0, & 1.0D0, 1.0D0, 0.47984100657241749994D0, & 3.0D0, 2.0D0, 0.10269431622039754738D1, & 2.0D0, 1.0D0, 0.17063547219458658863D1, & 5.0D0, 2.0D0, 0.24539217444475937661D1, & 3.0D0, 1.0D0, 0.32106046629422467723D1, & 4.0D0, 1.0D0, 0.45792174372291563703D1, & 17.0D0, 4.0D0, 0.48722022832940370805D1, & 5.0D0, 1.0D0, 0.56143866138422732286D1, & 11.0D0, 2.0D0, 0.59984455864575470009D1, & 6.0D0, 1.0D0, 0.63033953673480961120D1, & 8.0D0, 1.0D0, 0.69579908688361166266D1, & 10.0D0, 1.0D0, 0.71503227120085929750D1, & 15.0D0, 1.0D0, 0.72110731475871876393D1, & 20.0D0, 1.0D0, 0.72123221966388461839D1, & 30.0D0, 1.0D0, 0.72123414161609465119D1, & 50.0D0, 1.0D0, 0.72123414189575656868D1/ DATA TR4DAT/1.0D0, 512.0D0, 0.24835263919461834041D-8, & 1.0D0, 32.0D0, 0.10172029353616724881D-4, & 1.0D0, 8.0D0, 0.65053332405940765479D-3, & 1.0D0, 2.0D0, 0.41150448004155727767D-1, & 1.0D0, 1.0D0, 0.31724404523442648241D0, & 3.0D0, 2.0D0, 0.10079442901142373591D1, & 2.0D0, 1.0D0, 0.22010881024333408363D1, & 5.0D0, 2.0D0, 0.38846508619156545210D1, & 3.0D0, 1.0D0, 0.59648223973714765245D1, & 4.0D0, 1.0D0, 0.10731932392998622219D2, & 17.0D0, 4.0D0, 0.11940028876819364777D2, & 5.0D0, 1.0D0, 0.15359784316882182982D2, & 11.0D0, 2.0D0, 0.17372587633093742893D2, & 6.0D0, 1.0D0, 0.19122976016053166969D2, & 8.0D0, 1.0D0, 0.23583979156921941515D2, & 10.0D0, 1.0D0, 0.25273667677030441733D2, & 15.0D0, 1.0D0, 0.25955198214572256372D2, & 20.0D0, 1.0D0, 0.25975350935212241910D2, & 30.0D0, 1.0D0, 0.25975757522084093747D2, & 50.0D0, 1.0D0, 0.25975757609067315288D2/ DATA TR5DAT/1.0D0, 512.0D0, 0.36379780361036116971D-11, & 1.0D0, 32.0D0, 0.23840564453948442379D-6, & 1.0D0, 8.0D0, 0.60982205372226969189D-4, & 1.0D0, 2.0D0, 0.15410004586376649337D-1, & 1.0D0, 1.0D0, 0.23661587923909478926D0, & 3.0D0, 2.0D0, 0.11198756851307629651D1, & 2.0D0, 1.0D0, 0.32292901663684049171D1, & 5.0D0, 2.0D0, 0.70362973105160654056D1, & 3.0D0, 1.0D0, 0.12770557691044159511D2, & 4.0D0, 1.0D0, 0.29488339015245845447D2, & 17.0D0, 4.0D0, 0.34471340540362254586D2, & 5.0D0, 1.0D0, 0.50263092218175187785D2, & 11.0D0, 2.0D0, 0.60819909101127165207D2, & 6.0D0, 1.0D0, 0.70873334429213460498D2, & 8.0D0, 1.0D0, 0.10147781242977788097D3, & 10.0D0, 1.0D0, 0.11638074540242071077D3, & 15.0D0, 1.0D0, 0.12409623901262967878D3, & 20.0D0, 1.0D0, 0.12442270155632550228D3, & 30.0D0, 1.0D0, 0.12443132790838589548D3, & 50.0D0, 1.0D0, 0.12443133061720432435D3/ DATA TR6DAT/1.0D0, 512.0D0, 0.56843405953641209574D-14, & 1.0D0, 32.0D0, 0.59601180165247401484D-8, & 1.0D0, 8.0D0, 0.60978424397580572815D-5, & 1.0D0, 2.0D0, 0.61578909866319494394D-2, & 1.0D0, 1.0D0, 0.18854360275680840514D0, & 3.0D0, 2.0D0, 0.13319251347921659134D1, & 2.0D0, 1.0D0, 0.50857202271697616755D1, & 5.0D0, 2.0D0, 0.13729222365466557122D2, & 3.0D0, 1.0D0, 0.29579592481641441292D2, & 4.0D0, 1.0D0, 0.88600835706899853768D2, & 17.0D0, 4.0D0, 0.10916037113373004909D3, & 5.0D0, 1.0D0, 0.18224323749575359518D3, & 11.0D0, 2.0D0, 0.23765383125586756031D3, & 6.0D0, 1.0D0, 0.29543246745959381136D3, & 8.0D0, 1.0D0, 0.50681244381280455592D3, & 10.0D0, 1.0D0, 0.63878231134946125623D3, & 15.0D0, 1.0D0, 0.72699203556994876111D3, & 20.0D0, 1.0D0, 0.73230331643146851717D3, & 30.0D0, 1.0D0, 0.73248692015882096369D3, & 50.0D0, 1.0D0, 0.73248700462879996604D3/ DATA TR7DAT/1.0D0, 512.0D0, 0.92518563327283409427D-17, & 1.0D0, 32.0D0, 0.15521095556949867541D-9, & 1.0D0, 8.0D0, 0.63516238373841716290D-6, & 1.0D0, 2.0D0, 0.25638801246626135714D-2, & 1.0D0, 1.0D0, 0.15665328993811649746D0, & 3.0D0, 2.0D0, 0.16538225039181097423D1, & 2.0D0, 1.0D0, 0.83763085709508211054D1, & 5.0D0, 2.0D0, 0.28078570717830763747D2, & 3.0D0, 1.0D0, 0.72009676046751991365D2, & 4.0D0, 1.0D0, 0.28174905701691911450D3, & 17.0D0, 4.0D0, 0.36660227975327792529D3, & 5.0D0, 1.0D0, 0.70556067982603601123D3, & 11.0D0, 2.0D0, 0.99661927562755629434D3, & 6.0D0, 1.0D0, 0.13288914430417403901D4, & 8.0D0, 1.0D0, 0.27987640273169129925D4, & 10.0D0, 1.0D0, 0.39721376409416504325D4, & 15.0D0, 1.0D0, 0.49913492839319899726D4, & 20.0D0, 1.0D0, 0.50781562639825019000D4, & 30.0D0, 1.0D0, 0.50820777202028708434D4, & 50.0D0, 1.0D0, 0.50820803580047164618D4/ DATA TR8DAT/1.0D0, 512.0D0, 0.15488598634539359463D-19, & 1.0D0, 32.0D0, 0.41574269117845953797D-11, & 1.0D0, 8.0D0, 0.68050651245227411689D-7, & 1.0D0, 2.0D0, 0.10981703519563009836D-2, & 1.0D0, 1.0D0, 0.13396432776187883834D0, & 3.0D0, 2.0D0, 0.21153387806998617182D1, & 2.0D0, 1.0D0, 0.14227877028750735641D2, & 5.0D0, 2.0D0, 0.59312061431647843226D2, & 3.0D0, 1.0D0, 0.18139614577043147745D3, & 4.0D0, 1.0D0, 0.93148001928992220863D3, & 17.0D0, 4.0D0, 0.12817928112604611804D4, & 5.0D0, 1.0D0, 0.28572838386329242218D4, & 11.0D0, 2.0D0, 0.43872971687877730010D4, & 6.0D0, 1.0D0, 0.62993229139406657611D4, & 8.0D0, 1.0D0, 0.16589426277154888511D5, & 10.0D0, 1.0D0, 0.27064780798797398935D5, & 15.0D0, 1.0D0, 0.38974556062543661284D5, & 20.0D0, 1.0D0, 0.40400240716905025786D5, & 30.0D0, 1.0D0, 0.40484316504120655568D5, & 50.0D0, 1.0D0, 0.40484399001892184901D5/ DATA TR9DAT/1.0D0, 512.0D0, 0.26469772870084897671D-22, & 1.0D0, 32.0D0, 0.11367943653594246210D-12, & 1.0D0, 8.0D0, 0.74428246255329800255D-8, & 1.0D0, 2.0D0, 0.48022728485415366194D-3, & 1.0D0, 1.0D0, 0.11700243014358676725D0, & 3.0D0, 2.0D0, 0.27648973910899914391D1, & 2.0D0, 1.0D0, 0.24716631405829192997D2, & 5.0D0, 2.0D0, 0.12827119828849828583D3, & 3.0D0, 1.0D0, 0.46842894800662208986D3, & 4.0D0, 1.0D0, 0.31673967371627895718D4, & 17.0D0, 4.0D0, 0.46140886546630195390D4, & 5.0D0, 1.0D0, 0.11952718545392302185D5, & 11.0D0, 2.0D0, 0.20001612666477027728D5, & 6.0D0, 1.0D0, 0.31011073271851366554D5, & 8.0D0, 1.0D0, 0.10352949905541130133D6, & 10.0D0, 1.0D0, 0.19743173017140591390D6, & 15.0D0, 1.0D0, 0.33826030414658460679D6, & 20.0D0, 1.0D0, 0.36179607036750755227D6, & 30.0D0, 1.0D0, 0.36360622124777561525D6, & 50.0D0, 1.0D0, 0.36360880558827162725D6/ DATA Y0IDAT/1.0D0, 512.0D0, -0.91442642860172110926D-2, & 1.0D0, 128.0D0, -0.29682047390397591290D-1, & 1.0D0, 8.0D0, -0.25391431276585388961D0, & 1.0D0, 2.0D0, -0.56179545591464028187D0, & 1.0D0, 1.0D0, -0.63706937660742309754D0, & 2.0D0, 1.0D0, -0.28219285008510084123D0, & 4.0D0, 1.0D0, 0.38366964785312561103D0, & 6.0D0, 1.0D0, -0.12595061285798929390D0, & 10.0D0, 1.0D0, 0.24129031832266684828D0, & 16.0D0, 1.0D0, 0.17138069757627037938D0, & 65.0D0, 4.0D0, 0.18958142627134083732D0, & 17.0D0, 1.0D0, 0.17203846136449706946D0, & 20.0D0, 1.0D0, -0.16821597677215029611D0, & 25.0D0, 1.0D0, -0.93607927351428988679D-1, & 30.0D0, 1.0D0, 0.88229711948036648408D-1, & 40.0D0, 1.0D0, -0.89324662736274161841D-2, & 50.0D0, 1.0D0, -0.54814071000063488284D-1, & 70.0D0, 1.0D0, -0.94958246003466381588D-1, & 100.0D0, 1.0D0, -0.19598064853404969850D-1, & 125.0D0, 1.0D0, -0.83084772357154773468D-2/ C C TEST ABRAM0 C FNAME = 'ABRAM0' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 100 I = 1 , 20 NUM = AB0DAT ( 1 , I ) DEN = AB0DAT ( 2 , I ) RES = AB0DAT ( 3 , I ) PT = NUM / DEN COMP = ABRAM0(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 100 CONTINUE C C TEST ABRAM1 C FNAME = 'ABRAM1' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 110 I = 1 , 20 NUM = AB1DAT ( 1 , I ) DEN = AB1DAT ( 2 , I ) RES = AB1DAT ( 3 , I ) PT = NUM / DEN COMP = ABRAM1(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 110 CONTINUE C C TEST ABRAM2 C FNAME = 'ABRAM2' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 120 I = 1 , 20 NUM = AB2DAT ( 1 , I ) DEN = AB2DAT ( 2 , I ) RES = AB2DAT ( 3 , I ) PT = NUM / DEN COMP = ABRAM2(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 120 CONTINUE C C TEST AIRINT C FNAME = 'AIRINT' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 130 I = 1 , 20 NUM = AIIDAT ( 1 , I ) DEN = AIIDAT ( 2 , I ) RES = AIIDAT ( 3 , I ) PT = NUM / DEN COMP = AIRINT(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 130 CONTINUE C C TEST AIRYGI C FNAME = 'AIRYGI' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 140 I = 1 , 20 NUM = AGIDAT ( 1 , I ) DEN = AGIDAT ( 2 , I ) RES = AGIDAT ( 3 , I ) PT = NUM / DEN COMP = AIRYGI(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 140 CONTINUE C C TEST AIRYHI C FNAME = 'AIRYHI' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 150 I = 1 , 20 NUM = AHIDAT ( 1 , I ) DEN = AHIDAT ( 2 , I ) RES = AHIDAT ( 3 , I ) PT = NUM / DEN COMP = AIRYHI(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 150 CONTINUE C C TEST ATNINT C FNAME = 'ATNINT' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 160 I = 1 , 20 NUM = ATNDAT ( 1 , I ) DEN = ATNDAT ( 2 , I ) RES = ATNDAT ( 3 , I ) PT = NUM / DEN COMP = ATNINT(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 160 CONTINUE C C TEST BIRINT C FNAME = 'BIRINT' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 170 I = 1 , 20 NUM = BIIDAT ( 1 , I ) DEN = BIIDAT ( 2 , I ) RES = BIIDAT ( 3 , I ) PT = NUM / DEN COMP = BIRINT(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 170 CONTINUE C C TEST CLAUSN C FNAME = 'CLAUSN' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 180 I = 1 , 20 NUM = CLNDAT ( 1 , I ) DEN = CLNDAT ( 2 , I ) RES = CLNDAT ( 3 , I ) PT = NUM / DEN COMP = CLAUSN(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 180 CONTINUE C C TEST DEBYE1 C FNAME = 'DEBYE1' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 190 I = 1 , 20 NUM = DB1DAT ( 1 , I ) DEN = DB1DAT ( 2 , I ) RES = DB1DAT ( 3 , I ) PT = NUM / DEN COMP = DEBYE1(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 190 CONTINUE C C TEST DEBYE2 C FNAME = 'DEBYE2' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 200 I = 1 , 20 NUM = DB2DAT ( 1 , I ) DEN = DB2DAT ( 2 , I ) RES = DB2DAT ( 3 , I ) PT = NUM / DEN COMP = DEBYE2(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 200 CONTINUE C C TEST DEBYE3 C FNAME = 'DEBYE3' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 210 I = 1 , 20 NUM = DB3DAT ( 1 , I ) DEN = DB3DAT ( 2 , I ) RES = DB3DAT ( 3 , I ) PT = NUM / DEN COMP = DEBYE3(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 210 CONTINUE C C TEST DEBYE4 C FNAME = 'DEBYE4' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 220 I = 1 , 20 NUM = DB4DAT ( 1 , I ) DEN = DB4DAT ( 2 , I ) RES = DB4DAT ( 3 , I ) PT = NUM / DEN COMP = DEBYE4(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 220 CONTINUE C C TEST EXP3 C FNAME = 'EXP3 ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 230 I = 1 , 20 NUM = EX3DAT ( 1 , I ) DEN = EX3DAT ( 2 , I ) RES = EX3DAT ( 3 , I ) PT = NUM / DEN COMP = EXP3(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 230 CONTINUE C C TEST GOODST C FNAME = 'GOODST' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 240 I = 1 , 20 NUM = GSTDAT ( 1 , I ) DEN = GSTDAT ( 2 , I ) RES = GSTDAT ( 3 , I ) PT = NUM / DEN COMP = GOODST(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 240 CONTINUE C C TEST I0INT C FNAME = 'I0INT ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 250 I = 1 , 20 NUM = I0IDAT ( 1 , I ) DEN = I0IDAT ( 2 , I ) RES = I0IDAT ( 3 , I ) PT = NUM / DEN COMP = I0INT(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 250 CONTINUE C C TEST I0ML0 C FNAME = 'I0ML0 ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 260 I = 1 , 20 NUM = IL0DAT ( 1 , I ) DEN = IL0DAT ( 2 , I ) RES = IL0DAT ( 3 , I ) PT = NUM / DEN COMP = I0ML0(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 260 CONTINUE C C TEST I1ML1 C FNAME = 'I1ML1 ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 270 I = 1 , 20 NUM = IL1DAT ( 1 , I ) DEN = IL1DAT ( 2 , I ) RES = IL1DAT ( 3 , I ) PT = NUM / DEN COMP = I1ML1(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 270 CONTINUE C C TEST J0INT C FNAME = 'J0INT ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 280 I = 1 , 20 NUM = J0IDAT ( 1 , I ) DEN = J0IDAT ( 2 , I ) RES = J0IDAT ( 3 , I ) PT = NUM / DEN COMP = J0INT(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 280 CONTINUE C C TEST K0INT C FNAME = 'K0INT ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 290 I = 1 , 20 NUM = K0IDAT ( 1 , I ) DEN = K0IDAT ( 2 , I ) RES = K0IDAT ( 3 , I ) PT = NUM / DEN COMP = K0INT(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 290 CONTINUE C C TEST LOBACH C FNAME = 'LOBACH' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 300 I = 1 , 20 NUM = LOBDAT ( 1 , I ) DEN = LOBDAT ( 2 , I ) RES = LOBDAT ( 3 , I ) PT = NUM / DEN COMP = LOBACH(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 300 CONTINUE C C TEST STROM C FNAME = 'STROM ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 310 I = 1 , 20 NUM = STRDAT ( 1 , I ) DEN = STRDAT ( 2 , I ) RES = STRDAT ( 3 , I ) PT = NUM / DEN COMP = STROM(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 310 CONTINUE C C TEST STRVH0 C FNAME = 'STRVH0' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 320 I = 1 , 20 NUM = SH0DAT ( 1 , I ) DEN = SH0DAT ( 2 , I ) RES = SH0DAT ( 3 , I ) PT = NUM / DEN COMP = STRVH0(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 320 CONTINUE C C TEST STRVH1 C FNAME = 'STRVH1' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 330 I = 1 , 20 NUM = SH1DAT ( 1 , I ) DEN = SH1DAT ( 2 , I ) RES = SH1DAT ( 3 , I ) PT = NUM / DEN COMP = STRVH1(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 330 CONTINUE C C TEST STRVL0 C FNAME = 'STRVL0' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 340 I = 1 , 20 NUM = SL0DAT ( 1 , I ) DEN = SL0DAT ( 2 , I ) RES = SL0DAT ( 3 , I ) PT = NUM / DEN COMP = STRVL0(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 340 CONTINUE C C TEST STRVL1 C FNAME = 'STRVL1' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 350 I = 1 , 20 NUM = SL1DAT ( 1 , I ) DEN = SL1DAT ( 2 , I ) RES = SL1DAT ( 3 , I ) PT = NUM / DEN COMP = STRVL1(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 350 CONTINUE C C TEST SYNCH1 C FNAME = 'SYNCH1' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 360 I = 1 , 20 NUM = SY1DAT ( 1 , I ) DEN = SY1DAT ( 2 , I ) RES = SY1DAT ( 3 , I ) PT = NUM / DEN COMP = SYNCH1(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 360 CONTINUE C C TEST SYNCH2 C FNAME = 'SYNCH2' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 370 I = 1 , 20 NUM = SY2DAT ( 1 , I ) DEN = SY2DAT ( 2 , I ) RES = SY2DAT ( 3 , I ) PT = NUM / DEN COMP = SYNCH2(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 370 CONTINUE C C TEST TRAN02 C FNAME = 'TRAN02' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 380 I = 1 , 20 NUM = TR2DAT ( 1 , I ) DEN = TR2DAT ( 2 , I ) RES = TR2DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN02(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 380 CONTINUE C C TEST TRAN03 C FNAME = 'TRAN03' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 390 I = 1 , 20 NUM = TR3DAT ( 1 , I ) DEN = TR3DAT ( 2 , I ) RES = TR3DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN03(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 390 CONTINUE C C TEST TRAN04 C FNAME = 'TRAN04' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 400 I = 1 , 20 NUM = TR4DAT ( 1 , I ) DEN = TR4DAT ( 2 , I ) RES = TR4DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN04(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 400 CONTINUE C C TEST TRAN05 C FNAME = 'TRAN05' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 410 I = 1 , 20 NUM = TR5DAT ( 1 , I ) DEN = TR5DAT ( 2 , I ) RES = TR5DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN05(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 410 CONTINUE C C TEST TRAN06 C FNAME = 'TRAN06' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 420 I = 1 , 20 NUM = TR6DAT ( 1 , I ) DEN = TR6DAT ( 2 , I ) RES = TR6DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN06(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 420 CONTINUE C C TEST TRAN07 C FNAME = 'TRAN07' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 430 I = 1 , 20 NUM = TR7DAT ( 1 , I ) DEN = TR7DAT ( 2 , I ) RES = TR7DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN07(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 430 CONTINUE C C TEST TRAN08 C FNAME = 'TRAN08' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 440 I = 1 , 20 NUM = TR8DAT ( 1 , I ) DEN = TR8DAT ( 2 , I ) RES = TR8DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN08(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 440 CONTINUE C C TEST TRAN09 C FNAME = 'TRAN09' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 450 I = 1 , 20 NUM = TR9DAT ( 1 , I ) DEN = TR9DAT ( 2 , I ) RES = TR9DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN09(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 450 CONTINUE C C TEST Y0INT C FNAME = 'Y0INT ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 460 I = 1 , 20 NUM = Y0IDAT ( 1 , I ) DEN = Y0IDAT ( 2 , I ) RES = Y0IDAT ( 3 , I ) PT = NUM / DEN COMP = Y0INT(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 460 CONTINUE C C PRINT STATEMENTS C 1000 FORMAT(////15X,'TESTING THE FUNCTION ',A6) 1010 FORMAT(/5X,'ARGUMENT',13X,'ABS. ERROR',13X,'REL. ERROR') 1020 FORMAT(3X,F10.4,8X,D15.5,8X,D15.5) END SHAR_EOF fi # end of overwriting check cd .. if test ! -d 'Sp' then mkdir 'Sp' fi cd 'Sp' if test -f 'driver.f' then echo shar: will not over-write existing file "'driver.f'" else cat << \SHAR_EOF > 'driver.f' PROGRAM TEST C C This program tests the 37 functions in the file MISCFUN. C It is a fairly simple code with each function being tested C at 20 different arguments. The code compares the value C from the function with a pre-computed value, and produces C the absolute and relative errors. C C The file MISCFUN.F should be appended to the end of this file C and the complete program compiled. C C The program is written in single-precision Fortran 77. For C double-precision tests use the file MSCTSTDP.F C C The variable IOUT is used to direct the program output, and is C set to the standard value 6. For other output streams change C the DATA statement. C C Author: Allan MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C INTEGER I,IOUT REAL ABSERR,COMP,DEN,NUM,PT,RELERR,RES REAL AB0DAT(3,20),AB1DAT(3,20), & AB2DAT(3,20),AIIDAT(3,20),AGIDAT(3,20), & AHIDAT(3,20),ATNDAT(3,20),BIIDAT(3,20),CLNDAT(3,20), & DB1DAT(3,20),DB2DAT(3,20),DB3DAT(3,20),DB4DAT(3,20), & EX3DAT(3,20),GSTDAT(3,20),I0IDAT(3,20),IL0DAT(3,20), & IL1DAT(3,20),J0IDAT(3,20),K0IDAT(3,20),LOBDAT(3,20), & STRDAT(3,20),SH0DAT(3,20),SH1DAT(3,20),SL0DAT(3,20), & SL1DAT(3,20),SY1DAT(3,20),SY2DAT(3,20),TR2DAT(3,20), & TR3DAT(3,20),TR4DAT(3,20),TR5DAT(3,20),TR6DAT(3,20), & TR7DAT(3,20),TR8DAT(3,20),TR9DAT(3,20),Y0IDAT(3,20) REAL ABRAM0,ABRAM1,ABRAM2,AIRINT,AIRYGI,AIRYHI, & ATNINT,BIRINT,CLAUSN,DEBYE1,DEBYE2,DEBYE3,DEBYE4, & EXP3,GOODST,I0INT,I0ML0,I1ML1,J0INT,K0INT,LOBACH, & STROM,STRVH0,STRVH1,STRVL0,STRVL1,SYNCH1,SYNCH2, & TRAN02,TRAN03,TRAN04,TRAN05,TRAN06,TRAN07,TRAN08, & TRAN09,Y0INT CHARACTER*6 FNAME DATA IOUT/6/ DATA AB0DAT/1.0E0, 512.0E0, 0.87377726306985360531E0, & 1.0E0, 128.0E0, 0.84721859650456925922E0, & 1.0E0, 32.0E0, 0.77288934483988301615E0, & 1.0E0, 8.0E0, 0.59684345853450151603E0, & 1.0E0, 2.0E0, 0.29871735283675888392E0, & 1.0E0, 1.0E0, 0.15004596450516388138E0, & 5.0E0, 4.0E0, 0.11114662419157955096E0, & 3.0E0, 2.0E0, 0.83909567153151897766E-1, & 15.0E0, 8.0E0, 0.56552321717943417515E-1, & 2.0E0, 1.0E0, 0.49876496603033790206E-1, & 17.0E0, 8.0E0, 0.44100889219762791328E-1, & 3.0E0, 1.0E0, 0.19738535180254062496E-1, & 4.0E0, 1.0E0, 0.86193088287161479900E-2, & 5.0E0, 1.0E0, 0.40224788162540127227E-2, & 6.0E0, 1.0E0, 0.19718658458164884826E-2, & 7.0E0, 1.0E0, 0.10045868340133538505E-2, & 10.0E0, 1.0E0, 0.15726917263304498649E-3, & 15.0E0, 1.0E0, 0.10352666912350263437E-4, & 20.0E0, 1.0E0, 0.91229759190956745069E-6, & 40.0E0, 1.0E0, 0.25628287737952698742E-9/ DATA AB1DAT/1.0E0, 512.0E0, 0.49828219848799921792E0, & 1.0E0, 128.0E0, 0.49324391773047288556E0, & 1.0E0, 32.0E0, 0.47431612784691234649E0, & 1.0E0, 8.0E0, 0.41095983258760410149E0, & 1.0E0, 2.0E0, 0.25317617388227035867E0, & 1.0E0, 1.0E0, 0.14656338138597777543E0, & 5.0E0, 4.0E0, 0.11421547056018366587E0, & 3.0E0, 2.0E0, 0.90026307383483764795E-1, & 15.0E0, 8.0E0, 0.64088214170742303375E-1, & 2.0E0, 1.0E0, 0.57446614314166191085E-1, & 17.0E0, 8.0E0, 0.51581624564800730959E-1, & 3.0E0, 1.0E0, 0.25263719555776416016E-1, & 4.0E0, 1.0E0, 0.11930803330196594536E-1, & 5.0E0, 1.0E0, 0.59270542280915272465E-2, & 6.0E0, 1.0E0, 0.30609215358017829567E-2, & 7.0E0, 1.0E0, 0.16307382136979552833E-2, & 10.0E0, 1.0E0, 0.28371851916959455295E-3, & 15.0E0, 1.0E0, 0.21122150121323238154E-4, & 20.0E0, 1.0E0, 0.20344578892601627337E-5, & 40.0E0, 1.0E0, 0.71116517236209642290E-9/ DATA AB2DAT/1.0E0, 512.0E0, 0.44213858162107913430E0, & 1.0E0, 128.0E0, 0.43923379545684026308E0, & 1.0E0, 32.0E0, 0.42789857297092602234E0, & 1.0E0, 8.0E0, 0.38652825661854504406E0, & 1.0E0, 2.0E0, 0.26538204413231368110E0, & 1.0E0, 1.0E0, 0.16848734838334595000E0, & 5.0E0, 4.0E0, 0.13609200032513227112E0, & 3.0E0, 2.0E0, 0.11070330027727917352E0, & 15.0E0, 8.0E0, 0.82126019995530382267E-1, & 2.0E0, 1.0E0, 0.74538781999594581763E-1, & 17.0E0, 8.0E0, 0.67732034377612811390E-1, & 3.0E0, 1.0E0, 0.35641808698811851022E-1, & 4.0E0, 1.0E0, 0.17956589956618269083E-1, & 5.0E0, 1.0E0, 0.94058737143575370625E-2, & 6.0E0, 1.0E0, 0.50809356204299213556E-2, & 7.0E0, 1.0E0, 0.28149565414209719359E-2, & 10.0E0, 1.0E0, 0.53808696422559303431E-3, & 15.0E0, 1.0E0, 0.44821756380146327259E-4, & 20.0E0, 1.0E0, 0.46890678427324100410E-5, & 40.0E0, 1.0E0, 0.20161544850996420504E-8/ DATA AIIDAT/-12.0E0, 1.0E0, -0.75228838916610124300E0, & -11.0E0, 1.0E0, -0.57348350185854889466E0, & -10.0E0, 1.0E0, -0.76569840313421291743E0, & -19.0E0, 2.0E0, -0.65181015505382467421E0, & -9.0E0, 1.0E0, -0.55881974894471876922E0, & -13.0E0, 2.0E0, -0.56902352870716815309E0, & -4.0E0, 1.0E0, -0.47800749642926168100E0, & -1.0E0, 1.0E0, -0.46567398346706861416E0, & -1.0E0, 4.0E0, -0.96783140945618013679E-1, & -1.0E0, 1024.0E0, -0.34683049857035607494E-3, & 1.0E0, 1024.0E0, 0.34658366917927930790E-3, & 1.0E0, 128.0E0, 0.27657581846051227124E-2, & 1.0E0, 2.0E0, 0.14595330491185717833E0, & 1.0E0, 1.0E0, 0.23631734191710977960E0, & 4.0E0, 1.0E0, 0.33289264538612212697E0, & 9.0E0, 2.0E0, 0.33318759129779422976E0, & 6.0E0, 1.0E0, 0.33332945170523851439E0, & 8.0E0, 1.0E0, 0.33333331724248357420E0, & 10.0E0, 1.0E0, 0.33333333329916901594E0, & 12.0E0, 1.0E0, 0.33333333333329380187E0/ DATA AGIDAT/-1.0E0, 512.0E0, 0.20468308070040542435E0, & -1.0E0, 8.0E0, 0.18374662832557904078E0, & -1.0E0, 1.0E0, -0.11667221729601528265E0, & -4.0E0, 1.0E0, 0.31466934902729557596E0, & -8.0E0, 1.0E0, -0.37089040722426257729E0, & -33.0E0, 4.0E0, -0.25293059772424019694E0, & -9.0E0, 1.0E0, 0.28967410658692701936E0, & -10.0E0, 1.0E0, -0.34644836492634090590E0, & -11.0E0, 1.0E0, 0.28076035913873049496E0, & -13.0E0, 1.0E0, 0.21814994508094865815E0, & 1.0E0, 512.0E0, 0.20526679000810503329E0, & 1.0E0, 8.0E0, 0.22123695363784773258E0, & 1.0E0, 1.0E0, 0.23521843981043793760E0, & 4.0E0, 1.0E0, 0.82834303363768729338E-1, & 7.0E0, 1.0E0, 0.45757385490989281893E-1, & 29.0E0, 4.0E0, 0.44150012014605159922E-1, & 8.0E0, 1.0E0, 0.39951133719508907541E-1, & 9.0E0, 1.0E0, 0.35467706833949671483E-1, & 10.0E0, 1.0E0, 0.31896005100679587981E-1, & 12.0E0, 1.0E0, 0.26556892713512410405E-1/ DATA AHIDAT/-1.0E0, 512.0E0, 0.40936798278458884024E0, & -1.0E0, 8.0E0, 0.37495291608048868619E0, & -1.0E0, 1.0E0, 0.22066960679295989454E0, & -4.0E0, 1.0E0, 0.77565356679703713590E-1, & -8.0E0, 1.0E0, 0.39638826473124717315E-1, & -33.0E0, 4.0E0, 0.38450072575004151871E-1, & -9.0E0, 1.0E0, 0.35273216868317898556E-1, & -10.0E0, 1.0E0, 0.31768535282502272742E-1, & -11.0E0, 1.0E0, 0.28894408288051391369E-1, & -13.0E0, 1.0E0, 0.24463284011678541180E-1, & 1.0E0, 512.0E0, 0.41053540139998941517E0, & 1.0E0, 8.0E0, 0.44993502381204990817E0, & 1.0E0, 1.0E0, 0.97220515514243332184E0, & 4.0E0, 1.0E0, 0.83764237105104371193E2, & 7.0E0, 1.0E0, 0.80327744952044756016E5, & 29.0E0, 4.0E0, 0.15514138847749108298E6, & 8.0E0, 1.0E0, 0.11995859641733262114E7, & 9.0E0, 1.0E0, 0.21472868855967642259E8, & 10.0E0, 1.0E0, 0.45564115351632913590E9, & 12.0E0, 1.0E0, 0.32980722582904761929E12/ DATA ATNDAT/1.0E0, 512.0E0, 0.19531241721588483191E-2, & -1.0E0, 256.0E0, -0.39062433772980711281E-2, & 1.0E0, 128.0E0, 0.78124470192576499535E-2, & 1.0E0, 64.0E0, 0.15624576181996527280E-1, & -1.0E0, 32.0E0, -0.31246610349485401551E-1, & 1.0E0, 16.0E0, 0.62472911335014397321E-1, & 1.0E0, 8.0E0, 0.12478419717389654039E0, & -1.0E0, 4.0E0, -0.24830175098230686908E0, & 1.0E0, 2.0E0, 0.48722235829452235711E0, & 1.0E0, 1.0E0, 0.91596559417721901505E0, & 3.0E0, 2.0E0, 0.12749694484943800618E1, & -2.0E0, 1.0E0, -0.15760154034463234224E1, & 4.0E0, 1.0E0, 0.24258878412859089996E1, & 8.0E0, 1.0E0, 0.33911633326292997361E1, & 16.0E0, 1.0E0, 0.44176450919422186583E1, & -20.0E0, 1.0E0, -0.47556713749547247774E1, & 25.0E0, 1.0E0, 0.50961912150934111303E1, & 30.0E0, 1.0E0, 0.53759175735714876256E1, & -50.0E0, 1.0E0, -0.61649904785027487422E1, & 100.0E0, 1.0E0, 0.72437843013083534973E1/ DATA BIIDAT/-12.0E0, 1.0E0, 0.17660819031554631869E-1, & -10.0E0, 1.0E0, -0.15040424806140020451E-1, & -8.0E0, 1.0E0, 0.14756446293227661920E-1, & -15.0E0, 2.0E0, -0.11847304264848446271E0, & -7.0E0, 1.0E0, -0.64916741266165856037E-1, & -13.0E0, 2.0E0, 0.97260832464381044540E-1, & -4.0E0, 1.0E0, 0.50760058495287539119E-1, & -1.0E0, 1.0E0, -0.37300500963429492179E0, & -1.0E0, 4.0E0, -0.13962988442666578531E0, & -1.0E0, 512.0E0, -0.12001735266723296160E-2, & 1.0E0, 512.0E0, 0.12018836117890354598E-2, & 1.0E0, 2.0E0, 0.36533846550952011043E0, & 1.0E0, 1.0E0, 0.87276911673800812196E0, & 4.0E0, 1.0E0, 0.48219475263803429675E2, & 8.0E0, 1.0E0, 0.44006525804904178439E6, & 17.0E0, 2.0E0, 0.17608153976228301458E7, & 9.0E0, 1.0E0, 0.73779211705220007228E7, & 10.0E0, 1.0E0, 0.14780980310740671617E9, & 12.0E0, 1.0E0, 0.97037614223613433849E11, & 14.0E0, 1.0E0, 0.11632737638809878460E15/ DATA CLNDAT/1.0E0, 512.0E0, 0.14137352886760576684E-1, & 1.0E0, 32.0E0, 0.13955467081981281934E0, & -1.0E0, 8.0E0, -0.38495732156574238507E0, & 1.0E0, 2.0E0, 0.84831187770367927099E0, & 1.0E0, 1.0E0, 0.10139591323607685043E1, & -3.0E0, 2.0E0, -0.93921859275409211003E0, & 2.0E0, 1.0E0, 0.72714605086327924743E0, & 5.0E0, 2.0E0, 0.43359820323553277936E0, & -3.0E0, 1.0E0, -0.98026209391301421161E-1, & 4.0E0, 1.0E0, -0.56814394442986978080E0, & 17.0E0, 4.0E0, -0.70969701784448921625E0, & -5.0E0, 1.0E0, 0.99282013254695671871E0, & 11.0E0, 2.0E0, -0.98127747477447367875E0, & 6.0E0, 1.0E0, -0.64078266570172320959E0, & 8.0E0, 1.0E0, 0.86027963733231192456E0, & -10.0E0, 1.0E0, 0.39071647608680211043E0, & 15.0E0, 1.0E0, 0.47574793926539191502E0, & 20.0E0, 1.0E0, 0.10105014481412878253E1, & -30.0E0, 1.0E0, 0.96332089044363075154E0, & 50.0E0, 1.0E0, -0.61782699481929311757E0/ DATA DB1DAT/1.0E0, 512.0E0, 0.99951182471380889183E0, & 1.0E0, 32.0E0, 0.99221462647120597836E0, & 1.0E0, 8.0E0, 0.96918395997895308324E0, & 1.0E0, 2.0E0, 0.88192715679060552968E0, & 1.0E0, 1.0E0, 0.77750463411224827642E0, & 3.0E0, 2.0E0, 0.68614531078940204342E0, & 2.0E0, 1.0E0, 0.60694728460981007205E0, & 5.0E0, 2.0E0, 0.53878956907785587703E0, & 3.0E0, 1.0E0, 0.48043521957304283829E0, & 4.0E0, 1.0E0, 0.38814802129793784501E0, & 17.0E0, 4.0E0, 0.36930802829242526815E0, & 5.0E0, 1.0E0, 0.32087619770014612104E0, & 11.0E0, 2.0E0, 0.29423996623154246701E0, & 6.0E0, 1.0E0, 0.27126046678502189985E0, & 8.0E0, 1.0E0, 0.20523930310221503723E0, & 10.0E0, 1.0E0, 0.16444346567994602563E0, & 15.0E0, 1.0E0, 0.10966194482735821276E0, & 20.0E0, 1.0E0, 0.82246701178200016086E-1, & 30.0E0, 1.0E0, 0.54831135561510852445E-1, & 50.0E0, 1.0E0, 0.32898681336964528729E-1/ DATA DB2DAT/1.0E0, 512.0E0, 0.99934911727904599738E0, & 1.0E0, 32.0E0, 0.98962402299599181205E0, & 1.0E0, 8.0E0, 0.95898426200345986743E0, & 1.0E0, 2.0E0, 0.84372119334725358934E0, & 1.0E0, 1.0E0, 0.70787847562782928288E0, & 3.0E0, 2.0E0, 0.59149637225671282917E0, & 2.0E0, 1.0E0, 0.49308264399053185014E0, & 5.0E0, 2.0E0, 0.41079413579749669069E0, & 3.0E0, 1.0E0, 0.34261396060786351671E0, & 4.0E0, 1.0E0, 0.24055368752127897660E0, & 17.0E0, 4.0E0, 0.22082770061202308232E0, & 5.0E0, 1.0E0, 0.17232915939014138975E0, & 11.0E0, 2.0E0, 0.14724346738730182894E0, & 6.0E0, 1.0E0, 0.12666919046715789982E0, & 8.0E0, 1.0E0, 0.74268805954862854626E-1, & 10.0E0, 1.0E0, 0.47971498020121871622E-1, & 15.0E0, 1.0E0, 0.21369201683658373846E-1, & 20.0E0, 1.0E0, 0.12020564476446432799E-1, & 30.0E0, 1.0E0, 0.53424751249537071952E-2, & 50.0E0, 1.0E0, 0.19232910450553508562E-2/ DATA DB3DAT/1.0E0, 512.0E0, 0.99926776885985461940E0, & 1.0E0, 32.0E0, 0.98833007755734698212E0, & 1.0E0, 8.0E0, 0.95390610472023510237E0, & 1.0E0, 2.0E0, 0.82496296897623372315E0, & 1.0E0, 1.0E0, 0.67441556407781468010E0, & 3.0E0, 2.0E0, 0.54710665141286285468E0, & 2.0E0, 1.0E0, 0.44112847372762418113E0, & 5.0E0, 2.0E0, 0.35413603481042394211E0, & 3.0E0, 1.0E0, 0.28357982814342246206E0, & 4.0E0, 1.0E0, 0.18173691382177474795E0, & 17.0E0, 4.0E0, 0.16277924385112436877E0, & 5.0E0, 1.0E0, 0.11759741179993396450E0, & 11.0E0, 2.0E0, 0.95240802723158889887E-1, & 6.0E0, 1.0E0, 0.77581324733763020269E-1, & 8.0E0, 1.0E0, 0.36560295673194845002E-1, & 10.0E0, 1.0E0, 0.19295765690345489563E-1, & 15.0E0, 1.0E0, 0.57712632276188798621E-2, & 20.0E0, 1.0E0, 0.24352200674805479827E-2, & 30.0E0, 1.0E0, 0.72154882216335666096E-3, & 50.0E0, 1.0E0, 0.15585454565440389896E-3/ DATA DB4DAT/1.0E0, 512.0E0, 0.99921896192761576256E0, & 1.0E0, 32.0E0, 0.98755425280996071022E0, & 1.0E0, 8.0E0, 0.95086788606389739976E0, & 1.0E0, 2.0E0, 0.81384569172034042516E0, & 1.0E0, 1.0E0, 0.65487406888673697092E0, & 3.0E0, 2.0E0, 0.52162830964878715188E0, & 2.0E0, 1.0E0, 0.41189273671788528876E0, & 5.0E0, 2.0E0, 0.32295434858707304628E0, & 3.0E0, 1.0E0, 0.25187863642883314410E0, & 4.0E0, 1.0E0, 0.15185461258672022043E0, & 17.0E0, 4.0E0, 0.13372661145921413299E0, & 5.0E0, 1.0E0, 0.91471377664481164749E-1, & 11.0E0, 2.0E0, 0.71227828197462523663E-1, & 6.0E0, 1.0E0, 0.55676547822738862783E-1, & 8.0E0, 1.0E0, 0.21967566525574960096E-1, & 10.0E0, 1.0E0, 0.96736755602711590082E-2, & 15.0E0, 1.0E0, 0.19646978158351837850E-2, & 20.0E0, 1.0E0, 0.62214648623965450200E-3, & 30.0E0, 1.0E0, 0.12289514092077854510E-3, & 50.0E0, 1.0E0, 0.15927210319002161231E-4/ DATA EX3DAT/1.0E0, 512.0E0, 0.19531249963620212007E-2, & 1.0E0, 128.0E0, 0.78124990686775522671E-2, & 1.0E0, 32.0E0, 0.31249761583499728667E-1, & 1.0E0, 8.0E0, 0.12493899888803079984E0, & 1.0E0, 2.0E0, 0.48491714311363971332E0, & 1.0E0, 1.0E0, 0.80751118213967145286E0, & 5.0E0, 4.0E0, 0.86889265412623270696E0, & 3.0E0, 2.0E0, 0.88861722235357162648E0, & 15.0E0, 8.0E0, 0.89286018500218176869E0, & 2.0E0, 1.0E0, 0.89295351429387631138E0, & 17.0E0, 8.0E0, 0.89297479112737843939E0, & 18.0E0, 8.0E0, 0.89297880579798112220E0, & 5.0E0, 2.0E0, 0.89297950317496621294E0, & 11.0E0, 4.0E0, 0.89297951152951902903E0, & 3.0E0, 1.0E0, 0.89297951156918122102E0, & 25.0E0, 8.0E0, 0.89297951156924734716E0, & 13.0E0, 4.0E0, 0.89297951156924917298E0, & 7.0E0, 2.0E0, 0.89297951156924921121E0, & 15.0E0, 4.0E0, 0.89297951156924921122E0, & 4.0E0, 1.0E0, 0.89297951156924921122E0/ DATA GSTDAT/1.0E0, 512.0E0, 0.59531540040441651584E1, & 1.0E0, 128.0E0, 0.45769601268624494109E1, & 1.0E0, 32.0E0, 0.32288921331902217638E1, & 1.0E0, 8.0E0, 0.19746110873568719362E1, & 1.0E0, 2.0E0, 0.96356046208697728563E0, & 1.0E0, 1.0E0, 0.60513365250334458174E0, & 5.0E0, 4.0E0, 0.51305506459532198016E0, & 3.0E0, 2.0E0, 0.44598602820946133091E0, & 15.0E0, 8.0E0, 0.37344458206879749357E0, & 2.0E0, 1.0E0, 0.35433592884953063055E0, & 17.0E0, 8.0E0, 0.33712156518881920994E0, & 5.0E0, 2.0E0, 0.29436170729362979176E0, & 3.0E0, 1.0E0, 0.25193499644897222840E0, & 7.0E0, 2.0E0, 0.22028778222123939276E0, & 4.0E0, 1.0E0, 0.19575258237698917033E0, & 9.0E0, 2.0E0, 0.17616303166670699424E0, & 5.0E0, 1.0E0, 0.16015469479664778673E0, & 23.0E0, 4.0E0, 0.14096116876193391066E0, & 6.0E0, 1.0E0, 0.13554987191049066274E0, & 7.0E0, 1.0E0, 0.11751605060085098084E0/ DATA I0IDAT/1.0E0, 512.0E0, 0.19531256208818052282E-2, & -1.0E0, 256.0E0, -0.39062549670565734544E-2, & 1.0E0, 16.0E0, 0.62520348032546565850E-1, & 1.0E0, 8.0E0, 0.12516285581366971819E0, & -1.0E0, 2.0E0, -0.51051480879740303760E0, & 1.0E0, 1.0E0, 0.10865210970235898158E1, & 2.0E0, 1.0E0, 0.27750019054282535299E1, & -4.0E0, 1.0E0, -0.13775208868039716639E2, & 8.0E0, 1.0E0, 0.46424372058106108576E3, & 18.0E0, 1.0E0, 0.64111867658021584522E7, & -37.0E0, 2.0E0, -0.10414860803175857953E8, & 20.0E0, 1.0E0, 0.44758598913855743089E8, & -21.0E0, 1.0E0, -0.11852985311558287888E9, & 22.0E0, 1.0E0, 0.31430078220715992752E9, & -23.0E0, 1.0E0, -0.83440212900794309620E9, & 24.0E0, 1.0E0, 0.22175367579074298261E10, & 25.0E0, 1.0E0, 0.58991731842803636487E10, & -27.0E0, 1.0E0, -0.41857073244691522147E11, & 30.0E0, 1.0E0, 0.79553885818472357663E12, & 40.0E0, 1.0E0, 0.15089715082719201025E17/ DATA IL0DAT/1.0E0, 512.0E0, 0.99875755515461749793E0, & 1.0E0, 64.0E0, 0.99011358230706643807E0, & 1.0E0, 8.0E0, 0.92419435310023947018E0, & 1.0E0, 2.0E0, 0.73624267134714273902E0, & 1.0E0, 1.0E0, 0.55582269181411744686E0, & 2.0E0, 1.0E0, 0.34215154434462160628E0, & 4.0E0, 1.0E0, 0.17087174888774706539E0, & 8.0E0, 1.0E0, 0.81081008709219208918E-1, & 12.0E0, 1.0E0, 0.53449421441089580702E-1, & 16.0E0, 1.0E0, 0.39950321008923244846E-1, & 65.0E0, 4.0E0, 0.39330637437584921392E-1, & 17.0E0, 1.0E0, 0.37582274342808670750E-1, & 20.0E0, 1.0E0, 0.31912486554480390343E-1, & 25.0E0, 1.0E0, 0.25506146883504738403E-1, & 30.0E0, 1.0E0, 0.21244480317825292412E-1, & 40.0E0, 1.0E0, 0.15925498348551684335E-1, & 50.0E0, 1.0E0, 0.12737506927242585015E-1, & 75.0E0, 1.0E0, 0.84897750814784916847E-2, & 100.0E0, 1.0E0, 0.63668349178454469153E-2, & 125.0E0, 1.0E0, 0.50932843163122551114E-2/ DATA IL1DAT/1.0E0, 512.0E0, 0.97575346155386267134E-3, & 1.0E0, 64.0E0, 0.77609293280609272733E-2, & 1.0E0, 8.0E0, 0.59302966404545373770E-1, & 1.0E0, 2.0E0, 0.20395212276737365307E0, & 1.0E0, 1.0E0, 0.33839472293667639038E0, & 2.0E0, 1.0E0, 0.48787706726961324579E0, & 4.0E0, 1.0E0, 0.59018734196576517506E0, & 8.0E0, 1.0E0, 0.62604539530312149476E0, & 12.0E0, 1.0E0, 0.63209315274909764698E0, & 16.0E0, 1.0E0, 0.63410179313235359215E0, & 65.0E0, 4.0E0, 0.63417966797578128188E0, & 17.0E0, 1.0E0, 0.63439268632392089434E0, & 20.0E0, 1.0E0, 0.63501579073257770690E0, & 25.0E0, 1.0E0, 0.63559616677359459337E0, & 30.0E0, 1.0E0, 0.63591001826697110312E0, & 40.0E0, 1.0E0, 0.63622113181751073643E0, & 50.0E0, 1.0E0, 0.63636481702133606597E0, & 75.0E0, 1.0E0, 0.63650653499619902120E0, & 100.0E0, 1.0E0, 0.63655609126300261851E0, & 125.0E0, 1.0E0, 0.63657902087183929223E0/ DATA J0IDAT/1.0E0, 1024.0E0, 0.97656242238978822427E-3, & 1.0E0, 256.0E0, 0.39062450329491108875E-2, & -1.0E0, 16.0E0, -0.62479657927917933620E-1, & 1.0E0, 8.0E0, 0.12483733492120479139E0, & -1.0E0, 2.0E0, -0.48968050664604505505E0, & 1.0E0, 1.0E0, 0.91973041008976023931E0, & -2.0E0, 1.0E0, -0.14257702931970265690E1, & 4.0E0, 1.0E0, 0.10247341594606064818E1, & -8.0E0, 1.0E0, -0.12107468348304501655E1, & 16.0E0, 1.0E0, 0.11008652032736190799E1, & -33.0E0, 2.0E0, -0.10060334829904124192E1, & 18.0E0, 1.0E0, 0.81330572662485953519E0, & -20.0E0, 1.0E0, -0.10583788214211277585E1, & 25.0E0, 1.0E0, 0.87101492116545875169E0, & -30.0E0, 1.0E0, -0.88424908882547488420E0, & 40.0E0, 1.0E0, 0.11257761503599914603E1, & -50.0E0, 1.0E0, -0.90141212258183461184E0, & 75.0E0, 1.0E0, 0.91441344369647797803E0, & -80.0E0, 1.0E0, -0.94482281938334394886E0, & 100.0E0, 1.0E0, 0.92266255696016607257E0/ DATA K0IDAT/1.0E0, 1024.0E0, 0.78587929563466784589E-2, & 1.0E0, 256.0E0, 0.26019991617330578111E-1, & 1.0E0, 16.0E0, 0.24311842237541167904E0, & 1.0E0, 8.0E0, 0.39999633750480508861E0, & 1.0E0, 2.0E0, 0.92710252093114907345E0, & 1.0E0, 1.0E0, 0.12425098486237782662E1, & 2.0E0, 1.0E0, 0.14736757343168286825E1, & 4.0E0, 1.0E0, 0.15606495706051741364E1, & 5.0E0, 1.0E0, 0.15673873907283660493E1, & 6.0E0, 1.0E0, 0.15696345532693743714E1, & 13.0E0, 2.0E0, 0.15701153443250786355E1, & 8.0E0, 1.0E0, 0.15706574852894436220E1, & 10.0E0, 1.0E0, 0.15707793116159788598E1, & 12.0E0, 1.0E0, 0.15707942066465767196E1, & 15.0E0, 1.0E0, 0.15707962315469192247E1, & 20.0E0, 1.0E0, 0.15707963262340149876E1, & 30.0E0, 1.0E0, 0.15707963267948756308E1, & 50.0E0, 1.0E0, 0.15707963267948966192E1, & 80.0E0, 1.0E0, 0.15707963267948966192E1, & 100.0E0, 1.0E0, 0.15707963267948966192E1/ DATA LOBDAT/1.0E0, 512.0E0, 0.12417639065161393857E-8, & 1.0E0, 128.0E0, 0.79473344770001088225E-7, & 1.0E0, 32.0E0, 0.50867598186208834198E-5, & 1.0E0, 8.0E0, 0.32603097901207200319E-3, & 1.0E0, 2.0E0, 0.21380536815408214419E-1, & 1.0E0, 1.0E0, 0.18753816902083824050E0, & 3.0E0, 2.0E0, 0.83051199971883645115E0, & 2.0E0, 1.0E0, 0.18854362426679034904E1, & 5.0E0, 2.0E0, 0.21315988986516411053E1, & 3.0E0, 1.0E0, 0.21771120185613427221E1, & 4.0E0, 1.0E0, 0.22921027921896650849E1, & 5.0E0, 1.0E0, 0.39137195028784495586E1, & 6.0E0, 1.0E0, 0.43513563983836427904E1, & 7.0E0, 1.0E0, 0.44200644968478185898E1, & 10.0E0, 1.0E0, 0.65656013133623829156E1, & 15.0E0, 1.0E0, 0.10825504661504599479E2, & 20.0E0, 1.0E0, 0.13365512855474227325E2, & 30.0E0, 1.0E0, 0.21131002685639959927E2, & 50.0E0, 1.0E0, 0.34838236589449117389E2, & 100.0E0, 1.0E0, 0.69657062437837394278E2/ DATA STRDAT/1.0E0, 512.0E0, 0.21901065985698662316E-15, & 1.0E0, 128.0E0, 0.22481399438625244761E-12, & 1.0E0, 32.0E0, 0.23245019579558857124E-9, & 1.0E0, 8.0E0, 0.24719561475975007037E-6, & 1.0E0, 2.0E0, 0.28992610989833245669E-3, & 1.0E0, 1.0E0, 0.10698146390809715091E-1, & 3.0E0, 2.0E0, 0.89707650964424730705E-1, & 2.0E0, 1.0E0, 0.40049605719592888440E0, & 3.0E0, 1.0E0, 0.30504104398079096598E1, & 4.0E0, 1.0E0, 0.11367704858439426431E2, & 33.0E0, 8.0E0, 0.12960679405324786954E2, & 9.0E0, 2.0E0, 0.18548713944748505675E2, & 5.0E0, 1.0E0, 0.27866273821903121400E2, & 6.0E0, 1.0E0, 0.51963334071699323351E2, & 8.0E0, 1.0E0, 0.10861016747891228129E3, & 10.0E0, 1.0E0, 0.15378903316556621624E3, & 15.0E0, 1.0E0, 0.19302665532558721516E3, & 20.0E0, 1.0E0, 0.19636850166006541482E3, & 30.0E0, 1.0E0, 0.19651946766008214217E3, & 50.0E0, 1.0E0, 0.19651956920868316152E3/ DATA SH0DAT/1.0E0, 512.0E0, 0.12433974658847434366E-2, & -1.0E0, 128.0E0, -0.49735582423748415045E-2, & 1.0E0, 16.0E0, 0.39771469054536941564E-1, & -1.0E0, 4.0E0, -0.15805246001653314198E0, & 1.0E0, 1.0E0, 0.56865662704828795099E0, & 5.0E0, 4.0E0, 0.66598399314899916605E0, & 2.0E0, 1.0E0, 0.79085884950809589255E0, & -4.0E0, 1.0E0, -0.13501457342248639716E0, & 15.0E0, 2.0E0, 0.20086479668164503137E0, & 11.0E0, 1.0E0, -0.11142097800261991552E0, & 23.0E0, 2.0E0, -0.17026804865989885869E0, & -16.0E0, 1.0E0, -0.13544931808186467594E0, & 20.0E0, 1.0E0, 0.94393698081323450897E-1, & 25.0E0, 1.0E0, -0.10182482016001510271E0, & -30.0E0, 1.0E0, 0.96098421554162110012E-1, & 50.0E0, 1.0E0, -0.85337674826118998952E-1, & 75.0E0, 1.0E0, -0.76882290637052720045E-1, & -80.0E0, 1.0E0, 0.47663833591418256339E-1, & 100.0E0, 1.0E0, -0.70878751689647343204E-1, & -125.0E0, 1.0E0, 0.65752908073352785368E-1/ DATA SH1DAT/1.0E0, 512.0E0, 0.80950369576367526071E-6, & -1.0E0, 128.0E0, 0.12952009724113229165E-4, & 1.0E0, 16.0E0, 0.82871615165407083021E-3, & -1.0E0, 4.0E0, 0.13207748375849572564E-1, & 1.0E0, 1.0E0, 0.19845733620194439894E0, & 5.0E0, 4.0E0, 0.29853823231804706294E0, & 2.0E0, 1.0E0, 0.64676372828356211712E0, & -4.0E0, 1.0E0, 0.10697266613089193593E1, & 15.0E0, 2.0E0, 0.38831308000420560970E0, & 9.0E0, 1.0E0, 0.74854243745107710333E0, & 19.0E0, 2.0E0, 0.84664854642567359993E0, & -12.0E0, 1.0E0, 0.58385732464244384564E0, & 17.0E0, 1.0E0, 0.80600584524215772824E0, & 25.0E0, 1.0E0, 0.53880362132692947616E0, & -30.0E0, 1.0E0, 0.72175037834698998506E0, & 50.0E0, 1.0E0, 0.58007844794544189900E0, & 75.0E0, 1.0E0, 0.60151910385440804463E0, & -80.0E0, 1.0E0, 0.70611511147286827018E0, & 100.0E0, 1.0E0, 0.61631110327201338454E0, & -125.0E0, 1.0E0, 0.62778480765443656489E0/ DATA SL0DAT/1.0E0, 512.0E0, 0.12433985199262820188E-2, & -1.0E0, 32.0E0, -0.19896526647882937004E-1, & 1.0E0, 8.0E0, 0.79715713253115014945E-1, & -1.0E0, 2.0E0, -0.32724069939418078025E0, & 1.0E0, 1.0E0, 0.71024318593789088874E0, & 2.0E0, 1.0E0, 0.19374337579914456612E1, & -4.0E0, 1.0E0, -0.11131050203248583431E2, & 7.0E0, 1.0E0, 0.16850062034703267148E3, & -10.0E0, 1.0E0, -0.28156522493745948555E4, & 16.0E0, 1.0E0, 0.89344618796978400815E6, & 65.0E0, 4.0E0, 0.11382025002851451057E7, & -17.0E0, 1.0E0, -0.23549701855860190304E7, & 20.0E0, 1.0E0, 0.43558282527641046718E8, & 45.0E0, 2.0E0, 0.49993516476037957165E9, & -25.0E0, 1.0E0, -0.57745606064408041689E10, & 30.0E0, 1.0E0, 0.78167229782395624524E12, & -40.0E0, 1.0E0, -0.14894774793419899908E17, & 50.0E0, 1.0E0, 0.29325537838493363267E21, & 60.0E0, 1.0E0, 0.58940770556098011683E25, & -70.0E0, 1.0E0, -0.12015889579125463605E30/ DATA SL1DAT/1.0E0, 512.0E0, 0.80950410749865126939E-6, & -1.0E0, 32.0E0, 0.20724649092571514607E-3, & 1.0E0, 8.0E0, 0.33191834066894516744E-2, & -1.0E0, 2.0E0, 0.53942182623522663292E-1, & 1.0E0, 1.0E0, 0.22676438105580863683E0, & 2.0E0, 1.0E0, 0.11027597873677158176E1, & -4.0E0, 1.0E0, 0.91692778117386847344E1, & 7.0E0, 1.0E0, 0.15541656652426660966E3, & -10.0E0, 1.0E0, 0.26703582852084829694E4, & 16.0E0, 1.0E0, 0.86505880175304633906E6, & 65.0E0, 4.0E0, 0.11026046613094942620E7, & -17.0E0, 1.0E0, 0.22846209494153934787E7, & 20.0E0, 1.0E0, 0.42454972750111979449E8, & 45.0E0, 2.0E0, 0.48869614587997695539E9, & -25.0E0, 1.0E0, 0.56578651292431051863E10, & 30.0E0, 1.0E0, 0.76853203893832108948E12, & -40.0E0, 1.0E0, 0.14707396163259352103E17, & 50.0E0, 1.0E0, 0.29030785901035567967E21, & 60.0E0, 1.0E0, 0.58447515883904682813E25, & -70.0E0, 1.0E0, 0.11929750788892311875E30/ DATA SY1DAT/1.0E0, 512.0E0, 0.26514864547487397044E0, & 1.0E0, 32.0E0, 0.62050129979079045645E0, & 1.0E0, 8.0E0, 0.85112572132368011206E0, & 1.0E0, 2.0E0, 0.87081914687546885094E0, & 1.0E0, 1.0E0, 0.65142281535536396975E0, & 3.0E0, 2.0E0, 0.45064040920322354579E0, & 2.0E0, 1.0E0, 0.30163590285073940285E0, & 5.0E0, 2.0E0, 0.19814490804441305867E0, & 3.0E0, 1.0E0, 0.12856571000906381300E0, & 4.0E0, 1.0E0, 0.52827396697866818297E-1, & 17.0E0, 4.0E0, 0.42139298471720305542E-1, & 5.0E0, 1.0E0, 0.21248129774981984268E-1, & 11.0E0, 2.0E0, 0.13400258907505536491E-1, & 6.0E0, 1.0E0, 0.84260797314108699935E-2, & 8.0E0, 1.0E0, 0.12884516186754671469E-2, & 10.0E0, 1.0E0, 0.19223826430086897418E-3, & 12.0E0, 1.0E0, 0.28221070834007689394E-4, & 15.0E0, 1.0E0, 0.15548757973038189372E-5, & 20.0E0, 1.0E0, 0.11968634456097453636E-7, & 25.0E0, 1.0E0, 0.89564246772237127742E-10/ DATA SY2DAT/1.0E0, 512.0E0, 0.13430727275667378338E0, & 1.0E0, 32.0E0, 0.33485265272424176976E0, & 1.0E0, 8.0E0, 0.50404224110911078651E0, & 1.0E0, 2.0E0, 0.60296523236016785113E0, & 1.0E0, 1.0E0, 0.49447506210420826699E0, & 3.0E0, 2.0E0, 0.36036067860473360389E0, & 2.0E0, 1.0E0, 0.24967785497625662113E0, & 5.0E0, 2.0E0, 0.16813830542905833533E0, & 3.0E0, 1.0E0, 0.11117122348556549832E0, & 4.0E0, 1.0E0, 0.46923205826101330711E-1, & 17.0E0, 4.0E0, 0.37624545861980001482E-1, & 5.0E0, 1.0E0, 0.19222123172484106436E-1, & 11.0E0, 2.0E0, 0.12209535343654701398E-1, & 6.0E0, 1.0E0, 0.77249644268525771866E-2, & 8.0E0, 1.0E0, 0.12029044213679269639E-2, & 10.0E0, 1.0E0, 0.18161187569530204281E-3, & 12.0E0, 1.0E0, 0.26884338006629353506E-4, & 15.0E0, 1.0E0, 0.14942212731345828759E-5, & 20.0E0, 1.0E0, 0.11607696854385161390E-7, & 25.0E0, 1.0E0, 0.87362343746221526073E-10/ DATA TR2DAT/1.0E0, 512.0E0, 0.19531247930394515480E-2, & 1.0E0, 32.0E0, 0.31249152314331109004E-1, & 1.0E0, 8.0E0, 0.12494577194783451032E0, & 1.0E0, 2.0E0, 0.49655363615640595865E0, & 1.0E0, 1.0E0, 0.97303256135517012845E0, & 3.0E0, 2.0E0, 0.14121978695932525805E1, & 2.0E0, 1.0E0, 0.18017185674405776809E1, & 5.0E0, 2.0E0, 0.21350385339277043015E1, & 3.0E0, 1.0E0, 0.24110500490169534620E1, & 4.0E0, 1.0E0, 0.28066664045631179931E1, & 17.0E0, 4.0E0, 0.28777421863296234131E1, & 5.0E0, 1.0E0, 0.30391706043438554330E1, & 11.0E0, 2.0E0, 0.31125074928667355940E1, & 6.0E0, 1.0E0, 0.31656687817738577185E1, & 8.0E0, 1.0E0, 0.32623520367816009184E1, & 10.0E0, 1.0E0, 0.32843291144979517358E1, & 15.0E0, 1.0E0, 0.32897895167775788137E1, & 20.0E0, 1.0E0, 0.32898672226665499687E1, & 30.0E0, 1.0E0, 0.32898681336064325400E1, & 50.0E0, 1.0E0, 0.32898681336964528724E1/ DATA TR3DAT/1.0E0, 512.0E0, 0.19073483296476379584E-5, & 1.0E0, 32.0E0, 0.48826138243180786081E-3, & 1.0E0, 8.0E0, 0.78074163848431205820E-2, & 1.0E0, 2.0E0, 0.12370868718812031049E0, & 1.0E0, 1.0E0, 0.47984100657241749994E0, & 3.0E0, 2.0E0, 0.10269431622039754738E1, & 2.0E0, 1.0E0, 0.17063547219458658863E1, & 5.0E0, 2.0E0, 0.24539217444475937661E1, & 3.0E0, 1.0E0, 0.32106046629422467723E1, & 4.0E0, 1.0E0, 0.45792174372291563703E1, & 17.0E0, 4.0E0, 0.48722022832940370805E1, & 5.0E0, 1.0E0, 0.56143866138422732286E1, & 11.0E0, 2.0E0, 0.59984455864575470009E1, & 6.0E0, 1.0E0, 0.63033953673480961120E1, & 8.0E0, 1.0E0, 0.69579908688361166266E1, & 10.0E0, 1.0E0, 0.71503227120085929750E1, & 15.0E0, 1.0E0, 0.72110731475871876393E1, & 20.0E0, 1.0E0, 0.72123221966388461839E1, & 30.0E0, 1.0E0, 0.72123414161609465119E1, & 50.0E0, 1.0E0, 0.72123414189575656868E1/ DATA TR4DAT/1.0E0, 512.0E0, 0.24835263919461834041E-8, & 1.0E0, 32.0E0, 0.10172029353616724881E-4, & 1.0E0, 8.0E0, 0.65053332405940765479E-3, & 1.0E0, 2.0E0, 0.41150448004155727767E-1, & 1.0E0, 1.0E0, 0.31724404523442648241E0, & 3.0E0, 2.0E0, 0.10079442901142373591E1, & 2.0E0, 1.0E0, 0.22010881024333408363E1, & 5.0E0, 2.0E0, 0.38846508619156545210E1, & 3.0E0, 1.0E0, 0.59648223973714765245E1, & 4.0E0, 1.0E0, 0.10731932392998622219E2, & 17.0E0, 4.0E0, 0.11940028876819364777E2, & 5.0E0, 1.0E0, 0.15359784316882182982E2, & 11.0E0, 2.0E0, 0.17372587633093742893E2, & 6.0E0, 1.0E0, 0.19122976016053166969E2, & 8.0E0, 1.0E0, 0.23583979156921941515E2, & 10.0E0, 1.0E0, 0.25273667677030441733E2, & 15.0E0, 1.0E0, 0.25955198214572256372E2, & 20.0E0, 1.0E0, 0.25975350935212241910E2, & 30.0E0, 1.0E0, 0.25975757522084093747E2, & 50.0E0, 1.0E0, 0.25975757609067315288E2/ DATA TR5DAT/1.0E0, 512.0E0, 0.36379780361036116971E-11, & 1.0E0, 32.0E0, 0.23840564453948442379E-6, & 1.0E0, 8.0E0, 0.60982205372226969189E-4, & 1.0E0, 2.0E0, 0.15410004586376649337E-1, & 1.0E0, 1.0E0, 0.23661587923909478926E0, & 3.0E0, 2.0E0, 0.11198756851307629651E1, & 2.0E0, 1.0E0, 0.32292901663684049171E1, & 5.0E0, 2.0E0, 0.70362973105160654056E1, & 3.0E0, 1.0E0, 0.12770557691044159511E2, & 4.0E0, 1.0E0, 0.29488339015245845447E2, & 17.0E0, 4.0E0, 0.34471340540362254586E2, & 5.0E0, 1.0E0, 0.50263092218175187785E2, & 11.0E0, 2.0E0, 0.60819909101127165207E2, & 6.0E0, 1.0E0, 0.70873334429213460498E2, & 8.0E0, 1.0E0, 0.10147781242977788097E3, & 10.0E0, 1.0E0, 0.11638074540242071077E3, & 15.0E0, 1.0E0, 0.12409623901262967878E3, & 20.0E0, 1.0E0, 0.12442270155632550228E3, & 30.0E0, 1.0E0, 0.12443132790838589548E3, & 50.0E0, 1.0E0, 0.12443133061720432435E3/ DATA TR6DAT/1.0E0, 512.0E0, 0.56843405953641209574E-14, & 1.0E0, 32.0E0, 0.59601180165247401484E-8, & 1.0E0, 8.0E0, 0.60978424397580572815E-5, & 1.0E0, 2.0E0, 0.61578909866319494394E-2, & 1.0E0, 1.0E0, 0.18854360275680840514E0, & 3.0E0, 2.0E0, 0.13319251347921659134E1, & 2.0E0, 1.0E0, 0.50857202271697616755E1, & 5.0E0, 2.0E0, 0.13729222365466557122E2, & 3.0E0, 1.0E0, 0.29579592481641441292E2, & 4.0E0, 1.0E0, 0.88600835706899853768E2, & 17.0E0, 4.0E0, 0.10916037113373004909E3, & 5.0E0, 1.0E0, 0.18224323749575359518E3, & 11.0E0, 2.0E0, 0.23765383125586756031E3, & 6.0E0, 1.0E0, 0.29543246745959381136E3, & 8.0E0, 1.0E0, 0.50681244381280455592E3, & 10.0E0, 1.0E0, 0.63878231134946125623E3, & 15.0E0, 1.0E0, 0.72699203556994876111E3, & 20.0E0, 1.0E0, 0.73230331643146851717E3, & 30.0E0, 1.0E0, 0.73248692015882096369E3, & 50.0E0, 1.0E0, 0.73248700462879996604E3/ DATA TR7DAT/1.0E0, 512.0E0, 0.92518563327283409427E-17, & 1.0E0, 32.0E0, 0.15521095556949867541E-9, & 1.0E0, 8.0E0, 0.63516238373841716290E-6, & 1.0E0, 2.0E0, 0.25638801246626135714E-2, & 1.0E0, 1.0E0, 0.15665328993811649746E0, & 3.0E0, 2.0E0, 0.16538225039181097423E1, & 2.0E0, 1.0E0, 0.83763085709508211054E1, & 5.0E0, 2.0E0, 0.28078570717830763747E2, & 3.0E0, 1.0E0, 0.72009676046751991365E2, & 4.0E0, 1.0E0, 0.28174905701691911450E3, & 17.0E0, 4.0E0, 0.36660227975327792529E3, & 5.0E0, 1.0E0, 0.70556067982603601123E3, & 11.0E0, 2.0E0, 0.99661927562755629434E3, & 6.0E0, 1.0E0, 0.13288914430417403901E4, & 8.0E0, 1.0E0, 0.27987640273169129925E4, & 10.0E0, 1.0E0, 0.39721376409416504325E4, & 15.0E0, 1.0E0, 0.49913492839319899726E4, & 20.0E0, 1.0E0, 0.50781562639825019000E4, & 30.0E0, 1.0E0, 0.50820777202028708434E4, & 50.0E0, 1.0E0, 0.50820803580047164618E4/ DATA TR8DAT/1.0E0, 512.0E0, 0.15488598634539359463E-19, & 1.0E0, 32.0E0, 0.41574269117845953797E-11, & 1.0E0, 8.0E0, 0.68050651245227411689E-7, & 1.0E0, 2.0E0, 0.10981703519563009836E-2, & 1.0E0, 1.0E0, 0.13396432776187883834E0, & 3.0E0, 2.0E0, 0.21153387806998617182E1, & 2.0E0, 1.0E0, 0.14227877028750735641E2, & 5.0E0, 2.0E0, 0.59312061431647843226E2, & 3.0E0, 1.0E0, 0.18139614577043147745E3, & 4.0E0, 1.0E0, 0.93148001928992220863E3, & 17.0E0, 4.0E0, 0.12817928112604611804E4, & 5.0E0, 1.0E0, 0.28572838386329242218E4, & 11.0E0, 2.0E0, 0.43872971687877730010E4, & 6.0E0, 1.0E0, 0.62993229139406657611E4, & 8.0E0, 1.0E0, 0.16589426277154888511E5, & 10.0E0, 1.0E0, 0.27064780798797398935E5, & 15.0E0, 1.0E0, 0.38974556062543661284E5, & 20.0E0, 1.0E0, 0.40400240716905025786E5, & 30.0E0, 1.0E0, 0.40484316504120655568E5, & 50.0E0, 1.0E0, 0.40484399001892184901E5/ DATA TR9DAT/1.0E0, 512.0E0, 0.26469772870084897671E-22, & 1.0E0, 32.0E0, 0.11367943653594246210E-12, & 1.0E0, 8.0E0, 0.74428246255329800255E-8, & 1.0E0, 2.0E0, 0.48022728485415366194E-3, & 1.0E0, 1.0E0, 0.11700243014358676725E0, & 3.0E0, 2.0E0, 0.27648973910899914391E1, & 2.0E0, 1.0E0, 0.24716631405829192997E2, & 5.0E0, 2.0E0, 0.12827119828849828583E3, & 3.0E0, 1.0E0, 0.46842894800662208986E3, & 4.0E0, 1.0E0, 0.31673967371627895718E4, & 17.0E0, 4.0E0, 0.46140886546630195390E4, & 5.0E0, 1.0E0, 0.11952718545392302185E5, & 11.0E0, 2.0E0, 0.20001612666477027728E5, & 6.0E0, 1.0E0, 0.31011073271851366554E5, & 8.0E0, 1.0E0, 0.10352949905541130133E6, & 10.0E0, 1.0E0, 0.19743173017140591390E6, & 15.0E0, 1.0E0, 0.33826030414658460679E6, & 20.0E0, 1.0E0, 0.36179607036750755227E6, & 30.0E0, 1.0E0, 0.36360622124777561525E6, & 50.0E0, 1.0E0, 0.36360880558827162725E6/ DATA Y0IDAT/1.0E0, 512.0E0, -0.91442642860172110926E-2, & 1.0E0, 128.0E0, -0.29682047390397591290E-1, & 1.0E0, 8.0E0, -0.25391431276585388961E0, & 1.0E0, 2.0E0, -0.56179545591464028187E0, & 1.0E0, 1.0E0, -0.63706937660742309754E0, & 2.0E0, 1.0E0, -0.28219285008510084123E0, & 4.0E0, 1.0E0, 0.38366964785312561103E0, & 6.0E0, 1.0E0, -0.12595061285798929390E0, & 10.0E0, 1.0E0, 0.24129031832266684828E0, & 16.0E0, 1.0E0, 0.17138069757627037938E0, & 65.0E0, 4.0E0, 0.18958142627134083732E0, & 17.0E0, 1.0E0, 0.17203846136449706946E0, & 20.0E0, 1.0E0, -0.16821597677215029611E0, & 25.0E0, 1.0E0, -0.93607927351428988679E-1, & 30.0E0, 1.0E0, 0.88229711948036648408E-1, & 40.0E0, 1.0E0, -0.89324662736274161841E-2, & 50.0E0, 1.0E0, -0.54814071000063488284E-1, & 70.0E0, 1.0E0, -0.94958246003466381588E-1, & 100.0E0, 1.0E0, -0.19598064853404969850E-1, & 125.0E0, 1.0E0, -0.83084772357154773468E-2/ C C TEST ABRAM0 C FNAME = 'ABRAM0' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 100 I = 1 , 20 NUM = AB0DAT ( 1 , I ) DEN = AB0DAT ( 2 , I ) RES = AB0DAT ( 3 , I ) PT = NUM / DEN COMP = ABRAM0(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 100 CONTINUE C C TEST ABRAM1 C FNAME = 'ABRAM1' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 110 I = 1 , 20 NUM = AB1DAT ( 1 , I ) DEN = AB1DAT ( 2 , I ) RES = AB1DAT ( 3 , I ) PT = NUM / DEN COMP = ABRAM1(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 110 CONTINUE C C TEST ABRAM2 C FNAME = 'ABRAM2' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 120 I = 1 , 20 NUM = AB2DAT ( 1 , I ) DEN = AB2DAT ( 2 , I ) RES = AB2DAT ( 3 , I ) PT = NUM / DEN COMP = ABRAM2(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 120 CONTINUE C C TEST AIRINT C FNAME = 'AIRINT' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 130 I = 1 , 20 NUM = AIIDAT ( 1 , I ) DEN = AIIDAT ( 2 , I ) RES = AIIDAT ( 3 , I ) PT = NUM / DEN COMP = AIRINT(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 130 CONTINUE C C TEST AIRYGI C FNAME = 'AIRYGI' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 140 I = 1 , 20 NUM = AGIDAT ( 1 , I ) DEN = AGIDAT ( 2 , I ) RES = AGIDAT ( 3 , I ) PT = NUM / DEN COMP = AIRYGI(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 140 CONTINUE C C TEST AIRYHI C FNAME = 'AIRYHI' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 150 I = 1 , 20 NUM = AHIDAT ( 1 , I ) DEN = AHIDAT ( 2 , I ) RES = AHIDAT ( 3 , I ) PT = NUM / DEN COMP = AIRYHI(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 150 CONTINUE C C TEST ATNINT C FNAME = 'ATNINT' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 160 I = 1 , 20 NUM = ATNDAT ( 1 , I ) DEN = ATNDAT ( 2 , I ) RES = ATNDAT ( 3 , I ) PT = NUM / DEN COMP = ATNINT(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 160 CONTINUE C C TEST BIRINT C FNAME = 'BIRINT' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 170 I = 1 , 20 NUM = BIIDAT ( 1 , I ) DEN = BIIDAT ( 2 , I ) RES = BIIDAT ( 3 , I ) PT = NUM / DEN COMP = BIRINT(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 170 CONTINUE C C TEST CLAUSN C FNAME = 'CLAUSN' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 180 I = 1 , 20 NUM = CLNDAT ( 1 , I ) DEN = CLNDAT ( 2 , I ) RES = CLNDAT ( 3 , I ) PT = NUM / DEN COMP = CLAUSN(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 180 CONTINUE C C TEST DEBYE1 C FNAME = 'DEBYE1' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 190 I = 1 , 20 NUM = DB1DAT ( 1 , I ) DEN = DB1DAT ( 2 , I ) RES = DB1DAT ( 3 , I ) PT = NUM / DEN COMP = DEBYE1(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 190 CONTINUE C C TEST DEBYE2 C FNAME = 'DEBYE2' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 200 I = 1 , 20 NUM = DB2DAT ( 1 , I ) DEN = DB2DAT ( 2 , I ) RES = DB2DAT ( 3 , I ) PT = NUM / DEN COMP = DEBYE2(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 200 CONTINUE C C TEST DEBYE3 C FNAME = 'DEBYE3' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 210 I = 1 , 20 NUM = DB3DAT ( 1 , I ) DEN = DB3DAT ( 2 , I ) RES = DB3DAT ( 3 , I ) PT = NUM / DEN COMP = DEBYE3(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 210 CONTINUE C C TEST DEBYE4 C FNAME = 'DEBYE4' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 220 I = 1 , 20 NUM = DB4DAT ( 1 , I ) DEN = DB4DAT ( 2 , I ) RES = DB4DAT ( 3 , I ) PT = NUM / DEN COMP = DEBYE4(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 220 CONTINUE C C TEST EXP3 C FNAME = 'EXP3 ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 230 I = 1 , 20 NUM = EX3DAT ( 1 , I ) DEN = EX3DAT ( 2 , I ) RES = EX3DAT ( 3 , I ) PT = NUM / DEN COMP = EXP3(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 230 CONTINUE C C TEST GOODST C FNAME = 'GOODST' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 240 I = 1 , 20 NUM = GSTDAT ( 1 , I ) DEN = GSTDAT ( 2 , I ) RES = GSTDAT ( 3 , I ) PT = NUM / DEN COMP = GOODST(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 240 CONTINUE C C TEST I0INT C FNAME = 'I0INT ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 250 I = 1 , 20 NUM = I0IDAT ( 1 , I ) DEN = I0IDAT ( 2 , I ) RES = I0IDAT ( 3 , I ) PT = NUM / DEN COMP = I0INT(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 250 CONTINUE C C TEST I0ML0 C FNAME = 'I0ML0 ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 260 I = 1 , 20 NUM = IL0DAT ( 1 , I ) DEN = IL0DAT ( 2 , I ) RES = IL0DAT ( 3 , I ) PT = NUM / DEN COMP = I0ML0(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 260 CONTINUE C C TEST I1ML1 C FNAME = 'I1ML1 ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 270 I = 1 , 20 NUM = IL1DAT ( 1 , I ) DEN = IL1DAT ( 2 , I ) RES = IL1DAT ( 3 , I ) PT = NUM / DEN COMP = I1ML1(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 270 CONTINUE C C TEST J0INT C FNAME = 'J0INT ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 280 I = 1 , 20 NUM = J0IDAT ( 1 , I ) DEN = J0IDAT ( 2 , I ) RES = J0IDAT ( 3 , I ) PT = NUM / DEN COMP = J0INT(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 280 CONTINUE C C TEST K0INT C FNAME = 'K0INT ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 290 I = 1 , 20 NUM = K0IDAT ( 1 , I ) DEN = K0IDAT ( 2 , I ) RES = K0IDAT ( 3 , I ) PT = NUM / DEN COMP = K0INT(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 290 CONTINUE C C TEST LOBACH C FNAME = 'LOBACH' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 300 I = 1 , 20 NUM = LOBDAT ( 1 , I ) DEN = LOBDAT ( 2 , I ) RES = LOBDAT ( 3 , I ) PT = NUM / DEN COMP = LOBACH(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 300 CONTINUE C C TEST STROM C FNAME = 'STROM ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 310 I = 1 , 20 NUM = STRDAT ( 1 , I ) DEN = STRDAT ( 2 , I ) RES = STRDAT ( 3 , I ) PT = NUM / DEN COMP = STROM(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 310 CONTINUE C C TEST STRVH0 C FNAME = 'STRVH0' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 320 I = 1 , 20 NUM = SH0DAT ( 1 , I ) DEN = SH0DAT ( 2 , I ) RES = SH0DAT ( 3 , I ) PT = NUM / DEN COMP = STRVH0(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 320 CONTINUE C C TEST STRVH1 C FNAME = 'STRVH1' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 330 I = 1 , 20 NUM = SH1DAT ( 1 , I ) DEN = SH1DAT ( 2 , I ) RES = SH1DAT ( 3 , I ) PT = NUM / DEN COMP = STRVH1(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 330 CONTINUE C C TEST STRVL0 C FNAME = 'STRVL0' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 340 I = 1 , 20 NUM = SL0DAT ( 1 , I ) DEN = SL0DAT ( 2 , I ) RES = SL0DAT ( 3 , I ) PT = NUM / DEN COMP = STRVL0(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 340 CONTINUE C C TEST STRVL1 C FNAME = 'STRVL1' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 350 I = 1 , 20 NUM = SL1DAT ( 1 , I ) DEN = SL1DAT ( 2 , I ) RES = SL1DAT ( 3 , I ) PT = NUM / DEN COMP = STRVL1(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 350 CONTINUE C C TEST SYNCH1 C FNAME = 'SYNCH1' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 360 I = 1 , 20 NUM = SY1DAT ( 1 , I ) DEN = SY1DAT ( 2 , I ) RES = SY1DAT ( 3 , I ) PT = NUM / DEN COMP = SYNCH1(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 360 CONTINUE C C TEST SYNCH2 C FNAME = 'SYNCH2' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 370 I = 1 , 20 NUM = SY2DAT ( 1 , I ) DEN = SY2DAT ( 2 , I ) RES = SY2DAT ( 3 , I ) PT = NUM / DEN COMP = SYNCH2(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 370 CONTINUE C C TEST TRAN02 C FNAME = 'TRAN02' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 380 I = 1 , 20 NUM = TR2DAT ( 1 , I ) DEN = TR2DAT ( 2 , I ) RES = TR2DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN02(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 380 CONTINUE C C TEST TRAN03 C FNAME = 'TRAN03' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 390 I = 1 , 20 NUM = TR3DAT ( 1 , I ) DEN = TR3DAT ( 2 , I ) RES = TR3DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN03(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 390 CONTINUE C C TEST TRAN04 C FNAME = 'TRAN04' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 400 I = 1 , 20 NUM = TR4DAT ( 1 , I ) DEN = TR4DAT ( 2 , I ) RES = TR4DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN04(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 400 CONTINUE C C TEST TRAN05 C FNAME = 'TRAN05' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 410 I = 1 , 20 NUM = TR5DAT ( 1 , I ) DEN = TR5DAT ( 2 , I ) RES = TR5DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN05(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 410 CONTINUE C C TEST TRAN06 C FNAME = 'TRAN06' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 420 I = 1 , 20 NUM = TR6DAT ( 1 , I ) DEN = TR6DAT ( 2 , I ) RES = TR6DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN06(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 420 CONTINUE C C TEST TRAN07 C FNAME = 'TRAN07' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 430 I = 1 , 20 NUM = TR7DAT ( 1 , I ) DEN = TR7DAT ( 2 , I ) RES = TR7DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN07(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 430 CONTINUE C C TEST TRAN08 C FNAME = 'TRAN08' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 440 I = 1 , 20 NUM = TR8DAT ( 1 , I ) DEN = TR8DAT ( 2 , I ) RES = TR8DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN08(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 440 CONTINUE C C TEST TRAN09 C FNAME = 'TRAN09' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 450 I = 1 , 20 NUM = TR9DAT ( 1 , I ) DEN = TR9DAT ( 2 , I ) RES = TR9DAT ( 3 , I ) PT = NUM / DEN COMP = TRAN09(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 450 CONTINUE C C TEST Y0INT C FNAME = 'Y0INT ' WRITE(IOUT,1000)FNAME WRITE(IOUT,1010) DO 460 I = 1 , 20 NUM = Y0IDAT ( 1 , I ) DEN = Y0IDAT ( 2 , I ) RES = Y0IDAT ( 3 , I ) PT = NUM / DEN COMP = Y0INT(PT) ABSERR = ABS ( RES - COMP ) RELERR = ABSERR / ABS(RES) WRITE(IOUT,1020)PT,ABSERR,RELERR 460 CONTINUE C C PRINT STATEMENTS C 1000 FORMAT(////15X,'TESTING THE FUNCTION ',A6) 1010 FORMAT(/5X,'ARGUMENT',13X,'ABS. ERROR',13X,'REL. ERROR') 1020 FORMAT(3X,F10.4,8X,E15.5,8X,E15.5) END SHAR_EOF fi # end of overwriting check cd .. cd .. if test ! -d 'Src' then mkdir 'Src' fi cd 'Src' if test ! -d 'Dp' then mkdir 'Dp' fi cd 'Dp' if test -f 'src_gen.f' then echo shar: will not over-write existing file "'src_gen.f'" else cat << \SHAR_EOF > 'src_gen.f' DOUBLE PRECISION FUNCTION ABRAM0(XVALUE) C C DESCRIPTION: C This function calculates the Abramowitz function of order 0, C defined as C C ABRAM0(x) = integral{ 0 to infinity } exp( -t*t - x/t ) dt C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C If XVALUE < 0.0, the function prints a message and returns the C value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMF - INTEGER - No. of terms needed for the array AB0F. C Recommended value such that C ABS( AB0F(NTERMF) ) < EPS/100 C C NTERMG - INTEGER - No. of terms needed for array AB0G. C Recommended value such that C ABS( AB0G(NTERMG) ) < EPS/100 C C NTERMH - INTEGER - No. of terms needed for array AB0H. C Recommended value such that C ABS( AB0H(NTERMH) ) < EPS/100 C C NTERMA - INTEGER - No. of terms needed for array AB0AS. C Recommended value such that C ABS( AB0AS(NTERMA) ) < EPS/100 C C XLOW1 - DOUBLE PRECISION - The value below which C ABRAM0 = root(pi)/2 + X ( ln X - GVAL0 ) C Recommended value is SQRT(2*EPSNEG) C C LNXMIN - DOUBLE PRECISION - The value of ln XMIN. Used to prevent C exponential underflow for large X. C C For values of EPS, EPSNEG, XMIN refer to the file MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C LOG, EXP, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 23 January C C INTEGER NTERMA,NTERMF,NTERMG,NTERMH DOUBLE PRECISION AB0F(0:8),AB0G(0:8),AB0H(0:8),AB0AS(0:27), & ASLN,ASVAL,CHEVAL,FVAL,GVAL,GVAL0,HALF,HVAL, & LNXMIN,ONEHUN,ONERPI,RTPIB2,RT3BPI,SIX,T, & THREE,TWO,V,X,XLOW1,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*33 DATA FNNAME/'ABRAM0'/ DATA ERRMSG/'FUNCTION CALLED WITH ARGUMENT < 0'/ DATA AB0F/-0.68121 92709 35494 69816 D 0, 1 -0.78867 91981 61492 52495 D 0, 2 0.51215 81776 81881 9543 D -1, 3 -0.71092 35289 45412 96 D -3, 4 0.36868 18085 04287 D -5, 5 -0.91783 23372 37 D -8, 6 0.12702 02563 D -10, 7 -0.10768 88 D -13, 8 0.599 D -17/ DATA AB0G/-0.60506 03943 08682 73190 D 0, 1 -0.41950 39816 32017 79803 D 0, 2 0.17032 65125 19037 0333 D -1, 3 -0.16938 91784 24913 97 D -3, 4 0.67638 08951 9710 D -6, 5 -0.13572 36362 55 D -8, 6 0.15629 7065 D -11, 7 -0.11288 7 D -14, 8 0.55 D -18/ DATA AB0H/1.38202 65523 05749 89705 D 0, 1 -0.30097 92907 39749 04355 D 0, 2 0.79428 88093 64887 241 D -2, 3 -0.64319 10276 84756 3 D -4, 4 0.22549 83068 4374 D -6, 5 -0.41220 96619 5 D -9, 6 0.44185 282 D -12, 7 -0.30123 D -15, 8 0.14 D -18/ DATA AB0AS(0)/ 1.97755 49972 36930 67407 D 0/ DATA AB0AS(1)/ -0.10460 24792 00481 9485 D -1/ DATA AB0AS(2)/ 0.69680 79025 36253 66 D -3/ DATA AB0AS(3)/ -0.58982 98299 99659 9 D -4/ DATA AB0AS(4)/ 0.57716 44553 05320 D -5/ DATA AB0AS(5)/ -0.61523 01336 5756 D -6/ DATA AB0AS(6)/ 0.67853 96884 767 D -7/ DATA AB0AS(7)/ -0.72306 25379 07 D -8/ DATA AB0AS(8)/ 0.63306 62736 5 D -9/ DATA AB0AS(9)/ -0.98945 3793 D -11/ DATA AB0AS(10)/-0.16819 80530 D -10/ DATA AB0AS(11)/ 0.67379 9551 D -11/ DATA AB0AS(12)/-0.20099 7939 D -11/ DATA AB0AS(13)/ 0.54055 903 D -12/ DATA AB0AS(14)/-0.13816 679 D -12/ DATA AB0AS(15)/ 0.34222 05 D -13/ DATA AB0AS(16)/-0.82668 6 D -14/ DATA AB0AS(17)/ 0.19456 6 D -14/ DATA AB0AS(18)/-0.44268 D -15/ DATA AB0AS(19)/ 0.9562 D -16/ DATA AB0AS(20)/-0.1883 D -16/ DATA AB0AS(21)/ 0.301 D -17/ DATA AB0AS(22)/-0.19 D -18/ DATA AB0AS(23)/-0.14 D -18/ DATA AB0AS(24)/ 0.11 D -18/ DATA AB0AS(25)/-0.4 D -19/ DATA AB0AS(26)/ 0.2 D -19/ DATA AB0AS(27)/-0.1 D -19/ DATA ZERO,HALF,TWO/ 0.0 D 0 , 0.5 D 0, 2.0 D 0/ DATA THREE,SIX,ONEHUN/ 3.0 D 0, 6.0 D 0 , 100.0 D 0/ DATA RT3BPI/0.97720 50238 05839 84317 D 0/ DATA RTPIB2/0.88622 69254 52758 01365 D 0/ DATA GVAL0/0.13417 65026 47700 70909 D 0/ DATA ONERPI/0.56418 95835 47756 28695 D 0/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) ABRAM0 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = D1MACH(4) / ONEHUN IF ( X .LE. TWO ) THEN DO 10 NTERMF = 8 , 0 , -1 IF ( ABS(AB0F(NTERMF)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERMG = 8 , 0 , -1 IF ( ABS(AB0G(NTERMG)) .GT. T ) GOTO 29 20 CONTINUE 29 DO 30 NTERMH = 8 , 0 , -1 IF ( ABS(AB0H(NTERMH)) .GT. T ) GOTO 39 30 CONTINUE 39 XLOW1 = SQRT ( TWO * D1MACH(3) ) ELSE DO 40 NTERMA = 27 , 0 , -1 IF ( ABS(AB0AS(NTERMA)) .GT. T ) GOTO 49 40 CONTINUE 49 LNXMIN = LOG(D1MACH(1)) ENDIF C C Code for 0 <= XVALUE <= 2 C IF ( X .LE. TWO ) THEN IF ( X .EQ. ZERO ) THEN ABRAM0 = RTPIB2 RETURN ENDIF IF ( X .LT. XLOW1 ) THEN ABRAM0 = RTPIB2 + X * ( LOG( X ) - GVAL0 ) RETURN ELSE T = ( X * X / TWO - HALF ) - HALF FVAL = CHEVAL( NTERMF,AB0F,T ) GVAL = CHEVAL( NTERMG,AB0G,T ) HVAL = CHEVAL( NTERMH,AB0H,T ) ABRAM0 = FVAL/ONERPI + X * ( LOG( X ) * HVAL- GVAL ) RETURN ENDIF ELSE C C Code for XVALUE > 2 C V = THREE * ( (X / TWO) ** ( TWO / THREE ) ) T = ( SIX/V - HALF ) - HALF ASVAL = CHEVAL( NTERMA,AB0AS,T ) ASLN = LOG( ASVAL / RT3BPI ) - V IF ( ASLN .LT. LNXMIN ) THEN ABRAM0 = ZERO ELSE ABRAM0 = EXP( ASLN ) ENDIF RETURN ENDIF END DOUBLE PRECISION FUNCTION ABRAM1(XVALUE) C C DESCRIPTION: C This function calculates the Abramowitz function of order 1, C defined as C C ABRAM1(x) = integral{ 0 to infinity } t * exp( -t*t - x/t ) dt C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C If XVALUE < 0.0, the function prints a message and returns the C value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMF - INTEGER - No. of terms needed for the array AB1F. C Recommended value such that C ABS( AB1F(NTERMF) ) < EPS/100 C C NTERMG - INTEGER - No. of terms needed for array AB1G. C Recommended value such that C ABS( AB1G(NTERMG) ) < EPS/100 C C NTERMH - INTEGER - No. of terms needed for array AB1H. C Recommended value such that C ABS( AB1H(NTERMH) ) < EPS/100 C C NTERMA - INTEGER - No. of terms needed for array AB1AS. C Recommended value such that C ABS( AB1AS(NTERMA) ) < EPS/100 C C XLOW - DOUBLE PRECISION - The value below which C ABRAM1(x) = 0.5 to machine precision. C The recommended value is EPSNEG/2 C C XLOW1 - DOUBLE PRECISION - The value below which C ABRAM1(x) = (1 - x ( sqrt(pi) + xln(x) ) / 2 C Recommended value is SQRT(2*EPSNEG) C C LNXMIN - DOUBLE PRECISION - The value of ln XMIN. Used to prevent C exponential underflow for large X. C C For values of EPS, EPSNEG, XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by using C the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C LOG, EXP, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 23 January, 1996 C C INTEGER NTERMA,NTERMF,NTERMG,NTERMH DOUBLE PRECISION AB1F(0:9),AB1G(0:8),AB1H(0:8),AB1AS(0:27), & ASLN,ASVAL,CHEVAL,FVAL,GVAL,HALF,HVAL, & LNXMIN,ONE,ONEHUN,ONERPI,RT3BPI,SIX,T,THREE,TWO, & V,X,XLOW,XLOW1,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*33 DATA FNNAME/'ABRAM1'/ DATA ERRMSG/'FUNCTION CALLED WITH ARGUMENT < 0'/ DATA AB1F/1.47285 19257 79788 07369 D 0, 1 0.10903 49757 01689 56257 D 0, 2 -0.12430 67536 00565 69753 D 0, 3 0.30619 79468 53493 315 D -2, 4 -0.22184 10323 07651 1 D -4, 5 0.69899 78834 451 D -7, 6 -0.11597 07644 4 D -9, 7 0.11389 776 D -12, 8 -0.7173 D -16, 9 0.3 D -19/ DATA AB1G/0.39791 27794 90545 03528 D 0, 1 -0.29045 28522 64547 20849 D 0, 2 0.10487 84695 46536 3504 D -1, 3 -0.10249 86952 26913 36 D -3, 4 0.41150 27939 9110 D -6, 5 -0.83652 63894 0 D -9, 6 0.97862 595 D -12, 7 -0.71868 D -15, 8 0.35 D -18/ DATA AB1H/0.84150 29215 22749 47030 D 0, 1 -0.77900 50698 77414 3395 D -1, 2 0.13399 24558 78390 993 D -2, 3 -0.80850 39071 52788 D -5, 4 0.22618 58281 728 D -7, 5 -0.34413 95838 D -10, 6 0.31598 58 D -13, 7 -0.1884 D -16, 8 0.1 D -19/ DATA AB1AS(0)/ 2.13013 64342 90655 49448 D 0/ DATA AB1AS(1)/ 0.63715 26795 21853 9933 D -1/ DATA AB1AS(2)/ -0.12933 49174 77510 647 D -2/ DATA AB1AS(3)/ 0.56783 28753 22826 5 D -4/ DATA AB1AS(4)/ -0.27943 49391 77646 D -5/ DATA AB1AS(5)/ 0.56002 14736 787 D -7/ DATA AB1AS(6)/ 0.23920 09242 798 D -7/ DATA AB1AS(7)/ -0.75098 48650 09 D -8/ DATA AB1AS(8)/ 0.17301 53307 76 D -8/ DATA AB1AS(9)/ -0.36648 87795 5 D -9/ DATA AB1AS(10)/ 0.75207 58307 D -10/ DATA AB1AS(11)/-0.15179 90208 D -10/ DATA AB1AS(12)/ 0.30171 3710 D -11/ DATA AB1AS(13)/-0.58596 718 D -12/ DATA AB1AS(14)/ 0.10914 455 D -12/ DATA AB1AS(15)/-0.18705 36 D -13/ DATA AB1AS(16)/ 0.26254 2 D -14/ DATA AB1AS(17)/-0.14627 D -15/ DATA AB1AS(18)/-0.9500 D -16/ DATA AB1AS(19)/ 0.5873 D -16/ DATA AB1AS(20)/-0.2420 D -16/ DATA AB1AS(21)/ 0.868 D -17/ DATA AB1AS(22)/-0.290 D -17/ DATA AB1AS(23)/ 0.93 D -18/ DATA AB1AS(24)/-0.29 D -18/ DATA AB1AS(25)/ 0.9 D -19/ DATA AB1AS(26)/-0.3 D -19/ DATA AB1AS(27)/ 0.1 D -19/ DATA ZERO,HALF,ONE/ 0.0 D 0, 0.5 D 0, 1.0 D 0/ DATA TWO,THREE,SIX/ 2.0 D 0, 3.0 D 0, 6.0 D 0/ DATA ONEHUN/100.0 D 0/ DATA RT3BPI/ 0.97720 50238 05839 84317 D 0/ DATA ONERPI/ 0.56418 95835 47756 28695 D 0/ C C Start calculation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) ABRAM1 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = D1MACH(4) / ONEHUN IF ( X .LE. TWO ) THEN DO 10 NTERMF = 9 , 0 , -1 IF ( ABS(AB1F(NTERMF)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERMG = 8 , 0 , -1 IF ( ABS(AB1G(NTERMG)) .GT. T ) GOTO 29 20 CONTINUE 29 DO 30 NTERMH = 8 , 0 , -1 IF ( ABS(AB1H(NTERMH)) .GT. T ) GOTO 39 30 CONTINUE 39 T = D1MACH(3) XLOW1 = SQRT ( TWO * T ) XLOW = T / TWO ELSE DO 40 NTERMA = 27 , 0 , -1 IF ( ABS(AB1AS(NTERMA)) .GT. T ) GOTO 49 40 CONTINUE 49 LNXMIN = LOG(D1MACH(1)) ENDIF C C Code for 0 <= XVALUE <= 2 C IF ( X .LE. TWO ) THEN IF ( X .EQ. ZERO ) THEN ABRAM1 = HALF RETURN ENDIF IF ( X .LT. XLOW1 ) THEN IF ( X .LT. XLOW ) THEN ABRAM1 = HALF ELSE ABRAM1 = ( ONE - X / ONERPI - X * X * LOG( X ) ) * HALF ENDIF RETURN ELSE T = ( X * X / TWO - HALF ) - HALF FVAL = CHEVAL( NTERMF,AB1F,T ) GVAL = CHEVAL( NTERMG,AB1G,T ) HVAL = CHEVAL( NTERMH,AB1H,T ) ABRAM1 = FVAL - X * ( GVAL / ONERPI + X * LOG( X ) * HVAL ) RETURN ENDIF ELSE C C Code for XVALUE > 2 C V = THREE * ( (X / TWO) ** ( TWO / THREE ) ) T = ( SIX / V - HALF ) - HALF ASVAL = CHEVAL( NTERMA,AB1AS,T ) ASLN = LOG( ASVAL * SQRT ( V / THREE ) / RT3BPI ) - V IF ( ASLN .LT. LNXMIN ) THEN ABRAM1 = ZERO ELSE ABRAM1 = EXP( ASLN ) ENDIF RETURN ENDIF END DOUBLE PRECISION FUNCTION ABRAM2(XVALUE) C C DESCRIPTION: C This function calculates the Abramowitz function of order 2, C defined as C C ABRAM2(x) = integral{ 0 to infinity } (t**2) * exp( -t*t - x/t ) dt C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C If XVALUE < 0.0, the function prints a message and returns the C value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMF - INTEGER - No. of terms needed for the array AB2F. C Recommended value such that C ABS( AB2F(NTERMF) ) < EPS/100 C C NTERMG - INTEGER - No. of terms needed for array AB2G. C Recommended value such that C ABS( AB2G(NTERMG) ) < EPS/100 C C NTERMH - INTEGER - No. of terms needed for array AB2H. C Recommended value such that C ABS( AB2H(NTERMH) ) < EPS/100 C C NTERMA - INTEGER - No. of terms needed for array AB2AS. C Recommended value such that C ABS( AB2AS(NTERMA) ) < EPS/100 C C XLOW - DOUBLE PRECISION - The value below which C ABRAM2 = root(pi)/4 to machine precision. C The recommended value is EPSNEG C C XLOW1 - DOUBLE PRECISION - The value below which C ABRAM2 = root(pi)/4 - x/2 + x**3ln(x)/6 C Recommended value is SQRT(2*EPSNEG) C C LNXMIN - DOUBLE PRECISION - The value of ln XMIN. Used to prevent C exponential underflow for large X. C C For values of EPS, EPSNEG, XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C LOG, EXP C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 23 January, 1996 C C INTEGER NTERMA,NTERMF,NTERMG,NTERMH DOUBLE PRECISION AB2F(0:9),AB2G(0:8),AB2H(0:7),AB2AS(0:26), & ASLN,ASVAL,CHEVAL,FVAL,GVAL,HALF,HVAL,LNXMIN, & ONEHUN,ONERPI,RTPIB4,RT3BPI,SIX,T,THREE,TWO, & V,X,XLOW,XLOW1,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*33 DATA FNNAME/'ABRAM2'/ DATA ERRMSG/'FUNCTION CALLED WITH ARGUMENT < 0'/ DATA AB2F/1.03612 16280 42437 13846 D 0, 1 0.19371 24662 67945 70012 D 0, 2 -0.72587 58839 23300 7378 D -1, 3 0.17479 05908 64327 399 D -2, 4 -0.12812 23233 75654 9 D -4, 5 0.41150 18153 651 D -7, 6 -0.69710 47256 D -10, 7 0.69901 83 D -13, 8 -0.4492 D -16, 9 0.2 D -19/ DATA AB2G/1.46290 15719 86307 41150 D 0, 1 0.20189 46688 31540 14317 D 0, 2 -0.29082 92087 99712 9022 D -1, 3 0.47061 04903 52700 50 D -3, 4 -0.25792 20803 59333 D -5, 5 0.65613 37129 46 D -8, 6 -0.91411 0203 D -11, 7 0.77427 6 D -14, 8 -0.429 D -17/ DATA AB2H/0.30117 22501 09104 88881 D 0, 1 -0.15886 67818 31762 3783 D -1, 2 0.19295 93693 55845 26 D -3, 3 -0.90199 58784 9300 D -6, 4 0.20610 50418 37 D -8, 5 -0.26511 1806 D -11, 6 0.21086 4 D -14, 7 -0.111 D -17/ DATA AB2AS(0)/ 2.46492 32530 43348 56893 D 0/ DATA AB2AS(1)/ 0.23142 79742 22489 05432 D 0/ DATA AB2AS(2)/ -0.94068 17301 00857 73 D -3/ DATA AB2AS(3)/ 0.82902 70038 08973 3 D -4/ DATA AB2AS(4)/ -0.88389 47042 45866 D -5/ DATA AB2AS(5)/ 0.10663 85435 67985 D -5/ DATA AB2AS(6)/ -0.13991 12853 8529 D -6/ DATA AB2AS(7)/ 0.19397 93208 445 D -7/ DATA AB2AS(8)/ -0.27704 99383 75 D -8/ DATA AB2AS(9)/ 0.39590 68718 6 D -9/ DATA AB2AS(10)/-0.54083 54342 D -10/ DATA AB2AS(11)/ 0.63554 6076 D -11/ DATA AB2AS(12)/-0.38461 613 D -12/ DATA AB2AS(13)/-0.11696 067 D -12/ DATA AB2AS(14)/ 0.68966 71 D -13/ DATA AB2AS(15)/-0.25031 13 D -13/ DATA AB2AS(16)/ 0.78558 6 D -14/ DATA AB2AS(17)/-0.23033 4 D -14/ DATA AB2AS(18)/ 0.64914 D -15/ DATA AB2AS(19)/-0.17797 D -15/ DATA AB2AS(20)/ 0.4766 D -16/ DATA AB2AS(21)/-0.1246 D -16/ DATA AB2AS(22)/ 0.316 D -17/ DATA AB2AS(23)/-0.77 D -18/ DATA AB2AS(24)/ 0.18 D -18/ DATA AB2AS(25)/-0.4 D -19/ DATA AB2AS(26)/ 0.1 D -19/ DATA ZERO,HALF,TWO/ 0.0 D 0 , 0.5 D 0, 2.0 D 0/ DATA THREE,SIX,ONEHUN/ 3.0 D 0, 6.0 D 0 , 100.0 D 0/ DATA RT3BPI/ 0.97720 50238 05839 84317 D 0/ DATA RTPIB4/ 0.44311 34627 26379 00682 D 0/ DATA ONERPI/ 0.56418 95835 47756 28695 D 0/ C C Start calculation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) ABRAM2 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = D1MACH(4) / ONEHUN IF ( X .LE. TWO ) THEN DO 10 NTERMF = 9 , 0 , -1 IF ( ABS(AB2F(NTERMF)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERMG = 8 , 0 , -1 IF ( ABS(AB2G(NTERMG)) .GT. T ) GOTO 29 20 CONTINUE 29 DO 30 NTERMH = 7 , 0 , -1 IF ( ABS(AB2H(NTERMH)) .GT. T ) GOTO 39 30 CONTINUE 39 XLOW = D1MACH(3) XLOW1 = SQRT ( TWO * XLOW ) ELSE DO 40 NTERMA = 26 , 0 , -1 IF ( ABS(AB2AS(NTERMA)) .GT. T ) GOTO 49 40 CONTINUE 49 LNXMIN = LOG(D1MACH(1)) ENDIF C C Code for 0 <= XVALUE <= 2 C IF ( X .LE. TWO ) THEN IF ( X .EQ. ZERO ) THEN ABRAM2 = RTPIB4 RETURN ENDIF IF ( X .LT. XLOW1 ) THEN IF ( X .LT. XLOW ) THEN ABRAM2 = RTPIB4 ELSE ABRAM2 = RTPIB4 - HALF * X + X * X * X * LOG( X ) / SIX ENDIF RETURN ELSE T = ( X * X / TWO - HALF ) - HALF FVAL = CHEVAL( NTERMF,AB2F,T ) GVAL = CHEVAL( NTERMG,AB2G,T ) HVAL = CHEVAL( NTERMH,AB2H,T ) ABRAM2 = FVAL/ONERPI + X * ( X * X * LOG(X) * HVAL- GVAL ) RETURN ENDIF ELSE C C Code for XVALUE > 2 C V = THREE * ( (X / TWO) ** ( TWO / THREE ) ) T = ( SIX / V - HALF ) - HALF ASVAL = CHEVAL( NTERMA,AB2AS,T ) ASLN = LOG( ASVAL / RT3BPI ) + LOG( V / THREE ) - V IF ( ASLN .LT. LNXMIN ) THEN ABRAM2 = ZERO ELSE ABRAM2 = EXP( ASLN ) ENDIF RETURN ENDIF END DOUBLE PRECISION FUNCTION AIRINT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the Airy function Ai, C defined as C C AIRINT(x) = {integral 0 to x} Ai(t) dt C C The program uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C C ERROR RETURNS: C C If the argument is too large and negative, it is impossible C to accurately compute the necessary SIN and COS functions. C An error message is printed, and the program returns the C value -2/3 (the value at -infinity). C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C AAINT1. The recommended value is such that C ABS(AAINT1(NTERM1)) < EPS/100, C subject to 1 <= NTERM1 <= 25. C C NTERM2 - INTEGER - The no. of terms to be used from the array C AAINT2. The recommended value is such that C ABS(AAINT2(NTERM2)) < EPS/100, C subject to 1 <= NTERM2 <= 21. C C NTERM3 - INTEGER - The no. of terms to be used from the array C AAINT3. The recommended value is such that C ABS(AAINT3(NTERM3)) < EPS/100, C subject to 1 <= NTERM3 <= 40. C C NTERM4 - INTEGER - The no. of terms to be used from the array C AAINT4. The recommended value is such that C ABS(AAINT4(NTERM4)) < EPS/100, C subject to 1 <= NTERM4 <= 17. C C NTERM5 - INTEGER - The no. of terms to be used from the array C AAINT5. The recommended value is such that C ABS(AAINT5(NTERM5)) < EPS/100, C subject to 1 <= NTERM5 <= 17. C C XLOW1 - DOUBLE PRECISION - The value such that, if |x| < XLOW1, C AIRINT(x) = x * Ai(0) C to machine precision. The recommended value is C 2 * EPSNEG. C C XHIGH1 - DOUBLE PRECISION - The value such that, if x > XHIGH1, C AIRINT(x) = 1/3, C to machine precision. The recommended value is C (-1.5*LOG(EPSNEG)) ** (2/3). C C XNEG1 - DOUBLE PRECISION - The value such that, if x < XNEG1, C the trigonometric functions in the asymptotic C expansion cannot be calculated accurately. C The recommended value is C -(1/((EPS)**2/3)) C C For values of EPS and EPSNEG, refer to the file MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C COS, EXP, SIN, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C Univ. of Paisley, C High St., C Paisley, C SCOTLAND. C PA1 2BE C C (e-mail:macl_ms0@paisley.ac.uk) C C C LATEST REVISION: 23 January, 1996 C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5 DOUBLE PRECISION AAINT1(0:25),AAINT2(0:21),AAINT3(0:40), 1 AAINT4(0:17),AAINT5(0:17), 2 AIRZER,ARG,CHEVAL,EIGHT,FORTY1,FOUR,FR996,GVAL, 3 HVAL,NINE,NINHUN,ONE,ONEHUN,PIBY4,PITIM6,RT2B3P,T,TEMP, 4 THREE,TWO,X,XHIGH1,XLOW1,XNEG1,XVALUE,Z,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*46 DATA FNNAME/'AIRINT'/ DATA ERRMSG/'FUNCTION TOO NEGATIVE FOR ACCURATE COMPUTATION'/ DATA AAINT1(0)/ 0.37713 51769 46836 95526 D 0/ DATA AAINT1(1)/ -0.13318 86843 24079 47431 D 0/ DATA AAINT1(2)/ 0.31524 97374 78288 4809 D -1/ DATA AAINT1(3)/ -0.31854 30764 36574 077 D -2/ DATA AAINT1(4)/ -0.87398 76469 86219 15 D -3/ DATA AAINT1(5)/ 0.46699 49765 53969 71 D -3/ DATA AAINT1(6)/ -0.95449 36738 98369 2 D -4/ DATA AAINT1(7)/ 0.54270 56871 56716 D -5/ DATA AAINT1(8)/ 0.23949 64062 52188 D -5/ DATA AAINT1(9)/ -0.75690 27020 5649 D -6/ DATA AAINT1(10)/ 0.90501 38584 518 D -7/ DATA AAINT1(11)/ 0.32052 94560 43 D -8/ DATA AAINT1(12)/-0.30382 55364 44 D -8/ DATA AAINT1(13)/ 0.48900 11859 6 D -9/ DATA AAINT1(14)/-0.18398 20572 D -10/ DATA AAINT1(15)/-0.71124 7519 D -11/ DATA AAINT1(16)/ 0.15177 4419 D -11/ DATA AAINT1(17)/-0.10801 922 D -12/ DATA AAINT1(18)/-0.96354 2 D -14/ DATA AAINT1(19)/ 0.31342 5 D -14/ DATA AAINT1(20)/-0.29446 D -15/ DATA AAINT1(21)/-0.477 D -17/ DATA AAINT1(22)/ 0.461 D -17/ DATA AAINT1(23)/-0.53 D -18/ DATA AAINT1(24)/ 0.1 D -19/ DATA AAINT1(25)/ 0.1 D -19/ DATA AAINT2(0)/ 1.92002 52408 19840 09769 D 0/ DATA AAINT2(1)/ -0.42200 49417 25628 7021 D -1/ DATA AAINT2(2)/ -0.23945 77229 65939 223 D -2/ DATA AAINT2(3)/ -0.19564 07048 33529 71 D -3/ DATA AAINT2(4)/ -0.15472 52891 05611 2 D -4/ DATA AAINT2(5)/ -0.14049 01861 37889 D -5/ DATA AAINT2(6)/ -0.12128 01427 1367 D -6/ DATA AAINT2(7)/ -0.11791 86050 192 D -7/ DATA AAINT2(8)/ -0.10431 55787 88 D -8/ DATA AAINT2(9)/ -0.10908 20929 3 D -9/ DATA AAINT2(10)/-0.92963 3045 D -11/ DATA AAINT2(11)/-0.11094 6520 D -11/ DATA AAINT2(12)/-0.78164 83 D -13/ DATA AAINT2(13)/-0.13196 61 D -13/ DATA AAINT2(14)/-0.36823 D -15/ DATA AAINT2(15)/-0.21505 D -15/ DATA AAINT2(16)/ 0.1238 D -16/ DATA AAINT2(17)/-0.557 D -17/ DATA AAINT2(18)/ 0.84 D -18/ DATA AAINT2(19)/-0.21 D -18/ DATA AAINT2(20)/ 0.4 D -19/ DATA AAINT2(21)/-0.1 D -19/ DATA AAINT3(0)/ 0.47985 89326 47910 52053 D 0/ DATA AAINT3(1)/ -0.19272 37512 61696 08863 D 0/ DATA AAINT3(2)/ 0.20511 54129 52542 8189 D -1/ DATA AAINT3(3)/ 0.63320 00070 73248 8786 D -1/ DATA AAINT3(4)/ -0.50933 22261 84575 4082 D -1/ DATA AAINT3(5)/ 0.12844 24078 66166 3016 D -1/ DATA AAINT3(6)/ 0.27601 37088 98947 9413 D -1/ DATA AAINT3(7)/ -0.15470 66673 86664 9507 D -1/ DATA AAINT3(8)/ -0.14968 64655 38931 6026 D -1/ DATA AAINT3(9)/ 0.33661 76141 73574 541 D -2/ DATA AAINT3(10)/ 0.53085 11635 18892 985 D -2/ DATA AAINT3(11)/ 0.41371 22645 85550 81 D -3/ DATA AAINT3(12)/-0.10249 05799 26726 266 D -2/ DATA AAINT3(13)/-0.32508 22167 20258 53 D -3/ DATA AAINT3(14)/ 0.86086 60957 16921 3 D -4/ DATA AAINT3(15)/ 0.66713 67298 12077 5 D -4/ DATA AAINT3(16)/ 0.44920 59993 18095 D -5/ DATA AAINT3(17)/-0.67042 72309 58249 D -5/ DATA AAINT3(18)/-0.19663 65700 85009 D -5/ DATA AAINT3(19)/ 0.22229 67740 7226 D -6/ DATA AAINT3(20)/ 0.22332 22294 9137 D -6/ DATA AAINT3(21)/ 0.28033 13766 457 D -7/ DATA AAINT3(22)/-0.11556 51663 619 D -7/ DATA AAINT3(23)/-0.43306 98217 36 D -8/ DATA AAINT3(24)/-0.62277 77938 D -10/ DATA AAINT3(25)/ 0.26432 66490 3 D -9/ DATA AAINT3(26)/ 0.53338 81114 D -10/ DATA AAINT3(27)/-0.52295 7269 D -11/ DATA AAINT3(28)/-0.38222 9283 D -11/ DATA AAINT3(29)/-0.40958 233 D -12/ DATA AAINT3(30)/ 0.11515 622 D -12/ DATA AAINT3(31)/ 0.38757 66 D -13/ DATA AAINT3(32)/ 0.14028 3 D -14/ DATA AAINT3(33)/-0.14152 6 D -14/ DATA AAINT3(34)/-0.28746 D -15/ DATA AAINT3(35)/ 0.923 D -17/ DATA AAINT3(36)/ 0.1224 D -16/ DATA AAINT3(37)/ 0.157 D -17/ DATA AAINT3(38)/-0.19 D -18/ DATA AAINT3(39)/-0.8 D -19/ DATA AAINT3(40)/-0.1 D -19/ DATA AAINT4/1.99653 30582 85227 30048 D 0, 1 -0.18754 11776 05417 759 D -2, 2 -0.15377 53628 03057 50 D -3, 3 -0.12831 12967 68234 9 D -4, 4 -0.10812 84819 64162 D -5, 5 -0.91821 31174 057 D -7, 6 -0.78416 05909 60 D -8, 7 -0.67292 45387 8 D -9, 8 -0.57963 25198 D -10, 9 -0.50104 0991 D -11, X -0.43420 222 D -12, 1 -0.37743 05 D -13, 2 -0.32847 3 D -14, 3 -0.28700 D -15, 4 -0.2502 D -16, 5 -0.220 D -17, 6 -0.19 D -18, 7 -0.2 D -19/ DATA AAINT5/1.13024 60203 44657 16133 D 0, 1 -0.46471 80646 39872 334 D -2, 2 -0.35137 41338 26932 03 D -3, 3 -0.27681 17872 54518 5 D -4, 4 -0.22205 74525 58107 D -5, 5 -0.18089 14236 5974 D -6, 6 -0.14876 13383 373 D -7, 7 -0.12351 53881 68 D -8, 8 -0.10310 10425 7 D -9, 9 -0.86749 3013 D -11, X -0.73080 054 D -12, 1 -0.62235 61 D -13, 2 -0.52512 8 D -14, 3 -0.45677 D -15, 4 -0.3748 D -16, 5 -0.356 D -17, 6 -0.23 D -18, 7 -0.4 D -19/ DATA ZERO,ONE,TWO/ 0.0 D 0 , 1.0 D 0 , 2.0 D 0 / DATA THREE,FOUR,EIGHT/ 3.0 D 0 , 4.0 D 0 , 8.0 D 0 / DATA NINE,FORTY1,ONEHUN/ 9.0 D 0 , 41.0 D 0 , 100.0 D 0/ DATA NINHUN,FR996/ 900.0 D 0 , 4996.0 D 0 / DATA PIBY4/0.78539 81633 97448 30962 D 0/ DATA PITIM6/18.84955 59215 38759 43078 D 0/ DATA RT2B3P/0.46065 88659 61780 63902 D 0/ DATA AIRZER/0.35502 80538 87817 23926 D 0/ C C Start computation C X = XVALUE C C Compute the machine-dependent constants. C Z = D1MACH(3) XLOW1 = TWO * Z ARG = D1MACH(4) XNEG1 = - ONE / ( ARG ** (TWO/THREE) ) C C Error test C IF ( X .LT. XNEG1 ) THEN CALL ERRPRN(FNNAME,ERRMSG) AIRINT = -TWO / THREE RETURN ENDIF C C continue with machine-dependent constants C T = ARG / ONEHUN IF ( X .GE. ZERO ) THEN DO 10 NTERM1 = 25 , 0 , -1 IF ( ABS(AAINT1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 21 , 0 , -1 IF ( ABS(AAINT2(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 XHIGH1 = ( -THREE*LOG(Z)/TWO ) ** (TWO/THREE) ELSE DO 30 NTERM3 = 40 , 0 , -1 IF ( ABS(AAINT3(NTERM3)) .GT. T ) GOTO 39 30 CONTINUE 39 DO 40 NTERM4 = 17 , 0 , -1 IF ( ABS(AAINT4(NTERM4)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM5 = 17 , 0 , -1 IF ( ABS(AAINT5(NTERM5)) .GT. T ) GOTO 59 50 CONTINUE 59 ENDIF C C Code for x >= 0 C IF ( X .GE. ZERO ) THEN IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW1 ) THEN AIRINT = AIRZER * X ELSE T = X / TWO - ONE AIRINT = CHEVAL(NTERM1,AAINT1,T) * X ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN TEMP = ZERO ELSE Z = ( X + X ) * SQRT(X) / THREE TEMP = THREE * Z T = ( FORTY1 - TEMP ) / ( NINE + TEMP ) TEMP = EXP(-Z) * CHEVAL(NTERM2,AAINT2,T) / SQRT(PITIM6*Z) ENDIF AIRINT = ONE / THREE - TEMP ENDIF ELSE C C Code for x < 0 C IF ( X .GE. -EIGHT ) THEN IF ( X .GT. -XLOW1 ) THEN AIRINT = AIRZER * X ELSE T = -X / FOUR - ONE AIRINT = X * CHEVAL(NTERM3,AAINT3,T) ENDIF ELSE Z = - ( X + X ) * SQRT(-X) / THREE ARG = Z + PIBY4 TEMP = NINE * Z * Z T = ( FR996 - TEMP ) / ( NINHUN + TEMP) GVAL = CHEVAL(NTERM4,AAINT4,T) HVAL = CHEVAL(NTERM5,AAINT5,T) TEMP = GVAL * COS(ARG) + HVAL * SIN(ARG) / Z AIRINT = RT2B3P * TEMP / SQRT(Z) - TWO / THREE ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION AIRYGI(XVALUE) C C DESCRIPTION: C C This subroutine computes the modified Airy function Gi(x), C defined as C C AIRYGI(x) = [ Integral{0 to infinity} sin(x*t+t^3/3) dt ] / pi C C The approximation uses Chebyshev expansions with the coefficients C given to 20 decimal places. C C C ERROR RETURNS: C C If x < -XHIGH1*XHIGH1 (see below for definition of XHIGH1), then C the trig. functions needed for the asymptotic expansion of Bi(x) C cannot be computed to any accuracy. An error message is printed C and the code returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C ARGIP1. The recommended value is such that C ABS(ARGIP1(NTERM1)) < EPS/100 C subject to 1 <= NTERM1 <= 30. C C NTERM2 - INTEGER - The no. of terms to be used from the array C ARGIP2. The recommended value is such that C ABS(ARGIP2(NTERM2)) < EPS/100 C subject to 1 <= NTERM2 <= 29. C C NTERM3 - INTEGER - The no. of terms to be used from the array C ARGIN1. The recommended value is such that C ABS(ARGIN1(NTERM3)) < EPS/100 C subject to 1 <= NTERM3 <= 42. C C NTERM4 - INTEGER - The no. of terms to be used from the array C ARBIN1. The recommended value is such that C ABS(ARBIN1(NTERM4)) < EPS/100 C subject to 1 <= NTERM4 <= 10. C C NTERM5 - INTEGER - The no. of terms to be used from the array C ARBIN2. The recommended value is such that C ABS(ARBIN2(NTERM5)) < EPS/100 C subject to 1 <= NTERM5 <= 11. C C NTERM6 - INTEGER - The no. of terms to be used from the array C ARGH2. The recommended value is such that C ABS(ARHIN1(NTERM6)) < EPS/100 C subject to 1 <= NTERM6 <= 15. C C XLOW1 - DOUBLE PRECISION - The value such that, if -XLOW1 < x < XLOW1, C then AIRYGI = Gi(0) to machine precision. C The recommended value is EPS. C C XHIGH1 - DOUBLE PRECISION - The value such that, if x > XHIGH1, then C AIRYGI = 1/(Pi*x) to machine precision. C Also used for error test - see above. C The recommended value is C cube root( 2/EPS ). C C XHIGH2 - DOUBLE PRECISION - The value above which AIRYGI = 0.0. C The recommended value is C 1/(Pi*XMIN). C C XHIGH3 - DOUBLE PRECISION - The value such that, if x < XHIGH3, C then the Chebyshev expansions for the C asymptotic form of Bi(x) are not needed. C The recommended value is C -8 * cube root( 2/EPSNEG ). C C For values of EPS, EPSNEG, and XMIN refer to the file C MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C COS , SIN , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C Dr. Allan J. Macleod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND. C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST UPDATE: C 23 January, 1996 C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5,NTERM6 DOUBLE PRECISION ARGIP1(0:30),ARGIP2(0:29),ARGIN1(0:42), 1 ARBIN1(0:10),ARBIN2(0:11),ARHIN1(0:15), 2 ARG,BI,CHEB1,CHEB2,CHEVAL,COSZ,FIVE,FIVE14,FOUR, 3 GIZERO,MINATE,NINE,ONE,ONEBPI,ONEHUN,ONE76,ONE024,PIBY4, 4 RTPIIN,SEVEN,SEVEN2,SINZ,T,TEMP,THREE,TWELHU,TWENT8, 5 X,XCUBE,XHIGH1,XHIGH2,XHIGH3,XLOW1,XMINUS, 6 XVALUE,Z,ZERO,ZETA,D1MACH CHARACTER FNNAME*6,ERRMSG*46 DATA FNNAME/'AIRYGI'/ DATA ERRMSG/'ARGUMENT TOO NEGATIVE FOR ACCURATE COMPUTATION'/ DATA ARGIP1(0)/ 0.26585 77079 50227 45082 D 0/ DATA ARGIP1(1)/ -0.10500 33309 75019 22907 D 0/ DATA ARGIP1(2)/ 0.84134 74753 28454 492 D -2/ DATA ARGIP1(3)/ 0.20210 67387 81343 9541 D -1/ DATA ARGIP1(4)/ -0.15595 76113 86355 2234 D -1/ DATA ARGIP1(5)/ 0.56434 29390 43256 481 D -2/ DATA ARGIP1(6)/ -0.59776 84482 66558 09 D -3/ DATA ARGIP1(7)/ -0.42833 85026 48677 28 D -3/ DATA ARGIP1(8)/ 0.22605 66238 09090 27 D -3/ DATA ARGIP1(9)/ -0.36083 32945 59226 0 D -4/ DATA ARGIP1(10)/-0.78551 89887 88901 D -5/ DATA ARGIP1(11)/ 0.47325 24807 46370 D -5/ DATA ARGIP1(12)/-0.59743 51397 7694 D -6/ DATA ARGIP1(13)/-0.15917 60916 5602 D -6/ DATA ARGIP1(14)/ 0.63361 29065 570 D -7/ DATA ARGIP1(15)/-0.27609 02326 48 D -8/ DATA ARGIP1(16)/-0.25606 41540 85 D -8/ DATA ARGIP1(17)/ 0.47798 67685 6 D -9/ DATA ARGIP1(18)/ 0.44881 31863 D -10/ DATA ARGIP1(19)/-0.23465 08882 D -10/ DATA ARGIP1(20)/ 0.76839 085 D -12/ DATA ARGIP1(21)/ 0.73227 985 D -12/ DATA ARGIP1(22)/-0.85136 87 D -13/ DATA ARGIP1(23)/-0.16302 01 D -13/ DATA ARGIP1(24)/ 0.35676 9 D -14/ DATA ARGIP1(25)/ 0.25001 D -15/ DATA ARGIP1(26)/-0.10859 D -15/ DATA ARGIP1(27)/-0.158 D -17/ DATA ARGIP1(28)/ 0.275 D -17/ DATA ARGIP1(29)/-0.5 D -19/ DATA ARGIP1(30)/-0.6 D -19/ DATA ARGIP2(0)/ 2.00473 71227 58014 86391 D 0/ DATA ARGIP2(1)/ 0.29418 41393 64406 724 D -2/ DATA ARGIP2(2)/ 0.71369 24900 63401 67 D -3/ DATA ARGIP2(3)/ 0.17526 56343 05022 67 D -3/ DATA ARGIP2(4)/ 0.43591 82094 02988 2 D -4/ DATA ARGIP2(5)/ 0.10926 26947 60430 7 D -4/ DATA ARGIP2(6)/ 0.27238 24183 99029 D -5/ DATA ARGIP2(7)/ 0.66230 90094 7687 D -6/ DATA ARGIP2(8)/ 0.15425 32337 0315 D -6/ DATA ARGIP2(9)/ 0.34184 65242 306 D -7/ DATA ARGIP2(10)/ 0.72815 77248 94 D -8/ DATA ARGIP2(11)/ 0.15158 85254 52 D -8/ DATA ARGIP2(12)/ 0.30940 04803 9 D -9/ DATA ARGIP2(13)/ 0.61496 72614 D -10/ DATA ARGIP2(14)/ 0.12028 77045 D -10/ DATA ARGIP2(15)/ 0.23369 0586 D -11/ DATA ARGIP2(16)/ 0.43778 068 D -12/ DATA ARGIP2(17)/ 0.79964 47 D -13/ DATA ARGIP2(18)/ 0.14940 75 D -13/ DATA ARGIP2(19)/ 0.24679 0 D -14/ DATA ARGIP2(20)/ 0.37672 D -15/ DATA ARGIP2(21)/ 0.7701 D -16/ DATA ARGIP2(22)/ 0.354 D -17/ DATA ARGIP2(23)/-0.49 D -18/ DATA ARGIP2(24)/ 0.62 D -18/ DATA ARGIP2(25)/-0.40 D -18/ DATA ARGIP2(26)/-0.1 D -19/ DATA ARGIP2(27)/ 0.2 D -19/ DATA ARGIP2(28)/-0.3 D -19/ DATA ARGIP2(29)/ 0.1 D -19/ DATA ARGIN1(0)/ -0.20118 96505 67320 89130 D 0/ DATA ARGIN1(1)/ -0.72441 75303 32453 0499 D -1/ DATA ARGIN1(2)/ 0.45050 18923 89478 0120 D -1/ DATA ARGIN1(3)/ -0.24221 37112 20787 91099 D 0/ DATA ARGIN1(4)/ 0.27178 84964 36167 8294 D -1/ DATA ARGIN1(5)/ -0.57293 21004 81817 9697 D -1/ DATA ARGIN1(6)/ -0.18382 10786 03377 63587 D 0/ DATA ARGIN1(7)/ 0.77515 46082 14947 5511 D -1/ DATA ARGIN1(8)/ 0.18386 56473 39275 60387 D 0/ DATA ARGIN1(9)/ 0.29215 04250 18556 7173 D -1/ DATA ARGIN1(10)/-0.61422 94846 78801 8811 D -1/ DATA ARGIN1(11)/-0.29993 12505 79461 6238 D -1/ DATA ARGIN1(12)/ 0.58593 71183 27706 636 D -2/ DATA ARGIN1(13)/ 0.82222 16584 97402 529 D -2/ DATA ARGIN1(14)/ 0.13257 98171 66846 893 D -2/ DATA ARGIN1(15)/-0.96248 31076 65651 26 D -3/ DATA ARGIN1(16)/-0.45065 51599 82118 07 D -3/ DATA ARGIN1(17)/ 0.77242 34743 25474 D -5/ DATA ARGIN1(18)/ 0.54818 74134 75805 2 D -4/ DATA ARGIN1(19)/ 0.12458 98039 74287 6 D -4/ DATA ARGIN1(20)/-0.24619 68910 92083 D -5/ DATA ARGIN1(21)/-0.16915 41835 45285 D -5/ DATA ARGIN1(22)/-0.16769 15316 9442 D -6/ DATA ARGIN1(23)/ 0.96365 09337 672 D -7/ DATA ARGIN1(24)/ 0.32533 14928 030 D -7/ DATA ARGIN1(25)/ 0.50918 04231 D -10/ DATA ARGIN1(26)/-0.20918 04535 53 D -8/ DATA ARGIN1(27)/-0.41237 38787 0 D -9/ DATA ARGIN1(28)/ 0.41633 38253 D -10/ DATA ARGIN1(29)/ 0.30325 32117 D -10/ DATA ARGIN1(30)/ 0.34058 0529 D -11/ DATA ARGIN1(31)/-0.88444 592 D -12/ DATA ARGIN1(32)/-0.31639 612 D -12/ DATA ARGIN1(33)/-0.15050 76 D -13/ DATA ARGIN1(34)/ 0.11041 48 D -13/ DATA ARGIN1(35)/ 0.24650 8 D -14/ DATA ARGIN1(36)/-0.3107 D -16/ DATA ARGIN1(37)/-0.9851 D -16/ DATA ARGIN1(38)/-0.1453 D -16/ DATA ARGIN1(39)/ 0.118 D -17/ DATA ARGIN1(40)/ 0.67 D -18/ DATA ARGIN1(41)/ 0.6 D -19/ DATA ARGIN1(42)/-0.1 D -19/ DATA ARBIN1/1.99983 76358 35861 55980 D 0, 1 -0.81046 60923 66941 8 D -4, 2 0.13475 66598 4689 D -6, 3 -0.70855 84714 3 D -9, 4 0.74818 4187 D -11, 5 -0.12902 774 D -12, 6 0.32250 4 D -14, 7 -0.10809 D -15, 8 0.460 D -17, 9 -0.24 D -18, X 0.1 D -19/ DATA ARBIN2/0.13872 35645 38791 20276 D 0, 1 -0.82392 86225 55822 8 D -4, 2 0.26720 91950 9866 D -6, 3 -0.20742 36853 68 D -8, 4 0.28733 92593 D -10, 5 -0.60873 521 D -12, 6 0.17924 89 D -13, 7 -0.68760 D -15, 8 0.3280 D -16, 9 -0.188 D -17, X 0.13 D -18, 1 -0.1 D -19/ DATA ARHIN1/1.99647 72039 97796 50525 D 0, 1 -0.18756 37794 07173 213 D -2, 2 -0.12186 47089 77873 39 D -3, 3 -0.81402 16096 59287 D -5, 4 -0.55050 92595 3537 D -6, 5 -0.37630 08043 303 D -7, 6 -0.25885 83623 65 D -8, 7 -0.17931 82926 5 D -9, 8 -0.12459 16873 D -10, 9 -0.87171 247 D -12, X -0.60849 43 D -13, 1 -0.43117 8 D -14, 2 -0.29787 D -15, 3 -0.2210 D -16, 4 -0.136 D -17, 5 -0.14 D -18/ DATA ZERO,ONE,THREE,FOUR/ 0.0 D 0 , 1.0 D 0 , 3.0 D 0 , 4.0 D 0 / DATA FIVE,SEVEN,MINATE/ 5.0 D 0 , 7.0 D 0 , -8.0 D 0 / DATA NINE,TWENT8,SEVEN2/ 9.0 D 0 , 28.0 D 0 , 72.0 D 0 / DATA ONEHUN,ONE76,FIVE14/ 100.0 D 0 , 176.0 D 0 , 514.0 D 0 / DATA ONE024,TWELHU/ 1024.0 D 0 , 1200.0 D 0 / DATA GIZERO/0.20497 55424 82000 24505 D 0/ DATA ONEBPI/0.31830 98861 83790 67154 D 0/ DATA PIBY4/0.78539 81633 97448 30962 D 0/ DATA RTPIIN/0.56418 95835 47756 28695 D 0/ C C Start computation C X = XVALUE C C Compute the machine-dependent constants. C Z = D1MACH(3) XLOW1 = Z ARG = D1MACH(4) XHIGH1 = ONE / ARG XHIGH1 = ( XHIGH1 + XHIGH1 ) ** (ONE/THREE) C C Error test C IF ( X .LT. -XHIGH1*XHIGH1 ) THEN CALL ERRPRN(FNNAME,ERRMSG) AIRYGI = ZERO RETURN ENDIF C C continue with machine-dependent constants C T = ARG / ONEHUN IF ( X .GE. ZERO ) THEN DO 10 NTERM1 = 30 , 0 , -1 IF ( ABS(ARGIP1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 29 , 0 , -1 IF ( ABS(ARGIP2(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 TEMP = FOUR * PIBY4 XHIGH2 = ONE / ( TEMP * D1MACH(1) ) ELSE DO 30 NTERM3 = 42 , 0 , -1 IF ( ABS(ARGIN1(NTERM3)) .GT. T ) GOTO 39 30 CONTINUE 39 DO 40 NTERM4 = 10 , 0 , -1 IF ( ABS(ARBIN1(NTERM4)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM5 = 11 , 0 , -1 IF ( ABS(ARBIN2(NTERM5)) .GT. T ) GOTO 59 50 CONTINUE 59 DO 60 NTERM6 = 15 , 0 , -1 IF ( ABS(ARHIN1(NTERM6)) .GT. T ) GOTO 69 60 CONTINUE 69 TEMP = ONE / Z XHIGH3 = MINATE * ( TEMP + TEMP ) ** (ONE/THREE) ENDIF C C Code for x >= 0.0 C IF ( X .GE. ZERO ) THEN IF ( X .LE. SEVEN ) THEN IF ( X .LT. XLOW1 ) THEN AIRYGI = GIZERO ELSE T = ( NINE * X - TWENT8 ) / ( X + TWENT8 ) AIRYGI = CHEVAL ( NTERM1 , ARGIP1 , T ) ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN IF ( X .GT. XHIGH2 ) THEN AIRYGI = ZERO ELSE AIRYGI = ONEBPI/X ENDIF ELSE XCUBE = X * X * X T = ( TWELHU - XCUBE ) / ( FIVE14 + XCUBE ) AIRYGI = ONEBPI * CHEVAL(NTERM2,ARGIP2,T) / X ENDIF ENDIF ELSE C C Code for x < 0.0 C IF ( X .GE. MINATE ) THEN IF ( X .GT. -XLOW1 ) THEN AIRYGI = GIZERO ELSE T = -( X + FOUR ) / FOUR AIRYGI = CHEVAL(NTERM3,ARGIN1,T) ENDIF ELSE XMINUS = -X T = XMINUS * SQRT(XMINUS) ZETA = ( T + T ) / THREE TEMP = RTPIIN / SQRT(SQRT(XMINUS)) COSZ = COS ( ZETA + PIBY4 ) SINZ = SIN ( ZETA + PIBY4 ) / ZETA XCUBE = X * X * X IF ( X .GT. XHIGH3 ) THEN T = - ( ONE024 / ( XCUBE ) + ONE ) CHEB1 = CHEVAL(NTERM4,ARBIN1,T) CHEB2 = CHEVAL(NTERM5,ARBIN2,T) BI = ( COSZ * CHEB1 + SINZ * CHEB2 ) * TEMP ELSE BI = ( COSZ + SINZ * FIVE / SEVEN2 ) * TEMP ENDIF T = ( XCUBE + TWELHU ) / ( ONE76 - XCUBE ) AIRYGI = BI + CHEVAL(NTERM6,ARHIN1,T) * ONEBPI / X ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION AIRYHI(XVALUE) C C DESCRIPTION: C C This subroutine computes the modified Airy function Hi(x), C defined as C C AIRYHI(x) = [ Integral{0 to infinity} exp(x*t-t^3/3) dt ] / pi C C The approximation uses Chebyshev expansions with the coefficients C given to 20 decimal places. C C C ERROR RETURNS: C C If x > XHIGH1 (see below for definition of XHIGH1), then C the asymptotic expansion of Hi(x) will cause an overflow. C An error message is printed and the code returns the largest C floating-pt number as the result. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C ARHIP. The recommended value is such that C ABS(ARHIP(NTERM1)) < EPS/100 C subject to 1 <= NTERM1 <= 31. C C NTERM2 - INTEGER - The no. of terms to be used from the array C ARBIP. The recommended value is such that C ABS(ARBIP(NTERM2)) < EPS/100 C subject to 1 <= NTERM2 <= 23. C C NTERM3 - INTEGER - The no. of terms to be used from the array C ARGIP. The recommended value is such that C ABS(ARGIP1(NTERM3)) < EPS/100 C subject to 1 <= NTERM3 <= 29. C C NTERM4 - INTEGER - The no. of terms to be used from the array C ARHIN1. The recommended value is such that C ABS(ARHIN1(NTERM4)) < EPS/100 C subject to 1 <= NTERM4 <= 21. C C NTERM5 - INTEGER - The no. of terms to be used from the array C ARHIN2. The recommended value is such that C ABS(ARHIN2(NTERM5)) < EPS/100 C subject to 1 <= NTERM5 <= 15. C C XLOW1 - DOUBLE PRECISION - The value such that, if -XLOW1 < x < XLOW1, C then AIRYGI = Hi(0) to machine precision. C The recommended value is EPS. C C XHIGH1 - DOUBLE PRECISION - The value such that, if x > XHIGH1, then C overflow might occur. The recommended value is C computed as follows: C compute Z = 1.5*LOG(XMAX) C XHIGH1 = ( Z + LOG(Z)/4 + LOG(PI)/2 )**(2/3) C C XNEG1 - DOUBLE PRECISION - The value below which AIRYHI = 0.0. C The recommended value is C -1/(Pi*XMIN). C C XNEG2 - DOUBLE PRECISION - The value such that, if x < XNEG2, then C AIRYHI = -1/(Pi*x) to machine precision. C The recommended value is C -cube root( 2/EPS ). C C XMAX - DOUBLE PRECISION - The largest possible floating-pt. number. C This is the value given to the function C if x > XHIGH1. C C For values of EPS, EPSNEG, XMIN and XMAX refer to the file C MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C Dr. Allan J. Macleod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND. C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST UPDATE: C 23 January, 1996 C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5 DOUBLE PRECISION ARHIP(0:31),ARBIP(0:23),ARGIP1(0:29), 1 ARHIN1(0:21),ARHIN2(0:15), 2 BI,CHEVAL,FIVE14,FOUR,GI,HIZERO,LNRTPI, 3 MINATE,ONE,ONEBPI,ONEHUN,ONE76,SEVEN,T,TEMP, 4 THREE,THRE43,TWELHU,TWELVE,TWO,X,XCUBE, 5 XHIGH1,XLOW1,XMAX,XNEG1,XNEG2,XVALUE, 6 Z,ZERO,ZETA,D1MACH CHARACTER FNNAME*6,ERRMSG*30 DATA FNNAME/'AIRYHI'/ DATA ERRMSG/'ARGUMENT TO FUNCTION TOO LARGE'/ DATA ARHIP(0)/ 1.24013 56256 17628 31114 D 0/ DATA ARHIP(1)/ 0.64856 34197 39265 35804 D 0/ DATA ARHIP(2)/ 0.55236 25259 21149 03246 D 0/ DATA ARHIP(3)/ 0.20975 12207 38575 66794 D 0/ DATA ARHIP(4)/ 0.12025 66911 80523 73568 D 0/ DATA ARHIP(5)/ 0.37682 24931 09539 3785 D -1/ DATA ARHIP(6)/ 0.16510 88671 54807 1651 D -1/ DATA ARHIP(7)/ 0.45592 27552 11570 993 D -2/ DATA ARHIP(8)/ 0.16182 84804 77635 013 D -2/ DATA ARHIP(9)/ 0.40841 28250 81266 63 D -3/ DATA ARHIP(10)/0.12196 47972 13940 51 D -3/ DATA ARHIP(11)/0.28650 64098 65761 0 D -4/ DATA ARHIP(12)/0.74222 15564 24344 D -5/ DATA ARHIP(13)/0.16353 62319 32831 D -5/ DATA ARHIP(14)/0.37713 90818 8749 D -6/ DATA ARHIP(15)/0.78158 00336 008 D -7/ DATA ARHIP(16)/0.16384 47121 370 D -7/ DATA ARHIP(17)/0.31985 76659 92 D -8/ DATA ARHIP(18)/0.61933 90530 7 D -9/ DATA ARHIP(19)/0.11411 16119 1 D -9/ DATA ARHIP(20)/0.20649 23454 D -10/ DATA ARHIP(21)/0.36001 8664 D -11/ DATA ARHIP(22)/0.61401 849 D -12/ DATA ARHIP(23)/0.10162 125 D -12/ DATA ARHIP(24)/0.16437 01 D -13/ DATA ARHIP(25)/0.25908 4 D -14/ DATA ARHIP(26)/0.39931 D -15/ DATA ARHIP(27)/0.6014 D -16/ DATA ARHIP(28)/0.886 D -17/ DATA ARHIP(29)/0.128 D -17/ DATA ARHIP(30)/0.18 D -18/ DATA ARHIP(31)/0.3 D -19/ DATA ARBIP(0)/ 2.00582 13820 97590 64905 D 0/ DATA ARBIP(1)/ 0.29447 84491 70441 549 D -2/ DATA ARBIP(2)/ 0.34897 54514 77535 5 D -4/ DATA ARBIP(3)/ 0.83389 73337 4343 D -6/ DATA ARBIP(4)/ 0.31362 15471 813 D -7/ DATA ARBIP(5)/ 0.16786 53060 15 D -8/ DATA ARBIP(6)/ 0.12217 93405 9 D -9/ DATA ARBIP(7)/ 0.11915 84139 D -10/ DATA ARBIP(8)/ 0.15414 2553 D -11/ DATA ARBIP(9)/ 0.24844 455 D -12/ DATA ARBIP(10)/ 0.42130 12 D -13/ DATA ARBIP(11)/ 0.50529 3 D -14/ DATA ARBIP(12)/-0.60032 D -15/ DATA ARBIP(13)/-0.65474 D -15/ DATA ARBIP(14)/-0.22364 D -15/ DATA ARBIP(15)/-0.3015 D -16/ DATA ARBIP(16)/ 0.959 D -17/ DATA ARBIP(17)/ 0.616 D -17/ DATA ARBIP(18)/ 0.97 D -18/ DATA ARBIP(19)/-0.37 D -18/ DATA ARBIP(20)/-0.21 D -18/ DATA ARBIP(21)/-0.1 D -19/ DATA ARBIP(22)/ 0.2 D -19/ DATA ARBIP(23)/ 0.1 D -19/ DATA ARGIP1(0)/ 2.00473 71227 58014 86391 D 0/ DATA ARGIP1(1)/ 0.29418 41393 64406 724 D -2/ DATA ARGIP1(2)/ 0.71369 24900 63401 67 D -3/ DATA ARGIP1(3)/ 0.17526 56343 05022 67 D -3/ DATA ARGIP1(4)/ 0.43591 82094 02988 2 D -4/ DATA ARGIP1(5)/ 0.10926 26947 60430 7 D -4/ DATA ARGIP1(6)/ 0.27238 24183 99029 D -5/ DATA ARGIP1(7)/ 0.66230 90094 7687 D -6/ DATA ARGIP1(8)/ 0.15425 32337 0315 D -6/ DATA ARGIP1(9)/ 0.34184 65242 306 D -7/ DATA ARGIP1(10)/ 0.72815 77248 94 D -8/ DATA ARGIP1(11)/ 0.15158 85254 52 D -8/ DATA ARGIP1(12)/ 0.30940 04803 9 D -9/ DATA ARGIP1(13)/ 0.61496 72614 D -10/ DATA ARGIP1(14)/ 0.12028 77045 D -10/ DATA ARGIP1(15)/ 0.23369 0586 D -11/ DATA ARGIP1(16)/ 0.43778 068 D -12/ DATA ARGIP1(17)/ 0.79964 47 D -13/ DATA ARGIP1(18)/ 0.14940 75 D -13/ DATA ARGIP1(19)/ 0.24679 0 D -14/ DATA ARGIP1(20)/ 0.37672 D -15/ DATA ARGIP1(21)/ 0.7701 D -16/ DATA ARGIP1(22)/ 0.354 D -17/ DATA ARGIP1(23)/-0.49 D -18/ DATA ARGIP1(24)/ 0.62 D -18/ DATA ARGIP1(25)/-0.40 D -18/ DATA ARGIP1(26)/-0.1 D -19/ DATA ARGIP1(27)/ 0.2 D -19/ DATA ARGIP1(28)/-0.3 D -19/ DATA ARGIP1(29)/ 0.1 D -19/ DATA ARHIN1(0)/ 0.31481 01720 64234 04116 D 0/ DATA ARHIN1(1)/ -0.16414 49921 65889 64341 D 0/ DATA ARHIN1(2)/ 0.61766 51597 73091 3071 D -1/ DATA ARHIN1(3)/ -0.19718 81185 93593 3028 D -1/ DATA ARHIN1(4)/ 0.53690 28300 23331 343 D -2/ DATA ARHIN1(5)/ -0.12497 70684 39663 038 D -2/ DATA ARHIN1(6)/ 0.24835 51559 69949 33 D -3/ DATA ARHIN1(7)/ -0.41870 24096 74663 0 D -4/ DATA ARHIN1(8)/ 0.59094 54379 79124 D -5/ DATA ARHIN1(9)/ -0.68063 54118 4345 D -6/ DATA ARHIN1(10)/ 0.60728 97629 164 D -7/ DATA ARHIN1(11)/-0.36713 03492 42 D -8/ DATA ARHIN1(12)/ 0.70780 17552 D -10/ DATA ARHIN1(13)/ 0.11878 94334 D -10/ DATA ARHIN1(14)/-0.12089 8723 D -11/ DATA ARHIN1(15)/ 0.11896 56 D -13/ DATA ARHIN1(16)/ 0.59412 8 D -14/ DATA ARHIN1(17)/-0.32257 D -15/ DATA ARHIN1(18)/-0.2290 D -16/ DATA ARHIN1(19)/ 0.253 D -17/ DATA ARHIN1(20)/ 0.9 D -19/ DATA ARHIN1(21)/-0.2 D -19/ DATA ARHIN2/1.99647 72039 97796 50525 D 0, 1 -0.18756 37794 07173 213 D -2, 2 -0.12186 47089 77873 39 D -3, 3 -0.81402 16096 59287 D -5, 4 -0.55050 92595 3537 D -6, 5 -0.37630 08043 303 D -7, 6 -0.25885 83623 65 D -8, 7 -0.17931 82926 5 D -9, 8 -0.12459 16873 D -10, 9 -0.87171 247 D -12, X -0.60849 43 D -13, 1 -0.43117 8 D -14, 2 -0.29787 D -15, 3 -0.2210 D -16, 4 -0.136 D -17, 5 -0.14 D -18/ DATA ZERO,ONE,TWO/ 0.0 D 0 , 1.0 D 0 , 2.0 D 0/ DATA THREE,FOUR,SEVEN/ 3.0 D 0 , 4.0 D 0 , 7.0 D 0 / DATA MINATE,TWELVE,ONE76/ -8.0 D 0 , 12.0 D 0 , 176.0 D 0 / DATA THRE43,FIVE14,TWELHU/ 343.0 D 0 , 514.0 D 0 , 1200.0 D 0 / DATA ONEHUN/100.0 D 0/ DATA HIZERO/0.40995 10849 64000 49010 D 0/ DATA LNRTPI/0.57236 49429 24700 08707 D 0/ DATA ONEBPI/0.31830 98861 83790 67154 D 0/ C C Start computation C X = XVALUE C C Compute the machine-dependent constants. C XMAX = D1MACH(2) TEMP = THREE * LOG(XMAX) / TWO ZETA = ( TEMP + LOG(TEMP)/FOUR - LOG(ONEBPI)/TWO ) XHIGH1 = ZETA ** (TWO/THREE) C C Error test C IF ( X .GT. XHIGH1 ) THEN CALL ERRPRN(FNNAME,ERRMSG) AIRYHI = XMAX RETURN ENDIF C C continue with machine-dependent constants C Z = D1MACH(3) XLOW1 = Z T = Z / ONEHUN IF ( X .GE. ZERO ) THEN DO 10 NTERM1 = 31 , 0 , -1 IF ( ABS(ARHIP(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 23 , 0 , -1 IF ( ABS(ARBIP(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 DO 30 NTERM3 = 29 , 0 , -1 IF ( ABS(ARGIP1(NTERM3)) .GT. T ) GOTO 39 30 CONTINUE 39 CONTINUE ELSE DO 40 NTERM4 = 21 , 0 , -1 IF ( ABS(ARHIN1(NTERM4)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM5 = 15 , 0 , -1 IF ( ABS(ARHIN2(NTERM5)) .GT. T ) GOTO 59 50 CONTINUE 59 TEMP = ONE / ONEBPI XNEG1 = - ONE / ( TEMP * D1MACH(1) ) XNEG2 = - ( ( TWO / Z ) ** (ONE/THREE) ) ENDIF C C Code for x >= 0.0 C IF ( X .GE. ZERO ) THEN IF ( X .LE. SEVEN ) THEN IF ( X .LT. XLOW1 ) THEN AIRYHI = HIZERO ELSE T = ( X + X ) / SEVEN - ONE TEMP = ( X + X + X ) / TWO AIRYHI = EXP(TEMP) * CHEVAL(NTERM1,ARHIP,T) ENDIF ELSE XCUBE = X * X * X TEMP = SQRT(XCUBE) ZETA = ( TEMP + TEMP ) / THREE T = TWO * ( SQRT(THRE43/XCUBE) ) - ONE TEMP = CHEVAL(NTERM2,ARBIP,T) TEMP = ZETA + LOG(TEMP) - LOG(X) / FOUR - LNRTPI BI = EXP(TEMP) T = ( TWELHU - XCUBE ) / ( XCUBE + FIVE14 ) GI = CHEVAL(NTERM3,ARGIP1,T) * ONEBPI / X AIRYHI = BI - GI ENDIF ELSE C C Code for x < 0.0 C IF ( X .GE. MINATE ) THEN IF ( X .GT. -XLOW1 ) THEN AIRYHI = HIZERO ELSE T = ( FOUR * X + TWELVE ) / ( X - TWELVE ) AIRYHI = CHEVAL(NTERM4,ARHIN1,T) ENDIF ELSE IF ( X .LT. XNEG1 ) THEN AIRYHI = ZERO ELSE IF ( X .LT. XNEG2 ) THEN TEMP = ONE ELSE XCUBE = X * X * X T = ( XCUBE + TWELHU ) / ( ONE76 - XCUBE ) TEMP = CHEVAL(NTERM5,ARHIN2,T) ENDIF AIRYHI = - TEMP * ONEBPI / X ENDIF ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION ATNINT(XVALUE) C C DESCRIPTION: C C The function ATNINT calculates the value of the C inverse-tangent integral defined by C C ATNINT(x) = integral 0 to x ( (arctan t)/t ) dt C C The approximation uses Chebyshev series with the coefficients C given to an accuracy of 20D. C C C ERROR RETURNS: C C There are no error returns from this program. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The no. of terms of the array ATNINTT. C The recommended value is such that C ATNINA(NTERMS) < EPS/100 C C XLOW - DOUBLE PRECISION - A bound below which ATNINT(x) = x to machine C precision. The recommended value is C sqrt(EPSNEG/2). C C XUPPER - DOUBLE PRECISION - A bound on x, above which, to machine precision C ATNINT(x) = (pi/2)ln x C The recommended value is 1/EPS. C C For values of EPSNEG and EPS for various machine/compiler C combinations refer to the text file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C ABS , LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , D1MACH C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C PAISLEY C SCOTLAND C C (e-mail macl_ms0@paisley.ac.uk ) C C C LATEST MODIFICATION: 23 January, 1996 C C C INTEGER IND,NTERMS DOUBLE PRECISION ATNINA(0:22),CHEVAL,HALF,ONE,ONEHUN,T,TWOBPI, & X,XLOW,XUPPER,XVALUE,ZERO,D1MACH DATA ZERO,HALF,ONE/0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA ONEHUN/100.0 D 0/ DATA TWOBPI/0.63661 97723 67581 34308 D 0/ DATA ATNINA(0)/ 1.91040 36129 62359 37512 D 0/ DATA ATNINA(1)/ -0.41763 51437 65674 6940 D -1/ DATA ATNINA(2)/ 0.27539 25507 86367 434 D -2/ DATA ATNINA(3)/ -0.25051 80952 62488 81 D -3/ DATA ATNINA(4)/ 0.26669 81285 12117 1 D -4/ DATA ATNINA(5)/ -0.31189 05141 07001 D -5/ DATA ATNINA(6)/ 0.38833 85313 2249 D -6/ DATA ATNINA(7)/ -0.50572 74584 964 D -7/ DATA ATNINA(8)/ 0.68122 52829 49 D -8/ DATA ATNINA(9)/ -0.94212 56165 4 D -9/ DATA ATNINA(10)/ 0.13307 87881 6 D -9/ DATA ATNINA(11)/-0.19126 78075 D -10/ DATA ATNINA(12)/ 0.27891 2620 D -11/ DATA ATNINA(13)/-0.41174 820 D -12/ DATA ATNINA(14)/ 0.61429 87 D -13/ DATA ATNINA(15)/-0.92492 9 D -14/ DATA ATNINA(16)/ 0.14038 7 D -14/ DATA ATNINA(17)/-0.21460 D -15/ DATA ATNINA(18)/ 0.3301 D -16/ DATA ATNINA(19)/-0.511 D -17/ DATA ATNINA(20)/ 0.79 D -18/ DATA ATNINA(21)/-0.12 D -18/ DATA ATNINA(22)/ 0.2 D -19/ C C Compute the machine-dependent constants. C T = D1MACH(4) / ONEHUN DO 10 NTERMS = 22 , 0 , -1 IF ( ABS(ATNINA(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 T = D1MACH(3) XLOW = SQRT( T / ( ONE + ONE ) ) XUPPER = ONE / T C C Start calculation C IND = 1 X = XVALUE IF ( X .LT. ZERO ) THEN X = -X IND = -1 ENDIF C C Code for X < = 1.0 C IF ( X .LE. ONE ) THEN IF ( X .LT. XLOW ) THEN ATNINT = X ELSE T = X * X T = ( T - HALF ) + ( T - HALF ) ATNINT = X * CHEVAL( NTERMS , ATNINA , T ) ENDIF ELSE C C Code for X > 1.0 C IF ( X .GT. XUPPER ) THEN ATNINT = LOG( X ) / TWOBPI ELSE T = ONE / ( X * X ) T = ( T - HALF ) + ( T - HALF ) ATNINT = LOG( X ) / TWOBPI + CHEVAL( NTERMS,ATNINA,T ) / X ENDIF ENDIF IF ( IND .LT. 0 ) ATNINT = - ATNINT RETURN END DOUBLE PRECISION FUNCTION BIRINT(XVALUE) C C DESCRIPTION: C This function calculates the integral of the Airy function Bi, defined C C BIRINT(x) = integral{0 to x} Bi(t) dt C C The program uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C C ERROR RETURNS: C C If the function is too large and positive the correct C value would overflow. An error message is printed and the C program returns the value XMAX. C C If the argument is too large and negative, it is impossible C to accurately compute the necessary SIN and COS functions, C for the asymptotic expansion. C An error message is printed, and the program returns the C value 0 (the value at -infinity). C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C ABINT1. The recommended value is such that C ABS(ABINT1(NTERM1)) < EPS/100, C subject to 1 <= NTERM1 <= 36. C C NTERM2 - INTEGER - The no. of terms to be used from the array C ABINT2. The recommended value is such that C ABS(ABINT2(NTERM2)) < EPS/100, C subject to 1 <= NTERM2 <= 37. C C NTERM3 - INTEGER - The no. of terms to be used from the array C ABINT3. The recommended value is such that C ABS(ABINT3(NTERM3)) < EPS/100, C subject to 1 <= NTERM3 <= 37. C C NTERM4 - INTEGER - The no. of terms to be used from the array C ABINT4. The recommended value is such that C ABS(ABINT4(NTERM4)) < EPS/100, C subject to 1 <= NTERM4 <= 20. C C NTERM5 - INTEGER - The no. of terms to be used from the array C ABINT5. The recommended value is such that C ABS(ABINT5(NTERM5)) < EPS/100, C subject to 1 <= NTERM5 <= 20. C C XLOW1 - DOUBLE PRECISION - The value such that, if |x| < XLOW1, C BIRINT(x) = x * Bi(0) C to machine precision. The recommended value is C 2 * EPSNEG. C C XHIGH1 - DOUBLE PRECISION - The value such that, if x > XHIGH1, C the function value would overflow. C The recommended value is computed as C z = ln(XMAX) + 0.5ln(ln(XMAX)), C XHIGH1 = (3z/2)^(2/3) C C XNEG1 - DOUBLE PRECISION - The value such that, if x < XNEG1, C the trigonometric functions in the asymptotic C expansion cannot be calculated accurately. C The recommended value is C -(1/((EPS)**2/3)) C C XMAX - DOUBLE PRECISION - The value of the largest positive floating-pt C number. Used in giving a value to the function C if x > XHIGH1. C C For values of EPS, EPSNEG, and XMAX see the file MACHCON.TXT. C C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C COS, EXP, LOG, SIN, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C Univ. of Paisley, C High St., C Paisley, C SCOTLAND. C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 23 January, 1996 C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5 DOUBLE PRECISION ABINT1(0:36),ABINT2(0:37),ABINT3(0:37), 1 ABINT4(0:20),ABINT5(0:20), 2 ARG,BIRZER,CHEVAL,EIGHT,FOUR,F1,F2,NINE,NINHUN, 3 ONE,ONEHUN,ONEPT5,PIBY4,RT2B3P,SIXTEN,SEVEN,T,TEMP, 4 THREE,THR644,X,XLOW1,XHIGH1,XMAX,XNEG1,XVALUE, 5 Z,ZERO,D1MACH CHARACTER FNNAME*6,ERMSG1*31,ERMSG2*31 DATA FNNAME/'BIRINT'/ DATA ERMSG1/'ARGUMENT TOO LARGE AND POSITIVE'/ DATA ERMSG2/'ARGUMENT TOO LARGE AND NEGATIVE'/ DATA ABINT1(0)/ 0.38683 35244 50385 43350 D 0/ DATA ABINT1(1)/ -0.88232 13550 88890 8821 D -1/ DATA ABINT1(2)/ 0.21463 93744 03554 29239 D 0/ DATA ABINT1(3)/ -0.42053 47375 89131 5126 D -1/ DATA ABINT1(4)/ 0.59324 22547 49608 6771 D -1/ DATA ABINT1(5)/ -0.84078 70811 24270 210 D -2/ DATA ABINT1(6)/ 0.87182 47727 78487 955 D -2/ DATA ABINT1(7)/ -0.12191 60019 96134 55 D -3/ DATA ABINT1(8)/ 0.44024 82178 60232 34 D -3/ DATA ABINT1(9)/ 0.27894 68666 63866 78 D -3/ DATA ABINT1(10)/-0.70528 04689 78553 7 D -4/ DATA ABINT1(11)/ 0.59010 80066 77010 0 D -4/ DATA ABINT1(12)/-0.13708 62587 98214 2 D -4/ DATA ABINT1(13)/ 0.50596 25737 49073 D -5/ DATA ABINT1(14)/-0.51598 83776 6735 D -6/ DATA ABINT1(15)/ 0.39751 13123 49 D -8/ DATA ABINT1(16)/ 0.95249 85978 055 D -7/ DATA ABINT1(17)/-0.36814 35887 321 D -7/ DATA ABINT1(18)/ 0.12483 91688 136 D -7/ DATA ABINT1(19)/-0.24909 76191 37 D -8/ DATA ABINT1(20)/ 0.31775 24555 1 D -9/ DATA ABINT1(21)/ 0.54343 65270 D -10/ DATA ABINT1(22)/-0.40245 66915 D -10/ DATA ABINT1(23)/ 0.13938 55527 D -10/ DATA ABINT1(24)/-0.30381 7509 D -11/ DATA ABINT1(25)/ 0.40809 511 D -12/ DATA ABINT1(26)/ 0.16341 16 D -13/ DATA ABINT1(27)/-0.26838 09 D -13/ DATA ABINT1(28)/ 0.89664 1 D -14/ DATA ABINT1(29)/-0.18308 9 D -14/ DATA ABINT1(30)/ 0.21333 D -15/ DATA ABINT1(31)/ 0.1108 D -16/ DATA ABINT1(32)/-0.1276 D -16/ DATA ABINT1(33)/ 0.363 D -17/ DATA ABINT1(34)/-0.62 D -18/ DATA ABINT1(35)/ 0.5 D -19/ DATA ABINT1(36)/ 0.1 D -19/ DATA ABINT2(0)/ 2.04122 07860 25161 35181 D 0/ DATA ABINT2(1)/ 0.21241 33918 62122 1230 D -1/ DATA ABINT2(2)/ 0.66617 59976 67062 76 D -3/ DATA ABINT2(3)/ 0.38420 47982 80825 4 D -4/ DATA ABINT2(4)/ 0.36231 03660 20439 D -5/ DATA ABINT2(5)/ 0.50351 99011 5074 D -6/ DATA ABINT2(6)/ 0.79616 48702 253 D -7/ DATA ABINT2(7)/ 0.71780 84423 36 D -8/ DATA ABINT2(8)/ -0.26777 01591 04 D -8/ DATA ABINT2(9)/ -0.16848 95146 99 D -8/ DATA ABINT2(10)/-0.36811 75725 5 D -9/ DATA ABINT2(11)/ 0.47571 28727 D -10/ DATA ABINT2(12)/ 0.52636 21945 D -10/ DATA ABINT2(13)/ 0.77897 3500 D -11/ DATA ABINT2(14)/-0.46054 6143 D -11/ DATA ABINT2(15)/-0.18343 3736 D -11/ DATA ABINT2(16)/ 0.32191 249 D -12/ DATA ABINT2(17)/ 0.29352 060 D -12/ DATA ABINT2(18)/-0.16579 35 D -13/ DATA ABINT2(19)/-0.44838 08 D -13/ DATA ABINT2(20)/ 0.27907 D -15/ DATA ABINT2(21)/ 0.71192 1 D -14/ DATA ABINT2(22)/-0.1042 D -16/ DATA ABINT2(23)/-0.11959 1 D -14/ DATA ABINT2(24)/ 0.4606 D -16/ DATA ABINT2(25)/ 0.20884 D -15/ DATA ABINT2(26)/-0.2416 D -16/ DATA ABINT2(27)/-0.3638 D -16/ DATA ABINT2(28)/ 0.863 D -17/ DATA ABINT2(29)/ 0.591 D -17/ DATA ABINT2(30)/-0.256 D -17/ DATA ABINT2(31)/-0.77 D -18/ DATA ABINT2(32)/ 0.66 D -18/ DATA ABINT2(33)/ 0.3 D -19/ DATA ABINT2(34)/-0.15 D -18/ DATA ABINT2(35)/ 0.2 D -19/ DATA ABINT2(36)/ 0.3 D -19/ DATA ABINT2(37)/-0.1 D -19/ DATA ABINT3(0)/ 0.31076 96159 86403 49251 D 0/ DATA ABINT3(1)/ -0.27528 84588 74525 42718 D 0/ DATA ABINT3(2)/ 0.17355 96570 61365 43928 D 0/ DATA ABINT3(3)/ -0.55440 17909 49284 3130 D -1/ DATA ABINT3(4)/ -0.22512 65478 29595 0941 D -1/ DATA ABINT3(5)/ 0.41073 47447 81252 1894 D -1/ DATA ABINT3(6)/ 0.98476 12754 64262 480 D -2/ DATA ABINT3(7)/ -0.15556 18141 66604 1932 D -1/ DATA ABINT3(8)/ -0.56087 18707 30279 234 D -2/ DATA ABINT3(9)/ 0.24601 77833 22230 475 D -2/ DATA ABINT3(10)/ 0.16574 03922 92336 978 D -2/ DATA ABINT3(11)/-0.32775 87501 43540 2 D -4/ DATA ABINT3(12)/-0.24434 68086 05149 25 D -3/ DATA ABINT3(13)/-0.50353 05196 15232 1 D -4/ DATA ABINT3(14)/ 0.16302 64722 24785 4 D -4/ DATA ABINT3(15)/ 0.85191 40577 80934 D -5/ DATA ABINT3(16)/ 0.29790 36300 4664 D -6/ DATA ABINT3(17)/-0.64389 70789 6401 D -6/ DATA ABINT3(18)/-0.15046 98814 5803 D -6/ DATA ABINT3(19)/ 0.15870 13535 823 D -7/ DATA ABINT3(20)/ 0.12767 66299 622 D -7/ DATA ABINT3(21)/ 0.14057 85341 99 D -8/ DATA ABINT3(22)/-0.46564 73974 1 D -9/ DATA ABINT3(23)/-0.15682 74879 1 D -9/ DATA ABINT3(24)/-0.40389 3560 D -11/ DATA ABINT3(25)/ 0.66670 8192 D -11/ DATA ABINT3(26)/ 0.12886 9380 D -11/ DATA ABINT3(27)/-0.69686 63 D -13/ DATA ABINT3(28)/-0.62543 19 D -13/ DATA ABINT3(29)/-0.71839 2 D -14/ DATA ABINT3(30)/ 0.11529 6 D -14/ DATA ABINT3(31)/ 0.42276 D -15/ DATA ABINT3(32)/ 0.2493 D -16/ DATA ABINT3(33)/-0.971 D -17/ DATA ABINT3(34)/-0.216 D -17/ DATA ABINT3(35)/-0.2 D -19/ DATA ABINT3(36)/ 0.6 D -19/ DATA ABINT3(37)/ 0.1 D -19/ DATA ABINT4(0)/ 1.99507 95931 33520 47614 D 0/ DATA ABINT4(1)/ -0.27373 63759 70692 738 D -2/ DATA ABINT4(2)/ -0.30897 11308 12858 50 D -3/ DATA ABINT4(3)/ -0.35501 01982 79857 7 D -4/ DATA ABINT4(4)/ -0.41217 92715 20133 D -5/ DATA ABINT4(5)/ -0.48235 89231 6833 D -6/ DATA ABINT4(6)/ -0.56787 30727 927 D -7/ DATA ABINT4(7)/ -0.67187 48103 65 D -8/ DATA ABINT4(8)/ -0.79811 64985 7 D -9/ DATA ABINT4(9)/ -0.95142 71478 D -10/ DATA ABINT4(10)/-0.11374 68966 D -10/ DATA ABINT4(11)/-0.13635 9969 D -11/ DATA ABINT4(12)/-0.16381 418 D -12/ DATA ABINT4(13)/-0.19725 75 D -13/ DATA ABINT4(14)/-0.23784 4 D -14/ DATA ABINT4(15)/-0.28752 D -15/ DATA ABINT4(16)/-0.3475 D -16/ DATA ABINT4(17)/-0.422 D -17/ DATA ABINT4(18)/-0.51 D -18/ DATA ABINT4(19)/-0.6 D -19/ DATA ABINT4(20)/-0.1 D -19/ DATA ABINT5(0)/ 1.12672 08196 17825 66017 D 0/ DATA ABINT5(1)/ -0.67140 55675 25561 198 D -2/ DATA ABINT5(2)/ -0.69812 91801 78329 69 D -3/ DATA ABINT5(3)/ -0.75616 89886 42527 6 D -4/ DATA ABINT5(4)/ -0.83498 55745 10207 D -5/ DATA ABINT5(5)/ -0.93630 29823 2480 D -6/ DATA ABINT5(6)/ -0.10608 55629 6250 D -6/ DATA ABINT5(7)/ -0.12131 28916 741 D -7/ DATA ABINT5(8)/ -0.13963 11297 65 D -8/ DATA ABINT5(9)/ -0.16178 91805 4 D -9/ DATA ABINT5(10)/-0.18823 07907 D -10/ DATA ABINT5(11)/-0.22027 2985 D -11/ DATA ABINT5(12)/-0.25816 189 D -12/ DATA ABINT5(13)/-0.30479 64 D -13/ DATA ABINT5(14)/-0.35837 0 D -14/ DATA ABINT5(15)/-0.42831 D -15/ DATA ABINT5(16)/-0.4993 D -16/ DATA ABINT5(17)/-0.617 D -17/ DATA ABINT5(18)/-0.68 D -18/ DATA ABINT5(19)/-0.10 D -18/ DATA ABINT5(20)/-0.1 D -19/ DATA ZERO,ONE,ONEPT5/ 0.0 D 0 , 1.0 D 0 , 1.5 D 0 / DATA THREE,FOUR,SEVEN/ 3.0 D 0 , 4.0 D 0 , 7.0 D 0 / DATA EIGHT,NINE,SIXTEN/ 8.0 D 0 , 9.0 D 0 , 16.0 D 0 / DATA ONEHUN,NINHUN,THR644/100.0 D 0 , 900.0 D 0 , 3644.0 D 0 / DATA PIBY4/0.78539 81633 97448 30962 D 0/ DATA RT2B3P/0.46065 88659 61780 63902 D 0/ DATA BIRZER/0.61492 66274 46000 73515 D 0/ C C Start computation C X = XVALUE C C Compute the machine-dependent constants. C T = D1MACH(3) F2 = ONE + ONE XNEG1 = -ONE/(T**(F2/THREE)) XMAX = D1MACH(2) F1 = LOG(XMAX) TEMP = F1 + LOG(F1)/F2 XHIGH1 = (THREE*TEMP/F2)**(F2/THREE) C C Error test C IF ( X .GT. XHIGH1 ) THEN CALL ERRPRN(FNNAME,ERMSG1) BIRINT = XMAX RETURN ENDIF IF ( X .LT. XNEG1 ) THEN CALL ERRPRN(FNNAME,ERMSG2) BIRINT = ZERO RETURN ENDIF C C continue with machine-dependent constants C XLOW1 = F2 * T T = T / ONEHUN IF ( X .GE. ZERO ) THEN DO 10 NTERM1 = 36 , 0 , -1 IF ( ABS(ABINT1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 37 , 0 , -1 IF ( ABS(ABINT2(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 CONTINUE ELSE DO 30 NTERM3 = 37 , 0 , -1 IF ( ABS(ABINT3(NTERM3)) .GT. T ) GOTO 39 30 CONTINUE 39 DO 40 NTERM4 = 20 , 0 , -1 IF ( ABS(ABINT4(NTERM4)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM5 = 20 , 0 , -1 IF ( ABS(ABINT5(NTERM5)) .GT. T ) GOTO 59 50 CONTINUE 59 ENDIF C C Code for x >= 0.0 C IF ( X .GE. ZERO ) THEN IF ( X .LT. XLOW1 ) THEN BIRINT = BIRZER * X ELSE IF ( X .LE. EIGHT ) THEN T = X / FOUR - ONE BIRINT = X * EXP(ONEPT5*X) * CHEVAL(NTERM1,ABINT1,T) ELSE T = SIXTEN * SQRT(EIGHT/X) / X - ONE Z = ( X + X ) * SQRT(X) / THREE TEMP = RT2B3P * CHEVAL(NTERM2,ABINT2,T) / SQRT(Z) TEMP = Z + LOG(TEMP) BIRINT = EXP(TEMP) ENDIF ENDIF ELSE C C Code for x < 0.0 C IF ( X .GE. -SEVEN ) THEN IF ( X .GT. -XLOW1 ) THEN BIRINT = BIRZER * X ELSE T = - ( X + X ) / SEVEN - ONE BIRINT = X * CHEVAL(NTERM3,ABINT3,T) ENDIF ELSE Z = - ( X + X ) * SQRT(-X) / THREE ARG = Z + PIBY4 TEMP = NINE * Z * Z T = (THR644 - TEMP ) / ( NINHUN + TEMP ) F1 = CHEVAL(NTERM4,ABINT4,T) * SIN(ARG) F2 = CHEVAL(NTERM5,ABINT5,T) * COS(ARG) / Z BIRINT = ( F2 - F1 ) * RT2B3P / SQRT(Z) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION CLAUSN(XVALUE) C C DESCRIPTION: C C This program calculates Clausen's integral defined by C C CLAUSN(x) = integral 0 to x of (-ln(2*sin(t/2))) dt C C The code uses Chebyshev expansions with the coefficients C given to 20 decimal places. C C C ERROR RETURNS: C C If |x| is too large it is impossible to reduce the argument C to the range [0,2*pi] with any precision. An error message C is printed and the program returns the value 0.0 C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - the no. of terms of the array ACLAUS C to be used. The recommended value is C such that ABS(ACLAUS(NTERMS)) < EPS/100 C subject to 1 <= NTERMS <= 15 C C XSMALL - DOUBLE PRECISION - the value below which Cl(x) can be C approximated by x (1-ln x). The recommended C value is pi*sqrt(EPSNEG/2). C C XHIGH - DOUBLE PRECISION - The value of |x| above which we cannot C reliably reduce the argument to [0,2*pi]. C The recommended value is 1/EPS. C C For values of EPS and EPSNEG refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C AINT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St. C PAISLEY C SCOTLAND C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST MODIFICATION: 23 January, 1996 C INTEGER INDX,NTERMS DOUBLE PRECISION ACLAUS(0:15),CHEVAL,HALF,ONE,ONEHUN,PI,PISQ,T, & TWOPI,TWOPIA,TWOPIB,X,XHIGH,XSMALL,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'CLAUSN'/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,HALF,ONE/0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA ONEHUN/100.0 D 0/ DATA PI/3.14159 26535 89793 2385 D 0/ DATA PISQ/9.86960 44010 89358 6188 D 0/ DATA TWOPI/6.28318 53071 79586 4769 D 0/ DATA TWOPIA,TWOPIB/6.28125 D 0 , 0.19353 07179 58647 69253 D -2/ DATA ACLAUS/2.14269 43637 66688 44709 D 0, 1 0.72332 42812 21257 9245 D -1, 2 0.10164 24750 21151 164 D -2, 3 0.32452 50328 53164 5 D -4, 4 0.13331 51875 71472 D -5, 5 0.62132 40591 653 D -7, 6 0.31300 41353 37 D -8, 7 0.16635 72305 6 D -9, 8 0.91965 9293 D -11, 9 0.52400 462 D -12, X 0.30580 40 D -13, 1 0.18196 9 D -14, 2 0.11004 D -15, 3 0.675 D -17, 4 0.42 D -18, 5 0.3 D -19/ C C Start execution C X = XVALUE C C Compute the machine-dependent constants. C T = D1MACH(3) XHIGH = ONE / T C C Error test C IF ( ABS(X) .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) CLAUSN = ZERO RETURN ENDIF C C Continue with machine-dependent constants C XSMALL = PI * SQRT ( HALF * T ) T = T / ONEHUN DO 10 NTERMS = 15 , 0 , -1 IF ( ABS(ACLAUS(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE C C Continue with computation C 19 INDX = 1 IF ( X .LT. ZERO ) THEN X = -X INDX = -1 ENDIF C C Argument reduced using simulated extra precision C IF ( X .GT. TWOPI ) THEN T = AINT( X / TWOPI ) X = ( X - T * TWOPIA ) - T * TWOPIB ENDIF IF ( X .GT. PI ) THEN X = ( TWOPIA - X ) + TWOPIB INDX = -INDX ENDIF C C Set result to zero if X multiple of PI C IF ( X .EQ. ZERO ) THEN CLAUSN = ZERO RETURN ENDIF C C Code for X < XSMALL C IF ( X .LT. XSMALL ) THEN CLAUSN = X * ( ONE - LOG( X ) ) ELSE C C Code for XSMALL < = X < = PI C T = ( X * X ) / PISQ - HALF T = T + T IF ( T .GT. ONE ) T = ONE CLAUSN = X * CHEVAL( NTERMS,ACLAUS,T ) - X * LOG( X ) ENDIF IF ( INDX .LT. 0 ) CLAUSN = -CLAUSN RETURN END DOUBLE PRECISION FUNCTION DEBYE1(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 1, defined as C C DEBYE1(x) = [Integral {0 to x} t/(exp(t)-1) dt] / x C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB1. C The recommended value is such that C ABS(ADEB1(NTERMS)) < EPS/100 , with C 1 <= NTERMS <= 18 C C XLOW - DOUBLE PRECISION - The value below which C DEBYE1 = 1 - x/4 + x*x/36 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - DOUBLE PRECISION - The value above which C DEBYE1 = (pi*pi/(6*x)) - exp(-x)(x+1)/x. C The recommended value is C -LOG(2*EPS) C C XLIM - DOUBLE PRECISION - The value above which DEBYE1 = pi*pi/(6*x) C The recommended value is C -LOG(XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 23 january, 1996 C INTEGER I,NEXP,NTERMS DOUBLE PRECISION ADEB1(0:18),CHEVAL,DEBINF,EIGHT,EXPMX,FOUR,HALF, & NINE,ONE,ONEHUN,QUART,RK,SUM,T,THIRT6,X,XK,XLIM,XLOW, & XUPPER,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE1'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,QUART/0.0 D 0 , 0.25 D 0/ DATA HALF,ONE/0.5 D 0 , 1.0 D 0/ DATA FOUR,EIGHT/4.0 D 0 , 8.0 D 0/ DATA NINE,THIRT6,ONEHUN/9.0 D 0 , 36.0 D 0 , 100.0 D 0/ DATA DEBINF/0.60792 71018 54026 62866 D 0/ DATA ADEB1/2.40065 97190 38141 01941 D 0, 1 0.19372 13042 18936 00885 D 0, 2 -0.62329 12455 48957 703 D -2, 3 0.35111 74770 20648 00 D -3, 4 -0.22822 24667 01231 0 D -4, 5 0.15805 46787 50300 D -5, 6 -0.11353 78197 0719 D -6, 7 0.83583 36118 75 D -8, 8 -0.62644 24787 2 D -9, 9 0.47603 34890 D -10, X -0.36574 1540 D -11, 1 0.28354 310 D -12, 2 -0.22147 29 D -13, 3 0.17409 2 D -14, 4 -0.13759 D -15, 5 0.1093 D -16, 6 -0.87 D -18, 7 0.7 D -19, 8 -0.1 D -19/ C C Start computation C X = XVALUE C C Check XVALUE >= 0.0 C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE1 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = D1MACH(3) XLOW = SQRT ( T * EIGHT ) XUPPER = - LOG( T + T ) XLIM = - LOG( D1MACH(1) ) T = T / ONEHUN DO 10 NTERMS = 18 , 0 , -1 IF ( ABS(ADEB1(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE C C Code for x <= 4.0 C 19 IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE1 = ( ( X - NINE ) * X + THIRT6 ) / THIRT6 ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE1 = CHEVAL( NTERMS , ADEB1 , T ) - QUART * X ENDIF ELSE C C Code for x > 4.0 C DEBYE1 = ONE / ( X * DEBINF ) IF ( X .LT. XLIM ) THEN EXPMX = EXP( -X ) IF ( X .GT. XUPPER ) THEN DEBYE1 = DEBYE1 - EXPMX * ( ONE + ONE / X ) ELSE SUM = ZERO RK = AINT( XLIM / X ) NEXP = INT( RK ) XK = RK * X DO 100 I = NEXP,1,-1 T = ( ONE + ONE / XK ) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE DEBYE1 = DEBYE1 - SUM * EXPMX ENDIF ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION DEBYE2(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 1, defined as C C DEBYE2(x) = 2*[Integral {0 to x} t*t/(exp(t)-1) dt] / (x*x) C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB2. C The recommended value is such that C ABS(ADEB2(NTERMS)) < EPS/100, C subject to 1 <= NTERMS <= 18. C C XLOW - DOUBLE PRECISION - The value below which C DEBYE2 = 1 - x/3 + x*x/24 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - DOUBLE PRECISION - The value above which C DEBYE2 = (4*zeta(3)/x^2) - 2*exp(-x)(x^2+2x+1)/x^2. C The recommended value is C -LOG(2*EPS) C C XLIM1 - DOUBLE PRECISION - The value above which DEBYE2 = 4*zeta(3)/x^2 C The recommended value is C -LOG(XMIN) C C XLIM2 - DOUBLE PRECISION - The value above which DEBYE2 = 0.0 to machine C precision. The recommended value is C SQRT(4.8/XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 23 January, 1996 C INTEGER I,NEXP,NTERMS DOUBLE PRECISION ADEB2(0:18),CHEVAL,DEBINF,EIGHT,EXPMX,FOUR, & HALF,ONE,ONEHUN,RK,SUM,T,THREE,TWENT4,TWO,X,XK,XLIM1, & XLIM2,XLOW,XUPPER,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE2'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,HALF/0.0 D 0 , 0.5 D 0/ DATA ONE,TWO,THREE/1.0 D 0 , 2.0 D 0 , 3.0 D 0/ DATA FOUR,EIGHT,TWENT4/4.0 D 0 , 8.0 D 0 , 24.0 D 0/ DATA ONEHUN/100.0 D 0/ DATA DEBINF/4.80822 76126 38377 14160 D 0/ DATA ADEB2/2.59438 10232 57077 02826 D 0, 1 0.28633 57204 53071 98337 D 0, 2 -0.10206 26561 58046 7129 D -1, 3 0.60491 09775 34684 35 D -3, 4 -0.40525 76589 50210 4 D -4, 5 0.28633 82632 88107 D -5, 6 -0.20863 94303 0651 D -6, 7 0.15523 78758 264 D -7, 8 -0.11731 28008 66 D -8, 9 0.89735 85888 D -10, X -0.69317 6137 D -11, 1 0.53980 568 D -12, 2 -0.42324 05 D -13, 3 0.33377 8 D -14, 4 -0.26455 D -15, 5 0.2106 D -16, 6 -0.168 D -17, 7 0.13 D -18, 8 -0.1 D -19/ C C Start computation C X = XVALUE C C Check XVALUE >= 0.0 C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE2 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = D1MACH(1) XLIM1 = - LOG( T ) XLIM2 = SQRT( DEBINF ) / SQRT( T ) T = D1MACH(3) XLOW = SQRT ( T * EIGHT ) XUPPER = - LOG( T + T ) T = T / ONEHUN DO 10 NTERMS = 18 , 0 , -1 IF ( ABS(ADEB2(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE C C Code for x <= 4.0 C 19 IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE2 = ( ( X - EIGHT ) * X + TWENT4 ) / TWENT4 ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE2 = CHEVAL ( NTERMS , ADEB2 , T ) - X / THREE ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XLIM2 ) THEN DEBYE2 = ZERO ELSE DEBYE2 = DEBINF / ( X * X ) IF ( X .LT. XLIM1 ) THEN EXPMX = EXP ( -X ) IF ( X .GT. XUPPER ) THEN SUM = ( ( X + TWO ) * X + TWO ) / ( X * X ) ELSE SUM = ZERO RK = AINT ( XLIM1 / X ) NEXP = INT ( RK ) XK = RK * X DO 100 I = NEXP,1,-1 T = ( ONE + TWO / XK + TWO / ( XK*XK ) ) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE ENDIF DEBYE2 = DEBYE2 - TWO * SUM * EXPMX ENDIF ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION DEBYE3(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 3, defined as C C DEBYE3(x) = 3*[Integral {0 to x} t^3/(exp(t)-1) dt] / (x^3) C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB3. C The recommended value is such that C ABS(ADEB3(NTERMS)) < EPS/100, C subject to 1 <= NTERMS <= 18 C C XLOW - DOUBLE PRECISION - The value below which C DEBYE3 = 1 - 3x/8 + x*x/20 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - DOUBLE PRECISION - The value above which C DEBYE3 = (18*zeta(4)/x^3) - 3*exp(-x)(x^3+3x^2+6x+6)/x^3. C The recommended value is C -LOG(2*EPS) C C XLIM1 - DOUBLE PRECISION - The value above which DEBYE3 = 18*zeta(4)/x^3 C The recommended value is C -LOG(XMIN) C C XLIM2 - DOUBLE PRECISION - The value above which DEBYE3 = 0.0 to machine C precision. The recommended value is C CUBE ROOT(19/XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 23 January, 1996 C INTEGER I,NEXP,NTERMS DOUBLE PRECISION ADEB3(0:18),CHEVAL,DEBINF,EIGHT,EXPMX,FOUR, & HALF,ONE,ONEHUN,PT375,RK,SEVP5,SIX,SUM,T,THREE,TWENTY,X, & XK,XKI,XLIM1,XLIM2,XLOW,XUPPER,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE3'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,PT375/0.0 D 0 , 0.375 D 0/ DATA HALF,ONE/0.5 D 0 , 1.0 D 0/ DATA THREE,FOUR,SIX/3.0 D 0 , 4.0 D 0 , 6.0 D 0/ DATA SEVP5,EIGHT,TWENTY/7.5 D 0 , 8.0 D 0 , 20.0 D 0/ DATA ONEHUN/100.0 D 0/ DATA DEBINF/0.51329 91127 34216 75946 D -1/ DATA ADEB3/2.70773 70683 27440 94526 D 0, 1 0.34006 81352 11091 75100 D 0, 2 -0.12945 15018 44408 6863 D -1, 3 0.79637 55380 17381 64 D -3, 4 -0.54636 00095 90823 8 D -4, 5 0.39243 01959 88049 D -5, 6 -0.28940 32823 5386 D -6, 7 0.21731 76139 625 D -7, 8 -0.16542 09994 98 D -8, 9 0.12727 96189 2 D -9, X -0.98796 3459 D -11, 1 0.77250 740 D -12, 2 -0.60779 72 D -13, 3 0.48075 9 D -14, 4 -0.38204 D -15, 5 0.3048 D -16, 6 -0.244 D -17, 7 0.20 D -18, 8 -0.2 D -19/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE3 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = D1MACH(1) XLIM1 = - LOG( T ) XK = ONE / THREE XKI = (ONE/DEBINF) ** XK RK = T ** XK XLIM2 = XKI / RK T = D1MACH(3) XLOW = SQRT ( T * EIGHT ) XUPPER = - LOG( T + T ) T = T / ONEHUN DO 10 NTERMS = 18 , 0 , -1 IF ( ABS(ADEB3(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE C C Code for x <= 4.0 C 19 IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE3 = ( ( X - SEVP5 ) * X + TWENTY ) / TWENTY ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE3 = CHEVAL ( NTERMS , ADEB3 , T ) - PT375 * X ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XLIM2 ) THEN DEBYE3 = ZERO ELSE DEBYE3 = ONE / ( DEBINF * X * X * X ) IF ( X .LT. XLIM1 ) THEN EXPMX = EXP ( -X ) IF ( X .GT. XUPPER ) THEN SUM = (((X+THREE)*X+SIX)*X+SIX) / (X*X*X) ELSE SUM = ZERO RK = AINT ( XLIM1 / X ) NEXP = INT ( RK ) XK = RK * X DO 100 I = NEXP,1,-1 XKI = ONE / XK T = (((SIX*XKI+SIX)*XKI+THREE)*XKI+ONE) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE ENDIF DEBYE3 = DEBYE3 - THREE * SUM * EXPMX ENDIF ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION DEBYE4(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 4, defined as C C DEBYE4(x) = 4*[Integral {0 to x} t^4/(exp(t)-1) dt] / (x^4) C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB4. C The recommended value is such that C ABS(ADEB4(NTERMS)) < EPS/100, C subject to 1 <= NTERMS <= 18 C C XLOW - DOUBLE PRECISION - The value below which C DEBYE4 = 1 - 4x/10 + x*x/18 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - DOUBLE PRECISION - The value above which C DEBYE4=(96*zeta(5)/x^4)-4*exp(-x)(x^4+4x^2+12x^2+24x+24)/x^4. C The recommended value is C -LOG(2*EPS) C C XLIM1 - DOUBLE PRECISION - The value above which DEBYE4 = 96*zeta(5)/x^4 C The recommended value is C -LOG(XMIN) C C XLIM2 - DOUBLE PRECISION - The value above which DEBYE4 = 0.0 to machine C precision. The recommended value is C FOURTH ROOT(99/XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 23 January, 1996 C INTEGER I,NEXP,NTERMS DOUBLE PRECISION ADEB4(0:18),CHEVAL,DEBINF,EIGHT,EIGHTN,EXPMX, 1 FIVE,FOUR,FORTY5,HALF,ONE,ONEHUN,RK,SUM,T,TWELVE,TWENT4, 2 TWOPT5,X,XK,XKI,XLIM1,XLIM2,XLOW,XUPPER,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE4'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,HALF,ONE/0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA TWOPT5,FOUR,FIVE/2.5 D 0 , 4.0 D 0 , 5.0 D 0/ DATA EIGHT,TWELVE,EIGHTN/8.0 D 0 , 12.0 D 0 , 18.0 D 0/ DATA TWENT4,FORTY5,ONEHUN/24.0 D 0 , 45.0 D 0 , 100.0 D 0/ DATA DEBINF/99.54506 44937 63512 92781 D 0/ DATA ADEB4/2.78186 94150 20523 46008 D 0, 1 0.37497 67835 26892 86364 D 0, 2 -0.14940 90739 90315 8326 D -1, 3 0.94567 98114 37042 74 D -3, 4 -0.66132 91613 89325 5 D -4, 5 0.48156 32982 14449 D -5, 6 -0.35880 83958 7593 D -6, 7 0.27160 11874 160 D -7, 8 -0.20807 09912 23 D -8, 9 0.16093 83869 2 D -9, X -0.12547 09791 D -10, 1 0.98472 647 D -12, 2 -0.77723 69 D -13, 3 0.61648 3 D -14, 4 -0.49107 D -15, 5 0.3927 D -16, 6 -0.315 D -17, 7 0.25 D -18, 8 -0.2 D -19/ C C Start computation C X = XVALUE C C Check XVALUE >= 0.0 C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE4 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = D1MACH(1) XLIM1 = - LOG( T ) RK = ONE / FOUR XK = DEBINF ** RK XKI = T ** RK XLIM2 = XK / XKI T = D1MACH(3) XLOW = SQRT ( T * EIGHT ) XUPPER = - LOG( T + T ) T = T / ONEHUN DO 10 NTERMS = 18 , 0 , -1 IF ( ABS(ADEB4(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE C C Code for x <= 4.0 C 19 IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE4 = ( ( TWOPT5 * X - EIGHTN ) * X + FORTY5 ) / FORTY5 ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE4 = CHEVAL ( NTERMS , ADEB4 , T ) - ( X + X ) / FIVE ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XLIM2 ) THEN DEBYE4 = ZERO ELSE T = X * X DEBYE4 = ( DEBINF / T ) / T IF ( X .LT. XLIM1 ) THEN EXPMX = EXP ( -X ) IF ( X .GT. XUPPER ) THEN SUM = ( ( ( ( X + FOUR ) * X + TWELVE ) * X + & TWENT4 ) * X + TWENT4 ) / ( X * X * X * X ) ELSE SUM = ZERO RK = AINT ( XLIM1 / X ) NEXP = INT ( RK ) XK = RK * X DO 100 I = NEXP,1,-1 XKI = ONE / XK T = ( ( ( ( TWENT4 * XKI + TWENT4 ) * XKI + & TWELVE ) * XKI + FOUR ) * XKI + ONE ) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE ENDIF DEBYE4 = DEBYE4 - FOUR * SUM * EXPMX ENDIF ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION EXP3(XVALUE) C C DESCRIPTION C C This function calculates C C EXP3(X) = integral 0 to X (exp(-t*t*t)) dt C C The code uses Chebyshev expansions, whose coefficients are C given to 20 decimal places. C C C ERROR RETURNS C C If XVALUE < 0, an error message is printed and the function C returns the value 0. C C C MACHINE-DEPENDENT CONSTANTS C C NTERM1 - INTEGER - The no. of terms of the array AEXP3, C The recommended value is such that C AEXP3(NTERM1) < EPS/100. C C NTERM2 - INTEGER - The no. of terms of the array AEXP3A. C The recommended value is such that C AEXP3A(NTERM2) < EPS/100. C C XLOW - DOUBLE PRECISION - The value below which EXP3(X) = X to machine C precision. The recommended value is C cube root(4*EPSNEG) C C XUPPER - DOUBLE PRECISION - The value above which EXP3(X) = 0.89297... C to machine precision. The recommended value is C cube root(-ln(EPSNEG)) C C For values of EPS and EPSNEG for various machine/compiler C combinations refer to the file MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED C C EXP, LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR C C DR. ALLAN J. MACLEOD, C DEPARTMENT OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY C SCOTLAND. C C (e-mail macl_ms0@paisley.ac.uk ) C C C LATEST MODIFICATION: 23 January, 1996 C C INTEGER NTERM1,NTERM2 DOUBLE PRECISION AEXP3(0:24),AEXP3A(0:24),CHEVAL, 1 FOUR,FUNINF,HALF,ONE,ONEHUN,SIXTEN,T,THREE, 2 TWO,X,XLOW,XUPPER,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'EXP3 '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA TWO,THREE,FOUR/2.0 D 0 , 3.0 D 0 , 4.0 D 0 / DATA SIXTEN,ONEHUN/16.0 D 0 , 100.0 D 0/ DATA FUNINF/0.89297 95115 69249 21122 D 0/ DATA AEXP3(0)/ 1.26919 84142 21126 01434 D 0/ DATA AEXP3(1)/ -0.24884 64463 84140 98226 D 0/ DATA AEXP3(2)/ 0.80526 22071 72310 4125 D -1/ DATA AEXP3(3)/ -0.25772 73325 19683 2934 D -1/ DATA AEXP3(4)/ 0.75998 78873 07377 429 D -2/ DATA AEXP3(5)/ -0.20306 95581 94040 510 D -2/ DATA AEXP3(6)/ 0.49083 45866 99329 17 D -3/ DATA AEXP3(7)/ -0.10768 22391 42020 77 D -3/ DATA AEXP3(8)/ 0.21551 72626 42898 4 D -4/ DATA AEXP3(9)/ -0.39567 05137 38429 D -5/ DATA AEXP3(10)/ 0.66992 40933 8956 D -6/ DATA AEXP3(11)/-0.10513 21808 0703 D -6/ DATA AEXP3(12)/ 0.15362 58019 825 D -7/ DATA AEXP3(13)/-0.20990 96036 36 D -8/ DATA AEXP3(14)/ 0.26921 09538 1 D -9/ DATA AEXP3(15)/-0.32519 52422 D -10/ DATA AEXP3(16)/ 0.37114 8157 D -11/ DATA AEXP3(17)/-0.40136 518 D -12/ DATA AEXP3(18)/ 0.41233 46 D -13/ DATA AEXP3(19)/-0.40337 5 D -14/ DATA AEXP3(20)/ 0.37658 D -15/ DATA AEXP3(21)/-0.3362 D -16/ DATA AEXP3(22)/ 0.288 D -17/ DATA AEXP3(23)/-0.24 D -18/ DATA AEXP3(24)/ 0.2 D -19/ DATA AEXP3A(0)/ 1.92704 64955 06827 37293 D 0/ DATA AEXP3A(1)/ -0.34929 35652 04813 8054 D -1/ DATA AEXP3A(2)/ 0.14503 38371 89830 093 D -2/ DATA AEXP3A(3)/ -0.89253 36718 32790 3 D -4/ DATA AEXP3A(4)/ 0.70542 39219 11838 D -5/ DATA AEXP3A(5)/ -0.66717 27454 7611 D -6/ DATA AEXP3A(6)/ 0.72426 75899 824 D -7/ DATA AEXP3A(7)/ -0.87825 82560 56 D -8/ DATA AEXP3A(8)/ 0.11672 23442 78 D -8/ DATA AEXP3A(9)/ -0.16766 31281 2 D -9/ DATA AEXP3A(10)/ 0.25755 01577 D -10/ DATA AEXP3A(11)/-0.41957 8881 D -11/ DATA AEXP3A(12)/ 0.72010 412 D -12/ DATA AEXP3A(13)/-0.12949 055 D -12/ DATA AEXP3A(14)/ 0.24287 03 D -13/ DATA AEXP3A(15)/-0.47331 1 D -14/ DATA AEXP3A(16)/ 0.95531 D -15/ DATA AEXP3A(17)/-0.19914 D -15/ DATA AEXP3A(18)/ 0.4277 D -16/ DATA AEXP3A(19)/-0.944 D -17/ DATA AEXP3A(20)/ 0.214 D -17/ DATA AEXP3A(21)/-0.50 D -18/ DATA AEXP3A(22)/ 0.12 D -18/ DATA AEXP3A(23)/-0.3 D -19/ DATA AEXP3A(24)/ 0.1 D -19/ C C Start calculation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) EXP3 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = D1MACH(3) XLOW = ( FOUR * T ) ** (ONE/THREE) XUPPER = ( -LOG ( T ) ) ** (ONE/THREE) T = T / ONEHUN IF ( X .LE. TWO ) THEN DO 10 NTERM1 = 24 , 0 , -1 IF ( ABS(AEXP3(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 CONTINUE ELSE DO 40 NTERM2 = 24 , 0 , -1 IF ( ABS(AEXP3A(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 ENDIF C C Code for XVALUE < = 2 C IF ( X .LE. TWO ) THEN IF ( X .LT. XLOW ) THEN EXP3 = X ELSE T = ( ( X * X * X / FOUR ) - HALF ) - HALF EXP3 = X * CHEVAL ( NTERM1,AEXP3,T ) ENDIF ELSE C C Code for XVALUE > 2 C IF ( X .GT. XUPPER ) THEN EXP3 = FUNINF ELSE T = ( ( SIXTEN/ ( X * X * X ) ) - HALF ) - HALF T = CHEVAL ( NTERM2,AEXP3A,T ) T = T * EXP ( -X * X * X ) / ( THREE * X * X ) EXP3 = FUNINF - T ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION GOODST(XVALUE) C C DESCRIPTION: C C This function calculates the function defined as C C GOODST(x) = {integral 0 to inf} ( exp(-u*u)/(u+x) ) du C C The code uses Chebyshev expansions whose coefficients are C given to 20 decimal places. C C C ERROR RETURNS: C C If XVALUE <= 0.0, an error message is printed, and the C code returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array AGOST. C The recommended value is such that C AGOST(NTERM1) < EPS/100, C C NTERM2 - The no. of terms to be used in the array AGOSTA. C The recommended value is such that C AGOSTA(NTERM2) < EPS/100, C C XLOW - The value below which f(x) = -(gamma/2) - ln(x) C to machine precision. The recommended value is C EPSNEG C C XHIGH - The value above which f(x) = sqrt(pi)/(2x) to C machine precision. The recommended value is C 2 / EPSNEG C C For values of EPS and EPSNEG refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley. C SCOTLAND. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 23 January, 1996 C C INTEGER NTERM1,NTERM2 DOUBLE PRECISION AGOST(0:28),AGOSTA(0:23), 1 CHEVAL,FVAL,GAMBY2,HALF,ONE,ONEHUN,RTPIB2,SIX, 2 T,TWO,X,XHIGH,XLOW,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*15 DATA FNNAME/'GOODST'/ DATA ERRMSG/'ARGUMENT <= 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA TWO,SIX/ 2.0 D 0 , 6.0 D 0 / DATA ONEHUN/100.0 D 0/ DATA GAMBY2/0.28860 78324 50766 43030 D 0/ DATA RTPIB2/0.88622 69254 52758 01365 D 0/ DATA AGOST(0)/ 0.63106 56056 03984 46247 D 0/ DATA AGOST(1)/ 0.25051 73779 32167 08827 D 0/ DATA AGOST(2)/ -0.28466 20597 90189 40757 D 0/ DATA AGOST(3)/ 0.87615 87523 94862 3552 D -1/ DATA AGOST(4)/ 0.68260 22672 21252 724 D -2/ DATA AGOST(5)/ -0.10811 29544 19225 4677 D -1/ DATA AGOST(6)/ 0.16910 12441 17152 176 D -2/ DATA AGOST(7)/ 0.50272 98462 26151 86 D -3/ DATA AGOST(8)/ -0.18576 68720 41000 84 D -3/ DATA AGOST(9)/ -0.42870 36741 68474 D -5/ DATA AGOST(10)/ 0.10095 98903 20290 5 D -4/ DATA AGOST(11)/-0.86529 91351 7382 D -6/ DATA AGOST(12)/-0.34983 87432 0734 D -6/ DATA AGOST(13)/ 0.64832 78683 494 D -7/ DATA AGOST(14)/ 0.75759 24985 83 D -8/ DATA AGOST(15)/-0.27793 54243 62 D -8/ DATA AGOST(16)/-0.48302 35135 D -10/ DATA AGOST(17)/ 0.86632 21283 D -10/ DATA AGOST(18)/-0.39433 9687 D -11/ DATA AGOST(19)/-0.20952 9625 D -11/ DATA AGOST(20)/ 0.21501 759 D -12/ DATA AGOST(21)/ 0.39590 15 D -13/ DATA AGOST(22)/-0.69227 9 D -14/ DATA AGOST(23)/-0.54829 D -15/ DATA AGOST(24)/ 0.17108 D -15/ DATA AGOST(25)/ 0.376 D -17/ DATA AGOST(26)/-0.349 D -17/ DATA AGOST(27)/ 0.7 D -19/ DATA AGOST(28)/ 0.6 D -19/ DATA AGOSTA(0)/ 1.81775 46798 47187 58767 D 0/ DATA AGOSTA(1)/ -0.99211 46570 74409 7467 D -1/ DATA AGOSTA(2)/ -0.89405 86452 54819 243 D -2/ DATA AGOSTA(3)/ -0.94955 33127 77267 85 D -3/ DATA AGOSTA(4)/ -0.10971 37996 67596 65 D -3/ DATA AGOSTA(5)/ -0.13466 94539 57859 0 D -4/ DATA AGOSTA(6)/ -0.17274 92743 08265 D -5/ DATA AGOSTA(7)/ -0.22931 38019 9498 D -6/ DATA AGOSTA(8)/ -0.31278 44178 918 D -7/ DATA AGOSTA(9)/ -0.43619 79736 71 D -8/ DATA AGOSTA(10)/-0.61958 46474 3 D -9/ DATA AGOSTA(11)/-0.89379 91276 D -10/ DATA AGOSTA(12)/-0.13065 11094 D -10/ DATA AGOSTA(13)/-0.19316 6876 D -11/ DATA AGOSTA(14)/-0.28844 270 D -12/ DATA AGOSTA(15)/-0.43447 96 D -13/ DATA AGOSTA(16)/-0.65951 8 D -14/ DATA AGOSTA(17)/-0.10080 1 D -14/ DATA AGOSTA(18)/-0.15502 D -15/ DATA AGOSTA(19)/-0.2397 D -16/ DATA AGOSTA(20)/-0.373 D -17/ DATA AGOSTA(21)/-0.58 D -18/ DATA AGOSTA(22)/-0.9 D -19/ DATA AGOSTA(23)/-0.1 D -19/ C C Start computation C X = XVALUE C C Error test C IF ( X .LE. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) GOODST = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C FVAL = D1MACH(3) T = FVAL / ONEHUN IF ( X .LE. TWO ) THEN DO 10 NTERM1 = 28 , 0 , -1 IF ( ABS(AGOST(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW = FVAL ELSE DO 40 NTERM2 = 23 , 0 , -1 IF ( ABS(AGOSTA(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 XHIGH = TWO / FVAL ENDIF C C Computation for 0 < x <= 2 C IF ( X .LE. TWO ) THEN IF ( X .LT. XLOW ) THEN GOODST = - GAMBY2 - LOG(X) ELSE T = ( X - HALF ) - HALF GOODST = CHEVAL(NTERM1,AGOST,T) - EXP(-X*X) * LOG(X) ENDIF ELSE C C Computation for x > 2 C FVAL = RTPIB2 / X IF ( X .GT. XHIGH ) THEN GOODST = FVAL ELSE T = ( SIX - X ) / ( TWO + X ) GOODST = FVAL * CHEVAL(NTERM2,AGOSTA,T) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION I0INT(XVALUE) C C DESCRIPTION: C This program computes the integral of the modified Bessel C function I0(x) using the definition C C I0INT(x) = {integral 0 to x} I0(t) dt C C The program uses Chebyshev expansions, the coefficients of C which are given to 20 decimal places. C C C ERROR RETURNS: C If |XVALUE| larger than a certain limit, the value of C I0INT would cause an overflow. If such a situation occurs C the programs prints an error message, and returns the C value sign(XVALUE)*XMAX, where XMAX is the largest C acceptable floating-pt. value. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used from the array ARI01. C The recommended value is such that C ABS(ARI01(NTERM1)) < EPS/100 C C NTERM2 - The no. of terms to be used from the array ARI0A. C The recommended value is such that C ABS(ARI0A(NTERM2)) < EPS/100 C C XLOW - The value below which I0INT(x) = x, to machine precision. C The recommended value is C sqrt(12*EPS). C C XHIGH - The value above which overflow will occur. The C recommended value is C ln(XMAX) + 0.5*ln(ln(XMAX)) + ln(2). C C For values of EPS and XMAX refer to the file MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND C PA1 2BE C C (e-mail : macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 23 January, 1996 C INTEGER IND,NTERM1,NTERM2 DOUBLE PRECISION ARI01(0:28),ARI0A(0:33), 1 ATEEN,CHEVAL,HALF,LNR2PI,ONEHUN,T,TEMP,THREE,THIRT6, 2 X,XHIGH,XLOW,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'I0INT '/ DATA ERRMSG/'SIZE OF ARGUMENT TOO LARGE'/ DATA ZERO,HALF,THREE/ 0.0 D 0 , 0.5 D 0 , 3.0 D 0 / DATA ATEEN,THIRT6,ONEHUN/ 18.0 D 0 , 36.0 D 0 , 100.0 D 0/ DATA LNR2PI/0.91893 85332 04672 74178 D 0/ DATA ARI01(0)/ 0.41227 90692 67815 16801 D 0/ DATA ARI01(1)/ -0.34336 34515 00815 19562 D 0/ DATA ARI01(2)/ 0.22667 58871 57512 42585 D 0/ DATA ARI01(3)/ -0.12608 16471 87422 60032 D 0/ DATA ARI01(4)/ 0.60124 84628 77799 0271 D -1/ DATA ARI01(5)/ -0.24801 20462 91335 8248 D -1/ DATA ARI01(6)/ 0.89277 33895 65563 897 D -2/ DATA ARI01(7)/ -0.28325 37299 36696 605 D -2/ DATA ARI01(8)/ 0.79891 33904 17129 94 D -3/ DATA ARI01(9)/ -0.20053 93366 09648 90 D -3/ DATA ARI01(10)/ 0.44168 16783 01431 3 D -4/ DATA ARI01(11)/-0.82237 70422 46068 D -5/ DATA ARI01(12)/ 0.12005 97942 19015 D -5/ DATA ARI01(13)/-0.11350 86500 4889 D -6/ DATA ARI01(14)/ 0.69606 01446 6 D -9/ DATA ARI01(15)/ 0.18062 27728 36 D -8/ DATA ARI01(16)/-0.26039 48137 0 D -9/ DATA ARI01(17)/-0.16618 8103 D -11/ DATA ARI01(18)/ 0.51050 0232 D -11/ DATA ARI01(19)/-0.41515 879 D -12/ DATA ARI01(20)/-0.73681 38 D -13/ DATA ARI01(21)/ 0.12793 23 D -13/ DATA ARI01(22)/ 0.10324 7 D -14/ DATA ARI01(23)/-0.30379 D -15/ DATA ARI01(24)/-0.1789 D -16/ DATA ARI01(25)/ 0.673 D -17/ DATA ARI01(26)/ 0.44 D -18/ DATA ARI01(27)/-0.14 D -18/ DATA ARI01(28)/-0.1 D -19/ DATA ARI0A(0)/ 2.03739 65457 11432 87070 D 0/ DATA ARI0A(1)/ 0.19176 31647 50331 0248 D -1/ DATA ARI0A(2)/ 0.49923 33451 92881 47 D -3/ DATA ARI0A(3)/ 0.22631 87103 65981 5 D -4/ DATA ARI0A(4)/ 0.15868 21082 85561 D -5/ DATA ARI0A(5)/ 0.16507 85563 6318 D -6/ DATA ARI0A(6)/ 0.23850 58373 640 D -7/ DATA ARI0A(7)/ 0.39298 51823 04 D -8/ DATA ARI0A(8)/ 0.46042 71419 9 D -9/ DATA ARI0A(9)/ -0.70725 58172 D -10/ DATA ARI0A(10)/-0.67471 83961 D -10/ DATA ARI0A(11)/-0.20269 62001 D -10/ DATA ARI0A(12)/-0.87320 338 D -12/ DATA ARI0A(13)/ 0.17552 0014 D -11/ DATA ARI0A(14)/ 0.60383 944 D -12/ DATA ARI0A(15)/-0.39779 83 D -13/ DATA ARI0A(16)/-0.80490 48 D -13/ DATA ARI0A(17)/-0.11589 55 D -13/ DATA ARI0A(18)/ 0.82731 8 D -14/ DATA ARI0A(19)/ 0.28229 0 D -14/ DATA ARI0A(20)/-0.77667 D -15/ DATA ARI0A(21)/-0.48731 D -15/ DATA ARI0A(22)/ 0.7279 D -16/ DATA ARI0A(23)/ 0.7873 D -16/ DATA ARI0A(24)/-0.785 D -17/ DATA ARI0A(25)/-0.1281 D -16/ DATA ARI0A(26)/ 0.121 D -17/ DATA ARI0A(27)/ 0.214 D -17/ DATA ARI0A(28)/-0.27 D -18/ DATA ARI0A(29)/-0.36 D -18/ DATA ARI0A(30)/ 0.7 D -19/ DATA ARI0A(31)/ 0.6 D -19/ DATA ARI0A(32)/-0.2 D -19/ DATA ARI0A(33)/-0.1 D -19/ C C Start computation C IND = 1 X = XVALUE IF ( XVALUE .LT. ZERO ) THEN IND = -1 X = -X ENDIF C C Compute the machine-dependent constants. C T = LOG(D1MACH(2)) XHIGH = T + LOG(T)*HALF - LOG(HALF) C C Error test C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) I0INT = EXP ( XHIGH - LNR2PI - HALF * LOG(XHIGH) ) IF ( IND .EQ. -1 ) I0INT = -I0INT RETURN ENDIF C C Continue with machine-constants C TEMP = D1MACH(3) T = TEMP / ONEHUN IF ( X .LE. ATEEN ) THEN DO 10 NTERM1 = 28 , 0 , -1 IF ( ABS(ARI01(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW = SQRT ( THIRT6 * TEMP / THREE ) ELSE DO 40 NTERM2 = 33 , 0 , -1 IF ( ABS(ARI0A(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 ENDIF C C Code for 0 <= |x| <= 18 C IF ( X .LE. ATEEN ) THEN IF ( X .LT. XLOW ) THEN I0INT = X ELSE T = ( THREE * X - ATEEN ) / ( X + ATEEN ) I0INT = X * EXP(X) * CHEVAL(NTERM1,ARI01,T) ENDIF ELSE C C Code for |x| > 18 C T = ( THIRT6 / X - HALF ) - HALF TEMP = X - HALF*LOG(X) - LNR2PI + LOG(CHEVAL(NTERM2,ARI0A,T)) I0INT = EXP(TEMP) ENDIF IF ( IND .EQ. -1 ) I0INT = -I0INT RETURN END DOUBLE PRECISION FUNCTION I0ML0(XVALUE) C C DESCRIPTION: C C This program calculates the function I0ML0 defined as C C I0ML0(x) = I0(x) - L0(x) C C where I0(x) is the modified Bessel function of the first kind of C order 0, and L0(x) is the modified Struve function of order 0. C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20D. C C C ERROR RETURNS: C C The coefficients are only suitable for XVALUE >= 0.0. If C XVALUE < 0.0, an error message is printed and the function C returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The number of terms required for the array C AI0L0. The recommended value is such that C ABS(AI0L0(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The number of terms required for the array C AI0L0A. The recommended value is such that C ABS(AI0L0A(NTERM2)) < EPS/100 C C XLOW - DOUBLE PRECISION - The value below which I0ML0(x) = 1 to machine C precision. The recommended value is C EPSNEG C C XHIGH - DOUBLE PRECISION - The value above which I0ML0(x) = 2/(pi*x) to C machine precision. The recommended value is C SQRT(800/EPS) C C For values of EPS, and EPSNEG see the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C Dr. Allan J. MacLeod C Dept. of Mathematics and Statistics C University of Paisley C High St. C Paisley C SCOTLAND C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 23 January, 1996 C INTEGER NTERM1,NTERM2 DOUBLE PRECISION AI0L0(0:23),AI0L0A(0:23),ATEHUN,CHEVAL, 1 FORTY,ONE,ONEHUN,SIX,SIXTEN,T,TWOBPI,TWO88,X,XHIGH, 2 XLOW,XSQ,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'I0ML0 '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,ONE/ 0.0 D 0 , 1.0 D 0 / DATA SIX,SIXTEN/ 6.0 D 0 , 16.0 D 0 / DATA FORTY,ONEHUN/ 40.0 D 0 , 100.0 D 0 / DATA TWO88,ATEHUN/ 288.0 D 0 , 800.0 D 0 / DATA TWOBPI/0.63661 97723 67581 34308 D 0/ DATA AI0L0(0)/ 0.52468 73679 14855 99138 D 0/ DATA AI0L0(1)/ -0.35612 46069 96505 86196 D 0/ DATA AI0L0(2)/ 0.20487 20286 40099 27687 D 0/ DATA AI0L0(3)/ -0.10418 64052 04026 93629 D 0/ DATA AI0L0(4)/ 0.46342 11095 54842 9228 D -1/ DATA AI0L0(5)/ -0.17905 87192 40349 8630 D -1/ DATA AI0L0(6)/ 0.59796 86954 81143 177 D -2/ DATA AI0L0(7)/ -0.17177 75476 93565 429 D -2/ DATA AI0L0(8)/ 0.42204 65446 91714 22 D -3/ DATA AI0L0(9)/ -0.87961 78522 09412 5 D -4/ DATA AI0L0(10)/ 0.15354 34234 86922 3 D -4/ DATA AI0L0(11)/-0.21978 07695 84743 D -5/ DATA AI0L0(12)/ 0.24820 68393 6666 D -6/ DATA AI0L0(13)/-0.20327 06035 607 D -7/ DATA AI0L0(14)/ 0.90984 19842 1 D -9/ DATA AI0L0(15)/ 0.25617 93929 D -10/ DATA AI0L0(16)/-0.71060 9790 D -11/ DATA AI0L0(17)/ 0.32716 960 D -12/ DATA AI0L0(18)/ 0.23002 15 D -13/ DATA AI0L0(19)/-0.29210 9 D -14/ DATA AI0L0(20)/-0.3566 D -16/ DATA AI0L0(21)/ 0.1832 D -16/ DATA AI0L0(22)/-0.10 D -18/ DATA AI0L0(23)/-0.11 D -18/ DATA AI0L0A(0)/ 2.00326 51024 11606 43125 D 0/ DATA AI0L0A(1)/ 0.19520 68515 76492 081 D -2/ DATA AI0L0A(2)/ 0.38239 52356 99083 28 D -3/ DATA AI0L0A(3)/ 0.75342 80817 05443 6 D -4/ DATA AI0L0A(4)/ 0.14959 57655 89707 8 D -4/ DATA AI0L0A(5)/ 0.29994 05312 10557 D -5/ DATA AI0L0A(6)/ 0.60769 60482 2459 D -6/ DATA AI0L0A(7)/ 0.12399 49554 4506 D -6/ DATA AI0L0A(8)/ 0.25232 62552 649 D -7/ DATA AI0L0A(9)/ 0.50463 48573 32 D -8/ DATA AI0L0A(10)/0.97913 23623 0 D -9/ DATA AI0L0A(11)/0.18389 11524 1 D -9/ DATA AI0L0A(12)/0.33763 09278 D -10/ DATA AI0L0A(13)/0.61117 9703 D -11/ DATA AI0L0A(14)/0.10847 2972 D -11/ DATA AI0L0A(15)/0.18861 271 D -12/ DATA AI0L0A(16)/0.32803 45 D -13/ DATA AI0L0A(17)/0.56564 7 D -14/ DATA AI0L0A(18)/0.93300 D -15/ DATA AI0L0A(19)/0.15881 D -15/ DATA AI0L0A(20)/0.2791 D -16/ DATA AI0L0A(21)/0.389 D -17/ DATA AI0L0A(22)/0.70 D -18/ DATA AI0L0A(23)/0.16 D -18/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) I0ML0 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C XSQ = D1MACH(3) T = XSQ / ONEHUN IF ( X .LE. SIXTEN ) THEN DO 10 NTERM1 = 23 , 0 , -1 IF ( ABS(AI0L0(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW = XSQ ELSE DO 40 NTERM2 = 23 , 0 , -1 IF ( ABS(AI0L0A(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 XHIGH = SQRT ( ATEHUN / XSQ ) ENDIF C C Code for x <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN I0ML0 = ONE RETURN ELSE T = ( SIX * X - FORTY ) / ( X + FORTY ) I0ML0 = CHEVAL(NTERM1,AI0L0,T) RETURN ENDIF ELSE C C Code for x > 16 C IF ( X .GT. XHIGH ) THEN I0ML0 = TWOBPI / X ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) I0ML0 = CHEVAL(NTERM2,AI0L0A,T) * TWOBPI / X ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION I1ML1(XVALUE) C C DESCRIPTION: C C This program calculates the function I1ML1 defined as C C I1ML1(x) = I1(x) - L1(x) C C where I1(x) is the modified Bessel function of the first kind of C order 1, and L1(x) is the modified Struve function of order 1. C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20D. C C C ERROR RETURNS: C C The coefficients are only suitable for XVALUE >= 0.0. If C XVALUE < 0.0, an error message is printed and the function C returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The number of terms required for the array C AI1L1. The recommended value is such that C ABS(AI1L1(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The number of terms required for the array C AI1L1A. The recommended value is such that C ABS(AI1L1A(NTERM2)) < EPS/100 C C XLOW - DOUBLE PRECISION - The value below which I1ML1(x) = x/2 to machine C precision. The recommended value is C 2*EPSNEG C C XHIGH - DOUBLE PRECISION - The value above which I1ML1(x) = 2/pi to C machine precision. The recommended value is C SQRT(800/EPS) C C For values of EPS, and EPSNEG see the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C ABS , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C Dr. Allan J. MacLeod C Dept. of Mathematics and Statistics C University of Paisley C High St. C Paisley C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 23 January, 1996 C INTEGER NTERM1,NTERM2 DOUBLE PRECISION AI1L1(0:23),AI1L1A(0:25),ATEHUN,CHEVAL, 1 FORTY,ONE,ONEHUN,SIX,SIXTEN,T,TWO,TWOBPI,TWO88, 2 X,XHIGH,XLOW,XSQ,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'I1ML1 '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,ONE,TWO/ 0.0 D 0 , 1.0 D 0 , 2.0 D 0 / DATA SIX,SIXTEN,FORTY/ 6.0 D 0 , 16.0 D 0 , 40.0 D 0 / DATA ONEHUN,TWO88,ATEHUN/ 100.0 D 0 , 288.0 D 0 , 800.0 D 0 / DATA TWOBPI/0.63661 97723 67581 34308 D 0/ DATA AI1L1(0)/ 0.67536 36906 23505 76137 D 0/ DATA AI1L1(1)/ -0.38134 97109 72665 59040 D 0/ DATA AI1L1(2)/ 0.17452 17077 51339 43559 D 0/ DATA AI1L1(3)/ -0.70621 05887 23502 5061 D -1/ DATA AI1L1(4)/ 0.25173 41413 55880 3702 D -1/ DATA AI1L1(5)/ -0.78709 85616 06423 321 D -2/ DATA AI1L1(6)/ 0.21481 43686 51922 006 D -2/ DATA AI1L1(7)/ -0.50862 19971 79062 36 D -3/ DATA AI1L1(8)/ 0.10362 60828 04423 30 D -3/ DATA AI1L1(9)/ -0.17954 47212 05724 7 D -4/ DATA AI1L1(10)/ 0.25978 82745 15414 D -5/ DATA AI1L1(11)/-0.30442 40632 4667 D -6/ DATA AI1L1(12)/ 0.27202 39894 766 D -7/ DATA AI1L1(13)/-0.15812 61441 90 D -8/ DATA AI1L1(14)/ 0.18162 09172 D -10/ DATA AI1L1(15)/ 0.64796 7659 D -11/ DATA AI1L1(16)/-0.54113 290 D -12/ DATA AI1L1(17)/-0.30831 1 D -14/ DATA AI1L1(18)/ 0.30563 8 D -14/ DATA AI1L1(19)/-0.9717 D -16/ DATA AI1L1(20)/-0.1422 D -16/ DATA AI1L1(21)/ 0.84 D -18/ DATA AI1L1(22)/ 0.7 D -19/ DATA AI1L1(23)/-0.1 D -19/ DATA AI1L1A(0)/ 1.99679 36189 67891 36501 D 0/ DATA AI1L1A(1)/ -0.19066 32614 09686 132 D -2/ DATA AI1L1A(2)/ -0.36094 62241 01744 81 D -3/ DATA AI1L1A(3)/ -0.68418 47304 59982 0 D -4/ DATA AI1L1A(4)/ -0.12990 08228 50942 6 D -4/ DATA AI1L1A(5)/ -0.24715 21887 05765 D -5/ DATA AI1L1A(6)/ -0.47147 83969 1972 D -6/ DATA AI1L1A(7)/ -0.90208 19982 592 D -7/ DATA AI1L1A(8)/ -0.17304 58637 504 D -7/ DATA AI1L1A(9)/ -0.33232 36701 59 D -8/ DATA AI1L1A(10)/-0.63736 42173 5 D -9/ DATA AI1L1A(11)/-0.12180 23975 6 D -9/ DATA AI1L1A(12)/-0.23173 46832 D -10/ DATA AI1L1A(13)/-0.43906 8833 D -11/ DATA AI1L1A(14)/-0.82847 110 D -12/ DATA AI1L1A(15)/-0.15562 249 D -12/ DATA AI1L1A(16)/-0.29131 12 D -13/ DATA AI1L1A(17)/-0.54396 5 D -14/ DATA AI1L1A(18)/-0.10117 7 D -14/ DATA AI1L1A(19)/-0.18767 D -15/ DATA AI1L1A(20)/-0.3484 D -16/ DATA AI1L1A(21)/-0.643 D -17/ DATA AI1L1A(22)/-0.118 D -17/ DATA AI1L1A(23)/-0.22 D -18/ DATA AI1L1A(24)/-0.4 D -19/ DATA AI1L1A(25)/-0.1 D -19/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) I1ML1 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C XSQ = D1MACH(3) T = XSQ / ONEHUN IF ( X .LE. SIXTEN ) THEN DO 10 NTERM1 = 23 , 0 , -1 IF ( ABS(AI1L1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW = XSQ + XSQ ELSE DO 40 NTERM2 = 25 , 0 , -1 IF ( ABS(AI1L1A(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 XHIGH = SQRT ( ATEHUN / XSQ ) ENDIF C C Code for x <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN I1ML1 = X / TWO RETURN ELSE T = ( SIX * X - FORTY ) / ( X + FORTY ) I1ML1 = CHEVAL(NTERM1,AI1L1,T) * X / TWO RETURN ENDIF ELSE C C Code for x > 16 C IF ( X .GT. XHIGH ) THEN I1ML1 = TWOBPI ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) I1ML1 = CHEVAL(NTERM2,AI1L1A,T) * TWOBPI ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION J0INT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the Bessel C function J0, defined as C C J0INT(x) = {integral 0 to x} J0(t) dt C C The code uses Chebyshev expansions whose coefficients are C given to 20 decimal places. C C C ERROR RETURNS: C C If the value of |x| is too large, it is impossible to C accurately compute the trigonometric functions used. An C error message is printed, and the function returns the C value 1.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used from the array C ARJ01. The recommended value is such that C ABS(ARJ01(NTERM1)) < EPS/100, provided that C C NTERM2 - The no. of terms to be used from the array C ARJ0A1. The recommended value is such that C ABS(ARJ0A1(NTERM2)) < EPS/100, provided that C C NTERM3 - The no. of terms to be used from the array C ARJ0A2. The recommended value is such that C ABS(ARJ0A2(NTERM3)) < EPS/100, provided that C C XLOW - The value of |x| below which J0INT(x) = x to C machine-precision. The recommended value is C sqrt(12*EPSNEG) C C XHIGH - The value of |x| above which it is impossible C to calculate (x-pi/4) accurately. The recommended C value is 1/EPSNEG C C For values of EPS and EPSNEG for various machine/compiler C combinations refer to the file MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C COS , SIN , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 23 January, 1996 C INTEGER IND,NTERM1,NTERM2,NTERM3 DOUBLE PRECISION ARJ01(0:23),ARJ0A1(0:21),ARJ0A2(0:18), 1 CHEVAL,FIVE12,ONE,ONEHUN,ONE28,PIB41,PIB411,PIB412, 2 PIB42,RT2BPI,SIXTEN,T,TEMP,TWELVE,X,XHIGH,XLOW, 3 XMPI4,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'J0INT '/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,ONE/ 0.0 D 0 , 1.0 D 0 / DATA TWELVE,SIXTEN/ 12.0 D 0 , 16.0 D 0 / DATA ONEHUN,ONE28,FIVE12/ 100.0 D 0 , 128.0 D 0 , 512 D 0 / DATA RT2BPI/0.79788 45608 02865 35588 D 0/ DATA PIB411,PIB412/ 201.0 D 0 , 256.0 D 0/ DATA PIB42/0.24191 33974 48309 61566 D -3/ DATA ARJ01(0)/ 0.38179 27932 16901 73518 D 0/ DATA ARJ01(1)/ -0.21275 63635 05053 21870 D 0/ DATA ARJ01(2)/ 0.16754 21340 72157 94187 D 0/ DATA ARJ01(3)/ -0.12853 20977 21963 98954 D 0/ DATA ARJ01(4)/ 0.10114 40545 57788 47013 D 0/ DATA ARJ01(5)/ -0.91007 95343 20156 8859 D -1/ DATA ARJ01(6)/ 0.64013 45264 65687 3103 D -1/ DATA ARJ01(7)/ -0.30669 63029 92675 4312 D -1/ DATA ARJ01(8)/ 0.10308 36525 32506 4201 D -1/ DATA ARJ01(9)/ -0.25567 06503 99956 918 D -2/ DATA ARJ01(10)/ 0.48832 75580 57983 04 D -3/ DATA ARJ01(11)/-0.74249 35126 03607 7 D -4/ DATA ARJ01(12)/ 0.92226 05637 30861 D -5/ DATA ARJ01(13)/-0.95522 82830 7083 D -6/ DATA ARJ01(14)/ 0.83883 55845 986 D -7/ DATA ARJ01(15)/-0.63318 44888 58 D -8/ DATA ARJ01(16)/ 0.41560 50422 1 D -9/ DATA ARJ01(17)/-0.23955 29307 D -10/ DATA ARJ01(18)/ 0.12228 6885 D -11/ DATA ARJ01(19)/-0.55697 11 D -13/ DATA ARJ01(20)/ 0.22782 0 D -14/ DATA ARJ01(21)/-0.8417 D -16/ DATA ARJ01(22)/ 0.282 D -17/ DATA ARJ01(23)/-0.9 D -19/ DATA ARJ0A1(0)/ 1.24030 13303 75189 70827 D 0/ DATA ARJ0A1(1)/ -0.47812 53536 32280 693 D -2/ DATA ARJ0A1(2)/ 0.66131 48891 70667 8 D -4/ DATA ARJ0A1(3)/ -0.18604 27404 86349 D -5/ DATA ARJ0A1(4)/ 0.83627 35565 080 D -7/ DATA ARJ0A1(5)/ -0.52585 70367 31 D -8/ DATA ARJ0A1(6)/ 0.42606 36325 1 D -9/ DATA ARJ0A1(7)/ -0.42117 61024 D -10/ DATA ARJ0A1(8)/ 0.48894 6426 D -11/ DATA ARJ0A1(9)/ -0.64834 929 D -12/ DATA ARJ0A1(10)/ 0.96172 34 D -13/ DATA ARJ0A1(11)/-0.15703 67 D -13/ DATA ARJ0A1(12)/ 0.27871 2 D -14/ DATA ARJ0A1(13)/-0.53222 D -15/ DATA ARJ0A1(14)/ 0.10844 D -15/ DATA ARJ0A1(15)/-0.2342 D -16/ DATA ARJ0A1(16)/ 0.533 D -17/ DATA ARJ0A1(17)/-0.127 D -17/ DATA ARJ0A1(18)/ 0.32 D -18/ DATA ARJ0A1(19)/-0.8 D -19/ DATA ARJ0A1(20)/ 0.2 D -19/ DATA ARJ0A1(21)/-0.1 D -19/ DATA ARJ0A2(0)/ 1.99616 09630 13416 75339 D 0/ DATA ARJ0A2(1)/ -0.19037 98192 46668 161 D -2/ DATA ARJ0A2(2)/ 0.15397 10927 04422 6 D -4/ DATA ARJ0A2(3)/ -0.31145 08832 8103 D -6/ DATA ARJ0A2(4)/ 0.11108 50971 321 D -7/ DATA ARJ0A2(5)/ -0.58666 78712 3 D -9/ DATA ARJ0A2(6)/ 0.41399 26949 D -10/ DATA ARJ0A2(7)/ -0.36539 8763 D -11/ DATA ARJ0A2(8)/ 0.38557 568 D -12/ DATA ARJ0A2(9)/ -0.47098 00 D -13/ DATA ARJ0A2(10)/ 0.65022 0 D -14/ DATA ARJ0A2(11)/-0.99624 D -15/ DATA ARJ0A2(12)/ 0.16700 D -15/ DATA ARJ0A2(13)/-0.3028 D -16/ DATA ARJ0A2(14)/ 0.589 D -17/ DATA ARJ0A2(15)/-0.122 D -17/ DATA ARJ0A2(16)/ 0.27 D -18/ DATA ARJ0A2(17)/-0.6 D -19/ DATA ARJ0A2(18)/ 0.1 D -19/ C C Start computation C X = XVALUE IND = 1 IF ( X .LT. ZERO ) THEN X = -X IND = -1 ENDIF C C Compute the machine-dependent constants. C TEMP = D1MACH(3) XHIGH = ONE / TEMP C C Error test C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) J0INT = ONE IF ( IND .EQ. -1 ) J0INT = -J0INT RETURN ENDIF C C continue with constants C T = TEMP / ONEHUN IF ( X .LE. SIXTEN ) THEN DO 10 NTERM1 = 23 , 0 , -1 IF ( ABS(ARJ01(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW = SQRT ( TWELVE * TEMP ) ELSE DO 40 NTERM2 = 21 , 0 , -1 IF ( ABS(ARJ0A1(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM3 = 18 , 0 , -1 IF ( ABS(ARJ0A2(NTERM3)) .GT. T ) GOTO 59 50 CONTINUE 59 ENDIF C C Code for 0 <= |x| <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN J0INT = X ELSE T = X * X / ONE28 - ONE J0INT = X * CHEVAL(NTERM1,ARJ01,T) ENDIF ELSE C C Code for |x| > 16 C T = FIVE12 / ( X * X ) - ONE PIB41 = PIB411 / PIB412 XMPI4 = ( X - PIB41 ) - PIB42 TEMP = COS(XMPI4) * CHEVAL(NTERM2,ARJ0A1,T) / X TEMP = TEMP - SIN(XMPI4) * CHEVAL(NTERM3,ARJ0A2,T) J0INT = ONE - RT2BPI * TEMP / SQRT(X) ENDIF IF ( IND .EQ. -1 ) J0INT = -J0INT RETURN END DOUBLE PRECISION FUNCTION K0INT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the modified Bessel function C defined by C C K0INT(x) = {integral 0 to x} K0(t) dt C C The code uses Chebyshev expansions, whose coefficients are C given to 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, the function is undefined. An error message is C printed and the function returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array AK0IN1. The C recommended value is such that C ABS(AK0IN1(NTERM1)) < EPS/100, C C NTERM2 - The no. of terms to be used in the array AK0IN2. The C recommended value is such that C ABS(AK0IN2(NTERM2)) < EPS/100, C C NTERM3 - The no. of terms to be used in the array AK0INA. The C recommended value is such that C ABS(AK0INA(NTERM3)) < EPS/100, C C XLOW - The value below which K0INT = x * ( const - ln(x) ) to C machine precision. The recommended value is C sqrt (18*EPSNEG). C C XHIGH - The value above which K0INT = pi/2 to machine precision. C The recommended value is C - log (2*EPSNEG) C C For values of EPS and EPSNEG refer to the file MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 23 January, 1996 C INTEGER NTERM1,NTERM2,NTERM3 DOUBLE PRECISION AK0IN1(0:15),AK0IN2(0:15),AK0INA(0:27), 1 CHEVAL,CONST1,CONST2,EIGHTN,FVAL,HALF, 2 ONEHUN,PIBY2,RT2BPI,SIX,T,TEMP,TWELVE,X, 3 XHIGH,XLOW,XVALUE,ZERO,D1MACH CHARACTER FNNAME*8,ERRMSG*14 DATA FNNAME/'K0INT '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,SIX/ 0.0 D 0 , 0.5 D 0 , 6.0 D 0 / DATA TWELVE,EIGHTN,ONEHUN/ 12.0 D 0 , 18.0 D 0 , 100.0 D 0 / DATA CONST1/1.11593 15156 58412 44881 D 0/ DATA CONST2/-0.11593 15156 58412 44881 D 0/ DATA PIBY2/1.57079 63267 94896 61923 D 0/ DATA RT2BPI/0.79788 45608 02865 35588 D 0/ DATA AK0IN1/16.79702 71446 47109 59477 D 0, 1 9.79134 68767 68894 07070 D 0, 2 2.80501 31604 43379 39300 D 0, 3 0.45615 62053 18885 02068 D 0, 4 0.47162 24457 07476 0784 D -1, 5 0.33526 51482 69698 289 D -2, 6 0.17335 18119 38747 27 D -3, 7 0.67995 18893 64702 D -5, 8 0.20900 26835 9924 D -6, 9 0.51660 38469 76 D -8, X 0.10485 70833 1 D -9, 1 0.17782 9320 D -11, 2 0.25568 44 D -13, 3 0.31557 D -15, 4 0.338 D -17, 5 0.3 D -19/ DATA AK0IN2/10.76266 55822 78091 74077 D 0, 1 5.62333 47984 99975 11550 D 0, 2 1.43543 66487 92908 67158 D 0, 3 0.21250 41014 37438 96043 D 0, 4 0.20365 37393 10000 9554 D -1, 5 0.13602 35840 95623 632 D -2, 6 0.66753 88699 20909 3 D -4, 7 0.25043 00357 07337 D -5, 8 0.74064 23741 728 D -7, 9 0.17697 47043 14 D -8, X 0.34857 75254 D -10, 1 0.57544 785 D -12, 2 0.80748 1 D -14, 3 0.9747 D -16, 4 0.102 D -17, 5 0.1 D -19/ DATA AK0INA(0)/ 1.91172 06544 50604 53895 D 0/ DATA AK0INA(1)/ -0.41830 64565 76958 1085 D -1/ DATA AK0INA(2)/ 0.21335 25080 68147 486 D -2/ DATA AK0INA(3)/ -0.15859 49728 45041 81 D -3/ DATA AK0INA(4)/ 0.14976 24699 85835 1 D -4/ DATA AK0INA(5)/ -0.16795 59553 22241 D -5/ DATA AK0INA(6)/ 0.21495 47247 8804 D -6/ DATA AK0INA(7)/ -0.30583 56654 790 D -7/ DATA AK0INA(8)/ 0.47494 64133 43 D -8/ DATA AK0INA(9)/ -0.79424 66043 2 D -9/ DATA AK0INA(10)/ 0.14156 55532 5 D -9/ DATA AK0INA(11)/-0.26678 25359 D -10/ DATA AK0INA(12)/ 0.52814 9717 D -11/ DATA AK0INA(13)/-0.10926 3199 D -11/ DATA AK0INA(14)/ 0.23518 838 D -12/ DATA AK0INA(15)/-0.52479 91 D -13/ DATA AK0INA(16)/ 0.12101 91 D -13/ DATA AK0INA(17)/-0.28763 2 D -14/ DATA AK0INA(18)/ 0.70297 D -15/ DATA AK0INA(19)/-0.17631 D -15/ DATA AK0INA(20)/ 0.4530 D -16/ DATA AK0INA(21)/-0.1190 D -16/ DATA AK0INA(22)/ 0.319 D -17/ DATA AK0INA(23)/-0.87 D -18/ DATA AK0INA(24)/ 0.24 D -18/ DATA AK0INA(25)/-0.7 D -19/ DATA AK0INA(26)/ 0.2 D -19/ DATA AK0INA(27)/-0.1 D -19/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) K0INT = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C TEMP = D1MACH(3) T = TEMP / ONEHUN IF ( X .LE. SIX ) THEN DO 10 NTERM1 = 15 , 0 , -1 IF ( ABS(AK0IN1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 15 , 0 , -1 IF ( ABS(AK0IN2(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 XLOW = SQRT ( EIGHTN * TEMP ) ELSE DO 40 NTERM3 = 27 , 0 , -1 IF ( ABS(AK0INA(NTERM3)) .GT. T ) GOTO 49 40 CONTINUE 49 XHIGH = - LOG ( TEMP + TEMP ) ENDIF C C Code for 0 <= XVALUE <= 6 C IF ( X .LE. SIX ) THEN IF ( X .LT. XLOW ) THEN FVAL = X IF ( X .GT. ZERO ) THEN FVAL = FVAL * ( CONST1 - LOG(X) ) ENDIF K0INT = FVAL ELSE T = ( ( X * X ) / EIGHTN - HALF ) - HALF FVAL = ( CONST2 + LOG(X) ) * CHEVAL(NTERM2,AK0IN2,T) K0INT = X * ( CHEVAL(NTERM1,AK0IN1,T) - FVAL ) ENDIF C C Code for x > 6 C ELSE FVAL = PIBY2 IF ( X .LT. XHIGH ) THEN T = ( TWELVE / X - HALF ) - HALF TEMP = EXP(-X) * CHEVAL(NTERM3,AK0INA,T) FVAL = FVAL - TEMP / ( SQRT(X) * RT2BPI) ENDIF K0INT = FVAL ENDIF RETURN END DOUBLE PRECISION FUNCTION LOBACH(XVALUE) C C DESCRIPTION: C C This function calculates the Lobachewsky function L(x), defined as C C LOBACH(x) = {integral 0 to x} ( -ln ( | cos t | ) dt C C The code uses Chebyshev expansions whose coefficients are given C to 20 decimal places. C C C ERROR RETURNS: C C If |x| too large, it is impossible to accurately reduce the C argument to the range [0,pi]. An error message is printed C and the program returns the value 0.0 C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used of the array ARLOB1. C The recommended value is such that C ABS(ARLOB1(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The no. of terms to be used of the array ARLOB2. C The recommended value is such that C ABS(ARLOB2(NTERM2)) < EPS/100 C C XLOW1 - DOUBLE PRECISION - The value below which L(x) = 0.0 to machine-precision. C The recommended value is C cube-root ( 6*XMIN ) C C XLOW2 - DOUBLE PRECISION - The value below which L(x) = x**3/6 to C machine-precision. The recommended value is C sqrt ( 10*EPS ) C C XLOW3 - DOUBLE PRECISION - The value below which C L(pi/2) - L(pi/2-x) = x ( 1 - log(x) ) C to machine-precision. The recommended value is C sqrt ( 18*EPS ) C C XHIGH - DOUBLE PRECISION - The value of |x| above which it is impossible C to accurately reduce the argument. The C recommended value is 1 / EPS. C C For values of EPS, and XMIN, refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: C 23 January, 1996 C INTEGER INDPI2,INDSGN,NPI,NTERM1,NTERM2 DOUBLE PRECISION ARLOB1(0:15),ARLOB2(0:10), 1 CHEVAL,FVAL,FVAL1,HALF,LBPB21,LBPB22,LOBPIA,LOBPIB, 2 LOBPI1,LOBPI2,ONE,ONEHUN,PI,PIBY2,PIBY21,PIBY22,PIBY4,PI1, 3 PI11,PI12,PI2,SIX,T,TCON,TEN,TWO,X,XCUB,XHIGH,XLOW1, 4 XLOW2,XLOW3,XR,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'LOBACH'/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,HALF/ 0.0 D 0 , 0.5 D 0 / DATA ONE,TWO,SIX/ 1.0 D 0 , 2.0 D 0 , 6.0 D 0 / DATA TEN,ONEHUN/ 10.0 D 0 , 100.0 D 0 / DATA LOBPIA,LOBPIB/ 1115.0 D 0 , 512.0 D 0 / DATA LOBPI2/-1.48284 69639 78694 99311 D -4/ DATA LBPB22/-7.41423 48198 93474 96556 D -5/ DATA PI11,PI12/ 201.0 D 0 , 64.0 D 0 / DATA PI2/9.67653 58979 32384 62643 D -4/ DATA PIBY22/4.83826 79489 66192 31322 D -4/ DATA TCON/3.24227 78765 54808 68620 D 0/ DATA ARLOB1/0.34464 88495 34813 00507 D 0, 1 0.58419 83571 90277 669 D -2, 2 0.19175 02969 46003 30 D -3, 3 0.78725 16064 56769 D -5, 4 0.36507 47741 5804 D -6, 5 0.18302 87272 680 D -7, 6 0.96890 33300 5 D -9, 7 0.53390 55444 D -10, 8 0.30340 8025 D -11, 9 0.17667 875 D -12, X 0.10493 93 D -13, 1 0.63359 D -15, 2 0.3878 D -16, 3 0.240 D -17, 4 0.15 D -18, 5 0.1 D -19/ DATA ARLOB2/2.03459 41803 61328 51087 D 0, 1 0.17351 85882 02740 7681 D -1, 2 0.55162 80426 09052 1 D -4, 3 0.39781 64627 6598 D -6, 4 0.36901 80289 18 D -8, 5 0.38804 09214 D -10, 6 0.44069 698 D -12, 7 0.52767 4 D -14, 8 0.6568 D -16, 9 0.84 D -18, X 0.1 D -19/ C C Start computation C X = ABS ( XVALUE ) INDSGN = 1 IF ( XVALUE .LT. ZERO ) THEN INDSGN = -1 ENDIF C C Compute the machine-dependent constants. C XR = D1MACH(3) XHIGH = ONE / XR C C Error test C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) LOBACH = ZERO RETURN ENDIF C C continue with constants C T = XR / ONEHUN DO 10 NTERM1 = 15 , 0 , -1 IF ( ABS(ARLOB1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 10 , 0 , -1 IF ( ABS(ARLOB2(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 XLOW1 = ( SIX * D1MACH(1) ) ** (TWO/SIX) XLOW2 = SQRT ( TEN * XR ) T = TWO * TEN - TWO XLOW3 = SQRT ( T * XR ) C C Reduce argument to [0,pi] C PI1 = PI11/PI12 PI = PI1 + PI2 PIBY2 = PI/TWO PIBY21 = PI1/TWO PIBY4 = PIBY2/TWO NPI = INT ( X / PI ) XR = ( X - NPI * PI1 ) - NPI * PI2 C C Reduce argument to [0,pi/2] C INDPI2 = 0 IF ( XR .GT. PIBY2 ) THEN INDPI2 = 1 XR = ( PI1 - XR ) + PI2 ENDIF C C Code for argument in [0,pi/4] C IF ( XR .LE. PIBY4 ) THEN IF ( XR .LT. XLOW1 ) THEN FVAL = ZERO ELSE XCUB = XR * XR * XR IF ( XR .LT. XLOW2 ) THEN FVAL = XCUB / SIX ELSE T = ( TCON * XR * XR - HALF ) - HALF FVAL = XCUB * CHEVAL(NTERM1,ARLOB1,T) ENDIF ENDIF ELSE C C Code for argument in [pi/4,pi/2] C XR = ( PIBY21 - XR ) + PIBY22 IF ( XR .EQ. ZERO ) THEN FVAL1 = ZERO ELSE IF ( XR .LT. XLOW3 ) THEN FVAL1 = XR * ( ONE - LOG( XR ) ) ELSE T = ( TCON * XR * XR - HALF ) - HALF FVAL1 = XR * ( CHEVAL(NTERM2,ARLOB2,T) - LOG( XR ) ) ENDIF ENDIF LBPB21 = LOBPIA / ( LOBPIB + LOBPIB ) FVAL = ( LBPB21 - FVAL1 ) + LBPB22 ENDIF LOBPI1 = LOBPIA / LOBPIB C C Compute value for argument in [pi/2,pi] C IF ( INDPI2 .EQ. 1 ) THEN FVAL = ( LOBPI1 - FVAL ) + LOBPI2 ENDIF LOBACH = FVAL C C Scale up for arguments > pi C IF ( NPI .GT. 0 ) THEN LOBACH = ( FVAL + NPI * LOBPI2 ) + NPI * LOBPI1 ENDIF IF ( INDSGN .EQ. -1 ) THEN LOBACH = - LOBACH ENDIF RETURN END DOUBLE PRECISION FUNCTION STROM(XVALUE) C C DESCRIPTION: C C This program calculates Stromgren's integral, defined as C C STROM(X) = integral 0 to X { t**7 exp(2t)/[exp(t)-1]**3 } dt C C The code uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ASTROM to be used. C The recommended value is such that C ASTROM(NTERMS) < EPS/100 C C XLOW0 - DOUBLE PRECISION - The value below which STROM = 0.0 to machine C precision. The recommended value is C 5th root of (130*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which STROM = 3*(X**5)/(4*(pi**4)) C to machine precision. The recommended value is C 2*EPSNEG C C EPSLN - DOUBLE PRECISION - The value of ln(EPS). Used to determine the no. C of exponential terms for large X. C C EPNGLN - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent C overflow for large X. C C XHIGH - DOUBLE PRECISION - The value above which C STROM = 196.52 - 15*(x**7)*exp(-x)/(4pi**4) C to machine precision. The recommended value is C 7 / EPS C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 23 January, 1996 C C INTEGER K1,K2,NTERMS,NUMEXP DOUBLE PRECISION ASTROM(0:26),CHEVAL,EPNGLN,EPSLN,FOUR, 1 F15BP4,HALF,ONE,ONEHUN,ONE30,ONE5LN,PI4B3,RK, 2 SEVEN,SUMEXP,SUM2,T,TWO,VALINF,X,XHIGH, 3 XK,XK1,XLOW0,XLOW1,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'STROM '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA TWO,FOUR,SEVEN/ 2.0 D 0 , 4.0 D 0 , 7.0 D 0 / DATA ONEHUN,ONE30,ONE5LN/ 100.0 D 0 , 130.0 D 0 , 0.4055 D 0 / DATA F15BP4/0.38497 43345 50662 56959 D -1 / DATA PI4B3/1.29878 78804 53365 82982 D 2 / DATA VALINF/196.51956 92086 89882 61257 D 0/ DATA ASTROM(0)/ 0.56556 12087 25391 55290 D 0/ DATA ASTROM(1)/ 0.45557 31969 10178 5525 D -1/ DATA ASTROM(2)/ -0.40395 35875 93686 9170 D -1/ DATA ASTROM(3)/ -0.13339 05720 21486 815 D -2/ DATA ASTROM(4)/ 0.18586 25062 50538 030 D -2/ DATA ASTROM(5)/ -0.46855 55868 05365 9 D -4/ DATA ASTROM(6)/ -0.63434 75643 42294 9 D -4/ DATA ASTROM(7)/ 0.57254 87081 43200 D -5/ DATA ASTROM(8)/ 0.15935 28122 16822 D -5/ DATA ASTROM(9)/ -0.28884 32843 1036 D -6/ DATA ASTROM(10)/-0.24466 33604 801 D -7/ DATA ASTROM(11)/ 0.10072 50382 374 D -7/ DATA ASTROM(12)/-0.12482 98610 4 D -9/ DATA ASTROM(13)/-0.26300 62528 3 D -9/ DATA ASTROM(14)/ 0.24904 07578 D -10/ DATA ASTROM(15)/ 0.48545 4902 D -11/ DATA ASTROM(16)/-0.10537 8913 D -11/ DATA ASTROM(17)/-0.36044 17 D -13/ DATA ASTROM(18)/ 0.29920 78 D -13/ DATA ASTROM(19)/-0.16397 1 D -14/ DATA ASTROM(20)/-0.61061 D -15/ DATA ASTROM(21)/ 0.9335 D -16/ DATA ASTROM(22)/ 0.709 D -17/ DATA ASTROM(23)/-0.291 D -17/ DATA ASTROM(24)/ 0.8 D -19/ DATA ASTROM(25)/ 0.6 D -19/ DATA ASTROM(26)/-0.1 D -19/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) STROM = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C XK = D1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 26 , 0 , -1 IF ( ABS(ASTROM(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW0 = ( ONE30 * D1MACH(1) ) ** (ONE/(SEVEN-TWO)) XLOW1 = TWO * XK ELSE EPSLN = LOG ( D1MACH(4) ) EPNGLN = LOG ( XK ) XHIGH = SEVEN / XK ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW0 ) THEN STROM = ZERO ELSE IF ( X .LT. XLOW1 ) THEN STROM = (X**5) / PI4B3 ELSE T = ( ( X / TWO ) - HALF ) - HALF STROM = (X**5) * CHEVAL(NTERMS,ASTROM,T) * F15BP4 ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH ) THEN SUMEXP = ONE ELSE NUMEXP = INT( EPSLN / (ONE5LN - X ) ) + 1 IF ( NUMEXP .GT. 1 ) THEN T = EXP( -X ) ELSE T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , 7 SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUM2 = SUM2 * ( RK + ONE ) / TWO SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = SEVEN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. EPNGLN ) THEN STROM = VALINF ELSE STROM = VALINF - EXP(T) * F15BP4 ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION STRVH0(XVALUE) C C C DESCRIPTION: C C This function calculates the value of the Struve function C of order 0, denoted H0(x), for the argument XVALUE, defined C C STRVHO(x) = (2/pi) integral{0 to pi/2} sin(x cos(t)) dt C C H0 also satisfies the second-order equation C C x*D(Df) + Df + x*f = 2x/pi C C The code uses Chebyshev expansions whose coefficients are C given to 20D. C C C ERROR RETURNS: C C As the asymptotic expansion of H0 involves the Bessel function C of the second kind Y0, there is a problem for large x, since C we cannot accurately calculate the value of Y0. An error message C is printed and STRVH0 returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array ARRH0. The C recommended value is such that C ABS(ARRH0(NTERM1)) < EPS/100. C C NTERM2 - The no. of terms to be used in the array ARRH0A. The C recommended value is such that C ABS(ARRH0A(NTERM2)) < EPS/100. C C NTERM3 - The no. of terms to be used in the array AY0ASP. The C recommended value is such that C ABS(AY0ASP(NTERM3)) < EPS/100. C C NTERM4 - The no. of terms to be used in the array AY0ASQ. The C recommended value is such that C ABS(AY0ASQ(NTERM4)) < EPS/100. C C XLOW - The value for which H0(x) = 2*x/pi to machine precision, if C abs(x) < XLOW. The recommended value is C XLOW = 3 * SQRT(EPSNEG) C C XHIGH - The value above which we are unable to calculate Y0 with C any reasonable accuracy. An error message is printed and C STRVH0 returns the value 0.0. The recommended value is C XHIGH = 1/EPS. C C For values of EPS and EPSNEG refer to the file MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C ABS, COS, SIN, SQRT. C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C ALLAN J. MACLEOD C DEPT. OF MATHEMATICS AND STATISTICS C UNIVERSITY OF PAISLEY C HIGH ST. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 23 January, 1996 C C INTEGER INDSGN,NTERM1,NTERM2,NTERM3,NTERM4 DOUBLE PRECISION ARRH0(0:19),ARRH0A(0:20),AY0ASP(0:12), 1 AY0ASQ(0:13),CHEVAL,EIGHT,ELEVEN,HALF,H0AS, 2 ONEHUN,ONE,PIBY4,RT2BPI,SIXTP5,T,THR2P5,TWENTY, 3 TWOBPI,TWO62,X,XHIGH,XLOW,XMP4,XSQ,XVALUE, 4 Y0P,Y0Q,Y0VAL,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'STRVH0'/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,HALF,ONE/0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA EIGHT,ELEVEN/8.0 D 0 , 11.0 D 0/ DATA TWENTY,ONEHUN/20.0 D 0 , 100.0 D 0/ DATA SIXTP5,TWO62,THR2P5/60.5 D 0 , 262.0 D 0 , 302.5 D 0/ DATA PIBY4/0.78539 81633 97448 30962 D 0/ DATA RT2BPI/0.79788 45608 02865 35588 D 0/ DATA TWOBPI/0.63661 97723 67581 34308 D 0/ DATA ARRH0(0)/ 0.28696 48739 90132 25740 D 0/ DATA ARRH0(1)/ -0.25405 33268 16183 52305 D 0/ DATA ARRH0(2)/ 0.20774 02673 93238 94439 D 0/ DATA ARRH0(3)/ -0.20364 02956 03865 85140 D 0/ DATA ARRH0(4)/ 0.12888 46908 68661 86016 D 0/ DATA ARRH0(5)/ -0.48256 32815 62226 1202 D -1/ DATA ARRH0(6)/ 0.11686 29347 56900 1242 D -1/ DATA ARRH0(7)/ -0.19811 81356 42418 416 D -2/ DATA ARRH0(8)/ 0.24899 13851 24212 86 D -3/ DATA ARRH0(9)/ -0.24188 27913 78595 0 D -4/ DATA ARRH0(10)/ 0.18743 75479 93431 D -5/ DATA ARRH0(11)/-0.11873 34607 4362 D -6/ DATA ARRH0(12)/ 0.62698 49433 46 D -8/ DATA ARRH0(13)/-0.28045 54679 3 D -9/ DATA ARRH0(14)/ 0.10769 41205 D -10/ DATA ARRH0(15)/-0.35904 793 D -12/ DATA ARRH0(16)/ 0.10494 47 D -13/ DATA ARRH0(17)/-0.27119 D -15/ DATA ARRH0(18)/ 0.624 D -17/ DATA ARRH0(19)/-0.13 D -18/ DATA ARRH0A(0)/ 1.99291 88575 19923 05515 D 0/ DATA ARRH0A(1)/ -0.38423 26687 01456 887 D -2/ DATA ARRH0A(2)/ -0.32871 99371 23530 50 D -3/ DATA ARRH0A(3)/ -0.29411 81203 70340 9 D -4/ DATA ARRH0A(4)/ -0.26731 53519 87066 D -5/ DATA ARRH0A(5)/ -0.24681 03107 5013 D -6/ DATA ARRH0A(6)/ -0.22950 14861 143 D -7/ DATA ARRH0A(7)/ -0.21568 22318 33 D -8/ DATA ARRH0A(8)/ -0.20303 50648 3 D -9/ DATA ARRH0A(9)/ -0.19345 75509 D -10/ DATA ARRH0A(10)/-0.18277 3144 D -11/ DATA ARRH0A(11)/-0.17768 424 D -12/ DATA ARRH0A(12)/-0.16432 96 D -13/ DATA ARRH0A(13)/-0.17156 9 D -14/ DATA ARRH0A(14)/-0.13368 D -15/ DATA ARRH0A(15)/-0.2077 D -16/ DATA ARRH0A(16)/ 0.2 D -19/ DATA ARRH0A(17)/-0.55 D -18/ DATA ARRH0A(18)/ 0.10 D -18/ DATA ARRH0A(19)/-0.4 D -19/ DATA ARRH0A(20)/ 0.1 D -19/ DATA AY0ASP/1.99944 63940 23982 71568 D 0, 1 -0.28650 77864 70319 58 D -3, 2 -0.10050 72797 43762 0 D -4, 3 -0.35835 94100 2463 D -6, 4 -0.12879 65120 531 D -7, 5 -0.46609 48663 6 D -9, 6 -0.16937 69454 D -10, 7 -0.61852 269 D -12, 8 -0.22618 41 D -13, 9 -0.83268 D -15, X -0.3042 D -16, 1 -0.115 D -17, 2 -0.4 D -19/ DATA AY0ASQ/1.99542 68138 68286 04092 D 0, 1 -0.23601 31928 67514 472 D -2, 2 -0.76015 38908 50296 6 D -4, 3 -0.25610 88714 56343 D -5, 4 -0.87502 92185 106 D -7, 5 -0.30430 42121 59 D -8, 6 -0.10621 42831 4 D -9, 7 -0.37737 1479 D -11, 8 -0.13213 687 D -12, 9 -0.48862 1 D -14, X -0.15809 D -15, 1 -0.762 D -17, 2 -0.3 D -19, 3 -0.3 D -19/ C C Start computation C X = XVALUE INDSGN = 1 IF ( X .LT. ZERO ) THEN X = -X INDSGN = -1 ENDIF C C Compute the machine-dependent constants. C H0AS = D1MACH(3) XHIGH = ONE / D1MACH(4) C C Error test C IF ( ABS(XVALUE) .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) STRVH0 = ZERO RETURN ENDIF C C continue with machine constants C T = H0AS / ONEHUN IF ( X .LE. ELEVEN ) THEN DO 10 NTERM1 = 19 , 0 , -1 IF ( ABS(ARRH0(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 Y0P = SQRT ( H0AS ) XLOW = Y0P + Y0P + Y0P ELSE DO 40 NTERM2 = 20 , 0 , -1 IF ( ABS(ARRH0A(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM3 = 12 , 0 , -1 IF ( ABS(AY0ASP(NTERM3)) .GT. T ) GOTO 59 50 CONTINUE 59 DO 60 NTERM4 = 13 , 0 , -1 IF ( ABS(AY0ASQ(NTERM4)) .GT. T ) GOTO 69 60 CONTINUE 69 ENDIF C C Code for abs(x) <= 11 C IF ( X .LE. ELEVEN ) THEN IF ( X .LT. XLOW ) THEN STRVH0 = TWOBPI * X ELSE T = ( ( X * X ) / SIXTP5 - HALF ) - HALF STRVH0 = TWOBPI * X * CHEVAL ( NTERM1 , ARRH0 , T ) ENDIF ELSE C C Code for abs(x) > 11 C XSQ = X * X T = ( TWO62 - XSQ ) / ( TWENTY + XSQ ) Y0P = CHEVAL ( NTERM3 , AY0ASP , T ) Y0Q = CHEVAL ( NTERM4 , AY0ASQ , T ) / ( EIGHT * X ) XMP4 = X - PIBY4 Y0VAL = Y0P * SIN ( XMP4 ) - Y0Q * COS ( XMP4 ) Y0VAL = Y0VAL * RT2BPI / SQRT ( X ) T = ( THR2P5 - XSQ ) / ( SIXTP5 + XSQ ) H0AS = TWOBPI * CHEVAL ( NTERM2 , ARRH0A , T ) / X STRVH0 = Y0VAL + H0AS ENDIF IF ( INDSGN .EQ. -1 ) STRVH0 = -STRVH0 RETURN END DOUBLE PRECISION FUNCTION STRVH1(XVALUE) C C C DESCRIPTION: C This function calculates the value of the Struve function C of order 1, denoted H1(x), for the argument XVALUE, defined as C C 2 C STRVH1(x) = (2x/pi) integral{0 to pi/2} sin( x cos(t))*sin t dt C C H1 also satisfies the second-order differential equation C C 2 2 2 2 C x * D f + x * Df + (x - 1)f = 2x / pi C C The code uses Chebyshev expansions with the coefficients C given to 20D. C C C ERROR RETURNS: C As the asymptotic expansion of H1 involves the Bessel function C of the second kind Y1, there is a problem for large x, since C we cannot accurately calculate the value of Y1. An error message C is printed and STRVH1 returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array ARRH1. The C recommended value is such that C ABS(ARRH1(NTERM1)) < EPS/100. C C NTERM2 - The no. of terms to be used in the array ARRH1A. The C recommended value is such that C ABS(ARRH1A(NTERM2)) < EPS/100. C C NTERM3 - The no. of terms to be used in the array AY1ASP. The C recommended value is such that C ABS(AY1ASP(NTERM3)) < EPS/100. C C NTERM4 - The no. of terms to be used in the array AY1ASQ. The C recommended value is such that C ABS(AY1ASQ(NTERM4)) < EPS/100. C C XLOW1 - The value of x, below which H1(x) set to zero, if C abs(x) 9 C XSQ = X * X T = ( ONE82 - XSQ ) / ( TWENTY + XSQ ) Y1P = CHEVAL ( NTERM3 , AY1ASP , T ) Y1Q = CHEVAL ( NTERM4 , AY1ASQ , T ) / ( EIGHT * X) XM3P4 = X - THPBY4 Y1VAL = Y1P * SIN ( XM3P4 ) + Y1Q * COS ( XM3P4 ) Y1VAL = Y1VAL * RT2BPI / SQRT ( X ) T = ( TW02P5 - XSQ ) / ( FORTP5 + XSQ ) H1AS = TWOBPI * CHEVAL ( NTERM2 , ARRH1A , T ) STRVH1 = Y1VAL + H1AS ENDIF RETURN END DOUBLE PRECISION FUNCTION STRVL0(XVALUE) C C DESCRIPTION: C C This function calculates the modified Struve function of C order 0, denoted L0(x), defined as the solution of the C second-order equation C C x*D(Df) + Df - x*f = 2x/pi C C C ERROR RETURNS: C C If the value of |XVALUE| is too large, the result C would cause an floating-pt overflow. An error message C is printed and the function returns the value of C sign(XVALUE)*XMAX where XMAX is the largest possible C floating-pt argument. C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The no. of terms for the array ARL0. C The recommended value is such that C ABS(ARL0(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The no. of terms for the array ARL0AS. C The recommended value is such that C ABS(ARL0AS(NTERM2)) < EPS/100 C C NTERM3 - INTEGER - The no. of terms for the array AI0ML0. C The recommended value is such that C ABS(AI0ML0(NTERM3)) < EPS/100 C C XLOW - DOUBLE PRECISION - The value of x below which L0(x) = 2*x/pi C to machine precision. The recommended value is C 3*SQRT(EPS) C C XHIGH1 - DOUBLE PRECISION - The value beyond which the Chebyshev series C in the asymptotic expansion of I0 - L0 gives C 1.0 to machine precision. The recommended value C is SQRT( 30/EPSNEG ) C C XHIGH2 - DOUBLE PRECISION - The value beyond which the Chebyshev series C in the asymptotic expansion of I0 gives 1.0 C to machine precision. The recommended value C is 28 / EPSNEG C C XMAX - DOUBLE PRECISION - The value of XMAX, where XMAX is the C largest possible floating-pt argument. C This is used to prevent overflow. C C For values of EPS, EPSNEG and XMAX the user should refer C to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C DR. ALLAN J. MACLEOD C DEPT. OF MATHEMATICS AND STATISTICS C UNIVERSITY OF PAISLEY C HIGH ST. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 23 January, 1996 C C INTEGER INDSGN,NTERM1,NTERM2,NTERM3 DOUBLE PRECISION ARL0(0:27),ARL0AS(0:15),AI0ML0(0:23), 1 ATEHUN,CHEVAL,CH1,CH2,FOUR,LNR2PI,ONE,ONEHUN, 2 SIXTEN,T,TEST,TWENT4,TWENT8,TWO,TWOBPI,TWO88, 3 X,XHIGH1,XHIGH2,XLOW,XMAX,XVALUE,XSQ,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*24 DATA FNNAME/'STRVL0'/ DATA ERRMSG/'ARGUMENT CAUSES OVERFLOW'/ DATA ZERO,ONE,TWO/0.0 D 0 , 1.0 D 0 , 2.0 D 0/ DATA FOUR,SIXTEN/4.0 D 0 , 16.0 D 0/ DATA TWENT4,TWENT8,ONEHUN/24.0 D 0 , 28.0 D 0 , 100.0 D 0/ DATA TWO88,ATEHUN/288.0 D 0 , 800.0 D 0/ DATA LNR2PI/0.91893 85332 04672 74178 D 0/ DATA TWOBPI/0.63661 97723 67581 34308 D 0/ DATA ARL0(0)/ 0.42127 45834 99799 24863 D 0/ DATA ARL0(1)/ -0.33859 53639 12206 12188 D 0/ DATA ARL0(2)/ 0.21898 99481 27107 16064 D 0/ DATA ARL0(3)/ -0.12349 48282 07131 85712 D 0/ DATA ARL0(4)/ 0.62142 09793 86695 8440 D -1/ DATA ARL0(5)/ -0.28178 06028 10954 7545 D -1/ DATA ARL0(6)/ 0.11574 19676 63809 1209 D -1/ DATA ARL0(7)/ -0.43165 85743 06921 179 D -2/ DATA ARL0(8)/ 0.14614 23499 07298 329 D -2/ DATA ARL0(9)/ -0.44794 21180 54614 78 D -3/ DATA ARL0(10)/ 0.12364 74610 59437 61 D -3/ DATA ARL0(11)/-0.30490 28334 79704 4 D -4/ DATA ARL0(12)/ 0.66394 14015 21146 D -5/ DATA ARL0(13)/-0.12553 83577 03889 D -5/ DATA ARL0(14)/ 0.20073 44645 1228 D -6/ DATA ARL0(15)/-0.25882 60170 637 D -7/ DATA ARL0(16)/ 0.24114 37427 58 D -8/ DATA ARL0(17)/-0.10159 67435 2 D -9/ DATA ARL0(18)/-0.12024 30736 D -10/ DATA ARL0(19)/ 0.26290 6137 D -11/ DATA ARL0(20)/-0.15313 190 D -12/ DATA ARL0(21)/-0.15747 60 D -13/ DATA ARL0(22)/ 0.31563 5 D -14/ DATA ARL0(23)/-0.4096 D -16/ DATA ARL0(24)/-0.3620 D -16/ DATA ARL0(25)/ 0.239 D -17/ DATA ARL0(26)/ 0.36 D -18/ DATA ARL0(27)/-0.4 D -19/ DATA ARL0AS(0)/ 2.00861 30823 56058 88600 D 0/ DATA ARL0AS(1)/ 0.40373 79665 00438 470 D -2/ DATA ARL0AS(2)/ -0.25199 48028 65802 67 D -3/ DATA ARL0AS(3)/ 0.16057 36682 81117 6 D -4/ DATA ARL0AS(4)/ -0.10369 21824 73444 D -5/ DATA ARL0AS(5)/ 0.67655 78876 305 D -7/ DATA ARL0AS(6)/ -0.44499 99067 56 D -8/ DATA ARL0AS(7)/ 0.29468 88922 8 D -9/ DATA ARL0AS(8)/ -0.19621 80522 D -10/ DATA ARL0AS(9)/ 0.13133 0306 D -11/ DATA ARL0AS(10)/-0.88191 90 D -13/ DATA ARL0AS(11)/ 0.59537 6 D -14/ DATA ARL0AS(12)/-0.40389 D -15/ DATA ARL0AS(13)/ 0.2651 D -16/ DATA ARL0AS(14)/-0.208 D -17/ DATA ARL0AS(15)/ 0.11 D -18/ DATA AI0ML0(0)/ 2.00326 51024 11606 43125 D 0/ DATA AI0ML0(1)/ 0.19520 68515 76492 081 D -2/ DATA AI0ML0(2)/ 0.38239 52356 99083 28 D -3/ DATA AI0ML0(3)/ 0.75342 80817 05443 6 D -4/ DATA AI0ML0(4)/ 0.14959 57655 89707 8 D -4/ DATA AI0ML0(5)/ 0.29994 05312 10557 D -5/ DATA AI0ML0(6)/ 0.60769 60482 2459 D -6/ DATA AI0ML0(7)/ 0.12399 49554 4506 D -6/ DATA AI0ML0(8)/ 0.25232 62552 649 D -7/ DATA AI0ML0(9)/ 0.50463 48573 32 D -8/ DATA AI0ML0(10)/0.97913 23623 0 D -9/ DATA AI0ML0(11)/0.18389 11524 1 D -9/ DATA AI0ML0(12)/0.33763 09278 D -10/ DATA AI0ML0(13)/0.61117 9703 D -11/ DATA AI0ML0(14)/0.10847 2972 D -11/ DATA AI0ML0(15)/0.18861 271 D -12/ DATA AI0ML0(16)/0.32803 45 D -13/ DATA AI0ML0(17)/0.56564 7 D -14/ DATA AI0ML0(18)/0.93300 D -15/ DATA AI0ML0(19)/0.15881 D -15/ DATA AI0ML0(20)/0.2791 D -16/ DATA AI0ML0(21)/0.389 D -17/ DATA AI0ML0(22)/0.70 D -18/ DATA AI0ML0(23)/0.16 D -18/ C C Start computation C X = XVALUE INDSGN = 1 IF ( X .LT. ZERO ) THEN X = -X INDSGN = -1 ENDIF C C Compute the machine-dependent constants. C TEST = D1MACH(3) T = TEST / ONEHUN IF ( X .LE. SIXTEN ) THEN DO 10 NTERM1 = 27 , 0 , -1 IF ( ABS(ARL0(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW = ( ONE + TWO ) * SQRT ( TEST ) ELSE DO 40 NTERM2 = 15 , 0 , -1 IF ( ABS(ARL0AS(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM3 = 23 , 0 , -1 IF ( ABS(AI0ML0(NTERM3)) .GT. T ) GOTO 59 50 CONTINUE 59 XMAX = D1MACH(2) XHIGH1 = SQRT ( ( TWENT8 + TWO ) / TEST ) XHIGH2 = TWENT8 / TEST ENDIF C C Code for |xvalue| <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN STRVL0 = TWOBPI * X ELSE T = ( FOUR * X - TWENT4 ) / ( X + TWENT4 ) STRVL0 = TWOBPI * X * CHEVAL(NTERM1,ARL0,T) * EXP(X) ENDIF ELSE C C Code for |xvalue| > 16 C IF ( X .GT. XHIGH2 ) THEN CH1 = ONE ELSE T = ( X - TWENT8 ) / ( FOUR - X ) CH1 = CHEVAL(NTERM2,ARL0AS,T) ENDIF IF ( X .GT. XHIGH1 ) THEN CH2 = ONE ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) CH2 = CHEVAL(NTERM3,AI0ML0,T) ENDIF TEST = LOG(CH1) - LNR2PI - LOG(X)/TWO + X IF ( TEST .GT. LOG(XMAX) ) THEN CALL ERRPRN(FNNAME,ERRMSG) STRVL0 = XMAX ELSE STRVL0 = EXP(TEST) - TWOBPI * CH2 / X ENDIF ENDIF IF ( INDSGN .EQ. -1 ) STRVL0 = -STRVL0 RETURN END DOUBLE PRECISION FUNCTION STRVL1(XVALUE) C C DESCRIPTION: C C This function calculates the modified Struve function of C order 1, denoted L1(x), defined as the solution of C C x*x*D(Df) + x*Df - (x*x+1)f = 2*x*x/pi C C C ERROR RETURNS: C C If the value of |XVALUE| is too large, the result C would cause an floating-pt overflow. An error message C is printed and the function returns the value of C sign(XVALUE)*XMAX where XMAX is the largest possible C floating-pt argument. C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The no. of terms for the array ARL1. C The recommended value is such that C ABS(ARL1(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The no. of terms for the array ARL1AS. C The recommended value is such that C ABS(ARL1AS(NTERM2)) < EPS/100 C C NTERM3 - INTEGER - The no. of terms for the array AI1ML1. C The recommended value is such that C ABS(AI1ML1(NTERM3)) < EPS/100 C C XLOW1 - DOUBLE PRECISION - The value of x below which L1(x) = 2*x*x/(3*pi) C to machine precision. The recommended value is C SQRT(15*EPS) C C XLOW2 - DOUBLE PRECISION - The value of x below which L1(x) set to 0.0. C This is used to prevent underflow. The C recommended value is C SQRT(5*XMIN) C C XHIGH1 - DOUBLE PRECISION - The value of |x| above which the Chebyshev C series in the asymptotic expansion of I1 C equals 1.0 to machine precision. The C recommended value is SQRT( 30 / EPSNEG ). C C XHIGH2 - DOUBLE PRECISION - The value of |x| above which the Chebyshev C series in the asymptotic expansion of I1 - L1 C equals 1.0 to machine precision. The recommended C value is 30 / EPSNEG. C C XMAX - DOUBLE PRECISION - The value of XMAX, where XMAX is the C largest possible floating-pt argument. C This is used to prevent overflow. C C For values of EPS, EPSNEG, XMIN, and XMAX the user should refer C to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C DR. ALLAN J. MACLEOD C DEPT. OF MATHEMATICS AND STATISTICS C UNIVERSITY OF PAISLEY C HIGH ST. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: C 23 January, 1996 C C INTEGER NTERM1,NTERM2,NTERM3 DOUBLE PRECISION ARL1(0:26),ARL1AS(0:16),AI1ML1(0:25), 1 ATEHUN,CHEVAL,CH1,CH2,FOUR,LNR2PI, 2 ONE,ONEHUN,PI3BY2,SIXTEN,T,TEST,THIRTY,TWENT4, 3 TWO,TWOBPI,TWO88,X,XHIGH1,XHIGH2,XLOW1,XLOW2, 4 XMAX,XVALUE,XSQ,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*24 DATA FNNAME/'STRVL1'/ DATA ERRMSG/'ARGUMENT CAUSES OVERFLOW'/ DATA ZERO,ONE,TWO/0.0 D 0 , 1.0 D 0 , 2.0 D 0/ DATA FOUR,SIXTEN/4.0 D 0 , 16.0 D 0/ DATA TWENT4,THIRTY/24.0 D 0 , 30.0 D 0/ DATA ONEHUN/100.0 D 0/ DATA TWO88,ATEHUN/288.0 D 0 , 800.0 D 0/ DATA LNR2PI/0.91893 85332 04672 74178 D 0/ DATA PI3BY2/4.71238 89803 84689 85769 D 0/ DATA TWOBPI/0.63661 97723 67581 34308 D 0/ DATA ARL1(0)/ 0.38996 02735 12295 38208 D 0/ DATA ARL1(1)/ -0.33658 09610 19757 49366 D 0/ DATA ARL1(2)/ 0.23012 46791 25016 45616 D 0/ DATA ARL1(3)/ -0.13121 59400 79608 32327 D 0/ DATA ARL1(4)/ 0.64259 22289 91284 6518 D -1/ DATA ARL1(5)/ -0.27500 32950 61663 5833 D -1/ DATA ARL1(6)/ 0.10402 34148 63720 8871 D -1/ DATA ARL1(7)/ -0.35053 22949 36388 080 D -2/ DATA ARL1(8)/ 0.10574 84984 21439 717 D -2/ DATA ARL1(9)/ -0.28609 42640 36665 58 D -3/ DATA ARL1(10)/ 0.69257 08785 94220 8 D -4/ DATA ARL1(11)/-0.14896 93951 12271 7 D -4/ DATA ARL1(12)/ 0.28103 55825 97128 D -5/ DATA ARL1(13)/-0.45503 87929 7776 D -6/ DATA ARL1(14)/ 0.60901 71561 770 D -7/ DATA ARL1(15)/-0.62354 37248 08 D -8/ DATA ARL1(16)/ 0.38430 01206 7 D -9/ DATA ARL1(17)/ 0.79054 3916 D -11/ DATA ARL1(18)/-0.48982 4083 D -11/ DATA ARL1(19)/ 0.46356 884 D -12/ DATA ARL1(20)/ 0.68420 5 D -14/ DATA ARL1(21)/-0.56974 8 D -14/ DATA ARL1(22)/ 0.35324 D -15/ DATA ARL1(23)/ 0.4244 D -16/ DATA ARL1(24)/-0.644 D -17/ DATA ARL1(25)/-0.21 D -18/ DATA ARL1(26)/ 0.9 D -19/ DATA ARL1AS(0)/ 1.97540 37844 16523 56868 D 0/ DATA ARL1AS(1)/ -0.11951 30555 08829 4181 D -1/ DATA ARL1AS(2)/ 0.33639 48526 91960 46 D -3/ DATA ARL1AS(3)/ -0.10091 15655 48154 9 D -4/ DATA ARL1AS(4)/ 0.30638 95132 1998 D -6/ DATA ARL1AS(5)/ -0.95370 43703 96 D -8/ DATA ARL1AS(6)/ 0.29524 73555 8 D -9/ DATA ARL1AS(7)/ -0.95107 8318 D -11/ DATA ARL1AS(8)/ 0.28203 667 D -12/ DATA ARL1AS(9)/ -0.11341 75 D -13/ DATA ARL1AS(10)/ 0.147 D -17/ DATA ARL1AS(11)/-0.6232 D -16/ DATA ARL1AS(12)/-0.751 D -17/ DATA ARL1AS(13)/-0.17 D -18/ DATA ARL1AS(14)/ 0.51 D -18/ DATA ARL1AS(15)/ 0.23 D -18/ DATA ARL1AS(16)/ 0.5 D -19/ DATA AI1ML1(0)/ 1.99679 36189 67891 36501 D 0/ DATA AI1ML1(1)/ -0.19066 32614 09686 132 D -2/ DATA AI1ML1(2)/ -0.36094 62241 01744 81 D -3/ DATA AI1ML1(3)/ -0.68418 47304 59982 0 D -4/ DATA AI1ML1(4)/ -0.12990 08228 50942 6 D -4/ DATA AI1ML1(5)/ -0.24715 21887 05765 D -5/ DATA AI1ML1(6)/ -0.47147 83969 1972 D -6/ DATA AI1ML1(7)/ -0.90208 19982 592 D -7/ DATA AI1ML1(8)/ -0.17304 58637 504 D -7/ DATA AI1ML1(9)/ -0.33232 36701 59 D -8/ DATA AI1ML1(10)/-0.63736 42173 5 D -9/ DATA AI1ML1(11)/-0.12180 23975 6 D -9/ DATA AI1ML1(12)/-0.23173 46832 D -10/ DATA AI1ML1(13)/-0.43906 8833 D -11/ DATA AI1ML1(14)/-0.82847 110 D -12/ DATA AI1ML1(15)/-0.15562 249 D -12/ DATA AI1ML1(16)/-0.29131 12 D -13/ DATA AI1ML1(17)/-0.54396 5 D -14/ DATA AI1ML1(18)/-0.10117 7 D -14/ DATA AI1ML1(19)/-0.18767 D -15/ DATA AI1ML1(20)/-0.3484 D -16/ DATA AI1ML1(21)/-0.643 D -17/ DATA AI1ML1(22)/-0.118 D -17/ DATA AI1ML1(23)/-0.22 D -18/ DATA AI1ML1(24)/-0.4 D -19/ DATA AI1ML1(25)/-0.1 D -19/ C C START CALCULATION C X = ABS ( XVALUE ) C C Compute the machine-dependent constants. C TEST = D1MACH(3) T = TEST / ONEHUN IF ( X .LE. SIXTEN ) THEN DO 10 NTERM1 = 26 , 0 , -1 IF ( ABS(ARL1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT ( THIRTY * TEST / TWO ) XLOW2 = SQRT ( (FOUR + ONE) * D1MACH(1) ) ELSE DO 40 NTERM2 = 16 , 0 , -1 IF ( ABS(ARL1AS(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM3 = 25 , 0 , -1 IF ( ABS(AI1ML1(NTERM3)) .GT. T ) GOTO 59 50 CONTINUE 59 XMAX = D1MACH(2) XHIGH2 = THIRTY / TEST XHIGH1 = SQRT ( XHIGH2 ) ENDIF C C CODE FOR |XVALUE| <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LE. XLOW2 ) THEN STRVL1 = ZERO ELSE XSQ = X * X IF ( X .LT. XLOW1 ) THEN STRVL1 = XSQ / PI3BY2 ELSE T = ( FOUR * X - TWENT4 ) / ( X + TWENT4 ) STRVL1 = XSQ * CHEVAL(NTERM1,ARL1,T) * EXP(X) / PI3BY2 ENDIF ENDIF ELSE C C CODE FOR |XVALUE| > 16 C IF ( X .GT. XHIGH2 ) THEN CH1 = ONE ELSE T = ( X - THIRTY ) / ( TWO - X ) CH1 = CHEVAL(NTERM2,ARL1AS,T) ENDIF IF ( X .GT. XHIGH1 ) THEN CH2 = ONE ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) CH2 = CHEVAL(NTERM3,AI1ML1,T) ENDIF TEST = LOG(CH1) - LNR2PI - LOG(X)/TWO + X IF ( TEST .GT. LOG(XMAX) ) THEN CALL ERRPRN(FNNAME,ERRMSG) STRVL1 = XMAX ELSE STRVL1 = EXP(TEST) - TWOBPI * CH2 ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION SYNCH1(XVALUE) C C DESCRIPTION: C C This function calculates the synchrotron radiation function C defined as C C SYNCH1(x) = x * Integral{x to inf} K(5/3)(t) dt, C C where K(5/3) is a modified Bessel function of order 5/3. C C The code uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C C ERROR RETURNS: C C The function is undefined if x < 0.0. If XVALUE < 0.0, C an error message is printed and the function returns C the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms needed from the array C ASYNC1. The recommended value is such that C ABS(ASYNC1(NTERM1)) < EPS/100. C C NTERM2 - INTEGER - The no. of terms needed from the array C ASYNC2. The recommended value is such that C ABS(ASYNC2(NTERM2)) < EPS/100. C C NTERM3 - INTEGER - The no. of terms needed from the array C ASYNCA. The recommended value is such that C ABS(ASYNCA(NTERM3)) < EPS/100. C C XLOW - DOUBLE PRECISION - The value below which C SYNCH1(x) = 2.14952.. * (x**(1/3)) C to machine precision. The recommended value C is sqrt (8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which C SYNCH1(x) = 0.0 C to machine precision. The recommended value C is -8*LN(XMIN)/7 C C XHIGH2 - DOUBLE PRECISION - The value of LN(XMIN). This is used C to prevent underflow in calculations C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: C 23 January, 1996 C C INTEGER NTERM1,NTERM2,NTERM3 DOUBLE PRECISION ASYNC1(0:13),ASYNC2(0:11),ASYNCA(0:24), 1 CHEB1,CHEB2,CHEVAL,CONLOW,EIGHT,FOUR,HALF, 2 LNRTP2,ONE,ONEHUN,PIBRT3,T,THREE,TWELVE,X,XHIGH1, 3 XHIGH2,XLOW,XPOWTH,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'SYNCH1'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA THREE,FOUR/ 3.0 D 0 , 4.0 D 0 / DATA EIGHT,TWELVE/ 8.0 D 0 , 12.0 D 0 / DATA ONEHUN/ 100.0 D 0 / DATA CONLOW/2.14952 82415 34478 63671 D 0/ DATA PIBRT3/1.81379 93642 34217 85059 D 0/ DATA LNRTP2/0.22579 13526 44727 43236 D 0/ DATA ASYNC1/30.36468 29825 01076 27340 D 0, 1 17.07939 52774 08394 57449 D 0, 2 4.56013 21335 45072 88887 D 0, 3 0.54928 12467 30419 97963 D 0, 4 0.37297 60750 69301 1724 D -1, 5 0.16136 24302 01041 242 D -2, 6 0.48191 67721 20370 7 D -4, 7 0.10512 42528 89384 D -5, 8 0.17463 85046 697 D -7, 9 0.22815 48654 4 D -9, X 0.24044 3082 D -11, 1 0.20865 88 D -13, 2 0.15167 D -15, 3 0.94 D -18/ DATA ASYNC2/0.44907 21623 53266 08443 D 0, 1 0.89835 36779 94187 2179 D -1, 2 0.81044 57377 21512 894 D -2, 3 0.42617 16991 08916 19 D -3, 4 0.14760 96312 70746 0 D -4, 5 0.36286 33615 3998 D -6, 6 0.66634 80749 84 D -8, 7 0.94907 71655 D -10, 8 0.10791 2491 D -11, 9 0.10022 01 D -13, X 0.7745 D -16, 1 0.51 D -18/ DATA ASYNCA(0)/ 2.13293 05161 35500 09848 D 0/ DATA ASYNCA(1)/ 0.74135 28649 54200 2401 D -1/ DATA ASYNCA(2)/ 0.86968 09990 99641 978 D -2/ DATA ASYNCA(3)/ 0.11703 82624 87756 921 D -2/ DATA ASYNCA(4)/ 0.16451 05798 61919 15 D -3/ DATA ASYNCA(5)/ 0.24020 10214 20640 3 D -4/ DATA ASYNCA(6)/ 0.35827 75638 93885 D -5/ DATA ASYNCA(7)/ 0.54477 47626 9837 D -6/ DATA ASYNCA(8)/ 0.83880 28561 957 D -7/ DATA ASYNCA(9)/ 0.13069 88268 416 D -7/ DATA ASYNCA(10)/0.20530 99071 44 D -8/ DATA ASYNCA(11)/0.32518 75368 8 D -9/ DATA ASYNCA(12)/0.51791 40412 D -10/ DATA ASYNCA(13)/0.83002 9881 D -11/ DATA ASYNCA(14)/0.13352 7277 D -11/ DATA ASYNCA(15)/0.21591 498 D -12/ DATA ASYNCA(16)/0.34996 73 D -13/ DATA ASYNCA(17)/0.56994 2 D -14/ DATA ASYNCA(18)/0.92906 D -15/ DATA ASYNCA(19)/0.15222 D -15/ DATA ASYNCA(20)/0.2491 D -16/ DATA ASYNCA(21)/0.411 D -17/ DATA ASYNCA(22)/0.67 D -18/ DATA ASYNCA(23)/0.11 D -18/ DATA ASYNCA(24)/0.2 D -19/ C C Start calculation C X = XVALUE IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) SYNCH1 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C CHEB1 = D1MACH(3) T = CHEB1 / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERM1 = 13 , 0 , -1 IF ( ABS(ASYNC1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 11 , 0 , -1 IF ( ABS(ASYNC2(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 XLOW = SQRT ( EIGHT * CHEB1 ) ELSE DO 40 NTERM3 = 24 , 0 , -1 IF ( ABS(ASYNCA(NTERM3)) .GT. T ) GOTO 49 40 CONTINUE 49 XHIGH2 = LOG(D1MACH(1)) XHIGH1 = -EIGHT * XHIGH2 / ( EIGHT - ONE ) ENDIF C C Code for 0 <= x <= 4 C IF ( X .LE. FOUR ) THEN XPOWTH = X ** ( ONE / THREE ) IF ( X .LT. XLOW ) THEN SYNCH1 = CONLOW * XPOWTH ELSE T = ( X * X / EIGHT - HALF ) - HALF CHEB1 = CHEVAL(NTERM1,ASYNC1,T) CHEB2 = CHEVAL(NTERM2,ASYNC2,T) T = XPOWTH * CHEB1 - ( XPOWTH**11 ) * CHEB2 SYNCH1 = T - PIBRT3 * X ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN SYNCH1 = ZERO ELSE T = ( TWELVE - X ) / ( X + FOUR ) CHEB1 = CHEVAL(NTERM3,ASYNCA,T) T = LNRTP2 - X + LOG( SQRT(X) * CHEB1 ) IF ( T .LT. XHIGH2 ) THEN SYNCH1 = ZERO ELSE SYNCH1 = EXP(T) ENDIF ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION SYNCH2(XVALUE) C C DESCRIPTION: C C This function calculates the synchrotron radiation function C defined as C C SYNCH2(x) = x * K(2/3)(x) C C where K(2/3) is a modified Bessel function of order 2/3. C C The code uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C C ERROR RETURNS: C C The function is undefined if x < 0.0. If XVALUE < 0.0, C an error message is printed and the function returns C the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms needed from the array C ASYNC1. The recommended value is such that C ABS(ASYN21(NTERM1)) < EPS/100. C C NTERM2 - INTEGER - The no. of terms needed from the array C ASYNC2. The recommended value is such that C ABS(ASYN22(NTERM2)) < EPS/100. C C NTERM3 - INTEGER - The no. of terms needed from the array C ASYNCA. The recommended value is such that C ABS(ASYN2A(NTERM3)) < EPS/100. C C XLOW - DOUBLE PRECISION - The value below which C SYNCH2(x) = 1.074764... * (x**(1/3)) C to machine precision. The recommended value C is sqrt (8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which C SYNCH2(x) = 0.0 C to machine precision. The recommended value C is -8*LN(XMIN)/7 C C XHIGH2 - DOUBLE PRECISION - The value of LN(XMIN). This is used C to prevent underflow in calculations C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST UPDATE: C 23 January, 1996 C INTEGER NTERM1,NTERM2,NTERM3 DOUBLE PRECISION ASYN21(0:14),ASYN22(0:13),ASYN2A(0:18), 1 CHEB1,CHEB2,CHEVAL,CONLOW,EIGHT,FOUR,HALF, 2 LNRTP2,ONE,ONEHUN,T,TEN,THREE,TWO,X,XHIGH1, 3 XHIGH2,XLOW,XPOWTH,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'SYNCH2'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA TWO,THREE,FOUR/ 2.0 D 0 , 3.0 D 0 , 4.0 D 0 / DATA EIGHT,TEN,ONEHUN/ 8.0 D 0 , 10.0 D 0 , 100.0 D 0/ DATA CONLOW/1.07476 41207 67239 31836 D 0/ DATA LNRTP2/0.22579 13526 44727 43236 D 0/ DATA ASYN21/38.61783 99238 43085 48014 D 0, 1 23.03771 55949 63734 59697 D 0, 2 5.38024 99868 33570 59676 D 0, 3 0.61567 93806 99571 07760 D 0, 4 0.40668 80046 68895 5843 D -1, 5 0.17296 27455 26484 141 D -2, 6 0.51061 25883 65769 9 D -4, 7 0.11045 95950 22012 D -5, 8 0.18235 53020 649 D -7, 9 0.23707 69803 4 D -9, X 0.24887 2963 D -11, 1 0.21528 68 D -13, 2 0.15607 D -15, 3 0.96 D -18, 4 0.1 D -19/ DATA ASYN22/7.90631 48270 66080 42875 D 0, 1 3.13534 63612 85342 56841 D 0, 2 0.48548 79477 45371 45380 D 0, 3 0.39481 66758 27237 2337 D -1, 4 0.19661 62233 48088 022 D -2, 5 0.65907 89322 93042 0 D -4, 6 0.15857 56134 98559 D -5, 7 0.28686 53011 233 D -7, 8 0.40412 02359 5 D -9, 9 0.45568 4443 D -11, X 0.42045 90 D -13, 1 0.32326 D -15, 2 0.210 D -17, 3 0.1 D -19/ DATA ASYN2A/2.02033 70941 70713 60032 D 0, 1 0.10956 23712 18074 0443 D -1, 2 0.85423 84730 11467 55 D -3, 3 0.72343 02421 32822 2 D -4, 4 0.63124 42796 26992 D -5, 5 0.56481 93141 1744 D -6, 6 0.51283 24801 375 D -7, 7 0.47196 53291 45 D -8, 8 0.43807 44214 3 D -9, 9 0.41026 81493 D -10, X 0.38623 0721 D -11, 1 0.36613 228 D -12, 2 0.34802 32 D -13, 3 0.33301 0 D -14, 4 0.31856 D -15, 5 0.3074 D -16, 6 0.295 D -17, 7 0.29 D -18, 8 0.3 D -19/ C C Start calculation C X = XVALUE IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) SYNCH2 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C CHEB1 = D1MACH(3) T = CHEB1 / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERM1 = 14 , 0 , -1 IF ( ABS(ASYN21(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 13 , 0 , -1 IF ( ABS(ASYN22(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 XLOW = SQRT ( EIGHT * CHEB1 ) ELSE DO 40 NTERM3 = 18 , 0 , -1 IF ( ABS(ASYN2A(NTERM3)) .GT. T ) GOTO 49 40 CONTINUE 49 XHIGH2 = LOG(D1MACH(1)) XHIGH1 = -EIGHT * XHIGH2 / ( EIGHT - ONE ) ENDIF C C Code for 0 <= x <= 4 C IF ( X .LE. FOUR ) THEN XPOWTH = X ** ( ONE / THREE ) IF ( X .LT. XLOW ) THEN SYNCH2 = CONLOW * XPOWTH ELSE T = ( X * X / EIGHT - HALF ) - HALF CHEB1 = CHEVAL(NTERM1,ASYN21,T) CHEB2 = CHEVAL(NTERM2,ASYN22,T) SYNCH2 = XPOWTH * CHEB1 - ( XPOWTH**5 ) * CHEB2 ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN SYNCH2 = ZERO ELSE T = ( TEN - X ) / ( X + TWO ) CHEB1 = CHEVAL(NTERM3,ASYN2A,T) T = LNRTP2 - X + LOG( SQRT(X) * CHEB1 ) IF ( T .LT. XHIGH2 ) THEN SYNCH2 = ZERO ELSE SYNCH2 = EXP(T) ENDIF ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN02(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 2, defined as C C TRAN02(X) = integral 0 to X { t**2 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW1 - DOUBLE PRECISION - The value below which TRAN02 = x to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large x contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN02 = VALINF - x**2 exp(-x) C The recommended value is 2/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 23 January, 1996 C C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN02'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 2 , 2.0 D 0 / DATA VALINF/0.32898 68133 69645 28729 D 1/ DATA ATRAN/1.67176 04464 34538 50301 D 0, 1 -0.14773 53599 46794 48986 D 0, 2 0.14821 38199 46936 3384 D -1, 3 -0.14195 33032 63056 126 D -2, 4 0.13065 41324 41570 83 D -3, 5 -0.11715 57958 67579 0 D -4, 6 0.10333 49844 57557 D -5, 7 -0.90191 13042 227 D -7, 8 0.78177 16983 31 D -8, 9 -0.67445 65684 0 D -9, X 0.57994 63945 D -10, 1 -0.49747 6185 D -11, 2 0.42596 097 D -12, 3 -0.36421 89 D -13, 4 0.31108 6 D -14, 5 -0.26547 D -15, 6 0.2264 D -16, 7 -0.193 D -17, 8 0.16 D -18, 9 -0.1 D -19/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN02 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C XK = D1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) ELSE XHIGH1 = - LOG(D1MACH(4)) XHIGH2 = ONE / (HALF * XK) XHIGH3 = LOG(XK) ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW1 ) THEN TRAN02 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN02 = ( X ** ( NUMJN - 1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP(-X) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. XHIGH3 ) THEN TRAN02 = VALINF ELSE TRAN02 = VALINF - EXP(T) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN03(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 3, defined as C C TRAN03(X) = integral 0 to X { t**3 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - DOUBLE PRECISION - The value below which TRAN03 = 0.0 to machine C precision. The recommended value is C square root of (2*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which TRAN03 = X**2/2 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN03 = VALINF - X**3 exp(-X) C The recommended value is 3/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 23 January, 1996 C C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN03'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 3 , 3.0 D 0 / DATA VALINF/0.72123 41418 95756 57124 D 1/ DATA ATRAN/0.76201 25432 43872 00657 D 0, 1 -0.10567 43877 05058 53250 D 0, 2 0.11977 80848 19657 8097 D -1, 3 -0.12144 01520 36983 073 D -2, 4 0.11550 99769 39285 47 D -3, 5 -0.10581 59921 24422 9 D -4, 6 0.94746 63385 3018 D -6, 7 -0.83622 12128 581 D -7, 8 0.73109 09927 75 D -8, 9 -0.63505 94778 8 D -9, X 0.54911 82819 D -10, 1 -0.47321 3954 D -11, 2 0.40676 948 D -12, 3 -0.34897 06 D -13, 4 0.29892 3 D -14, 5 -0.25574 D -15, 6 0.2186 D -16, 7 -0.187 D -17, 8 0.16 D -18, 9 -0.1 D -19/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN03 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C XK = D1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) XLOW2 = SQRT( D1MACH(1) / HALF ) ELSE XHIGH1 = - LOG(D1MACH(4)) XHIGH2 = RNUMJN / XK XHIGH3 = LOG(XK) ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN03 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN03 = ( X**(NUMJN-1) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X*X ) / EIGHT ) - HALF ) - HALF TRAN03 = ( X**(NUMJN-1) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT(XHIGH1/X) + 1 T = EXP(-X) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. XHIGH3 ) THEN TRAN03 = VALINF ELSE TRAN03 = VALINF - EXP(T) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN04(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 4, defined as C C TRAN04(X) = integral 0 to X { t**4 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - DOUBLE PRECISION - The value below which TRAN04 = 0.0 to machine C precision. The recommended value is C cube root of (3*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which TRAN04 = X**3/3 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN04 = VALINF - X**4 exp(-X) C The recommended value is 4/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 23 January, 1996 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN04'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 4 , 4.0 D 0 / DATA VALINF/0.25975 75760 90673 16596 D 2/ DATA ATRAN/0.48075 70994 61511 05786 D 0, 1 -0.81753 78810 32108 3956 D -1, 2 0.10027 00665 97516 2973 D -1, 3 -0.10599 33935 98201 507 D -2, 4 0.10345 06245 03040 53 D -3, 5 -0.96442 70548 58991 D -5, 6 0.87455 44408 5147 D -6, 7 -0.77932 12079 811 D -7, 8 0.68649 88614 10 D -8, 9 -0.59995 71076 4 D -9, X 0.52136 62413 D -10, 1 -0.45118 3819 D -11, 2 0.38921 592 D -12, 3 -0.33493 60 D -13, 4 0.28766 7 D -14, 5 -0.24668 D -15, 6 0.2113 D -16, 7 -0.181 D -17, 8 0.15 D -18, 9 -0.1 D -19/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN04 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C XK = D1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) XK1 = RNUMJN - ONE XLOW2 = ( XK1 * D1MACH(1) ) ** (ONE/XK1) ELSE XHIGH1 = - LOG(D1MACH(4)) XHIGH2 = RNUMJN / XK XHIGH3 = LOG(XK) ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN04 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN04 = ( X ** ( NUMJN-1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN04 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP ( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE/ ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN04 = VALINF ELSE TRAN04 = VALINF - EXP( T ) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN05(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order n, defined as C C TRAN05(X) = integral 0 to X { t**5 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - DOUBLE PRECISION - The value below which TRAN05 = 0.0 to machine C precision. The recommended value is C 4th root of (4*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which TRAN05 = X**4/4 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN05 = VALINF - X**5 exp(-X) C The recommended value is 5/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 23 January, 1996 C C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN05'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 5 , 5.0 D 0 / DATA VALINF/0.12443 13306 17204 39116 D 3/ DATA ATRAN/0.34777 77771 33910 78928 D 0, 1 -0.66456 98897 60504 2801 D -1, 2 0.86110 72656 88330 882 D -2, 3 -0.93966 82223 75553 84 D -3, 4 0.93632 48060 81513 4 D -4, 5 -0.88571 31934 08328 D -5, 6 0.81191 49891 4503 D -6, 7 -0.72957 65423 277 D -7, 8 0.64697 14550 45 D -8, 9 -0.56849 02825 5 D -9, X 0.49625 59787 D -10, 1 -0.43109 3996 D -11, 2 0.37310 094 D -12, 3 -0.32197 69 D -13, 4 0.27722 0 D -14, 5 -0.23824 D -15, 6 0.2044 D -16, 7 -0.175 D -17, 8 0.15 D -18, 9 -0.1 D -19/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN05 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C XK = D1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) XK1 = RNUMJN - ONE XLOW2 = ( XK1 * D1MACH(1) ) ** (ONE/XK1) ELSE XHIGH1 = - LOG(D1MACH(4)) XHIGH2 = RNUMJN / XK XHIGH3 = LOG(XK) ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN05 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN05 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN05 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP ( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG ( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN05 = VALINF ELSE TRAN05 = VALINF - EXP( T ) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN06(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 6, defined as C C TRAN06(X) = integral 0 to X { t**6 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - DOUBLE PRECISION - The value below which TRAN06 = 0.0 to machine C precision. The recommended value is C 5th root of (5*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which TRAN06 = X**5/5 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN06 = VALINF - X**6 exp(-X) C The recommended value is 6/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 23 January, 1996 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN06'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 6 , 6.0 D 0 / DATA VALINF/0.73248 70046 28803 38059 D 3/ DATA ATRAN/0.27127 33539 78400 08227 D 0, 1 -0.55886 10553 19145 3393 D -1, 2 0.75391 95132 90083 056 D -2, 3 -0.84351 13857 92112 19 D -3, 4 0.85490 98079 67670 2 D -4, 5 -0.81871 54932 93098 D -5, 6 0.75754 24042 7986 D -6, 7 -0.68573 06541 831 D -7, 8 0.61170 03760 31 D -8, 9 -0.54012 70702 4 D -9, X 0.47343 06435 D -10, 1 -0.41270 1055 D -11, 2 0.35825 603 D -12, 3 -0.30997 52 D -13, 4 0.26750 1 D -14, 5 -0.23036 D -15, 6 0.1980 D -16, 7 -0.170 D -17, 8 0.15 D -18, 9 -0.1 D -19/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN06 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C XK = D1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) XK1 = RNUMJN - ONE XLOW2 = ( XK1 * D1MACH(1) ) ** (ONE/XK1) ELSE XHIGH1 = - LOG(D1MACH(4)) XHIGH2 = RNUMJN / XK XHIGH3 = LOG(XK) ENDIF C C Code for x < = 4 .0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN06 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN06 = ( X ** ( NUMJN-1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN06 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4 .0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP( - X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN06 = VALINF ELSE TRAN06 = VALINF - EXP( T ) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN07(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 7, defined as C C TRAN07(X) = integral 0 to X { t**7 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - DOUBLE PRECISION - The value below which TRAN07 = 0.0 to machine C precision. The recommended value is C 6th root of (6*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which TRAN07 = X**6/6 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN07 = VALINF - X**7 exp(-X) C The recommended value is 7/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 23 January, 1996 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN07'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 7 , 7.0 D 0/ DATA VALINF/0.50820 80358 00489 10473 D 4/ DATA ATRAN/0.22189 25073 40104 04423 D 0, 1 -0.48167 51061 17799 3694 D -1, 2 0.67009 24481 03153 629 D -2, 3 -0.76495 18344 30825 57 D -3, 4 0.78634 85592 34869 0 D -4, 5 -0.76102 51808 87504 D -5, 6 0.70991 69629 9917 D -6, 7 -0.64680 25624 903 D -7, 8 0.58003 92339 60 D -8, 9 -0.51443 37014 9 D -9, X 0.45259 44183 D -10, 1 -0.39580 0363 D -11, 2 0.34453 785 D -12, 3 -0.29882 92 D -13, 4 0.25843 4 D -14, 5 -0.22297 D -15, 6 0.1920 D -16, 7 -0.165 D -17, 8 0.14 D -18, 9 -0.1 D -19/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN07 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C XK = D1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) XK1 = RNUMJN - ONE XLOW2 = ( XK1 * D1MACH(1) ) ** (ONE/XK1) ELSE XHIGH1 = - LOG(D1MACH(4)) XHIGH2 = RNUMJN / XK XHIGH3 = LOG(XK) ENDIF C C Code for x <= 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN07 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN07 = ( X**(NUMJN-1) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X*X ) / EIGHT ) - HALF ) - HALF TRAN07 = ( X**(NUMJN-1) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1/X ) + 1 T = EXP( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. XHIGH3 ) THEN TRAN07 = VALINF ELSE TRAN07 = VALINF - EXP(T) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN08(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 8, defined as C C TRAN08(X) = integral 0 to X { t**8 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - DOUBLE PRECISION - The value below which TRAN08 = 0.0 to machine C precision. The recommended value is C 7th root of (7*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which TRAN08 = X**7/7 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN08 = VALINF - X**8 exp(-X) C The recommended value is 8/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 23 January, 1996 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN08'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 8 , 8.0 D 0 / DATA VALINF/0.40484 39900 19011 15764 D 5/ DATA ATRAN/0.18750 69577 40437 19233 D 0, 1 -0.42295 27646 09367 3337 D -1, 2 0.60281 48569 29065 592 D -2, 3 -0.69961 05481 18147 76 D -3, 4 0.72784 82421 29878 9 D -4, 5 -0.71084 62500 50067 D -5, 6 0.66786 70689 0115 D -6, 7 -0.61201 57501 844 D -7, 8 0.55146 52644 74 D -8, 9 -0.49105 30705 2 D -9, X 0.43350 00869 D -10, 1 -0.38021 8700 D -11, 2 0.33182 369 D -12, 3 -0.28845 12 D -13, 4 0.24995 8 D -14, 5 -0.21605 D -15, 6 0.1863 D -16, 7 -0.160 D -17, 8 0.14 D -18, 9 -0.1 D -19/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN08 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C XK = D1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) XK1 = RNUMJN - ONE XLOW2 = ( XK1 * D1MACH(1) ) ** (ONE/XK1) ELSE XHIGH1 = - LOG(D1MACH(4)) XHIGH2 = RNUMJN / XK XHIGH3 = LOG(XK) ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN08 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN08 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN08 = ( X ** ( NUMJN - 1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP ( - X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN08 = VALINF ELSE TRAN08 = VALINF - EXP( T ) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN09(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 9, defined as C C TRAN09(X) = integral 0 to X { t**9 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - DOUBLE PRECISION - The value below which TRAN09 = 0.0 to machine C precision. The recommended value is C 8th root of (8*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which TRAN09 = X**8/8 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN09 = VALINF - X**9 exp(-X) C The recommended value is 9/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 23 January, 1996 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN09'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 9 , 9.0 D 0 / DATA VALINF/0.36360 88055 88728 71397 D 6/ DATA ATRAN/0.16224 04999 19498 46835 D 0, 1 -0.37683 51452 19593 7773 D -1, 2 0.54766 97159 17719 770 D -2, 3 -0.64443 94500 94495 21 D -3, 4 0.67736 45285 28098 3 D -4, 5 -0.66681 34975 82042 D -5, 6 0.63047 56001 9047 D -6, 7 -0.58074 78663 611 D -7, 8 0.52555 13051 23 D -8, 9 -0.46968 86176 1 D -9, X 0.41593 95065 D -10, 1 -0.36580 8491 D -11, 2 0.32000 794 D -12, 3 -0.27876 51 D -13, 4 0.24201 7 D -14, 5 -0.20953 D -15, 6 0.1810 D -16, 7 -0.156 D -17, 8 0.13 D -18, 9 -0.1 D -19/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN09 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C XK = D1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) XK1 = RNUMJN - ONE XLOW2 = ( XK1 * D1MACH(1) ) ** (ONE/XK1) ELSE XHIGH1 = - LOG(D1MACH(4)) XHIGH2 = RNUMJN / XK XHIGH3 = LOG(XK) ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN09 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN09 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN09 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T.LT.XHIGH3 ) THEN TRAN09 = VALINF ELSE TRAN09 = VALINF - EXP( T ) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION Y0INT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the Bessel C function Y0, defined as C C Y0INT(x) = {integral 0 to x} Y0(t) dt C C The code uses Chebyshev expansions whose coefficients are C given to 20 decimal places. C C C ERROR RETURNS: C C If x < 0.0, the function is undefined. An error message C is printed and the function returns the value 0.0. C C If the value of x is too large, it is impossible to C accurately compute the trigonometric functions used. An C error message is printed, and the function returns the C value 1.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used from the array C ARJ01. The recommended value is such that C ABS(ARJ01(NTERM1)) < EPS/100 C C NTERM2 - The no. of terms to be used from the array C ARY01. The recommended value is such that C ABS(ARY01(NTERM2)) < EPS/100 C C NTERM3 - The no. of terms to be used from the array C ARY0A1. The recommended value is such that C ABS(ARY0A1(NTERM3)) < EPS/100 C C NTERM4 - The no. of terms to be used from the array C ARY0A2. The recommended value is such that C ABS(ARY0A2(NTERM4)) < EPS/100 C C XLOW - The value of x below which C Y0INT(x) = x*(ln(x) - 0.11593)*2/pi C to machine-precision. The recommended value is C sqrt(9*EPSNEG) C C XHIGH - The value of x above which it is impossible C to calculate (x-pi/4) accurately. The recommended C value is 1/EPSNEG C C For values of EPS and EPSNEG, refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the D1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C COS , LOG , SIN , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, D1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST REVISION: C 23 January, 1996 C INTEGER NTERM1,NTERM2,NTERM3,NTERM4 DOUBLE PRECISION ARJ01(0:23),ARY01(0:24),ARY0A1(0:21), 1 ARY0A2(0:18),CHEVAL,FIVE12,GAL2M1,GAMLN2, 2 NINE,ONE,ONEHUN,ONE28,PIB41,PIB411,PIB412, 3 PIB42,RT2BPI,SIXTEN,T,TEMP,TWOBPI,X,XHIGH, 4 XLOW,XMPI4,XVALUE,ZERO,D1MACH CHARACTER FNNAME*6,ERMSG1*14,ERMSG2*18 DATA FNNAME/'Y0INT '/ DATA ERMSG1/'ARGUMENT < 0.0'/ DATA ERMSG2/'ARGUMENT TOO LARGE'/ DATA ZERO,ONE/ 0.0 D 0 , 1.0 D 0 / DATA NINE,SIXTEN/ 9.0 D 0 , 16.0 D 0 / DATA ONEHUN,ONE28,FIVE12/ 100.0 D 0 , 128.0 D 0 , 512.0 D 0 / DATA RT2BPI/0.79788 45608 02865 35588 D 0/ DATA PIB411,PIB412/ 201.0 D 0 , 256.0 D 0/ DATA PIB42/0.24191 33974 48309 61566 D -3/ DATA TWOBPI/0.63661 97723 67581 34308 D 0/ DATA GAL2M1/-1.11593 15156 58412 44881 D 0/ DATA GAMLN2/-0.11593 15156 58412 44881 D 0/ DATA ARJ01(0)/ 0.38179 27932 16901 73518 D 0/ DATA ARJ01(1)/ -0.21275 63635 05053 21870 D 0/ DATA ARJ01(2)/ 0.16754 21340 72157 94187 D 0/ DATA ARJ01(3)/ -0.12853 20977 21963 98954 D 0/ DATA ARJ01(4)/ 0.10114 40545 57788 47013 D 0/ DATA ARJ01(5)/ -0.91007 95343 20156 8859 D -1/ DATA ARJ01(6)/ 0.64013 45264 65687 3103 D -1/ DATA ARJ01(7)/ -0.30669 63029 92675 4312 D -1/ DATA ARJ01(8)/ 0.10308 36525 32506 4201 D -1/ DATA ARJ01(9)/ -0.25567 06503 99956 918 D -2/ DATA ARJ01(10)/ 0.48832 75580 57983 04 D -3/ DATA ARJ01(11)/-0.74249 35126 03607 7 D -4/ DATA ARJ01(12)/ 0.92226 05637 30861 D -5/ DATA ARJ01(13)/-0.95522 82830 7083 D -6/ DATA ARJ01(14)/ 0.83883 55845 986 D -7/ DATA ARJ01(15)/-0.63318 44888 58 D -8/ DATA ARJ01(16)/ 0.41560 50422 1 D -9/ DATA ARJ01(17)/-0.23955 29307 D -10/ DATA ARJ01(18)/ 0.12228 6885 D -11/ DATA ARJ01(19)/-0.55697 11 D -13/ DATA ARJ01(20)/ 0.22782 0 D -14/ DATA ARJ01(21)/-0.8417 D -16/ DATA ARJ01(22)/ 0.282 D -17/ DATA ARJ01(23)/-0.9 D -19/ DATA ARY01(0)/ 0.54492 69630 27243 65490 D 0/ DATA ARY01(1)/ -0.14957 32358 86847 82157 D 0/ DATA ARY01(2)/ 0.11085 63448 62548 42337 D 0/ DATA ARY01(3)/ -0.94953 30018 68377 7109 D -1/ DATA ARY01(4)/ 0.68208 17786 99145 6963 D -1/ DATA ARY01(5)/ -0.10324 65338 33682 00408 D 0/ DATA ARY01(6)/ 0.10625 70328 75344 25491 D 0/ DATA ARY01(7)/ -0.62583 67679 96168 1990 D -1/ DATA ARY01(8)/ 0.23856 45760 33829 3285 D -1/ DATA ARY01(9)/ -0.64486 49130 15404 481 D -2/ DATA ARY01(10)/ 0.13128 70828 91002 331 D -2/ DATA ARY01(11)/-0.20988 08817 49896 40 D -3/ DATA ARY01(12)/ 0.27160 42484 13834 7 D -4/ DATA ARY01(13)/-0.29119 91140 14694 D -5/ DATA ARY01(14)/ 0.26344 33309 3795 D -6/ DATA ARY01(15)/-0.20411 72069 780 D -7/ DATA ARY01(16)/ 0.13712 47813 17 D -8/ DATA ARY01(17)/-0.80706 80792 D -10/ DATA ARY01(18)/ 0.41988 3057 D -11/ DATA ARY01(19)/-0.19459 104 D -12/ DATA ARY01(20)/ 0.80878 2 D -14/ DATA ARY01(21)/-0.30329 D -15/ DATA ARY01(22)/ 0.1032 D -16/ DATA ARY01(23)/-0.32 D -18/ DATA ARY01(24)/ 0.1 D -19/ DATA ARY0A1(0)/ 1.24030 13303 75189 70827 D 0/ DATA ARY0A1(1)/ -0.47812 53536 32280 693 D -2/ DATA ARY0A1(2)/ 0.66131 48891 70667 8 D -4/ DATA ARY0A1(3)/ -0.18604 27404 86349 D -5/ DATA ARY0A1(4)/ 0.83627 35565 080 D -7/ DATA ARY0A1(5)/ -0.52585 70367 31 D -8/ DATA ARY0A1(6)/ 0.42606 36325 1 D -9/ DATA ARY0A1(7)/ -0.42117 61024 D -10/ DATA ARY0A1(8)/ 0.48894 6426 D -11/ DATA ARY0A1(9)/ -0.64834 929 D -12/ DATA ARY0A1(10)/ 0.96172 34 D -13/ DATA ARY0A1(11)/-0.15703 67 D -13/ DATA ARY0A1(12)/ 0.27871 2 D -14/ DATA ARY0A1(13)/-0.53222 D -15/ DATA ARY0A1(14)/ 0.10844 D -15/ DATA ARY0A1(15)/-0.2342 D -16/ DATA ARY0A1(16)/ 0.533 D -17/ DATA ARY0A1(17)/-0.127 D -17/ DATA ARY0A1(18)/ 0.32 D -18/ DATA ARY0A1(19)/-0.8 D -19/ DATA ARY0A1(20)/ 0.2 D -19/ DATA ARY0A1(21)/-0.1 D -19/ DATA ARY0A2(0)/ 1.99616 09630 13416 75339 D 0/ DATA ARY0A2(1)/ -0.19037 98192 46668 161 D -2/ DATA ARY0A2(2)/ 0.15397 10927 04422 6 D -4/ DATA ARY0A2(3)/ -0.31145 08832 8103 D -6/ DATA ARY0A2(4)/ 0.11108 50971 321 D -7/ DATA ARY0A2(5)/ -0.58666 78712 3 D -9/ DATA ARY0A2(6)/ 0.41399 26949 D -10/ DATA ARY0A2(7)/ -0.36539 8763 D -11/ DATA ARY0A2(8)/ 0.38557 568 D -12/ DATA ARY0A2(9)/ -0.47098 00 D -13/ DATA ARY0A2(10)/ 0.65022 0 D -14/ DATA ARY0A2(11)/-0.99624 D -15/ DATA ARY0A2(12)/ 0.16700 D -15/ DATA ARY0A2(13)/-0.3028 D -16/ DATA ARY0A2(14)/ 0.589 D -17/ DATA ARY0A2(15)/-0.122 D -17/ DATA ARY0A2(16)/ 0.27 D -18/ DATA ARY0A2(17)/-0.6 D -19/ DATA ARY0A2(18)/ 0.1 D -19/ C C Start computation C X = XVALUE C C First error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERMSG1) Y0INT = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C TEMP = D1MACH(3) XHIGH = ONE / TEMP C C Second error test C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERMSG2) Y0INT = ZERO RETURN ENDIF C C continue with machine constants C T = TEMP / ONEHUN IF ( X .LE. SIXTEN ) THEN DO 10 NTERM1 = 23 , 0 , -1 IF ( ABS(ARJ01(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 24 , 0 , -1 IF ( ABS(ARY01(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 XLOW = SQRT ( NINE * TEMP ) ELSE DO 40 NTERM3 = 21 , 0 , -1 IF ( ABS(ARY0A1(NTERM3)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM4 = 18 , 0 , -1 IF ( ABS(ARY0A2(NTERM4)) .GT. T ) GOTO 59 50 CONTINUE 59 ENDIF C C Code for 0 <= x <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN IF ( X .EQ. ZERO ) THEN Y0INT = ZERO ELSE Y0INT = ( LOG(X) + GAL2M1 ) * TWOBPI * X ENDIF ELSE T = X * X / ONE28 - ONE TEMP = ( LOG(X) + GAMLN2 ) * CHEVAL(NTERM1,ARJ01,T) TEMP = TEMP - CHEVAL(NTERM2,ARY01,T) Y0INT = TWOBPI * X * TEMP ENDIF ELSE C C Code for x > 16 C T = FIVE12 / ( X * X ) - ONE PIB41 = PIB411 / PIB412 XMPI4 = ( X - PIB41 ) - PIB42 TEMP = SIN(XMPI4) * CHEVAL(NTERM3,ARY0A1,T) / X TEMP = TEMP + COS(XMPI4) * CHEVAL(NTERM4,ARY0A2,T) Y0INT = - RT2BPI * TEMP / SQRT(X) ENDIF RETURN END DOUBLE PRECISION FUNCTION CHEVAL(N,A,T) C C This function evaluates a Chebyshev series, using the C Clenshaw method with Reinsch modification, as analysed C in the paper by Oliver. C C INPUT PARAMETERS C C N - INTEGER - The no. of terms in the sequence C C A - DOUBLE PRECISION ARRAY, dimension 0 to N - The coefficients of C the Chebyshev series C C T - DOUBLE PRECISION - The value at which the series is to be C evaluated C C C REFERENCES C C "An error analysis of the modified Clenshaw method for C evaluating Chebyshev and Fourier series" J. Oliver, C J.I.M.A., vol. 20, 1977, pp379-391 C C C MACHINE-DEPENDENT CONSTANTS: NONE C C C INTRINSIC FUNCTIONS USED; C C ABS C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley , C High St., C PAISLEY, C SCOTLAND C C C LATEST MODIFICATION: 21 December , 1992 C C INTEGER I,N DOUBLE PRECISION A(0:N),D1,D2,HALF,T,TEST,TT,TWO,U0,U1,U2,ZERO DATA ZERO,HALF/ 0.0 D 0 , 0.5 D 0 / DATA TEST,TWO/ 0.6 D 0 , 2.0 D 0 / U1 = ZERO C C If ABS ( T ) < 0.6 use the standard Clenshaw method C IF ( ABS( T ) .LT. TEST ) THEN U0 = ZERO TT = T + T DO 100 I = N , 0 , -1 U2 = U1 U1 = U0 U0 = TT * U1 + A( I ) - U2 100 CONTINUE CHEVAL = ( U0 - U2 ) / TWO ELSE C C If ABS ( T ) > = 0.6 use the Reinsch modification C D1 = ZERO C C T > = 0.6 code C IF ( T .GT. ZERO ) THEN TT = ( T - HALF ) - HALF TT = TT + TT DO 200 I = N , 0 , -1 D2 = D1 U2 = U1 D1 = TT * U2 + A( I ) + D2 U1 = D1 + U2 200 CONTINUE CHEVAL = ( D1 + D2 ) / TWO ELSE C C T < = -0.6 code C TT = ( T + HALF ) + HALF TT = TT + TT DO 300 I = N , 0 , -1 D2 = D1 U2 = U1 D1 = TT * U2 + A( I ) - D2 U1 = D1 - U2 300 CONTINUE CHEVAL = ( D1 - D2 ) / TWO ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION D1MACH(I) C C DOUBLE-PRECISION MACHINE CONSTANTS C C D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. C C D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. C C D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING. C C D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING. C C D1MACH( 5) = LOG10(B) C C TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, C THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY C REMOVING THE C FROM COLUMN 1. C C WHERE POSSIBLE, OCTAL OR HEXADECIMAL CONSTANTS HAVE BEEN USED C TO SPECIFY THE CONSTANTS EXACTLY WHICH HAS IN SOME CASES C REQUIRED THE USE OF EQUIVALENT INTEGER ARRAYS. C INTEGER I INTEGER SMALL(4) INTEGER LARGE(4) INTEGER RIGHT(4) INTEGER DIVER(4) INTEGER LOG10(4) C DOUBLE PRECISION DMACH(5) C EQUIVALENCE (DMACH(1),SMALL(1)) EQUIVALENCE (DMACH(2),LARGE(1)) EQUIVALENCE (DMACH(3),RIGHT(1)) EQUIVALENCE (DMACH(4),DIVER(1)) EQUIVALENCE (DMACH(5),LOG10(1)) C C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. C C DATA SMALL(1) / ZC00800000 / C DATA SMALL(2) / Z000000000 / C C DATA LARGE(1) / ZDFFFFFFFF / C DATA LARGE(2) / ZFFFFFFFFF / C C DATA RIGHT(1) / ZCC5800000 / C DATA RIGHT(2) / Z000000000 / C C DATA DIVER(1) / ZCC6800000 / C DATA DIVER(2) / Z000000000 / C C DATA LOG10(1) / ZD00E730E7 / C DATA LOG10(2) / ZC77800DC0 / C C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. C C DATA SMALL(1) / O1771000000000000 / C DATA SMALL(2) / O0000000000000000 / C C DATA LARGE(1) / O0777777777777777 / C DATA LARGE(2) / O0007777777777777 / C C DATA RIGHT(1) / O1461000000000000 / C DATA RIGHT(2) / O0000000000000000 / C C DATA DIVER(1) / O1451000000000000 / C DATA DIVER(2) / O0000000000000000 / C C DATA LOG10(1) / O1157163034761674 / C DATA LOG10(2) / O0006677466732724 / C C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. C C DATA SMALL(1) / O1771000000000000 / C DATA SMALL(2) / O7770000000000000 / C C DATA LARGE(1) / O0777777777777777 / C DATA LARGE(2) / O7777777777777777 / C C DATA RIGHT(1) / O1461000000000000 / C DATA RIGHT(2) / O0000000000000000 / C C DATA DIVER(1) / O1451000000000000 / C DATA DIVER(2) / O0000000000000000 / C C DATA LOG10(1) / O1157163034761674 / C DATA LOG10(2) / O0006677466732724 / C C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES. C C DATA SMALL(1) / 00604000000000000000B / C DATA SMALL(2) / 00000000000000000000B / C C DATA LARGE(1) / 37767777777777777777B / C DATA LARGE(2) / 37167777777777777777B / C C DATA RIGHT(1) / 15604000000000000000B / C DATA RIGHT(2) / 15000000000000000000B / C C DATA DIVER(1) / 15614000000000000000B / C DATA DIVER(2) / 15010000000000000000B / C C DATA LOG10(1) / 17164642023241175717B / C DATA LOG10(2) / 16367571421742254654B / C C MACHINE CONSTANTS FOR THE CRAY 1 C C DATA SMALL(1) / 200004000000000000000B / C DATA SMALL(2) / 00000000000000000000B / C C DATA LARGE(1) / 577777777777777777777B / C DATA LARGE(2) / 000007777777777777777B / C C DATA RIGHT(1) / 377214000000000000000B / C DATA RIGHT(2) / 000000000000000000000B / C C DATA DIVER(1) / 377224000000000000000B / C DATA DIVER(2) / 000000000000000000000B / C C DATA LOG10(1) / 377774642023241175717B / C DATA LOG10(2) / 000007571421742254654B / C C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 C C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD - C STATIC DMACH(5) C C DATA SMALL/20K,3*0/,LARGE/77777K,3*177777K/ C DATA RIGHT/31420K,3*0/,DIVER/32020K,3*0/ C DATA LOG10/40423K,42023K,50237K,74776K/ C C MACHINE CONSTANTS FOR THE HARRIS 220 C C DATA SMALL(1),SMALL(2) / '20000000, '00000201 / C DATA LARGE(1),LARGE(2) / '37777777, '37777577 / C DATA RIGHT(1),RIGHT(2) / '20000000, '00000333 / C DATA DIVER(1),DIVER(2) / '20000000, '00000334 / C DATA LOG10(1),LOG10(2) / '23210115, '10237777 / C C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES. C C DATA SMALL(1),SMALL(2) / O402400000000, O000000000000 / C DATA LARGE(1),LARGE(2) / O376777777777, O777777777777 / C DATA RIGHT(1),RIGHT(2) / O604400000000, O000000000000 / C DATA DIVER(1),DIVER(2) / O606400000000, O000000000000 / C DATA LOG10(1),LOG10(2) / O776464202324, O117571775714 / C C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, C THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. C C DATA SMALL(1),SMALL(2) / Z00100000, Z00000000 / C DATA LARGE(1),LARGE(2) / Z7FFFFFFF, ZFFFFFFFF / C DATA RIGHT(1),RIGHT(2) / Z33100000, Z00000000 / C DATA DIVER(1),DIVER(2) / Z34100000, Z00000000 / C DATA LOG10(1),LOG10(2) / Z41134413, Z509F79FF / C C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS IBM PC C C DATA SMALL(1),SMALL(2) / 0 , 1048576 / C DATA LARGE(1),LARGE(2) / -1 , 2146435071 / C DATA RIGHT(1),RIGHT(2) / 0 , 1017118720 / C DATA DIVER(1),DIVER(2) / 0 , 1018167296 / C DATA LOG10(1),LOG10(2) / 1352628735 , 1070810131 / C C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS SUN SPARC C DATA SMALL(1),SMALL(2) / 1048576 , 0 / DATA LARGE(1),LARGE(2) / 2146435071 , -1 / DATA RIGHT(1),RIGHT(2) / 1017118720 , 0 / DATA DIVER(1),DIVER(2) / 1018167296 , 0 / DATA LOG10(1),LOG10(2) / 1070810131 , 1352628735 / C C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). C C DATA SMALL(1),SMALL(2) / "033400000000, "000000000000 / C DATA LARGE(1),LARGE(2) / "377777777777, "344777777777 / C DATA RIGHT(1),RIGHT(2) / "113400000000, "000000000000 / C DATA DIVER(1),DIVER(2) / "114400000000, "000000000000 / C DATA LOG10(1),LOG10(2) / "177464202324, "144117571776 / C C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). C C DATA SMALL(1),SMALL(2) / "000400000000, "000000000000 / C DATA LARGE(1),LARGE(2) / "377777777777, "377777777777 / C DATA RIGHT(1),RIGHT(2) / "103400000000, "000000000000 / C DATA DIVER(1),DIVER(2) / "104400000000, "000000000000 / C DATA LOG10(1),LOG10(2) / "177464202324, "476747767461 / C C MACHINE CONSTANTS FOR PDP-11 FORTRAN'S SUPPORTING C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). C C DATA SMALL(1),SMALL(2) / 8388608, 0 / C DATA LARGE(1),LARGE(2) / 2147483647, -1 / C DATA RIGHT(1),RIGHT(2) / 612368384, 0 / C DATA DIVER(1),DIVER(2) / 620756992, 0 / C DATA LOG10(1),LOG10(2) / 1067065498, -2063872008 / C C DATA SMALL(1),SMALL(2) / O00040000000, O00000000000 / C DATA LARGE(1),LARGE(2) / O17777777777, O37777777777 / C DATA RIGHT(1),RIGHT(2) / O04440000000, O00000000000 / C DATA DIVER(1),DIVER(2) / O04500000000, O00000000000 / C DATA LOG10(1),LOG10(2) / O07746420232, O20476747770 / C C MACHINE CONSTANTS FOR PDP-11 FORTRAN'S SUPPORTING C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). C C DATA SMALL(1),SMALL(2) / 128, 0 / C DATA SMALL(3),SMALL(4) / 0, 0 / C C DATA LARGE(1),LARGE(2) / 32767, -1 / C DATA LARGE(3),LARGE(4) / -1, -1 / C C DATA RIGHT(1),RIGHT(2) / 9344, 0 / C DATA RIGHT(3),RIGHT(4) / 0, 0 / C C DATA DIVER(1),DIVER(2) / 9472, 0 / C DATA DIVER(3),DIVER(4) / 0, 0 / C C DATA LOG10(1),LOG10(2) / 16282, 8346 / C DATA LOG10(3),LOG10(4) / -31493, -12296 / C C DATA SMALL(1),SMALL(2) / O000200, O000000 / C DATA SMALL(3),SMALL(4) / O000000, O000000 / C C DATA LARGE(1),LARGE(2) / O077777, O177777 / C DATA LARGE(3),LARGE(4) / O177777, O177777 / C C DATA RIGHT(1),RIGHT(2) / O022200, O000000 / C DATA RIGHT(3),RIGHT(4) / O000000, O000000 / C C DATA DIVER(1),DIVER(2) / O022400, O000000 / C DATA DIVER(3),DIVER(4) / O000000, O000000 / C C DATA LOG10(1),LOG10(2) / O037632, O020232 / C DATA LOG10(3),LOG10(4) / O102373, O147770 / C C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. C C DATA SMALL(1),SMALL(2) / O000040000000, O000000000000 / C DATA LARGE(1),LARGE(2) / O377777777777, O777777777777 / C DATA RIGHT(1),RIGHT(2) / O170540000000, O000000000000 / C DATA DIVER(1),DIVER(2) / O170640000000, O000000000000 / C DATA LOG10(1),LOG10(2) / O177746420232, O411757177572 / C C C D1MACH = DMACH(I) RETURN END SUBROUTINE ERRPRN(FNNAME,ERRMSG) C C DESCRIPTION: C This subroutine prints out an error message if C an error has occurred in one of the MISCFUN C functions. C C C INPUT PARAMETERS: C C FNNAME - CHARACTER - The name of the function with the error. C C ERRMSG - CHARACTER - The message to be printed out. C C C MACHINE-DEPENDENT PARAMETER: C C OUTSTR - INTEGER - The numerical value of the output C stream to be used for printing the C error message. The subroutine has the C default value OUTSTR = 6. C C C AUTHOR: C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 2 JUNE, 1995 C INTEGER OUTSTR CHARACTER FNNAME*6,ERRMSG*(*) DATA OUTSTR/6/ WRITE(OUTSTR,1000)FNNAME WRITE(OUTSTR,2000)ERRMSG 1000 FORMAT(/5X,'ERROR IN MISCFUN FUNCTION ',A6) 2000 FORMAT(/5X,A50) RETURN END SHAR_EOF fi # end of overwriting check if test -f 'src_ieee.f' then echo shar: will not over-write existing file "'src_ieee.f'" else cat << \SHAR_EOF > 'src_ieee.f' DOUBLE PRECISION FUNCTION ABRAM0(XVALUE) C C DESCRIPTION: C This function calculates the Abramowitz function of order 0, C defined as C C ABRAM0(x) = integral{ 0 to infinity } exp( -t*t - x/t ) dt C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C ERROR RETURNS: C If XVALUE < 0.0, the function prints a message and returns the C value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMF - INTEGER - No. of terms needed for the array AB0F. C Recommended value such that C ABS( AB0F(NTERMF) ) < EPS/100 C C NTERMG - INTEGER - No. of terms needed for array AB0G. C Recommended value such that C ABS( AB0G(NTERMG) ) < EPS/100 C C NTERMH - INTEGER - No. of terms needed for array AB0H. C Recommended value such that C ABS( AB0H(NTERMH) ) < EPS/100 C C NTERMA - INTEGER - No. of terms needed for array AB0AS. C Recommended value such that C ABS( AB0AS(NTERMA) ) < EPS/100 C C XLOW1 - DOUBLE PRECISION - The value below which C ABRAM0 = root(pi)/2 + X ( ln X - GVAL0 ) C Recommended value is SQRT(2*EPSNEG) C C LNXMIN - DOUBLE PRECISION - The value of ln XMIN. Used to prevent C exponential underflow for large X. C C For values of EPS, EPSNEG, XMIN refer to the file MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C INTRINSIC FUNCTIONS USED: C C LOG, EXP, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 22 NOVEMBER, 1995 C C INTEGER NTERMA,NTERMF,NTERMG,NTERMH DOUBLE PRECISION AB0F(0:8),AB0G(0:8),AB0H(0:8),AB0AS(0:27), & ASLN,ASVAL,CHEVAL,FVAL,GVAL,GVAL0,HALF,HVAL, & LNXMIN,ONEHUN,ONERPI,RTPIB2,RT3BPI,SIX,T, & THREE,TWO,V,X,XLOW1,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*33 DATA FNNAME/'ABRAM0'/ DATA ERRMSG/'FUNCTION CALLED WITH ARGUMENT < 0'/ DATA AB0F/-0.68121 92709 35494 69816 D 0, 1 -0.78867 91981 61492 52495 D 0, 2 0.51215 81776 81881 9543 D -1, 3 -0.71092 35289 45412 96 D -3, 4 0.36868 18085 04287 D -5, 5 -0.91783 23372 37 D -8, 6 0.12702 02563 D -10, 7 -0.10768 88 D -13, 8 0.599 D -17/ DATA AB0G/-0.60506 03943 08682 73190 D 0, 1 -0.41950 39816 32017 79803 D 0, 2 0.17032 65125 19037 0333 D -1, 3 -0.16938 91784 24913 97 D -3, 4 0.67638 08951 9710 D -6, 5 -0.13572 36362 55 D -8, 6 0.15629 7065 D -11, 7 -0.11288 7 D -14, 8 0.55 D -18/ DATA AB0H/1.38202 65523 05749 89705 D 0, 1 -0.30097 92907 39749 04355 D 0, 2 0.79428 88093 64887 241 D -2, 3 -0.64319 10276 84756 3 D -4, 4 0.22549 83068 4374 D -6, 5 -0.41220 96619 5 D -9, 6 0.44185 282 D -12, 7 -0.30123 D -15, 8 0.14 D -18/ DATA AB0AS(0)/ 1.97755 49972 36930 67407 D 0/ DATA AB0AS(1)/ -0.10460 24792 00481 9485 D -1/ DATA AB0AS(2)/ 0.69680 79025 36253 66 D -3/ DATA AB0AS(3)/ -0.58982 98299 99659 9 D -4/ DATA AB0AS(4)/ 0.57716 44553 05320 D -5/ DATA AB0AS(5)/ -0.61523 01336 5756 D -6/ DATA AB0AS(6)/ 0.67853 96884 767 D -7/ DATA AB0AS(7)/ -0.72306 25379 07 D -8/ DATA AB0AS(8)/ 0.63306 62736 5 D -9/ DATA AB0AS(9)/ -0.98945 3793 D -11/ DATA AB0AS(10)/-0.16819 80530 D -10/ DATA AB0AS(11)/ 0.67379 9551 D -11/ DATA AB0AS(12)/-0.20099 7939 D -11/ DATA AB0AS(13)/ 0.54055 903 D -12/ DATA AB0AS(14)/-0.13816 679 D -12/ DATA AB0AS(15)/ 0.34222 05 D -13/ DATA AB0AS(16)/-0.82668 6 D -14/ DATA AB0AS(17)/ 0.19456 6 D -14/ DATA AB0AS(18)/-0.44268 D -15/ DATA AB0AS(19)/ 0.9562 D -16/ DATA AB0AS(20)/-0.1883 D -16/ DATA AB0AS(21)/ 0.301 D -17/ DATA AB0AS(22)/-0.19 D -18/ DATA AB0AS(23)/-0.14 D -18/ DATA AB0AS(24)/ 0.11 D -18/ DATA AB0AS(25)/-0.4 D -19/ DATA AB0AS(26)/ 0.2 D -19/ DATA AB0AS(27)/-0.1 D -19/ DATA ZERO,HALF,TWO/ 0.0 D 0 , 0.5 D 0, 2.0 D 0/ DATA THREE,SIX,ONEHUN/ 3.0 D 0, 6.0 D 0 , 100.0 D 0/ DATA RT3BPI/0.97720 50238 05839 84317 D 0/ DATA RTPIB2/0.88622 69254 52758 01365 D 0/ DATA GVAL0/0.13417 65026 47700 70909 D 0/ DATA ONERPI/0.56418 95835 47756 28695 D 0/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERMF,NTERMG,NTERMH,NTERMA/8,8,8,22/ DATA XLOW1,LNXMIN/1.490116D-8,-708.3964D0/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) ABRAM0 = ZERO RETURN ENDIF C C Code for 0 <= XVALUE <= 2 C IF ( X .LE. TWO ) THEN IF ( X .EQ. ZERO ) THEN ABRAM0 = RTPIB2 RETURN ENDIF IF ( X .LT. XLOW1 ) THEN ABRAM0 = RTPIB2 + X * ( LOG( X ) - GVAL0 ) RETURN ELSE T = ( X * X / TWO - HALF ) - HALF FVAL = CHEVAL( NTERMF,AB0F,T ) GVAL = CHEVAL( NTERMG,AB0G,T ) HVAL = CHEVAL( NTERMH,AB0H,T ) ABRAM0 = FVAL/ONERPI + X * ( LOG( X ) * HVAL- GVAL ) RETURN ENDIF ELSE C C Code for XVALUE > 2 C V = THREE * ( (X / TWO) ** ( TWO / THREE ) ) T = ( SIX/V - HALF ) - HALF ASVAL = CHEVAL( NTERMA,AB0AS,T ) ASLN = LOG( ASVAL / RT3BPI ) - V IF ( ASLN .LT. LNXMIN ) THEN ABRAM0 = ZERO ELSE ABRAM0 = EXP( ASLN ) ENDIF RETURN ENDIF END DOUBLE PRECISION FUNCTION ABRAM1(XVALUE) C C DESCRIPTION: C This function calculates the Abramowitz function of order 1, C defined as C C ABRAM1(x) = integral{ 0 to infinity } t * exp( -t*t - x/t ) dt C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C If XVALUE < 0.0, the function prints a message and returns the C value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMF - INTEGER - No. of terms needed for the array AB1F. C Recommended value such that C ABS( AB1F(NTERMF) ) < EPS/100 C C NTERMG - INTEGER - No. of terms needed for array AB1G. C Recommended value such that C ABS( AB1G(NTERMG) ) < EPS/100 C C NTERMH - INTEGER - No. of terms needed for array AB1H. C Recommended value such that C ABS( AB1H(NTERMH) ) < EPS/100 C C NTERMA - INTEGER - No. of terms needed for array AB1AS. C Recommended value such that C ABS( AB1AS(NTERMA) ) < EPS/100 C C XLOW - DOUBLE PRECISION - The value below which C ABRAM1(x) = 0.5 to machine precision. C The recommended value is EPSNEG/2 C C XLOW1 - DOUBLE PRECISION - The value below which C ABRAM1(x) = (1 - x ( sqrt(pi) + xln(x) ) / 2 C Recommended value is SQRT(2*EPSNEG) C C LNXMIN - DOUBLE PRECISION - The value of ln XMIN. Used to prevent C exponential underflow for large X. C C For values of EPS, EPSNEG, XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C LOG, EXP, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 22 NOVEMBER, 1995 C C INTEGER NTERMA,NTERMF,NTERMG,NTERMH DOUBLE PRECISION AB1F(0:9),AB1G(0:8),AB1H(0:8),AB1AS(0:27), & ASLN,ASVAL,CHEVAL,FVAL,GVAL,HALF,HVAL, & LNXMIN,ONE,ONEHUN,ONERPI,RT3BPI,SIX,T,THREE,TWO, & V,X,XLOW,XLOW1,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*33 DATA FNNAME/'ABRAM1'/ DATA ERRMSG/'FUNCTION CALLED WITH ARGUMENT < 0'/ DATA AB1F/1.47285 19257 79788 07369 D 0, 1 0.10903 49757 01689 56257 D 0, 2 -0.12430 67536 00565 69753 D 0, 3 0.30619 79468 53493 315 D -2, 4 -0.22184 10323 07651 1 D -4, 5 0.69899 78834 451 D -7, 6 -0.11597 07644 4 D -9, 7 0.11389 776 D -12, 8 -0.7173 D -16, 9 0.3 D -19/ DATA AB1G/0.39791 27794 90545 03528 D 0, 1 -0.29045 28522 64547 20849 D 0, 2 0.10487 84695 46536 3504 D -1, 3 -0.10249 86952 26913 36 D -3, 4 0.41150 27939 9110 D -6, 5 -0.83652 63894 0 D -9, 6 0.97862 595 D -12, 7 -0.71868 D -15, 8 0.35 D -18/ DATA AB1H/0.84150 29215 22749 47030 D 0, 1 -0.77900 50698 77414 3395 D -1, 2 0.13399 24558 78390 993 D -2, 3 -0.80850 39071 52788 D -5, 4 0.22618 58281 728 D -7, 5 -0.34413 95838 D -10, 6 0.31598 58 D -13, 7 -0.1884 D -16, 8 0.1 D -19/ DATA AB1AS(0)/ 2.13013 64342 90655 49448 D 0/ DATA AB1AS(1)/ 0.63715 26795 21853 9933 D -1/ DATA AB1AS(2)/ -0.12933 49174 77510 647 D -2/ DATA AB1AS(3)/ 0.56783 28753 22826 5 D -4/ DATA AB1AS(4)/ -0.27943 49391 77646 D -5/ DATA AB1AS(5)/ 0.56002 14736 787 D -7/ DATA AB1AS(6)/ 0.23920 09242 798 D -7/ DATA AB1AS(7)/ -0.75098 48650 09 D -8/ DATA AB1AS(8)/ 0.17301 53307 76 D -8/ DATA AB1AS(9)/ -0.36648 87795 5 D -9/ DATA AB1AS(10)/ 0.75207 58307 D -10/ DATA AB1AS(11)/-0.15179 90208 D -10/ DATA AB1AS(12)/ 0.30171 3710 D -11/ DATA AB1AS(13)/-0.58596 718 D -12/ DATA AB1AS(14)/ 0.10914 455 D -12/ DATA AB1AS(15)/-0.18705 36 D -13/ DATA AB1AS(16)/ 0.26254 2 D -14/ DATA AB1AS(17)/-0.14627 D -15/ DATA AB1AS(18)/-0.9500 D -16/ DATA AB1AS(19)/ 0.5873 D -16/ DATA AB1AS(20)/-0.2420 D -16/ DATA AB1AS(21)/ 0.868 D -17/ DATA AB1AS(22)/-0.290 D -17/ DATA AB1AS(23)/ 0.93 D -18/ DATA AB1AS(24)/-0.29 D -18/ DATA AB1AS(25)/ 0.9 D -19/ DATA AB1AS(26)/-0.3 D -19/ DATA AB1AS(27)/ 0.1 D -19/ DATA ZERO,HALF,ONE/ 0.0 D 0, 0.5 D 0, 1.0 D 0/ DATA TWO,THREE,SIX/ 2.0 D 0, 3.0 D 0, 6.0 D 0/ DATA ONEHUN/100.0 D 0/ DATA RT3BPI/ 0.97720 50238 05839 84317 D 0/ DATA ONERPI/ 0.56418 95835 47756 28695 D 0/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERMF,NTERMG,NTERMH,NTERMA/9,8,8,23/ DATA XLOW,XLOW1,LNXMIN/1.11023D-16,1.490116D-8,-708.3964D0/ C C Start calculation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) ABRAM1 = ZERO RETURN ENDIF C C Code for 0 <= XVALUE <= 2 C IF ( X .LE. TWO ) THEN IF ( X .EQ. ZERO ) THEN ABRAM1 = HALF RETURN ENDIF IF ( X .LT. XLOW1 ) THEN IF ( X .LT. XLOW ) THEN ABRAM1 = HALF ELSE ABRAM1 = ( ONE - X / ONERPI - X * X * LOG( X ) ) * HALF ENDIF RETURN ELSE T = ( X * X / TWO - HALF ) - HALF FVAL = CHEVAL( NTERMF,AB1F,T ) GVAL = CHEVAL( NTERMG,AB1G,T ) HVAL = CHEVAL( NTERMH,AB1H,T ) ABRAM1 = FVAL - X * ( GVAL / ONERPI + X * LOG( X ) * HVAL ) RETURN ENDIF ELSE C C Code for XVALUE > 2 C V = THREE * ( (X / TWO) ** ( TWO / THREE ) ) T = ( SIX / V - HALF ) - HALF ASVAL = CHEVAL( NTERMA,AB1AS,T ) ASLN = LOG( ASVAL * SQRT ( V / THREE ) / RT3BPI ) - V IF ( ASLN .LT. LNXMIN ) THEN ABRAM1 = ZERO ELSE ABRAM1 = EXP( ASLN ) ENDIF RETURN ENDIF END DOUBLE PRECISION FUNCTION ABRAM2(XVALUE) C C DESCRIPTION: C This function calculates the Abramowitz function of order 2, C defined as C C ABRAM2(x) = integral{ 0 to infinity } (t**2) * exp( -t*t - x/t ) dt C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C ERROR RETURNS: C If XVALUE < 0.0, the function prints a message and returns the C value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMF - INTEGER - No. of terms needed for the array AB2F. C Recommended value such that C ABS( AB2F(NTERMF) ) < EPS/100 C C NTERMG - INTEGER - No. of terms needed for array AB2G. C Recommended value such that C ABS( AB2G(NTERMG) ) < EPS/100 C C NTERMH - INTEGER - No. of terms needed for array AB2H. C Recommended value such that C ABS( AB2H(NTERMH) ) < EPS/100 C C NTERMA - INTEGER - No. of terms needed for array AB2AS. C Recommended value such that C ABS( AB2AS(NTERMA) ) < EPS/100 C C XLOW - DOUBLE PRECISION - The value below which C ABRAM2 = root(pi)/4 to machine precision. C The recommended value is EPSNEG C C XLOW1 - DOUBLE PRECISION - The value below which C ABRAM2 = root(pi)/4 - x/2 + x**3ln(x)/6 C Recommended value is SQRT(2*EPSNEG) C C LNXMIN - DOUBLE PRECISION - The value of ln XMIN. Used to prevent C exponential underflow for large X. C C For values of EPS, EPSNEG, XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C LOG, EXP C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 22 NOVEMBER , 1995 C C INTEGER NTERMA,NTERMF,NTERMG,NTERMH DOUBLE PRECISION AB2F(0:9),AB2G(0:8),AB2H(0:7),AB2AS(0:26), & ASLN,ASVAL,CHEVAL,FVAL,GVAL,HALF,HVAL,LNXMIN, & ONEHUN,ONERPI,RTPIB4,RT3BPI,SIX,T,THREE,TWO, & V,X,XLOW,XLOW1,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*33 DATA FNNAME/'ABRAM2'/ DATA ERRMSG/'FUNCTION CALLED WITH ARGUMENT < 0'/ DATA AB2F/1.03612 16280 42437 13846 D 0, 1 0.19371 24662 67945 70012 D 0, 2 -0.72587 58839 23300 7378 D -1, 3 0.17479 05908 64327 399 D -2, 4 -0.12812 23233 75654 9 D -4, 5 0.41150 18153 651 D -7, 6 -0.69710 47256 D -10, 7 0.69901 83 D -13, 8 -0.4492 D -16, 9 0.2 D -19/ DATA AB2G/1.46290 15719 86307 41150 D 0, 1 0.20189 46688 31540 14317 D 0, 2 -0.29082 92087 99712 9022 D -1, 3 0.47061 04903 52700 50 D -3, 4 -0.25792 20803 59333 D -5, 5 0.65613 37129 46 D -8, 6 -0.91411 0203 D -11, 7 0.77427 6 D -14, 8 -0.429 D -17/ DATA AB2H/0.30117 22501 09104 88881 D 0, 1 -0.15886 67818 31762 3783 D -1, 2 0.19295 93693 55845 26 D -3, 3 -0.90199 58784 9300 D -6, 4 0.20610 50418 37 D -8, 5 -0.26511 1806 D -11, 6 0.21086 4 D -14, 7 -0.111 D -17/ DATA AB2AS(0)/ 2.46492 32530 43348 56893 D 0/ DATA AB2AS(1)/ 0.23142 79742 22489 05432 D 0/ DATA AB2AS(2)/ -0.94068 17301 00857 73 D -3/ DATA AB2AS(3)/ 0.82902 70038 08973 3 D -4/ DATA AB2AS(4)/ -0.88389 47042 45866 D -5/ DATA AB2AS(5)/ 0.10663 85435 67985 D -5/ DATA AB2AS(6)/ -0.13991 12853 8529 D -6/ DATA AB2AS(7)/ 0.19397 93208 445 D -7/ DATA AB2AS(8)/ -0.27704 99383 75 D -8/ DATA AB2AS(9)/ 0.39590 68718 6 D -9/ DATA AB2AS(10)/-0.54083 54342 D -10/ DATA AB2AS(11)/ 0.63554 6076 D -11/ DATA AB2AS(12)/-0.38461 613 D -12/ DATA AB2AS(13)/-0.11696 067 D -12/ DATA AB2AS(14)/ 0.68966 71 D -13/ DATA AB2AS(15)/-0.25031 13 D -13/ DATA AB2AS(16)/ 0.78558 6 D -14/ DATA AB2AS(17)/-0.23033 4 D -14/ DATA AB2AS(18)/ 0.64914 D -15/ DATA AB2AS(19)/-0.17797 D -15/ DATA AB2AS(20)/ 0.4766 D -16/ DATA AB2AS(21)/-0.1246 D -16/ DATA AB2AS(22)/ 0.316 D -17/ DATA AB2AS(23)/-0.77 D -18/ DATA AB2AS(24)/ 0.18 D -18/ DATA AB2AS(25)/-0.4 D -19/ DATA AB2AS(26)/ 0.1 D -19/ DATA ZERO,HALF,TWO/ 0.0 D 0 , 0.5 D 0, 2.0 D 0/ DATA THREE,SIX,ONEHUN/ 3.0 D 0, 6.0 D 0 , 100.0 D 0/ DATA RT3BPI/ 0.97720 50238 05839 84317 D 0/ DATA RTPIB4/ 0.44311 34627 26379 00682 D 0/ DATA ONERPI/ 0.56418 95835 47756 28695 D 0/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERMF,NTERMG,NTERMH,NTERMA/9,8,7,23/ DATA XLOW,XLOW1,LNXMIN/2.22045D-16,1.490116D-8,-708.3964D0/ C C Start calculation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) ABRAM2 = ZERO RETURN ENDIF C C Code for 0 <= XVALUE <= 2 C IF ( X .LE. TWO ) THEN IF ( X .EQ. ZERO ) THEN ABRAM2 = RTPIB4 RETURN ENDIF IF ( X .LT. XLOW1 ) THEN IF ( X .LT. XLOW ) THEN ABRAM2 = RTPIB4 ELSE ABRAM2 = RTPIB4 - HALF * X + X * X * X * LOG( X ) / SIX ENDIF RETURN ELSE T = ( X * X / TWO - HALF ) - HALF FVAL = CHEVAL( NTERMF,AB2F,T ) GVAL = CHEVAL( NTERMG,AB2G,T ) HVAL = CHEVAL( NTERMH,AB2H,T ) ABRAM2 = FVAL/ONERPI + X * ( X * X * LOG(X) * HVAL- GVAL ) RETURN ENDIF ELSE C C Code for XVALUE > 2 C V = THREE * ( (X / TWO) ** ( TWO / THREE ) ) T = ( SIX / V - HALF ) - HALF ASVAL = CHEVAL( NTERMA,AB2AS,T ) ASLN = LOG( ASVAL / RT3BPI ) + LOG( V / THREE ) - V IF ( ASLN .LT. LNXMIN ) THEN ABRAM2 = ZERO ELSE ABRAM2 = EXP( ASLN ) ENDIF RETURN ENDIF END DOUBLE PRECISION FUNCTION AIRINT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the Airy function Ai, C defined as C C AIRINT(x) = {integral 0 to x} Ai(t) dt C C The program uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If the argument is too large and negative, it is impossible C to accurately compute the necessary SIN and COS functions. C An error message is printed, and the program returns the C value -2/3 (the value at -infinity). C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C AAINT1. The recommended value is such that C ABS(AAINT1(NTERM1)) < EPS/100, C subject to 1 <= NTERM1 <= 25. C C NTERM2 - INTEGER - The no. of terms to be used from the array C AAINT2. The recommended value is such that C ABS(AAINT2(NTERM2)) < EPS/100, C subject to 1 <= NTERM2 <= 21. C C NTERM3 - INTEGER - The no. of terms to be used from the array C AAINT3. The recommended value is such that C ABS(AAINT3(NTERM3)) < EPS/100, C subject to 1 <= NTERM3 <= 40. C C NTERM4 - INTEGER - The no. of terms to be used from the array C AAINT4. The recommended value is such that C ABS(AAINT4(NTERM4)) < EPS/100, C subject to 1 <= NTERM4 <= 17. C C NTERM5 - INTEGER - The no. of terms to be used from the array C AAINT5. The recommended value is such that C ABS(AAINT5(NTERM5)) < EPS/100, C subject to 1 <= NTERM5 <= 17. C C XLOW1 - DOUBLE PRECISION - The value such that, if |x| < XLOW1, C AIRINT(x) = x * Ai(0) C to machine precision. The recommended value is C 2 * EPSNEG. C C XHIGH1 - DOUBLE PRECISION - The value such that, if x > XHIGH1, C AIRINT(x) = 1/3, C to machine precision. The recommended value is C (-1.5*LOG(EPSNEG)) ** (2/3). C C XNEG1 - DOUBLE PRECISION - The value such that, if x < XNEG1, C the trigonometric functions in the asymptotic C expansion cannot be calculated accurately. C The recommended value is C -(1/((EPS)**2/3)) C C For values of EPS and EPSNEG, refer to the file MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C COS, EXP, SIN, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C Univ. of Paisley, C High St., C Paisley, C SCOTLAND. C PA1 2BE C C (e-mail:macl_ms0@paisley.ac.uk) C C C LATEST REVISION: 22 NOVEMBER, 1995. C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5 DOUBLE PRECISION AAINT1(0:25),AAINT2(0:21),AAINT3(0:40), 1 AAINT4(0:17),AAINT5(0:17), 2 AIRZER,ARG,CHEVAL,EIGHT,FORTY1,FOUR,FR996,GVAL, 3 HVAL,NINE,NINHUN,ONE,ONEHUN,PIBY4,PITIM6,RT2B3P,T,TEMP, 4 THREE,TWO,X,XHIGH1,XLOW1,XNEG1,XVALUE,Z,ZERO CHARACTER FNNAME*6,ERRMSG*46 DATA FNNAME/'AIRINT'/ DATA ERRMSG/'FUNCTION TOO NEGATIVE FOR ACCURATE COMPUTATION'/ DATA AAINT1(0)/ 0.37713 51769 46836 95526 D 0/ DATA AAINT1(1)/ -0.13318 86843 24079 47431 D 0/ DATA AAINT1(2)/ 0.31524 97374 78288 4809 D -1/ DATA AAINT1(3)/ -0.31854 30764 36574 077 D -2/ DATA AAINT1(4)/ -0.87398 76469 86219 15 D -3/ DATA AAINT1(5)/ 0.46699 49765 53969 71 D -3/ DATA AAINT1(6)/ -0.95449 36738 98369 2 D -4/ DATA AAINT1(7)/ 0.54270 56871 56716 D -5/ DATA AAINT1(8)/ 0.23949 64062 52188 D -5/ DATA AAINT1(9)/ -0.75690 27020 5649 D -6/ DATA AAINT1(10)/ 0.90501 38584 518 D -7/ DATA AAINT1(11)/ 0.32052 94560 43 D -8/ DATA AAINT1(12)/-0.30382 55364 44 D -8/ DATA AAINT1(13)/ 0.48900 11859 6 D -9/ DATA AAINT1(14)/-0.18398 20572 D -10/ DATA AAINT1(15)/-0.71124 7519 D -11/ DATA AAINT1(16)/ 0.15177 4419 D -11/ DATA AAINT1(17)/-0.10801 922 D -12/ DATA AAINT1(18)/-0.96354 2 D -14/ DATA AAINT1(19)/ 0.31342 5 D -14/ DATA AAINT1(20)/-0.29446 D -15/ DATA AAINT1(21)/-0.477 D -17/ DATA AAINT1(22)/ 0.461 D -17/ DATA AAINT1(23)/-0.53 D -18/ DATA AAINT1(24)/ 0.1 D -19/ DATA AAINT1(25)/ 0.1 D -19/ DATA AAINT2(0)/ 1.92002 52408 19840 09769 D 0/ DATA AAINT2(1)/ -0.42200 49417 25628 7021 D -1/ DATA AAINT2(2)/ -0.23945 77229 65939 223 D -2/ DATA AAINT2(3)/ -0.19564 07048 33529 71 D -3/ DATA AAINT2(4)/ -0.15472 52891 05611 2 D -4/ DATA AAINT2(5)/ -0.14049 01861 37889 D -5/ DATA AAINT2(6)/ -0.12128 01427 1367 D -6/ DATA AAINT2(7)/ -0.11791 86050 192 D -7/ DATA AAINT2(8)/ -0.10431 55787 88 D -8/ DATA AAINT2(9)/ -0.10908 20929 3 D -9/ DATA AAINT2(10)/-0.92963 3045 D -11/ DATA AAINT2(11)/-0.11094 6520 D -11/ DATA AAINT2(12)/-0.78164 83 D -13/ DATA AAINT2(13)/-0.13196 61 D -13/ DATA AAINT2(14)/-0.36823 D -15/ DATA AAINT2(15)/-0.21505 D -15/ DATA AAINT2(16)/ 0.1238 D -16/ DATA AAINT2(17)/-0.557 D -17/ DATA AAINT2(18)/ 0.84 D -18/ DATA AAINT2(19)/-0.21 D -18/ DATA AAINT2(20)/ 0.4 D -19/ DATA AAINT2(21)/-0.1 D -19/ DATA AAINT3(0)/ 0.47985 89326 47910 52053 D 0/ DATA AAINT3(1)/ -0.19272 37512 61696 08863 D 0/ DATA AAINT3(2)/ 0.20511 54129 52542 8189 D -1/ DATA AAINT3(3)/ 0.63320 00070 73248 8786 D -1/ DATA AAINT3(4)/ -0.50933 22261 84575 4082 D -1/ DATA AAINT3(5)/ 0.12844 24078 66166 3016 D -1/ DATA AAINT3(6)/ 0.27601 37088 98947 9413 D -1/ DATA AAINT3(7)/ -0.15470 66673 86664 9507 D -1/ DATA AAINT3(8)/ -0.14968 64655 38931 6026 D -1/ DATA AAINT3(9)/ 0.33661 76141 73574 541 D -2/ DATA AAINT3(10)/ 0.53085 11635 18892 985 D -2/ DATA AAINT3(11)/ 0.41371 22645 85550 81 D -3/ DATA AAINT3(12)/-0.10249 05799 26726 266 D -2/ DATA AAINT3(13)/-0.32508 22167 20258 53 D -3/ DATA AAINT3(14)/ 0.86086 60957 16921 3 D -4/ DATA AAINT3(15)/ 0.66713 67298 12077 5 D -4/ DATA AAINT3(16)/ 0.44920 59993 18095 D -5/ DATA AAINT3(17)/-0.67042 72309 58249 D -5/ DATA AAINT3(18)/-0.19663 65700 85009 D -5/ DATA AAINT3(19)/ 0.22229 67740 7226 D -6/ DATA AAINT3(20)/ 0.22332 22294 9137 D -6/ DATA AAINT3(21)/ 0.28033 13766 457 D -7/ DATA AAINT3(22)/-0.11556 51663 619 D -7/ DATA AAINT3(23)/-0.43306 98217 36 D -8/ DATA AAINT3(24)/-0.62277 77938 D -10/ DATA AAINT3(25)/ 0.26432 66490 3 D -9/ DATA AAINT3(26)/ 0.53338 81114 D -10/ DATA AAINT3(27)/-0.52295 7269 D -11/ DATA AAINT3(28)/-0.38222 9283 D -11/ DATA AAINT3(29)/-0.40958 233 D -12/ DATA AAINT3(30)/ 0.11515 622 D -12/ DATA AAINT3(31)/ 0.38757 66 D -13/ DATA AAINT3(32)/ 0.14028 3 D -14/ DATA AAINT3(33)/-0.14152 6 D -14/ DATA AAINT3(34)/-0.28746 D -15/ DATA AAINT3(35)/ 0.923 D -17/ DATA AAINT3(36)/ 0.1224 D -16/ DATA AAINT3(37)/ 0.157 D -17/ DATA AAINT3(38)/-0.19 D -18/ DATA AAINT3(39)/-0.8 D -19/ DATA AAINT3(40)/-0.1 D -19/ DATA AAINT4/1.99653 30582 85227 30048 D 0, 1 -0.18754 11776 05417 759 D -2, 2 -0.15377 53628 03057 50 D -3, 3 -0.12831 12967 68234 9 D -4, 4 -0.10812 84819 64162 D -5, 5 -0.91821 31174 057 D -7, 6 -0.78416 05909 60 D -8, 7 -0.67292 45387 8 D -9, 8 -0.57963 25198 D -10, 9 -0.50104 0991 D -11, X -0.43420 222 D -12, 1 -0.37743 05 D -13, 2 -0.32847 3 D -14, 3 -0.28700 D -15, 4 -0.2502 D -16, 5 -0.220 D -17, 6 -0.19 D -18, 7 -0.2 D -19/ DATA AAINT5/1.13024 60203 44657 16133 D 0, 1 -0.46471 80646 39872 334 D -2, 2 -0.35137 41338 26932 03 D -3, 3 -0.27681 17872 54518 5 D -4, 4 -0.22205 74525 58107 D -5, 5 -0.18089 14236 5974 D -6, 6 -0.14876 13383 373 D -7, 7 -0.12351 53881 68 D -8, 8 -0.10310 10425 7 D -9, 9 -0.86749 3013 D -11, X -0.73080 054 D -12, 1 -0.62235 61 D -13, 2 -0.52512 8 D -14, 3 -0.45677 D -15, 4 -0.3748 D -16, 5 -0.356 D -17, 6 -0.23 D -18, 7 -0.4 D -19/ DATA ZERO,ONE,TWO/ 0.0 D 0 , 1.0 D 0 , 2.0 D 0 / DATA THREE,FOUR,EIGHT/ 3.0 D 0 , 4.0 D 0 , 8.0 D 0 / DATA NINE,FORTY1,ONEHUN/ 9.0 D 0 , 41.0 D 0 , 100.0 D 0/ DATA NINHUN,FR996/ 900.0 D 0 , 4996.0 D 0 / DATA PIBY4/0.78539 81633 97448 30962 D 0/ DATA PITIM6/18.84955 59215 38759 43078 D 0/ DATA RT2B3P/0.46065 88659 61780 63902 D 0/ DATA AIRZER/0.35502 80538 87817 23926 D 0/ C C Machine-dependant constants (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3,NTERM4,NTERM5/22,17,37,15,15/ DATA XLOW1,XHIGH1,XNEG1/2.22045D-16,14.480884D0,-2.727134D10/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. XNEG1 ) THEN CALL ERRPRN(FNNAME,ERRMSG) AIRINT = -TWO / THREE RETURN ENDIF C C Code for x >= 0 C IF ( X .GE. ZERO ) THEN IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW1 ) THEN AIRINT = AIRZER * X ELSE T = X / TWO - ONE AIRINT = CHEVAL(NTERM1,AAINT1,T) * X ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN TEMP = ZERO ELSE Z = ( X + X ) * SQRT(X) / THREE TEMP = THREE * Z T = ( FORTY1 - TEMP ) / ( NINE + TEMP ) TEMP = EXP(-Z) * CHEVAL(NTERM2,AAINT2,T) / SQRT(PITIM6*Z) ENDIF AIRINT = ONE / THREE - TEMP ENDIF ELSE C C Code for x < 0 C IF ( X .GE. -EIGHT ) THEN IF ( X .GT. -XLOW1 ) THEN AIRINT = AIRZER * X ELSE T = -X / FOUR - ONE AIRINT = X * CHEVAL(NTERM3,AAINT3,T) ENDIF ELSE Z = - ( X + X ) * SQRT(-X) / THREE ARG = Z + PIBY4 TEMP = NINE * Z * Z T = ( FR996 - TEMP ) / ( NINHUN + TEMP) GVAL = CHEVAL(NTERM4,AAINT4,T) HVAL = CHEVAL(NTERM5,AAINT5,T) TEMP = GVAL * COS(ARG) + HVAL * SIN(ARG) / Z AIRINT = RT2B3P * TEMP / SQRT(Z) - TWO / THREE ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION AIRYGI(XVALUE) C C DESCRIPTION: C C This subroutine computes the modified Airy function Gi(x), C defined as C C AIRYGI(x) = [ Integral{0 to infinity} sin(x*t+t^3/3) dt ] / pi C C The approximation uses Chebyshev expansions with the coefficients C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If x < -XHIGH1*XHIGH1 (see below for definition of XHIGH1), then C the trig. functions needed for the asymptotic expansion of Bi(x) C cannot be computed to any accuracy. An error message is printed C and the code returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C ARGIP1. The recommended value is such that C ABS(ARGIP1(NTERM1)) < EPS/100 C subject to 1 <= NTERM1 <= 30. C C NTERM2 - INTEGER - The no. of terms to be used from the array C ARGIP2. The recommended value is such that C ABS(ARGIP2(NTERM2)) < EPS/100 C subject to 1 <= NTERM2 <= 29. C C NTERM3 - INTEGER - The no. of terms to be used from the array C ARGIN1. The recommended value is such that C ABS(ARGIN1(NTERM3)) < EPS/100 C subject to 1 <= NTERM3 <= 42. C C NTERM4 - INTEGER - The no. of terms to be used from the array C ARBIN1. The recommended value is such that C ABS(ARBIN1(NTERM4)) < EPS/100 C subject to 1 <= NTERM4 <= 10. C C NTERM5 - INTEGER - The no. of terms to be used from the array C ARBIN2. The recommended value is such that C ABS(ARBIN2(NTERM5)) < EPS/100 C subject to 1 <= NTERM5 <= 11. C C NTERM6 - INTEGER - The no. of terms to be used from the array C ARGH2. The recommended value is such that C ABS(ARHIN1(NTERM6)) < EPS/100 C subject to 1 <= NTERM6 <= 15. C C XLOW1 - DOUBLE PRECISION - The value such that, if -XLOW1 < x < XLOW1, C then AIRYGI = Gi(0) to machine precision. C The recommended value is EPS. C C XHIGH1 - DOUBLE PRECISION - The value such that, if x > XHIGH1, then C AIRYGI = 1/(Pi*x) to machine precision. C Also used for error test - see above. C The recommended value is C cube root( 2/EPS ). C C XHIGH2 - DOUBLE PRECISION - The value above which AIRYGI = 0.0. C The recommended value is C 1/(Pi*XMIN). C C XHIGH3 - DOUBLE PRECISION - The value such that, if x < XHIGH3, C then the Chebyshev expansions for the C asymptotic form of Bi(x) are not needed. C The recommended value is C -8 * cube root( 2/EPSNEG ). C C For values of EPS, EPSNEG, and XMIN refer to the file C MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C COS , SIN , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. Macleod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND. C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST UPDATE: C 22 NOVEMBER, 1995. C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5,NTERM6 DOUBLE PRECISION ARGIP1(0:30),ARGIP2(0:29),ARGIN1(0:42), 1 ARBIN1(0:10),ARBIN2(0:11),ARHIN1(0:15), 2 BI,CHEB1,CHEB2,CHEVAL,COSZ,FIVE,FIVE14,FOUR, 3 GIZERO,MINATE,NINE,ONE,ONEBPI,ONEHUN,ONE76,ONE024,PIBY4, 4 RTPIIN,SEVEN,SEVEN2,SINZ,T,TEMP,THREE,TWELHU,TWENT8, 5 X,XCUBE,XHIGH1,XHIGH2,XHIGH3,XLOW1,XMINUS, 6 XVALUE,ZERO,ZETA CHARACTER FNNAME*6,ERRMSG*46 DATA FNNAME/'AIRYGI'/ DATA ERRMSG/'ARGUMENT TOO NEGATIVE FOR ACCURATE COMPUTATION'/ DATA ARGIP1(0)/ 0.26585 77079 50227 45082 D 0/ DATA ARGIP1(1)/ -0.10500 33309 75019 22907 D 0/ DATA ARGIP1(2)/ 0.84134 74753 28454 492 D -2/ DATA ARGIP1(3)/ 0.20210 67387 81343 9541 D -1/ DATA ARGIP1(4)/ -0.15595 76113 86355 2234 D -1/ DATA ARGIP1(5)/ 0.56434 29390 43256 481 D -2/ DATA ARGIP1(6)/ -0.59776 84482 66558 09 D -3/ DATA ARGIP1(7)/ -0.42833 85026 48677 28 D -3/ DATA ARGIP1(8)/ 0.22605 66238 09090 27 D -3/ DATA ARGIP1(9)/ -0.36083 32945 59226 0 D -4/ DATA ARGIP1(10)/-0.78551 89887 88901 D -5/ DATA ARGIP1(11)/ 0.47325 24807 46370 D -5/ DATA ARGIP1(12)/-0.59743 51397 7694 D -6/ DATA ARGIP1(13)/-0.15917 60916 5602 D -6/ DATA ARGIP1(14)/ 0.63361 29065 570 D -7/ DATA ARGIP1(15)/-0.27609 02326 48 D -8/ DATA ARGIP1(16)/-0.25606 41540 85 D -8/ DATA ARGIP1(17)/ 0.47798 67685 6 D -9/ DATA ARGIP1(18)/ 0.44881 31863 D -10/ DATA ARGIP1(19)/-0.23465 08882 D -10/ DATA ARGIP1(20)/ 0.76839 085 D -12/ DATA ARGIP1(21)/ 0.73227 985 D -12/ DATA ARGIP1(22)/-0.85136 87 D -13/ DATA ARGIP1(23)/-0.16302 01 D -13/ DATA ARGIP1(24)/ 0.35676 9 D -14/ DATA ARGIP1(25)/ 0.25001 D -15/ DATA ARGIP1(26)/-0.10859 D -15/ DATA ARGIP1(27)/-0.158 D -17/ DATA ARGIP1(28)/ 0.275 D -17/ DATA ARGIP1(29)/-0.5 D -19/ DATA ARGIP1(30)/-0.6 D -19/ DATA ARGIP2(0)/ 2.00473 71227 58014 86391 D 0/ DATA ARGIP2(1)/ 0.29418 41393 64406 724 D -2/ DATA ARGIP2(2)/ 0.71369 24900 63401 67 D -3/ DATA ARGIP2(3)/ 0.17526 56343 05022 67 D -3/ DATA ARGIP2(4)/ 0.43591 82094 02988 2 D -4/ DATA ARGIP2(5)/ 0.10926 26947 60430 7 D -4/ DATA ARGIP2(6)/ 0.27238 24183 99029 D -5/ DATA ARGIP2(7)/ 0.66230 90094 7687 D -6/ DATA ARGIP2(8)/ 0.15425 32337 0315 D -6/ DATA ARGIP2(9)/ 0.34184 65242 306 D -7/ DATA ARGIP2(10)/ 0.72815 77248 94 D -8/ DATA ARGIP2(11)/ 0.15158 85254 52 D -8/ DATA ARGIP2(12)/ 0.30940 04803 9 D -9/ DATA ARGIP2(13)/ 0.61496 72614 D -10/ DATA ARGIP2(14)/ 0.12028 77045 D -10/ DATA ARGIP2(15)/ 0.23369 0586 D -11/ DATA ARGIP2(16)/ 0.43778 068 D -12/ DATA ARGIP2(17)/ 0.79964 47 D -13/ DATA ARGIP2(18)/ 0.14940 75 D -13/ DATA ARGIP2(19)/ 0.24679 0 D -14/ DATA ARGIP2(20)/ 0.37672 D -15/ DATA ARGIP2(21)/ 0.7701 D -16/ DATA ARGIP2(22)/ 0.354 D -17/ DATA ARGIP2(23)/-0.49 D -18/ DATA ARGIP2(24)/ 0.62 D -18/ DATA ARGIP2(25)/-0.40 D -18/ DATA ARGIP2(26)/-0.1 D -19/ DATA ARGIP2(27)/ 0.2 D -19/ DATA ARGIP2(28)/-0.3 D -19/ DATA ARGIP2(29)/ 0.1 D -19/ DATA ARGIN1(0)/ -0.20118 96505 67320 89130 D 0/ DATA ARGIN1(1)/ -0.72441 75303 32453 0499 D -1/ DATA ARGIN1(2)/ 0.45050 18923 89478 0120 D -1/ DATA ARGIN1(3)/ -0.24221 37112 20787 91099 D 0/ DATA ARGIN1(4)/ 0.27178 84964 36167 8294 D -1/ DATA ARGIN1(5)/ -0.57293 21004 81817 9697 D -1/ DATA ARGIN1(6)/ -0.18382 10786 03377 63587 D 0/ DATA ARGIN1(7)/ 0.77515 46082 14947 5511 D -1/ DATA ARGIN1(8)/ 0.18386 56473 39275 60387 D 0/ DATA ARGIN1(9)/ 0.29215 04250 18556 7173 D -1/ DATA ARGIN1(10)/-0.61422 94846 78801 8811 D -1/ DATA ARGIN1(11)/-0.29993 12505 79461 6238 D -1/ DATA ARGIN1(12)/ 0.58593 71183 27706 636 D -2/ DATA ARGIN1(13)/ 0.82222 16584 97402 529 D -2/ DATA ARGIN1(14)/ 0.13257 98171 66846 893 D -2/ DATA ARGIN1(15)/-0.96248 31076 65651 26 D -3/ DATA ARGIN1(16)/-0.45065 51599 82118 07 D -3/ DATA ARGIN1(17)/ 0.77242 34743 25474 D -5/ DATA ARGIN1(18)/ 0.54818 74134 75805 2 D -4/ DATA ARGIN1(19)/ 0.12458 98039 74287 6 D -4/ DATA ARGIN1(20)/-0.24619 68910 92083 D -5/ DATA ARGIN1(21)/-0.16915 41835 45285 D -5/ DATA ARGIN1(22)/-0.16769 15316 9442 D -6/ DATA ARGIN1(23)/ 0.96365 09337 672 D -7/ DATA ARGIN1(24)/ 0.32533 14928 030 D -7/ DATA ARGIN1(25)/ 0.50918 04231 D -10/ DATA ARGIN1(26)/-0.20918 04535 53 D -8/ DATA ARGIN1(27)/-0.41237 38787 0 D -9/ DATA ARGIN1(28)/ 0.41633 38253 D -10/ DATA ARGIN1(29)/ 0.30325 32117 D -10/ DATA ARGIN1(30)/ 0.34058 0529 D -11/ DATA ARGIN1(31)/-0.88444 592 D -12/ DATA ARGIN1(32)/-0.31639 612 D -12/ DATA ARGIN1(33)/-0.15050 76 D -13/ DATA ARGIN1(34)/ 0.11041 48 D -13/ DATA ARGIN1(35)/ 0.24650 8 D -14/ DATA ARGIN1(36)/-0.3107 D -16/ DATA ARGIN1(37)/-0.9851 D -16/ DATA ARGIN1(38)/-0.1453 D -16/ DATA ARGIN1(39)/ 0.118 D -17/ DATA ARGIN1(40)/ 0.67 D -18/ DATA ARGIN1(41)/ 0.6 D -19/ DATA ARGIN1(42)/-0.1 D -19/ DATA ARBIN1/1.99983 76358 35861 55980 D 0, 1 -0.81046 60923 66941 8 D -4, 2 0.13475 66598 4689 D -6, 3 -0.70855 84714 3 D -9, 4 0.74818 4187 D -11, 5 -0.12902 774 D -12, 6 0.32250 4 D -14, 7 -0.10809 D -15, 8 0.460 D -17, 9 -0.24 D -18, X 0.1 D -19/ DATA ARBIN2/0.13872 35645 38791 20276 D 0, 1 -0.82392 86225 55822 8 D -4, 2 0.26720 91950 9866 D -6, 3 -0.20742 36853 68 D -8, 4 0.28733 92593 D -10, 5 -0.60873 521 D -12, 6 0.17924 89 D -13, 7 -0.68760 D -15, 8 0.3280 D -16, 9 -0.188 D -17, X 0.13 D -18, 1 -0.1 D -19/ DATA ARHIN1/1.99647 72039 97796 50525 D 0, 1 -0.18756 37794 07173 213 D -2, 2 -0.12186 47089 77873 39 D -3, 3 -0.81402 16096 59287 D -5, 4 -0.55050 92595 3537 D -6, 5 -0.37630 08043 303 D -7, 6 -0.25885 83623 65 D -8, 7 -0.17931 82926 5 D -9, 8 -0.12459 16873 D -10, 9 -0.87171 247 D -12, X -0.60849 43 D -13, 1 -0.43117 8 D -14, 2 -0.29787 D -15, 3 -0.2210 D -16, 4 -0.136 D -17, 5 -0.14 D -18/ DATA ZERO,ONE,THREE,FOUR/ 0.0 D 0 , 1.0 D 0 , 3.0 D 0 , 4.0 D 0 / DATA FIVE,SEVEN,MINATE/ 5.0 D 0 , 7.0 D 0 , -8.0 D 0 / DATA NINE,TWENT8,SEVEN2/ 9.0 D 0 , 28.0 D 0 , 72.0 D 0 / DATA ONEHUN,ONE76,FIVE14/ 100.0 D 0 , 176.0 D 0 , 514.0 D 0 / DATA ONE024,TWELHU/ 1024.0 D 0 , 1200.0 D 0 / DATA GIZERO/0.20497 55424 82000 24505 D 0/ DATA ONEBPI/0.31830 98861 83790 67154 D 0/ DATA PIBY4/0.78539 81633 97448 30962 D 0/ DATA RTPIIN/0.56418 95835 47756 28695 D 0/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3/28,23,39/ DATA NTERM4,NTERM5,NTERM6/9,10,14/ DATA XLOW1,XHIGH1/2.22045D-16,208063.8307D0/ DATA XHIGH2,XHIGH3/0.14274D308,-2097152.0D0/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. -XHIGH1*XHIGH1 ) THEN CALL ERRPRN(FNNAME,ERRMSG) AIRYGI = ZERO RETURN ENDIF C C Code for x >= 0.0 C IF ( X .GE. ZERO ) THEN IF ( X .LE. SEVEN ) THEN IF ( X .LT. XLOW1 ) THEN AIRYGI = GIZERO ELSE T = ( NINE * X - TWENT8 ) / ( X + TWENT8 ) AIRYGI = CHEVAL ( NTERM1 , ARGIP1 , T ) ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN IF ( X .GT. XHIGH2 ) THEN AIRYGI = ZERO ELSE AIRYGI = ONEBPI/X ENDIF ELSE XCUBE = X * X * X T = ( TWELHU - XCUBE ) / ( FIVE14 + XCUBE ) AIRYGI = ONEBPI * CHEVAL(NTERM2,ARGIP2,T) / X ENDIF ENDIF ELSE C C Code for x < 0.0 C IF ( X .GE. MINATE ) THEN IF ( X .GT. -XLOW1 ) THEN AIRYGI = GIZERO ELSE T = -( X + FOUR ) / FOUR AIRYGI = CHEVAL(NTERM3,ARGIN1,T) ENDIF ELSE XMINUS = -X T = XMINUS * SQRT(XMINUS) ZETA = ( T + T ) / THREE TEMP = RTPIIN / SQRT(SQRT(XMINUS)) COSZ = COS ( ZETA + PIBY4 ) SINZ = SIN ( ZETA + PIBY4 ) / ZETA XCUBE = X * X * X IF ( X .GT. XHIGH3 ) THEN T = - ( ONE024 / ( XCUBE ) + ONE ) CHEB1 = CHEVAL(NTERM4,ARBIN1,T) CHEB2 = CHEVAL(NTERM5,ARBIN2,T) BI = ( COSZ * CHEB1 + SINZ * CHEB2 ) * TEMP ELSE BI = ( COSZ + SINZ * FIVE / SEVEN2 ) * TEMP ENDIF T = ( XCUBE + TWELHU ) / ( ONE76 - XCUBE ) AIRYGI = BI + CHEVAL(NTERM6,ARHIN1,T) * ONEBPI / X ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION AIRYHI(XVALUE) C C DESCRIPTION: C C This subroutine computes the modified Airy function Hi(x), C defined as C C AIRYHI(x) = [ Integral{0 to infinity} exp(x*t-t^3/3) dt ] / pi C C The approximation uses Chebyshev expansions with the coefficients C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If x > XHIGH1 (see below for definition of XHIGH1), then C the asymptotic expansion of Hi(x) will cause an overflow. C An error message is printed and the code returns the largest C floating-pt number as the result. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C ARHIP. The recommended value is such that C ABS(ARHIP(NTERM1)) < EPS/100 C subject to 1 <= NTERM1 <= 31. C C NTERM2 - INTEGER - The no. of terms to be used from the array C ARBIP. The recommended value is such that C ABS(ARBIP(NTERM2)) < EPS/100 C subject to 1 <= NTERM2 <= 23. C C NTERM3 - INTEGER - The no. of terms to be used from the array C ARGIP. The recommended value is such that C ABS(ARGIP1(NTERM3)) < EPS/100 C subject to 1 <= NTERM3 <= 29. C C NTERM4 - INTEGER - The no. of terms to be used from the array C ARHIN1. The recommended value is such that C ABS(ARHIN1(NTERM4)) < EPS/100 C subject to 1 <= NTERM4 <= 21. C C NTERM5 - INTEGER - The no. of terms to be used from the array C ARHIN2. The recommended value is such that C ABS(ARHIN2(NTERM5)) < EPS/100 C subject to 1 <= NTERM5 <= 15. C C XLOW1 - DOUBLE PRECISION - The value such that, if -XLOW1 < x < XLOW1, C then AIRYGI = Hi(0) to machine precision. C The recommended value is EPS. C C XHIGH1 - DOUBLE PRECISION - The value such that, if x > XHIGH1, then C overflow might occur. The recommended value is C computed as follows: C compute Z = 1.5*LOG(XMAX) C XHIGH1 = ( Z + LOG(Z)/4 + LOG(PI)/2 )**(2/3) C C XNEG1 - DOUBLE PRECISION - The value below which AIRYHI = 0.0. C The recommended value is C -1/(Pi*XMIN). C C XNEG2 - DOUBLE PRECISION - The value such that, if x < XNEG2, then C AIRYHI = -1/(Pi*x) to machine precision. C The recommended value is C -cube root( 2/EPS ). C C XMAX - DOUBLE PRECISION - The largest possible floating-pt. number. C This is the value given to the function C if x > XHIGH1. C C For values of EPS, EPSNEG, XMIN and XMAX refer to the file C MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C EXP , LOG , SQRT C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. Macleod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND. C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST UPDATE: C 23 NOVEMBER, 1995. C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5 DOUBLE PRECISION ARHIP(0:31),ARBIP(0:23),ARGIP1(0:29), 1 ARHIN1(0:21),ARHIN2(0:15), 2 BI,CHEVAL,FIVE14,FOUR,GI,HIZERO,LNRTPI, 3 MINATE,ONE,ONEBPI,ONEHUN,ONE76,SEVEN,T,TEMP, 4 THREE,THRE43,TWELHU,TWELVE,TWO,X,XCUBE, 5 XHIGH1,XLOW1,XMAX,XNEG1,XNEG2,XVALUE, 6 ZERO,ZETA CHARACTER FNNAME*6,ERRMSG*30 DATA FNNAME/'AIRYHI'/ DATA ERRMSG/'ARGUMENT TO FUNCTION TOO LARGE'/ DATA ARHIP(0)/ 1.24013 56256 17628 31114 D 0/ DATA ARHIP(1)/ 0.64856 34197 39265 35804 D 0/ DATA ARHIP(2)/ 0.55236 25259 21149 03246 D 0/ DATA ARHIP(3)/ 0.20975 12207 38575 66794 D 0/ DATA ARHIP(4)/ 0.12025 66911 80523 73568 D 0/ DATA ARHIP(5)/ 0.37682 24931 09539 3785 D -1/ DATA ARHIP(6)/ 0.16510 88671 54807 1651 D -1/ DATA ARHIP(7)/ 0.45592 27552 11570 993 D -2/ DATA ARHIP(8)/ 0.16182 84804 77635 013 D -2/ DATA ARHIP(9)/ 0.40841 28250 81266 63 D -3/ DATA ARHIP(10)/0.12196 47972 13940 51 D -3/ DATA ARHIP(11)/0.28650 64098 65761 0 D -4/ DATA ARHIP(12)/0.74222 15564 24344 D -5/ DATA ARHIP(13)/0.16353 62319 32831 D -5/ DATA ARHIP(14)/0.37713 90818 8749 D -6/ DATA ARHIP(15)/0.78158 00336 008 D -7/ DATA ARHIP(16)/0.16384 47121 370 D -7/ DATA ARHIP(17)/0.31985 76659 92 D -8/ DATA ARHIP(18)/0.61933 90530 7 D -9/ DATA ARHIP(19)/0.11411 16119 1 D -9/ DATA ARHIP(20)/0.20649 23454 D -10/ DATA ARHIP(21)/0.36001 8664 D -11/ DATA ARHIP(22)/0.61401 849 D -12/ DATA ARHIP(23)/0.10162 125 D -12/ DATA ARHIP(24)/0.16437 01 D -13/ DATA ARHIP(25)/0.25908 4 D -14/ DATA ARHIP(26)/0.39931 D -15/ DATA ARHIP(27)/0.6014 D -16/ DATA ARHIP(28)/0.886 D -17/ DATA ARHIP(29)/0.128 D -17/ DATA ARHIP(30)/0.18 D -18/ DATA ARHIP(31)/0.3 D -19/ DATA ARBIP(0)/ 2.00582 13820 97590 64905 D 0/ DATA ARBIP(1)/ 0.29447 84491 70441 549 D -2/ DATA ARBIP(2)/ 0.34897 54514 77535 5 D -4/ DATA ARBIP(3)/ 0.83389 73337 4343 D -6/ DATA ARBIP(4)/ 0.31362 15471 813 D -7/ DATA ARBIP(5)/ 0.16786 53060 15 D -8/ DATA ARBIP(6)/ 0.12217 93405 9 D -9/ DATA ARBIP(7)/ 0.11915 84139 D -10/ DATA ARBIP(8)/ 0.15414 2553 D -11/ DATA ARBIP(9)/ 0.24844 455 D -12/ DATA ARBIP(10)/ 0.42130 12 D -13/ DATA ARBIP(11)/ 0.50529 3 D -14/ DATA ARBIP(12)/-0.60032 D -15/ DATA ARBIP(13)/-0.65474 D -15/ DATA ARBIP(14)/-0.22364 D -15/ DATA ARBIP(15)/-0.3015 D -16/ DATA ARBIP(16)/ 0.959 D -17/ DATA ARBIP(17)/ 0.616 D -17/ DATA ARBIP(18)/ 0.97 D -18/ DATA ARBIP(19)/-0.37 D -18/ DATA ARBIP(20)/-0.21 D -18/ DATA ARBIP(21)/-0.1 D -19/ DATA ARBIP(22)/ 0.2 D -19/ DATA ARBIP(23)/ 0.1 D -19/ DATA ARGIP1(0)/ 2.00473 71227 58014 86391 D 0/ DATA ARGIP1(1)/ 0.29418 41393 64406 724 D -2/ DATA ARGIP1(2)/ 0.71369 24900 63401 67 D -3/ DATA ARGIP1(3)/ 0.17526 56343 05022 67 D -3/ DATA ARGIP1(4)/ 0.43591 82094 02988 2 D -4/ DATA ARGIP1(5)/ 0.10926 26947 60430 7 D -4/ DATA ARGIP1(6)/ 0.27238 24183 99029 D -5/ DATA ARGIP1(7)/ 0.66230 90094 7687 D -6/ DATA ARGIP1(8)/ 0.15425 32337 0315 D -6/ DATA ARGIP1(9)/ 0.34184 65242 306 D -7/ DATA ARGIP1(10)/ 0.72815 77248 94 D -8/ DATA ARGIP1(11)/ 0.15158 85254 52 D -8/ DATA ARGIP1(12)/ 0.30940 04803 9 D -9/ DATA ARGIP1(13)/ 0.61496 72614 D -10/ DATA ARGIP1(14)/ 0.12028 77045 D -10/ DATA ARGIP1(15)/ 0.23369 0586 D -11/ DATA ARGIP1(16)/ 0.43778 068 D -12/ DATA ARGIP1(17)/ 0.79964 47 D -13/ DATA ARGIP1(18)/ 0.14940 75 D -13/ DATA ARGIP1(19)/ 0.24679 0 D -14/ DATA ARGIP1(20)/ 0.37672 D -15/ DATA ARGIP1(21)/ 0.7701 D -16/ DATA ARGIP1(22)/ 0.354 D -17/ DATA ARGIP1(23)/-0.49 D -18/ DATA ARGIP1(24)/ 0.62 D -18/ DATA ARGIP1(25)/-0.40 D -18/ DATA ARGIP1(26)/-0.1 D -19/ DATA ARGIP1(27)/ 0.2 D -19/ DATA ARGIP1(28)/-0.3 D -19/ DATA ARGIP1(29)/ 0.1 D -19/ DATA ARHIN1(0)/ 0.31481 01720 64234 04116 D 0/ DATA ARHIN1(1)/ -0.16414 49921 65889 64341 D 0/ DATA ARHIN1(2)/ 0.61766 51597 73091 3071 D -1/ DATA ARHIN1(3)/ -0.19718 81185 93593 3028 D -1/ DATA ARHIN1(4)/ 0.53690 28300 23331 343 D -2/ DATA ARHIN1(5)/ -0.12497 70684 39663 038 D -2/ DATA ARHIN1(6)/ 0.24835 51559 69949 33 D -3/ DATA ARHIN1(7)/ -0.41870 24096 74663 0 D -4/ DATA ARHIN1(8)/ 0.59094 54379 79124 D -5/ DATA ARHIN1(9)/ -0.68063 54118 4345 D -6/ DATA ARHIN1(10)/ 0.60728 97629 164 D -7/ DATA ARHIN1(11)/-0.36713 03492 42 D -8/ DATA ARHIN1(12)/ 0.70780 17552 D -10/ DATA ARHIN1(13)/ 0.11878 94334 D -10/ DATA ARHIN1(14)/-0.12089 8723 D -11/ DATA ARHIN1(15)/ 0.11896 56 D -13/ DATA ARHIN1(16)/ 0.59412 8 D -14/ DATA ARHIN1(17)/-0.32257 D -15/ DATA ARHIN1(18)/-0.2290 D -16/ DATA ARHIN1(19)/ 0.253 D -17/ DATA ARHIN1(20)/ 0.9 D -19/ DATA ARHIN1(21)/-0.2 D -19/ DATA ARHIN2/1.99647 72039 97796 50525 D 0, 1 -0.18756 37794 07173 213 D -2, 2 -0.12186 47089 77873 39 D -3, 3 -0.81402 16096 59287 D -5, 4 -0.55050 92595 3537 D -6, 5 -0.37630 08043 303 D -7, 6 -0.25885 83623 65 D -8, 7 -0.17931 82926 5 D -9, 8 -0.12459 16873 D -10, 9 -0.87171 247 D -12, X -0.60849 43 D -13, 1 -0.43117 8 D -14, 2 -0.29787 D -15, 3 -0.2210 D -16, 4 -0.136 D -17, 5 -0.14 D -18/ DATA ZERO,ONE,TWO/ 0.0 D 0 , 1.0 D 0 , 2.0 D 0/ DATA THREE,FOUR,SEVEN/ 3.0 D 0 , 4.0 D 0 , 7.0 D 0 / DATA MINATE,TWELVE,ONE76/ -8.0 D 0 , 12.0 D 0 , 176.0 D 0 / DATA THRE43,FIVE14,TWELHU/ 343.0 D 0 , 514.0 D 0 , 1200.0 D 0 / DATA ONEHUN/100.0 D 0/ DATA HIZERO/0.40995 10849 64000 49010 D 0/ DATA LNRTPI/0.57236 49429 24700 08707 D 0/ DATA ONEBPI/0.31830 98861 83790 67154 D 0/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3,NTERM4,NTERM5/29,17,22,19,14/ DATA XLOW1,XHIGH1/2.220446D-16,104.4175D0/ DATA XNEG1,XNEG2,XMAX/-0.14274D308,-208063.831D0,1.79D308/ C C Start computation C X = XVALUE C C Error test C IF ( X .GT. XHIGH1 ) THEN CALL ERRPRN(FNNAME,ERRMSG) AIRYHI = XMAX RETURN ENDIF C C Code for x >= 0.0 C IF ( X .GE. ZERO ) THEN IF ( X .LE. SEVEN ) THEN IF ( X .LT. XLOW1 ) THEN AIRYHI = HIZERO ELSE T = ( X + X ) / SEVEN - ONE TEMP = ( X + X + X ) / TWO AIRYHI = EXP(TEMP) * CHEVAL(NTERM1,ARHIP,T) ENDIF ELSE XCUBE = X * X * X TEMP = SQRT(XCUBE) ZETA = ( TEMP + TEMP ) / THREE T = TWO * ( SQRT(THRE43/XCUBE) ) - ONE TEMP = CHEVAL(NTERM2,ARBIP,T) TEMP = ZETA + LOG(TEMP) - LOG(X) / FOUR - LNRTPI BI = EXP(TEMP) T = ( TWELHU - XCUBE ) / ( XCUBE + FIVE14 ) GI = CHEVAL(NTERM3,ARGIP1,T) * ONEBPI / X AIRYHI = BI - GI ENDIF ELSE C C Code for x < 0.0 C IF ( X .GE. MINATE ) THEN IF ( X .GT. -XLOW1 ) THEN AIRYHI = HIZERO ELSE T = ( FOUR * X + TWELVE ) / ( X - TWELVE ) AIRYHI = CHEVAL(NTERM4,ARHIN1,T) ENDIF ELSE IF ( X .LT. XNEG1 ) THEN AIRYHI = ZERO ELSE IF ( X .LT. XNEG2 ) THEN TEMP = ONE ELSE XCUBE = X * X * X T = ( XCUBE + TWELHU ) / ( ONE76 - XCUBE ) TEMP = CHEVAL(NTERM5,ARHIN2,T) ENDIF AIRYHI = - TEMP * ONEBPI / X ENDIF ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION ATNINT(XVALUE) C C DESCRIPTION: C C The function ATNINT calculates the value of the C inverse-tangent integral defined by C C ATNINT(x) = integral 0 to x ( (arctan t)/t ) dt C C The approximation uses Chebyshev series with the coefficients C given to an accuracy of 20D. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C There are no error returns from this program. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The no. of terms of the array ATNINTT. C The recommended value is such that C ATNINA(NTERMS) < EPS/100 C C XLOW - DOUBLE PRECISION - A bound below which ATNINT(x) = x to machine C precision. The recommended value is C sqrt(EPSNEG/2). C C XUPPER - DOUBLE PRECISION - A bound on x, above which, to machine precision C ATNINT(x) = (pi/2)ln x C The recommended value is 1/EPS. C C For values of EPSNEG and EPS for various machine/compiler C combinations refer to the text file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C ABS , LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C PAISLEY C SCOTLAND C C (e-mail macl_ms0@paisley.ac.uk ) C C C LATEST MODIFICATION: 23 NOVEMBER , 1995 C C C INTEGER IND,NTERMS DOUBLE PRECISION ATNINA(0:22),CHEVAL,HALF,ONE,ONEHUN,T,TWOBPI, & X,XLOW,XUPPER,XVALUE,ZERO DATA ZERO,HALF,ONE/0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA ONEHUN/100.0 D 0/ DATA TWOBPI/0.63661 97723 67581 34308 D 0/ DATA ATNINA(0)/ 1.91040 36129 62359 37512 D 0/ DATA ATNINA(1)/ -0.41763 51437 65674 6940 D -1/ DATA ATNINA(2)/ 0.27539 25507 86367 434 D -2/ DATA ATNINA(3)/ -0.25051 80952 62488 81 D -3/ DATA ATNINA(4)/ 0.26669 81285 12117 1 D -4/ DATA ATNINA(5)/ -0.31189 05141 07001 D -5/ DATA ATNINA(6)/ 0.38833 85313 2249 D -6/ DATA ATNINA(7)/ -0.50572 74584 964 D -7/ DATA ATNINA(8)/ 0.68122 52829 49 D -8/ DATA ATNINA(9)/ -0.94212 56165 4 D -9/ DATA ATNINA(10)/ 0.13307 87881 6 D -9/ DATA ATNINA(11)/-0.19126 78075 D -10/ DATA ATNINA(12)/ 0.27891 2620 D -11/ DATA ATNINA(13)/-0.41174 820 D -12/ DATA ATNINA(14)/ 0.61429 87 D -13/ DATA ATNINA(15)/-0.92492 9 D -14/ DATA ATNINA(16)/ 0.14038 7 D -14/ DATA ATNINA(17)/-0.21460 D -15/ DATA ATNINA(18)/ 0.3301 D -16/ DATA ATNINA(19)/-0.511 D -17/ DATA ATNINA(20)/ 0.79 D -18/ DATA ATNINA(21)/-0.12 D -18/ DATA ATNINA(22)/ 0.2 D -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERMS/19/ DATA XLOW,XUPPER/7.4505806D-9,4.5036D15/ C C Start calculation C IND = 1 X = XVALUE IF ( X .LT. ZERO ) THEN X = -X IND = -1 ENDIF C C Code for X < = 1.0 C IF ( X .LE. ONE ) THEN IF ( X .LT. XLOW ) THEN ATNINT = X ELSE T = X * X T = ( T - HALF ) + ( T - HALF ) ATNINT = X * CHEVAL( NTERMS , ATNINA , T ) ENDIF ELSE C C Code for X > 1.0 C IF ( X .GT. XUPPER ) THEN ATNINT = LOG( X ) / TWOBPI ELSE T = ONE / ( X * X ) T = ( T - HALF ) + ( T - HALF ) ATNINT = LOG( X ) / TWOBPI + CHEVAL( NTERMS,ATNINA,T ) / X ENDIF ENDIF IF ( IND .LT. 0 ) ATNINT = - ATNINT RETURN END DOUBLE PRECISION FUNCTION BIRINT(XVALUE) C C DESCRIPTION: C This function calculates the integral of the Airy function Bi, defined C C BIRINT(x) = integral{0 to x} Bi(t) dt C C The program uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If the function is too large and positive the correct C value would overflow. An error message is printed and the C program returns the value XMAX. C C If the argument is too large and negative, it is impossible C to accurately compute the necessary SIN and COS functions, C for the asymptotic expansion. C An error message is printed, and the program returns the C value 0 (the value at -infinity). C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C ABINT1. The recommended value is such that C ABS(ABINT1(NTERM1)) < EPS/100, C subject to 1 <= NTERM1 <= 36. C C NTERM2 - INTEGER - The no. of terms to be used from the array C ABINT2. The recommended value is such that C ABS(ABINT2(NTERM2)) < EPS/100, C subject to 1 <= NTERM2 <= 37. C C NTERM3 - INTEGER - The no. of terms to be used from the array C ABINT3. The recommended value is such that C ABS(ABINT3(NTERM3)) < EPS/100, C subject to 1 <= NTERM3 <= 37. C C NTERM4 - INTEGER - The no. of terms to be used from the array C ABINT4. The recommended value is such that C ABS(ABINT4(NTERM4)) < EPS/100, C subject to 1 <= NTERM4 <= 20. C C NTERM5 - INTEGER - The no. of terms to be used from the array C ABINT5. The recommended value is such that C ABS(ABINT5(NTERM5)) < EPS/100, C subject to 1 <= NTERM5 <= 20. C C XLOW1 - DOUBLE PRECISION - The value such that, if |x| < XLOW1, C BIRINT(x) = x * Bi(0) C to machine precision. The recommended value is C 2 * EPSNEG. C C XHIGH1 - DOUBLE PRECISION - The value such that, if x > XHIGH1, C the function value would overflow. C The recommended value is computed as C z = ln(XMAX) + 0.5ln(ln(XMAX)), C XHIGH1 = (3z/2)^(2/3) C C XNEG1 - DOUBLE PRECISION - The value such that, if x < XNEG1, C the trigonometric functions in the asymptotic C expansion cannot be calculated accurately. C The recommended value is C -(1/((EPS)**2/3)) C C XMAX - DOUBLE PRECISION - The value of the largest positive floating-pt C number. Used in giving a value to the function C if x > XHIGH1. C C For values of EPS, EPSNEG, and XMAX see the file MACHCON.TXT. C C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C COS, EXP, LOG, SIN, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C Univ. of Paisley, C High St., C Paisley, C SCOTLAND. C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 23 NOVEMBER, 1995. C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5 DOUBLE PRECISION ABINT1(0:36),ABINT2(0:37),ABINT3(0:37), 1 ABINT4(0:20),ABINT5(0:20), 2 ARG,BIRZER,CHEVAL,EIGHT,FOUR,F1,F2,NINE,NINHUN, 3 ONE,ONEHUN,ONEPT5,PIBY4,RT2B3P,SIXTEN,SEVEN,T,TEMP, 4 THREE,THR644,X,XLOW1,XHIGH1,XMAX,XNEG1,XVALUE, 5 Z,ZERO CHARACTER FNNAME*6,ERMSG1*31,ERMSG2*31 DATA FNNAME/'BIRINT'/ DATA ERMSG1/'ARGUMENT TOO LARGE AND POSITIVE'/ DATA ERMSG2/'ARGUMENT TOO LARGE AND NEGATIVE'/ DATA ABINT1(0)/ 0.38683 35244 50385 43350 D 0/ DATA ABINT1(1)/ -0.88232 13550 88890 8821 D -1/ DATA ABINT1(2)/ 0.21463 93744 03554 29239 D 0/ DATA ABINT1(3)/ -0.42053 47375 89131 5126 D -1/ DATA ABINT1(4)/ 0.59324 22547 49608 6771 D -1/ DATA ABINT1(5)/ -0.84078 70811 24270 210 D -2/ DATA ABINT1(6)/ 0.87182 47727 78487 955 D -2/ DATA ABINT1(7)/ -0.12191 60019 96134 55 D -3/ DATA ABINT1(8)/ 0.44024 82178 60232 34 D -3/ DATA ABINT1(9)/ 0.27894 68666 63866 78 D -3/ DATA ABINT1(10)/-0.70528 04689 78553 7 D -4/ DATA ABINT1(11)/ 0.59010 80066 77010 0 D -4/ DATA ABINT1(12)/-0.13708 62587 98214 2 D -4/ DATA ABINT1(13)/ 0.50596 25737 49073 D -5/ DATA ABINT1(14)/-0.51598 83776 6735 D -6/ DATA ABINT1(15)/ 0.39751 13123 49 D -8/ DATA ABINT1(16)/ 0.95249 85978 055 D -7/ DATA ABINT1(17)/-0.36814 35887 321 D -7/ DATA ABINT1(18)/ 0.12483 91688 136 D -7/ DATA ABINT1(19)/-0.24909 76191 37 D -8/ DATA ABINT1(20)/ 0.31775 24555 1 D -9/ DATA ABINT1(21)/ 0.54343 65270 D -10/ DATA ABINT1(22)/-0.40245 66915 D -10/ DATA ABINT1(23)/ 0.13938 55527 D -10/ DATA ABINT1(24)/-0.30381 7509 D -11/ DATA ABINT1(25)/ 0.40809 511 D -12/ DATA ABINT1(26)/ 0.16341 16 D -13/ DATA ABINT1(27)/-0.26838 09 D -13/ DATA ABINT1(28)/ 0.89664 1 D -14/ DATA ABINT1(29)/-0.18308 9 D -14/ DATA ABINT1(30)/ 0.21333 D -15/ DATA ABINT1(31)/ 0.1108 D -16/ DATA ABINT1(32)/-0.1276 D -16/ DATA ABINT1(33)/ 0.363 D -17/ DATA ABINT1(34)/-0.62 D -18/ DATA ABINT1(35)/ 0.5 D -19/ DATA ABINT1(36)/ 0.1 D -19/ DATA ABINT2(0)/ 2.04122 07860 25161 35181 D 0/ DATA ABINT2(1)/ 0.21241 33918 62122 1230 D -1/ DATA ABINT2(2)/ 0.66617 59976 67062 76 D -3/ DATA ABINT2(3)/ 0.38420 47982 80825 4 D -4/ DATA ABINT2(4)/ 0.36231 03660 20439 D -5/ DATA ABINT2(5)/ 0.50351 99011 5074 D -6/ DATA ABINT2(6)/ 0.79616 48702 253 D -7/ DATA ABINT2(7)/ 0.71780 84423 36 D -8/ DATA ABINT2(8)/ -0.26777 01591 04 D -8/ DATA ABINT2(9)/ -0.16848 95146 99 D -8/ DATA ABINT2(10)/-0.36811 75725 5 D -9/ DATA ABINT2(11)/ 0.47571 28727 D -10/ DATA ABINT2(12)/ 0.52636 21945 D -10/ DATA ABINT2(13)/ 0.77897 3500 D -11/ DATA ABINT2(14)/-0.46054 6143 D -11/ DATA ABINT2(15)/-0.18343 3736 D -11/ DATA ABINT2(16)/ 0.32191 249 D -12/ DATA ABINT2(17)/ 0.29352 060 D -12/ DATA ABINT2(18)/-0.16579 35 D -13/ DATA ABINT2(19)/-0.44838 08 D -13/ DATA ABINT2(20)/ 0.27907 D -15/ DATA ABINT2(21)/ 0.71192 1 D -14/ DATA ABINT2(22)/-0.1042 D -16/ DATA ABINT2(23)/-0.11959 1 D -14/ DATA ABINT2(24)/ 0.4606 D -16/ DATA ABINT2(25)/ 0.20884 D -15/ DATA ABINT2(26)/-0.2416 D -16/ DATA ABINT2(27)/-0.3638 D -16/ DATA ABINT2(28)/ 0.863 D -17/ DATA ABINT2(29)/ 0.591 D -17/ DATA ABINT2(30)/-0.256 D -17/ DATA ABINT2(31)/-0.77 D -18/ DATA ABINT2(32)/ 0.66 D -18/ DATA ABINT2(33)/ 0.3 D -19/ DATA ABINT2(34)/-0.15 D -18/ DATA ABINT2(35)/ 0.2 D -19/ DATA ABINT2(36)/ 0.3 D -19/ DATA ABINT2(37)/-0.1 D -19/ DATA ABINT3(0)/ 0.31076 96159 86403 49251 D 0/ DATA ABINT3(1)/ -0.27528 84588 74525 42718 D 0/ DATA ABINT3(2)/ 0.17355 96570 61365 43928 D 0/ DATA ABINT3(3)/ -0.55440 17909 49284 3130 D -1/ DATA ABINT3(4)/ -0.22512 65478 29595 0941 D -1/ DATA ABINT3(5)/ 0.41073 47447 81252 1894 D -1/ DATA ABINT3(6)/ 0.98476 12754 64262 480 D -2/ DATA ABINT3(7)/ -0.15556 18141 66604 1932 D -1/ DATA ABINT3(8)/ -0.56087 18707 30279 234 D -2/ DATA ABINT3(9)/ 0.24601 77833 22230 475 D -2/ DATA ABINT3(10)/ 0.16574 03922 92336 978 D -2/ DATA ABINT3(11)/-0.32775 87501 43540 2 D -4/ DATA ABINT3(12)/-0.24434 68086 05149 25 D -3/ DATA ABINT3(13)/-0.50353 05196 15232 1 D -4/ DATA ABINT3(14)/ 0.16302 64722 24785 4 D -4/ DATA ABINT3(15)/ 0.85191 40577 80934 D -5/ DATA ABINT3(16)/ 0.29790 36300 4664 D -6/ DATA ABINT3(17)/-0.64389 70789 6401 D -6/ DATA ABINT3(18)/-0.15046 98814 5803 D -6/ DATA ABINT3(19)/ 0.15870 13535 823 D -7/ DATA ABINT3(20)/ 0.12767 66299 622 D -7/ DATA ABINT3(21)/ 0.14057 85341 99 D -8/ DATA ABINT3(22)/-0.46564 73974 1 D -9/ DATA ABINT3(23)/-0.15682 74879 1 D -9/ DATA ABINT3(24)/-0.40389 3560 D -11/ DATA ABINT3(25)/ 0.66670 8192 D -11/ DATA ABINT3(26)/ 0.12886 9380 D -11/ DATA ABINT3(27)/-0.69686 63 D -13/ DATA ABINT3(28)/-0.62543 19 D -13/ DATA ABINT3(29)/-0.71839 2 D -14/ DATA ABINT3(30)/ 0.11529 6 D -14/ DATA ABINT3(31)/ 0.42276 D -15/ DATA ABINT3(32)/ 0.2493 D -16/ DATA ABINT3(33)/-0.971 D -17/ DATA ABINT3(34)/-0.216 D -17/ DATA ABINT3(35)/-0.2 D -19/ DATA ABINT3(36)/ 0.6 D -19/ DATA ABINT3(37)/ 0.1 D -19/ DATA ABINT4(0)/ 1.99507 95931 33520 47614 D 0/ DATA ABINT4(1)/ -0.27373 63759 70692 738 D -2/ DATA ABINT4(2)/ -0.30897 11308 12858 50 D -3/ DATA ABINT4(3)/ -0.35501 01982 79857 7 D -4/ DATA ABINT4(4)/ -0.41217 92715 20133 D -5/ DATA ABINT4(5)/ -0.48235 89231 6833 D -6/ DATA ABINT4(6)/ -0.56787 30727 927 D -7/ DATA ABINT4(7)/ -0.67187 48103 65 D -8/ DATA ABINT4(8)/ -0.79811 64985 7 D -9/ DATA ABINT4(9)/ -0.95142 71478 D -10/ DATA ABINT4(10)/-0.11374 68966 D -10/ DATA ABINT4(11)/-0.13635 9969 D -11/ DATA ABINT4(12)/-0.16381 418 D -12/ DATA ABINT4(13)/-0.19725 75 D -13/ DATA ABINT4(14)/-0.23784 4 D -14/ DATA ABINT4(15)/-0.28752 D -15/ DATA ABINT4(16)/-0.3475 D -16/ DATA ABINT4(17)/-0.422 D -17/ DATA ABINT4(18)/-0.51 D -18/ DATA ABINT4(19)/-0.6 D -19/ DATA ABINT4(20)/-0.1 D -19/ DATA ABINT5(0)/ 1.12672 08196 17825 66017 D 0/ DATA ABINT5(1)/ -0.67140 55675 25561 198 D -2/ DATA ABINT5(2)/ -0.69812 91801 78329 69 D -3/ DATA ABINT5(3)/ -0.75616 89886 42527 6 D -4/ DATA ABINT5(4)/ -0.83498 55745 10207 D -5/ DATA ABINT5(5)/ -0.93630 29823 2480 D -6/ DATA ABINT5(6)/ -0.10608 55629 6250 D -6/ DATA ABINT5(7)/ -0.12131 28916 741 D -7/ DATA ABINT5(8)/ -0.13963 11297 65 D -8/ DATA ABINT5(9)/ -0.16178 91805 4 D -9/ DATA ABINT5(10)/-0.18823 07907 D -10/ DATA ABINT5(11)/-0.22027 2985 D -11/ DATA ABINT5(12)/-0.25816 189 D -12/ DATA ABINT5(13)/-0.30479 64 D -13/ DATA ABINT5(14)/-0.35837 0 D -14/ DATA ABINT5(15)/-0.42831 D -15/ DATA ABINT5(16)/-0.4993 D -16/ DATA ABINT5(17)/-0.617 D -17/ DATA ABINT5(18)/-0.68 D -18/ DATA ABINT5(19)/-0.10 D -18/ DATA ABINT5(20)/-0.1 D -19/ DATA ZERO,ONE,ONEPT5/ 0.0 D 0 , 1.0 D 0 , 1.5 D 0 / DATA THREE,FOUR,SEVEN/ 3.0 D 0 , 4.0 D 0 , 7.0 D 0 / DATA EIGHT,NINE,SIXTEN/ 8.0 D 0 , 9.0 D 0 , 16.0 D 0 / DATA ONEHUN,NINHUN,THR644/100.0 D 0 , 900.0 D 0 , 3644.0 D 0 / DATA PIBY4/0.78539 81633 97448 30962 D 0/ DATA RT2B3P/0.46065 88659 61780 63902 D 0/ DATA BIRZER/0.61492 66274 46000 73515 D 0/ C C Machine-dependent parameters (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3,NTERM4,NTERM5/33,30,34,17,17/ DATA XLOW1,XHIGH1/2.22044604D-16,104.587632D0/ DATA XNEG1,XMAX/-2.727134D10,1.79D308/ C C Start computation C X = XVALUE C C Error test C IF ( X .GT. XHIGH1 ) THEN CALL ERRPRN(FNNAME,ERMSG1) BIRINT = XMAX RETURN ENDIF IF ( X .LT. XNEG1 ) THEN CALL ERRPRN(FNNAME,ERMSG2) BIRINT = ZERO RETURN ENDIF C C Code for x >= 0.0 C IF ( X .GE. ZERO ) THEN IF ( X .LT. XLOW1 ) THEN BIRINT = BIRZER * X ELSE IF ( X .LE. EIGHT ) THEN T = X / FOUR - ONE BIRINT = X * EXP(ONEPT5*X) * CHEVAL(NTERM1,ABINT1,T) ELSE T = SIXTEN * SQRT(EIGHT/X) / X - ONE Z = ( X + X ) * SQRT(X) / THREE TEMP = RT2B3P * CHEVAL(NTERM2,ABINT2,T) / SQRT(Z) TEMP = Z + LOG(TEMP) BIRINT = EXP(TEMP) ENDIF ENDIF ELSE C C Code for x < 0.0 C IF ( X .GE. -SEVEN ) THEN IF ( X .GT. -XLOW1 ) THEN BIRINT = BIRZER * X ELSE T = - ( X + X ) / SEVEN - ONE BIRINT = X * CHEVAL(NTERM3,ABINT3,T) ENDIF ELSE Z = - ( X + X ) * SQRT(-X) / THREE ARG = Z + PIBY4 TEMP = NINE * Z * Z T = (THR644 - TEMP ) / ( NINHUN + TEMP ) F1 = CHEVAL(NTERM4,ABINT4,T) * SIN(ARG) F2 = CHEVAL(NTERM5,ABINT5,T) * COS(ARG) / Z BIRINT = ( F2 - F1 ) * RT2B3P / SQRT(Z) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION CLAUSN(XVALUE) C C DESCRIPTION: C C This program calculates Clausen's integral defined by C C CLAUSN(x) = integral 0 to x of (-ln(2*sin(t/2))) dt C C The code uses Chebyshev expansions with the coefficients C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If |x| is too large it is impossible to reduce the argument C to the range [0,2*pi] with any precision. An error message C is printed and the program returns the value 0.0 C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - the no. of terms of the array ACLAUS C to be used. The recommended value is C such that ABS(ACLAUS(NTERMS)) < EPS/100 C subject to 1 <= NTERMS <= 15 C C XSMALL - DOUBLE PRECISION - the value below which Cl(x) can be C approximated by x (1-ln x). The recommended C value is pi*sqrt(EPSNEG/2). C C XHIGH - DOUBLE PRECISION - The value of |x| above which we cannot C reliably reduce the argument to [0,2*pi]. C The recommended value is 1/EPS. C C For values of EPS and EPSNEG refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C AINT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St. C PAISLEY C SCOTLAND C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST MODIFICATION: 23 NOVEMBER , 1995 C INTEGER INDX,NTERMS DOUBLE PRECISION ACLAUS(0:15),CHEVAL,HALF,ONE,ONEHUN,PI,PISQ,T, & TWOPI,TWOPIA,TWOPIB,X,XHIGH,XSMALL,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'CLAUSN'/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,HALF,ONE/0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA ONEHUN/100.0 D 0/ DATA PI/3.14159 26535 89793 2385 D 0/ DATA PISQ/9.86960 44010 89358 6188 D 0/ DATA TWOPI/6.28318 53071 79586 4769 D 0/ DATA TWOPIA,TWOPIB/6.28125 D 0 , 0.19353 07179 58647 69253 D -2/ DATA ACLAUS/2.14269 43637 66688 44709 D 0, 1 0.72332 42812 21257 9245 D -1, 2 0.10164 24750 21151 164 D -2, 3 0.32452 50328 53164 5 D -4, 4 0.13331 51875 71472 D -5, 5 0.62132 40591 653 D -7, 6 0.31300 41353 37 D -8, 7 0.16635 72305 6 D -9, 8 0.91965 9293 D -11, 9 0.52400 462 D -12, X 0.30580 40 D -13, 1 0.18196 9 D -14, 2 0.11004 D -15, 3 0.675 D -17, 4 0.42 D -18, 5 0.3 D -19/ C C Set machine-dependent constants (suitable for IEEE machines) C DATA NTERMS/13/ DATA XSMALL,XHIGH/2.3406689D-8,4.5036D15/ C C Start execution C X = XVALUE C C Error test C IF ( ABS(X) .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) CLAUSN = ZERO RETURN ENDIF INDX = 1 IF ( X .LT. ZERO ) THEN X = -X INDX = -1 ENDIF C C Argument reduced using simulated extra precision C IF ( X .GT. TWOPI ) THEN T = AINT( X / TWOPI ) X = ( X - T * TWOPIA ) - T * TWOPIB ENDIF IF ( X .GT. PI ) THEN X = ( TWOPIA - X ) + TWOPIB INDX = -INDX ENDIF C C Set result to zero if X multiple of PI C IF ( X .EQ. ZERO ) THEN CLAUSN = ZERO RETURN ENDIF C C Code for X < XSMALL C IF ( X .LT. XSMALL ) THEN CLAUSN = X * ( ONE - LOG( X ) ) ELSE C C Code for XSMALL < = X < = PI C T = ( X * X ) / PISQ - HALF T = T + T IF ( T .GT. ONE ) T = ONE CLAUSN = X * CHEVAL( NTERMS,ACLAUS,T ) - X * LOG( X ) ENDIF IF ( INDX .LT. 0 ) CLAUSN = -CLAUSN RETURN END DOUBLE PRECISION FUNCTION DEBYE1(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 1, defined as C C DEBYE1(x) = [Integral {0 to x} t/(exp(t)-1) dt] / x C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB1. C The recommended value is such that C ABS(ADEB1(NTERMS)) < EPS/100 , with C 1 <= NTERMS <= 18 C C XLOW - DOUBLE PRECISION - The value below which C DEBYE1 = 1 - x/4 + x*x/36 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - DOUBLE PRECISION - The value above which C DEBYE1 = (pi*pi/(6*x)) - exp(-x)(x+1)/x. C The recommended value is C -LOG(2*EPS) C C XLIM - DOUBLE PRECISION - The value above which DEBYE1 = pi*pi/(6*x) C The recommended value is C -LOG(XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 29 NOVEMBER, 1995 C INTEGER I,NEXP,NTERMS DOUBLE PRECISION ADEB1(0:18),CHEVAL,DEBINF,EIGHT,EXPMX,FOUR,HALF, & NINE,ONE,ONEHUN,QUART,RK,SUM,T,THIRT6,X,XK,XLIM,XLOW, & XUPPER,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE1'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,QUART/0.0 D 0 , 0.25 D 0/ DATA HALF,ONE/0.5 D 0 , 1.0 D 0/ DATA FOUR,EIGHT/4.0 D 0 , 8.0 D 0/ DATA NINE,THIRT6,ONEHUN/9.0 D 0 , 36.0 D 0 , 100.0 D 0/ DATA DEBINF/0.60792 71018 54026 62866 D 0/ DATA ADEB1/2.40065 97190 38141 01941 D 0, 1 0.19372 13042 18936 00885 D 0, 2 -0.62329 12455 48957 703 D -2, 3 0.35111 74770 20648 00 D -3, 4 -0.22822 24667 01231 0 D -4, 5 0.15805 46787 50300 D -5, 6 -0.11353 78197 0719 D -6, 7 0.83583 36118 75 D -8, 8 -0.62644 24787 2 D -9, 9 0.47603 34890 D -10, X -0.36574 1540 D -11, 1 0.28354 310 D -12, 2 -0.22147 29 D -13, 3 0.17409 2 D -14, 4 -0.13759 D -15, 5 0.1093 D -16, 6 -0.87 D -18, 7 0.7 D -19, 8 -0.1 D -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA XLOW,XUPPER,XLIM/0.298023D-7,35.35051D0,708.39642D0/ DATA NTERMS/15/ C C Start computation C X = XVALUE C C Check XVALUE >= 0.0 C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE1 = ZERO RETURN ENDIF C C Code for x <= 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE1 = ( ( X - NINE ) * X + THIRT6 ) / THIRT6 ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE1 = CHEVAL( NTERMS , ADEB1 , T ) - QUART * X ENDIF ELSE C C Code for x > 4.0 C DEBYE1 = ONE / ( X * DEBINF ) IF ( X .LT. XLIM ) THEN EXPMX = EXP( -X ) IF ( X .GT. XUPPER ) THEN DEBYE1 = DEBYE1 - EXPMX * ( ONE + ONE / X ) ELSE SUM = ZERO RK = AINT( XLIM / X ) NEXP = INT( RK ) XK = RK * X DO 100 I = NEXP,1,-1 T = ( ONE + ONE / XK ) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE DEBYE1 = DEBYE1 - SUM * EXPMX ENDIF ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION DEBYE2(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 1, defined as C C DEBYE2(x) = 2*[Integral {0 to x} t*t/(exp(t)-1) dt] / (x*x) C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB2. C The recommended value is such that C ABS(ADEB2(NTERMS)) < EPS/100, C subject to 1 <= NTERMS <= 18. C C XLOW - DOUBLE PRECISION - The value below which C DEBYE2 = 1 - x/3 + x*x/24 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - DOUBLE PRECISION - The value above which C DEBYE2 = (4*zeta(3)/x^2) - 2*exp(-x)(x^2+2x+1)/x^2. C The recommended value is C -LOG(2*EPS) C C XLIM1 - DOUBLE PRECISION - The value above which DEBYE2 = 4*zeta(3)/x^2 C The recommended value is C -LOG(XMIN) C C XLIM2 - DOUBLE PRECISION - The value above which DEBYE2 = 0.0 to machine C precision. The recommended value is C SQRT(4.8/XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 29 NOVEMBER, 1995 C INTEGER I,NEXP,NTERMS DOUBLE PRECISION ADEB2(0:18),CHEVAL,DEBINF,EIGHT,EXPMX,FOUR, & HALF,ONE,ONEHUN,RK,SUM,T,THREE,TWENT4,TWO,X,XK,XLIM1, & XLIM2,XLOW,XUPPER,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE2'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,HALF/0.0 D 0 , 0.5 D 0/ DATA ONE,TWO,THREE/1.0 D 0 , 2.0 D 0 , 3.0 D 0/ DATA FOUR,EIGHT,TWENT4/4.0 D 0 , 8.0 D 0 , 24.0 D 0/ DATA ONEHUN/100.0 D 0/ DATA DEBINF/4.80822 76126 38377 14160 D 0/ DATA ADEB2/2.59438 10232 57077 02826 D 0, 1 0.28633 57204 53071 98337 D 0, 2 -0.10206 26561 58046 7129 D -1, 3 0.60491 09775 34684 35 D -3, 4 -0.40525 76589 50210 4 D -4, 5 0.28633 82632 88107 D -5, 6 -0.20863 94303 0651 D -6, 7 0.15523 78758 264 D -7, 8 -0.11731 28008 66 D -8, 9 0.89735 85888 D -10, X -0.69317 6137 D -11, 1 0.53980 568 D -12, 2 -0.42324 05 D -13, 3 0.33377 8 D -14, 4 -0.26455 D -15, 5 0.2106 D -16, 6 -0.168 D -17, 7 0.13 D -18, 8 -0.1 D -19/ C C Machine-dependent constants C DATA XLOW,XUPPER/0.298023D-7,35.35051D0/ DATA XLIM1,XLIM2/708.39642D0,2.1572317D154/ DATA NTERMS/17/ C C Start computation C X = XVALUE C C Check XVALUE >= 0.0 C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE2 = ZERO RETURN ENDIF C C Code for x <= 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE2 = ( ( X - EIGHT ) * X + TWENT4 ) / TWENT4 ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE2 = CHEVAL ( NTERMS , ADEB2 , T ) - X / THREE ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XLIM2 ) THEN DEBYE2 = ZERO ELSE DEBYE2 = DEBINF / ( X * X ) IF ( X .LT. XLIM1 ) THEN EXPMX = EXP ( -X ) IF ( X .GT. XUPPER ) THEN SUM = ( ( X + TWO ) * X + TWO ) / ( X * X ) ELSE SUM = ZERO RK = AINT ( XLIM1 / X ) NEXP = INT ( RK ) XK = RK * X DO 100 I = NEXP,1,-1 T = ( ONE + TWO / XK + TWO / ( XK*XK ) ) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE ENDIF DEBYE2 = DEBYE2 - TWO * SUM * EXPMX ENDIF ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION DEBYE3(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 3, defined as C C DEBYE3(x) = 3*[Integral {0 to x} t^3/(exp(t)-1) dt] / (x^3) C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB3. C The recommended value is such that C ABS(ADEB3(NTERMS)) < EPS/100, C subject to 1 <= NTERMS <= 18 C C XLOW - DOUBLE PRECISION - The value below which C DEBYE3 = 1 - 3x/8 + x*x/20 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - DOUBLE PRECISION - The value above which C DEBYE3 = (18*zeta(4)/x^3) - 3*exp(-x)(x^3+3x^2+6x+6)/x^3. C The recommended value is C -LOG(2*EPS) C C XLIM1 - DOUBLE PRECISION - The value above which DEBYE3 = 18*zeta(4)/x^3 C The recommended value is C -LOG(XMIN) C C XLIM2 - DOUBLE PRECISION - The value above which DEBYE3 = 0.0 to machine C precision. The recommended value is C CUBE ROOT(19/XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 29 NOVEMBER, 1995 C INTEGER I,NEXP,NTERMS DOUBLE PRECISION ADEB3(0:18),CHEVAL,DEBINF,EIGHT,EXPMX,FOUR, & HALF,ONE,ONEHUN,PT375,RK,SEVP5,SIX,SUM,T,THREE,TWENTY,X, & XK,XKI,XLIM1,XLIM2,XLOW,XUPPER,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE3'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,PT375/0.0 D 0 , 0.375 D 0/ DATA HALF,ONE/0.5 D 0 , 1.0 D 0/ DATA THREE,FOUR,SIX/3.0 D 0 , 4.0 D 0 , 6.0 D 0/ DATA SEVP5,EIGHT,TWENTY/7.5 D 0 , 8.0 D 0 , 20.0 D 0/ DATA ONEHUN/100.0 D 0/ DATA DEBINF/0.51329 91127 34216 75946 D -1/ DATA ADEB3/2.70773 70683 27440 94526 D 0, 1 0.34006 81352 11091 75100 D 0, 2 -0.12945 15018 44408 6863 D -1, 3 0.79637 55380 17381 64 D -3, 4 -0.54636 00095 90823 8 D -4, 5 0.39243 01959 88049 D -5, 6 -0.28940 32823 5386 D -6, 7 0.21731 76139 625 D -7, 8 -0.16542 09994 98 D -8, 9 0.12727 96189 2 D -9, X -0.98796 3459 D -11, 1 0.77250 740 D -12, 2 -0.60779 72 D -13, 3 0.48075 9 D -14, 4 -0.38204 D -15, 5 0.3048 D -16, 6 -0.244 D -17, 7 0.20 D -18, 8 -0.2 D -19/ C C Machine-dependent constants C DATA XLOW,XUPPER/0.298023D-7,35.35051D0/ DATA XLIM1,XLIM2/708.39642D0,0.9487163D103/ DATA NTERMS/16/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE3 = ZERO RETURN ENDIF C C Code for x <= 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE3 = ( ( X - SEVP5 ) * X + TWENTY ) / TWENTY ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE3 = CHEVAL ( NTERMS , ADEB3 , T ) - PT375 * X ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XLIM2 ) THEN DEBYE3 = ZERO ELSE DEBYE3 = ONE / ( DEBINF * X * X * X ) IF ( X .LT. XLIM1 ) THEN EXPMX = EXP ( -X ) IF ( X .GT. XUPPER ) THEN SUM = (((X+THREE)*X+SIX)*X+SIX) / (X*X*X) ELSE SUM = ZERO RK = AINT ( XLIM1 / X ) NEXP = INT ( RK ) XK = RK * X DO 100 I = NEXP,1,-1 XKI = ONE / XK T = (((SIX*XKI+SIX)*XKI+THREE)*XKI+ONE) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE ENDIF DEBYE3 = DEBYE3 - THREE * SUM * EXPMX ENDIF ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION DEBYE4(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 4, defined as C C DEBYE4(x) = 4*[Integral {0 to x} t^4/(exp(t)-1) dt] / (x^4) C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB4. C The recommended value is such that C ABS(ADEB4(NTERMS)) < EPS/100, C subject to 1 <= NTERMS <= 18 C C XLOW - DOUBLE PRECISION - The value below which C DEBYE4 = 1 - 4x/10 + x*x/18 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - DOUBLE PRECISION - The value above which C DEBYE4=(96*zeta(5)/x^4)-4*exp(-x)(x^4+4x^2+12x^2+24x+24)/x^4. C The recommended value is C -LOG(2*EPS) C C XLIM1 - DOUBLE PRECISION - The value above which DEBYE4 = 96*zeta(5)/x^4 C The recommended value is C -LOG(XMIN) C C XLIM2 - DOUBLE PRECISION - The value above which DEBYE4 = 0.0 to machine C precision. The recommended value is C FOURTH ROOT(99/XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 29 NOVEMBER, 1995 C INTEGER I,NEXP,NTERMS DOUBLE PRECISION ADEB4(0:18),CHEVAL,DEBINF,EIGHT,EIGHTN,EXPMX, 1 FIVE,FOUR,FORTY5,HALF,ONE,ONEHUN,RK,SUM,T,TWELVE,TWENT4, 2 TWOPT5,X,XK,XKI,XLIM1,XLIM2,XLOW,XUPPER,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE4'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,HALF,ONE/0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA TWOPT5,FOUR,FIVE/2.5 D 0 , 4.0 D 0 , 5.0 D 0/ DATA EIGHT,TWELVE,EIGHTN/8.0 D 0 , 12.0 D 0 , 18.0 D 0/ DATA TWENT4,FORTY5,ONEHUN/24.0 D 0 , 45.0 D 0 , 100.0 D 0/ DATA DEBINF/99.54506 44937 63512 92781 D 0/ DATA ADEB4/2.78186 94150 20523 46008 D 0, 1 0.37497 67835 26892 86364 D 0, 2 -0.14940 90739 90315 8326 D -1, 3 0.94567 98114 37042 74 D -3, 4 -0.66132 91613 89325 5 D -4, 5 0.48156 32982 14449 D -5, 6 -0.35880 83958 7593 D -6, 7 0.27160 11874 160 D -7, 8 -0.20807 09912 23 D -8, 9 0.16093 83869 2 D -9, X -0.12547 09791 D -10, 1 0.98472 647 D -12, 2 -0.77723 69 D -13, 3 0.61648 3 D -14, 4 -0.49107 D -15, 5 0.3927 D -16, 6 -0.315 D -17, 7 0.25 D -18, 8 -0.2 D -19/ C C Machine-dependent constants C DATA XLOW,XUPPER/0.298023D-7,35.35051D0/ DATA XLIM1,XLIM2/708.39642D0,2.5826924D77/ DATA NTERMS/16/ C C Start computation C X = XVALUE C C Check XVALUE >= 0.0 C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE4 = ZERO RETURN ENDIF C C Code for x <= 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE4 = ( ( TWOPT5 * X - EIGHTN ) * X + FORTY5 ) / FORTY5 ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE4 = CHEVAL ( NTERMS , ADEB4 , T ) - ( X + X ) / FIVE ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XLIM2 ) THEN DEBYE4 = ZERO ELSE T = X * X DEBYE4 = ( DEBINF / T ) / T IF ( X .LT. XLIM1 ) THEN EXPMX = EXP ( -X ) IF ( X .GT. XUPPER ) THEN SUM = ( ( ( ( X + FOUR ) * X + TWELVE ) * X + & TWENT4 ) * X + TWENT4 ) / ( X * X * X * X ) ELSE SUM = ZERO RK = AINT ( XLIM1 / X ) NEXP = INT ( RK ) XK = RK * X DO 100 I = NEXP,1,-1 XKI = ONE / XK T = ( ( ( ( TWENT4 * XKI + TWENT4 ) * XKI + & TWELVE ) * XKI + FOUR ) * XKI + ONE ) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE ENDIF DEBYE4 = DEBYE4 - FOUR * SUM * EXPMX ENDIF ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION EXP3(XVALUE) C C DESCRIPTION C C This function calculates C C EXP3(X) = integral 0 to X (exp(-t*t*t)) dt C C The code uses Chebyshev expansions, whose coefficients are C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS C C If XVALUE < 0, an error message is printed and the function C returns the value 0. C C C MACHINE-DEPENDENT CONSTANTS C C NTERM1 - INTEGER - The no. of terms of the array AEXP3, C The recommended value is such that C AEXP3(NTERM1) < EPS/100. C C NTERM2 - INTEGER - The no. of terms of the array AEXP3A. C The recommended value is such that C AEXP3A(NTERM2) < EPS/100. C C XLOW - DOUBLE PRECISION - The value below which EXP3(X) = X to machine C precision. The recommended value is C cube root(4*EPSNEG) C C XUPPER - DOUBLE PRECISION - The value above which EXP3(X) = 0.89297... C to machine precision. The recommended value is C cube root(-ln(EPSNEG)) C C For values of EPS and EPSNEG for various machine/compiler C combinations refer to the file MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED C C EXP, LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR C C DR. ALLAN J. MACLEOD, C DEPARTMENT OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY C SCOTLAND. C C (e-mail macl_ms0@paisley.ac.uk ) C C C LATEST MODIFICATION: 29 NOVEMBER, 1995 C C INTEGER NTERM1,NTERM2 DOUBLE PRECISION AEXP3(0:24),AEXP3A(0:24),CHEVAL,FOUR, 1 FUNINF,HALF,ONE,ONEHUN,SIXTEN,T,THREE,TWO,X, 2 XLOW,XUPPER,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'EXP3 '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA TWO,THREE,FOUR/2.0 D 0 , 3.0 D 0 , 4.0 D 0 / DATA SIXTEN,ONEHUN/16.0 D 0 , 100.0 D 0/ DATA FUNINF/0.89297 95115 69249 21122 D 0/ DATA AEXP3(0)/ 1.26919 84142 21126 01434 D 0/ DATA AEXP3(1)/ -0.24884 64463 84140 98226 D 0/ DATA AEXP3(2)/ 0.80526 22071 72310 4125 D -1/ DATA AEXP3(3)/ -0.25772 73325 19683 2934 D -1/ DATA AEXP3(4)/ 0.75998 78873 07377 429 D -2/ DATA AEXP3(5)/ -0.20306 95581 94040 510 D -2/ DATA AEXP3(6)/ 0.49083 45866 99329 17 D -3/ DATA AEXP3(7)/ -0.10768 22391 42020 77 D -3/ DATA AEXP3(8)/ 0.21551 72626 42898 4 D -4/ DATA AEXP3(9)/ -0.39567 05137 38429 D -5/ DATA AEXP3(10)/ 0.66992 40933 8956 D -6/ DATA AEXP3(11)/-0.10513 21808 0703 D -6/ DATA AEXP3(12)/ 0.15362 58019 825 D -7/ DATA AEXP3(13)/-0.20990 96036 36 D -8/ DATA AEXP3(14)/ 0.26921 09538 1 D -9/ DATA AEXP3(15)/-0.32519 52422 D -10/ DATA AEXP3(16)/ 0.37114 8157 D -11/ DATA AEXP3(17)/-0.40136 518 D -12/ DATA AEXP3(18)/ 0.41233 46 D -13/ DATA AEXP3(19)/-0.40337 5 D -14/ DATA AEXP3(20)/ 0.37658 D -15/ DATA AEXP3(21)/-0.3362 D -16/ DATA AEXP3(22)/ 0.288 D -17/ DATA AEXP3(23)/-0.24 D -18/ DATA AEXP3(24)/ 0.2 D -19/ DATA AEXP3A(0)/ 1.92704 64955 06827 37293 D 0/ DATA AEXP3A(1)/ -0.34929 35652 04813 8054 D -1/ DATA AEXP3A(2)/ 0.14503 38371 89830 093 D -2/ DATA AEXP3A(3)/ -0.89253 36718 32790 3 D -4/ DATA AEXP3A(4)/ 0.70542 39219 11838 D -5/ DATA AEXP3A(5)/ -0.66717 27454 7611 D -6/ DATA AEXP3A(6)/ 0.72426 75899 824 D -7/ DATA AEXP3A(7)/ -0.87825 82560 56 D -8/ DATA AEXP3A(8)/ 0.11672 23442 78 D -8/ DATA AEXP3A(9)/ -0.16766 31281 2 D -9/ DATA AEXP3A(10)/ 0.25755 01577 D -10/ DATA AEXP3A(11)/-0.41957 8881 D -11/ DATA AEXP3A(12)/ 0.72010 412 D -12/ DATA AEXP3A(13)/-0.12949 055 D -12/ DATA AEXP3A(14)/ 0.24287 03 D -13/ DATA AEXP3A(15)/-0.47331 1 D -14/ DATA AEXP3A(16)/ 0.95531 D -15/ DATA AEXP3A(17)/-0.19914 D -15/ DATA AEXP3A(18)/ 0.4277 D -16/ DATA AEXP3A(19)/-0.944 D -17/ DATA AEXP3A(20)/ 0.214 D -17/ DATA AEXP3A(21)/-0.50 D -18/ DATA AEXP3A(22)/ 0.12 D -18/ DATA AEXP3A(23)/-0.3 D -19/ DATA AEXP3A(24)/ 0.1 D -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA XLOW,XUPPER/0.762939D-5,3.3243018D0/ DATA NTERM1,NTERM2/22,20/ C C Start calculation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) EXP3 = ZERO RETURN ENDIF C C Code for XVALUE < = 2 C IF ( X .LE. TWO ) THEN IF ( X .LT. XLOW ) THEN EXP3 = X ELSE T = ( ( X * X * X / FOUR ) - HALF ) - HALF EXP3 = X * CHEVAL ( NTERM1,AEXP3,T ) ENDIF ELSE C C Code for XVALUE > 2 C IF ( X .GT. XUPPER ) THEN EXP3 = FUNINF ELSE T = ( ( SIXTEN/ ( X * X * X ) ) - HALF ) - HALF T = CHEVAL ( NTERM2,AEXP3A,T ) T = T * EXP ( -X * X * X ) / ( THREE * X * X ) EXP3 = FUNINF - T ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION GOODST(XVALUE) C C DESCRIPTION: C C This function calculates the function defined as C C GOODST(x) = {integral 0 to inf} ( exp(-u*u)/(u+x) ) du C C The code uses Chebyshev expansions whose coefficients are C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE <= 0.0, an error message is printed, and the C code returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array AGOST. C The recommended value is such that C AGOST(NTERM1) < EPS/100, C C NTERM2 - The no. of terms to be used in the array AGOSTA. C The recommended value is such that C AGOSTA(NTERM2) < EPS/100, C C XLOW - The value below which f(x) = -(gamma/2) - ln(x) C to machine precision. The recommended value is C EPSNEG C C XHIGH - The value above which f(x) = sqrt(pi)/(2x) to C machine precision. The recommended value is C 2 / EPSNEG C C For values of EPS and EPSNEG refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley. C SCOTLAND. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 29 NOVEMBER, 1995 C C INTEGER NTERM1,NTERM2 DOUBLE PRECISION AGOST(0:28),AGOSTA(0:23), 1 CHEVAL,FVAL,GAMBY2,HALF,ONE,ONEHUN,RTPIB2,SIX, 2 T,TWO,X,XHIGH,XLOW,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*15 DATA FNNAME/'GOODST'/ DATA ERRMSG/'ARGUMENT <= 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA TWO,SIX/ 2.0 D 0 , 6.0 D 0 / DATA ONEHUN/100.0 D 0/ DATA GAMBY2/0.28860 78324 50766 43030 D 0/ DATA RTPIB2/0.88622 69254 52758 01365 D 0/ DATA AGOST(0)/ 0.63106 56056 03984 46247 D 0/ DATA AGOST(1)/ 0.25051 73779 32167 08827 D 0/ DATA AGOST(2)/ -0.28466 20597 90189 40757 D 0/ DATA AGOST(3)/ 0.87615 87523 94862 3552 D -1/ DATA AGOST(4)/ 0.68260 22672 21252 724 D -2/ DATA AGOST(5)/ -0.10811 29544 19225 4677 D -1/ DATA AGOST(6)/ 0.16910 12441 17152 176 D -2/ DATA AGOST(7)/ 0.50272 98462 26151 86 D -3/ DATA AGOST(8)/ -0.18576 68720 41000 84 D -3/ DATA AGOST(9)/ -0.42870 36741 68474 D -5/ DATA AGOST(10)/ 0.10095 98903 20290 5 D -4/ DATA AGOST(11)/-0.86529 91351 7382 D -6/ DATA AGOST(12)/-0.34983 87432 0734 D -6/ DATA AGOST(13)/ 0.64832 78683 494 D -7/ DATA AGOST(14)/ 0.75759 24985 83 D -8/ DATA AGOST(15)/-0.27793 54243 62 D -8/ DATA AGOST(16)/-0.48302 35135 D -10/ DATA AGOST(17)/ 0.86632 21283 D -10/ DATA AGOST(18)/-0.39433 9687 D -11/ DATA AGOST(19)/-0.20952 9625 D -11/ DATA AGOST(20)/ 0.21501 759 D -12/ DATA AGOST(21)/ 0.39590 15 D -13/ DATA AGOST(22)/-0.69227 9 D -14/ DATA AGOST(23)/-0.54829 D -15/ DATA AGOST(24)/ 0.17108 D -15/ DATA AGOST(25)/ 0.376 D -17/ DATA AGOST(26)/-0.349 D -17/ DATA AGOST(27)/ 0.7 D -19/ DATA AGOST(28)/ 0.6 D -19/ DATA AGOSTA(0)/ 1.81775 46798 47187 58767 D 0/ DATA AGOSTA(1)/ -0.99211 46570 74409 7467 D -1/ DATA AGOSTA(2)/ -0.89405 86452 54819 243 D -2/ DATA AGOSTA(3)/ -0.94955 33127 77267 85 D -3/ DATA AGOSTA(4)/ -0.10971 37996 67596 65 D -3/ DATA AGOSTA(5)/ -0.13466 94539 57859 0 D -4/ DATA AGOSTA(6)/ -0.17274 92743 08265 D -5/ DATA AGOSTA(7)/ -0.22931 38019 9498 D -6/ DATA AGOSTA(8)/ -0.31278 44178 918 D -7/ DATA AGOSTA(9)/ -0.43619 79736 71 D -8/ DATA AGOSTA(10)/-0.61958 46474 3 D -9/ DATA AGOSTA(11)/-0.89379 91276 D -10/ DATA AGOSTA(12)/-0.13065 11094 D -10/ DATA AGOSTA(13)/-0.19316 6876 D -11/ DATA AGOSTA(14)/-0.28844 270 D -12/ DATA AGOSTA(15)/-0.43447 96 D -13/ DATA AGOSTA(16)/-0.65951 8 D -14/ DATA AGOSTA(17)/-0.10080 1 D -14/ DATA AGOSTA(18)/-0.15502 D -15/ DATA AGOSTA(19)/-0.2397 D -16/ DATA AGOSTA(20)/-0.373 D -17/ DATA AGOSTA(21)/-0.58 D -18/ DATA AGOSTA(22)/-0.9 D -19/ DATA AGOSTA(23)/-0.1 D -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2/26,20/ DATA XLOW,XHIGH/1.11022303D-16,1.80144D16/ C C Start computation C X = XVALUE C C Error test C IF ( X .LE. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) GOODST = ZERO RETURN ENDIF C C Computation for 0 < x <= 2 C IF ( X .LE. TWO ) THEN IF ( X .LT. XLOW ) THEN GOODST = - GAMBY2 - LOG(X) ELSE T = ( X - HALF ) - HALF GOODST = CHEVAL(NTERM1,AGOST,T) - EXP(-X*X) * LOG(X) ENDIF ELSE C C Computation for x > 2 C FVAL = RTPIB2 / X IF ( X .GT. XHIGH ) THEN GOODST = FVAL ELSE T = ( SIX - X ) / ( TWO + X ) GOODST = FVAL * CHEVAL(NTERM2,AGOSTA,T) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION I0INT(XVALUE) C C DESCRIPTION: C This program computes the integral of the modified Bessel C function I0(x) using the definition C C I0INT(x) = {integral 0 to x} I0(t) dt C C The program uses Chebyshev expansions, the coefficients of C which are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If |XVALUE| larger than a certain limit, the value of C I0INT would cause an overflow. If such a situation occurs C the programs prints an error message, and returns the C value sign(XVALUE)*XMAX, where XMAX is the largest C acceptable floating-pt. value. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used from the array ARI01. C The recommended value is such that C ABS(ARI01(NTERM1)) < EPS/100 C C NTERM2 - The no. of terms to be used from the array ARI0A. C The recommended value is such that C ABS(ARI0A(NTERM2)) < EPS/100 C C XLOW - The value below which I0INT(x) = x, to machine precision. C The recommended value is C sqrt(12*EPS). C C XHIGH - The value above which overflow will occur. The C recommended value is C ln(XMAX) + 0.5*ln(ln(XMAX)) + ln(2). C C For values of EPS and XMAX refer to the file MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND C PA1 2BE C C (e-mail : macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 29 NOVEMBER, 1995 C INTEGER IND,NTERM1,NTERM2 DOUBLE PRECISION ARI01(0:28),ARI0A(0:33), 1 ATEEN,CHEVAL,HALF,LNR2PI,ONEHUN,T,TEMP,THREE,THIRT6, 2 X,XHIGH,XLOW,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'I0INT '/ DATA ERRMSG/'SIZE OF ARGUMENT TOO LARGE'/ DATA ZERO,HALF,THREE/ 0.0 D 0 , 0.5 D 0 , 3.0 D 0 / DATA ATEEN,THIRT6,ONEHUN/ 18.0 D 0 , 36.0 D 0 , 100.0 D 0/ DATA LNR2PI/0.91893 85332 04672 74178 D 0/ DATA ARI01(0)/ 0.41227 90692 67815 16801 D 0/ DATA ARI01(1)/ -0.34336 34515 00815 19562 D 0/ DATA ARI01(2)/ 0.22667 58871 57512 42585 D 0/ DATA ARI01(3)/ -0.12608 16471 87422 60032 D 0/ DATA ARI01(4)/ 0.60124 84628 77799 0271 D -1/ DATA ARI01(5)/ -0.24801 20462 91335 8248 D -1/ DATA ARI01(6)/ 0.89277 33895 65563 897 D -2/ DATA ARI01(7)/ -0.28325 37299 36696 605 D -2/ DATA ARI01(8)/ 0.79891 33904 17129 94 D -3/ DATA ARI01(9)/ -0.20053 93366 09648 90 D -3/ DATA ARI01(10)/ 0.44168 16783 01431 3 D -4/ DATA ARI01(11)/-0.82237 70422 46068 D -5/ DATA ARI01(12)/ 0.12005 97942 19015 D -5/ DATA ARI01(13)/-0.11350 86500 4889 D -6/ DATA ARI01(14)/ 0.69606 01446 6 D -9/ DATA ARI01(15)/ 0.18062 27728 36 D -8/ DATA ARI01(16)/-0.26039 48137 0 D -9/ DATA ARI01(17)/-0.16618 8103 D -11/ DATA ARI01(18)/ 0.51050 0232 D -11/ DATA ARI01(19)/-0.41515 879 D -12/ DATA ARI01(20)/-0.73681 38 D -13/ DATA ARI01(21)/ 0.12793 23 D -13/ DATA ARI01(22)/ 0.10324 7 D -14/ DATA ARI01(23)/-0.30379 D -15/ DATA ARI01(24)/-0.1789 D -16/ DATA ARI01(25)/ 0.673 D -17/ DATA ARI01(26)/ 0.44 D -18/ DATA ARI01(27)/-0.14 D -18/ DATA ARI01(28)/-0.1 D -19/ DATA ARI0A(0)/ 2.03739 65457 11432 87070 D 0/ DATA ARI0A(1)/ 0.19176 31647 50331 0248 D -1/ DATA ARI0A(2)/ 0.49923 33451 92881 47 D -3/ DATA ARI0A(3)/ 0.22631 87103 65981 5 D -4/ DATA ARI0A(4)/ 0.15868 21082 85561 D -5/ DATA ARI0A(5)/ 0.16507 85563 6318 D -6/ DATA ARI0A(6)/ 0.23850 58373 640 D -7/ DATA ARI0A(7)/ 0.39298 51823 04 D -8/ DATA ARI0A(8)/ 0.46042 71419 9 D -9/ DATA ARI0A(9)/ -0.70725 58172 D -10/ DATA ARI0A(10)/-0.67471 83961 D -10/ DATA ARI0A(11)/-0.20269 62001 D -10/ DATA ARI0A(12)/-0.87320 338 D -12/ DATA ARI0A(13)/ 0.17552 0014 D -11/ DATA ARI0A(14)/ 0.60383 944 D -12/ DATA ARI0A(15)/-0.39779 83 D -13/ DATA ARI0A(16)/-0.80490 48 D -13/ DATA ARI0A(17)/-0.11589 55 D -13/ DATA ARI0A(18)/ 0.82731 8 D -14/ DATA ARI0A(19)/ 0.28229 0 D -14/ DATA ARI0A(20)/-0.77667 D -15/ DATA ARI0A(21)/-0.48731 D -15/ DATA ARI0A(22)/ 0.7279 D -16/ DATA ARI0A(23)/ 0.7873 D -16/ DATA ARI0A(24)/-0.785 D -17/ DATA ARI0A(25)/-0.1281 D -16/ DATA ARI0A(26)/ 0.121 D -17/ DATA ARI0A(27)/ 0.214 D -17/ DATA ARI0A(28)/-0.27 D -18/ DATA ARI0A(29)/-0.36 D -18/ DATA ARI0A(30)/ 0.7 D -19/ DATA ARI0A(31)/ 0.6 D -19/ DATA ARI0A(32)/-0.2 D -19/ DATA ARI0A(33)/-0.1 D -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2/25,27/ DATA XLOW,XHIGH/0.5161914D-7,713.758339D0/ C C Start computation C IND = 1 X = XVALUE IF ( XVALUE .LT. ZERO ) THEN IND = -1 X = -X ENDIF C C Error test C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) I0INT = EXP ( XHIGH - LNR2PI - HALF * LOG(XHIGH) ) IF ( IND .EQ. -1 ) I0INT = -I0INT RETURN ENDIF C C Code for 0 <= !x! <= 18 C IF ( X .LE. ATEEN ) THEN IF ( X .LT. XLOW ) THEN I0INT = X ELSE T = ( THREE * X - ATEEN ) / ( X + ATEEN ) I0INT = X * EXP(X) * CHEVAL(NTERM1,ARI01,T) ENDIF ELSE C C Code for !x! > 18 C T = ( THIRT6 / X - HALF ) - HALF TEMP = X - HALF*LOG(X) - LNR2PI + LOG(CHEVAL(NTERM2,ARI0A,T)) I0INT = EXP(TEMP) ENDIF IF ( IND .EQ. -1 ) I0INT = -I0INT RETURN END DOUBLE PRECISION FUNCTION I0ML0(XVALUE) C C DESCRIPTION: C C This program calculates the function I0ML0 defined as C C I0ML0(x) = I0(x) - L0(x) C C where I0(x) is the modified Bessel function of the first kind of C order 0, and L0(x) is the modified Struve function of order 0. C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20D. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C The coefficients are only suitable for XVALUE >= 0.0. If C XVALUE < 0.0, an error message is printed and the function C returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The number of terms required for the array C AI0L0. The recommended value is such that C ABS(AI0L0(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The number of terms required for the array C AI0L0A. The recommended value is such that C ABS(AI0L0A(NTERM2)) < EPS/100 C C XLOW - DOUBLE PRECISION - The value below which I0ML0(x) = 1 to machine C precision. The recommended value is C EPSNEG C C XHIGH - DOUBLE PRECISION - The value above which I0ML0(x) = 2/(pi*x) to C machine precision. The recommended value is C SQRT(800/EPS) C C For values of EPS, and EPSNEG see the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod C Dept. of Mathematics and Statistics C University of Paisley C High St. C Paisley C SCOTLAND C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 29 NOVEMBER, 1995 C INTEGER NTERM1,NTERM2 DOUBLE PRECISION AI0L0(0:23),AI0L0A(0:23),ATEHUN,CHEVAL, 1 FORTY,ONE,ONEHUN,SIX,SIXTEN,T,TWOBPI,TWO88,X,XHIGH, 2 XLOW,XSQ,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'I0ML0 '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,ONE/ 0.0 D 0 , 1.0 D 0 / DATA SIX,SIXTEN/ 6.0 D 0 , 16.0 D 0 / DATA FORTY,ONEHUN/ 40.0 D 0 , 100.0 D 0 / DATA TWO88,ATEHUN/ 288.0 D 0 , 800.0 D 0 / DATA TWOBPI/0.63661 97723 67581 34308 D 0/ DATA AI0L0(0)/ 0.52468 73679 14855 99138 D 0/ DATA AI0L0(1)/ -0.35612 46069 96505 86196 D 0/ DATA AI0L0(2)/ 0.20487 20286 40099 27687 D 0/ DATA AI0L0(3)/ -0.10418 64052 04026 93629 D 0/ DATA AI0L0(4)/ 0.46342 11095 54842 9228 D -1/ DATA AI0L0(5)/ -0.17905 87192 40349 8630 D -1/ DATA AI0L0(6)/ 0.59796 86954 81143 177 D -2/ DATA AI0L0(7)/ -0.17177 75476 93565 429 D -2/ DATA AI0L0(8)/ 0.42204 65446 91714 22 D -3/ DATA AI0L0(9)/ -0.87961 78522 09412 5 D -4/ DATA AI0L0(10)/ 0.15354 34234 86922 3 D -4/ DATA AI0L0(11)/-0.21978 07695 84743 D -5/ DATA AI0L0(12)/ 0.24820 68393 6666 D -6/ DATA AI0L0(13)/-0.20327 06035 607 D -7/ DATA AI0L0(14)/ 0.90984 19842 1 D -9/ DATA AI0L0(15)/ 0.25617 93929 D -10/ DATA AI0L0(16)/-0.71060 9790 D -11/ DATA AI0L0(17)/ 0.32716 960 D -12/ DATA AI0L0(18)/ 0.23002 15 D -13/ DATA AI0L0(19)/-0.29210 9 D -14/ DATA AI0L0(20)/-0.3566 D -16/ DATA AI0L0(21)/ 0.1832 D -16/ DATA AI0L0(22)/-0.10 D -18/ DATA AI0L0(23)/-0.11 D -18/ DATA AI0L0A(0)/ 2.00326 51024 11606 43125 D 0/ DATA AI0L0A(1)/ 0.19520 68515 76492 081 D -2/ DATA AI0L0A(2)/ 0.38239 52356 99083 28 D -3/ DATA AI0L0A(3)/ 0.75342 80817 05443 6 D -4/ DATA AI0L0A(4)/ 0.14959 57655 89707 8 D -4/ DATA AI0L0A(5)/ 0.29994 05312 10557 D -5/ DATA AI0L0A(6)/ 0.60769 60482 2459 D -6/ DATA AI0L0A(7)/ 0.12399 49554 4506 D -6/ DATA AI0L0A(8)/ 0.25232 62552 649 D -7/ DATA AI0L0A(9)/ 0.50463 48573 32 D -8/ DATA AI0L0A(10)/0.97913 23623 0 D -9/ DATA AI0L0A(11)/0.18389 11524 1 D -9/ DATA AI0L0A(12)/0.33763 09278 D -10/ DATA AI0L0A(13)/0.61117 9703 D -11/ DATA AI0L0A(14)/0.10847 2972 D -11/ DATA AI0L0A(15)/0.18861 271 D -12/ DATA AI0L0A(16)/0.32803 45 D -13/ DATA AI0L0A(17)/0.56564 7 D -14/ DATA AI0L0A(18)/0.93300 D -15/ DATA AI0L0A(19)/0.15881 D -15/ DATA AI0L0A(20)/0.2791 D -16/ DATA AI0L0A(21)/0.389 D -17/ DATA AI0L0A(22)/0.70 D -18/ DATA AI0L0A(23)/0.16 D -18/ C C MACHINE-DEPENDENT CONSTANTS (suitable for IEEE-arithmetic machines) C DATA NTERM1,NTERM2/21,21/ DATA XLOW,XHIGH/1.11022303D-16,1.8981253D9/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) I0ML0 = ZERO RETURN ENDIF C C Code for x <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN I0ML0 = ONE RETURN ELSE T = ( SIX * X - FORTY ) / ( X + FORTY ) I0ML0 = CHEVAL(NTERM1,AI0L0,T) RETURN ENDIF ELSE C C Code for x > 16 C IF ( X .GT. XHIGH ) THEN I0ML0 = TWOBPI / X ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) I0ML0 = CHEVAL(NTERM2,AI0L0A,T) * TWOBPI / X ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION I1ML1(XVALUE) C C DESCRIPTION: C C This program calculates the function I1ML1 defined as C C I1ML1(x) = I1(x) - L1(x) C C where I1(x) is the modified Bessel function of the first kind of C order 1, and L1(x) is the modified Struve function of order 1. C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20D. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C The coefficients are only suitable for XVALUE >= 0.0. If C XVALUE < 0.0, an error message is printed and the function C returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The number of terms required for the array C AI1L1. The recommended value is such that C ABS(AI1L1(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The number of terms required for the array C AI1L1A. The recommended value is such that C ABS(AI1L1A(NTERM2)) < EPS/100 C C XLOW - DOUBLE PRECISION - The value below which I1ML1(x) = x/2 to machine C precision. The recommended value is C 2*EPSNEG C C XHIGH - DOUBLE PRECISION - The value above which I1ML1(x) = 2/pi to C machine precision. The recommended value is C SQRT(800/EPS) C C For values of EPS, and EPSNEG see the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod C Dept. of Mathematics and Statistics C University of Paisley C High St. C Paisley C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 29 NOVEMBER 1995 C INTEGER NTERM1,NTERM2 DOUBLE PRECISION AI1L1(0:23),AI1L1A(0:25),ATEHUN,CHEVAL, 1 FORTY,ONE,ONEHUN,SIX,SIXTEN,T,TWO,TWOBPI,TWO88, 2 X,XHIGH,XLOW,XSQ,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'I1ML1 '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,ONE,TWO/ 0.0 D 0 , 1.0 D 0 , 2.0 D 0 / DATA SIX,SIXTEN,FORTY/ 6.0 D 0 , 16.0 D 0 , 40.0 D 0 / DATA ONEHUN,TWO88,ATEHUN/ 100.0 D 0 , 288.0 D 0 , 800.0 D 0 / DATA TWOBPI/0.63661 97723 67581 34308 D 0/ DATA AI1L1(0)/ 0.67536 36906 23505 76137 D 0/ DATA AI1L1(1)/ -0.38134 97109 72665 59040 D 0/ DATA AI1L1(2)/ 0.17452 17077 51339 43559 D 0/ DATA AI1L1(3)/ -0.70621 05887 23502 5061 D -1/ DATA AI1L1(4)/ 0.25173 41413 55880 3702 D -1/ DATA AI1L1(5)/ -0.78709 85616 06423 321 D -2/ DATA AI1L1(6)/ 0.21481 43686 51922 006 D -2/ DATA AI1L1(7)/ -0.50862 19971 79062 36 D -3/ DATA AI1L1(8)/ 0.10362 60828 04423 30 D -3/ DATA AI1L1(9)/ -0.17954 47212 05724 7 D -4/ DATA AI1L1(10)/ 0.25978 82745 15414 D -5/ DATA AI1L1(11)/-0.30442 40632 4667 D -6/ DATA AI1L1(12)/ 0.27202 39894 766 D -7/ DATA AI1L1(13)/-0.15812 61441 90 D -8/ DATA AI1L1(14)/ 0.18162 09172 D -10/ DATA AI1L1(15)/ 0.64796 7659 D -11/ DATA AI1L1(16)/-0.54113 290 D -12/ DATA AI1L1(17)/-0.30831 1 D -14/ DATA AI1L1(18)/ 0.30563 8 D -14/ DATA AI1L1(19)/-0.9717 D -16/ DATA AI1L1(20)/-0.1422 D -16/ DATA AI1L1(21)/ 0.84 D -18/ DATA AI1L1(22)/ 0.7 D -19/ DATA AI1L1(23)/-0.1 D -19/ DATA AI1L1A(0)/ 1.99679 36189 67891 36501 D 0/ DATA AI1L1A(1)/ -0.19066 32614 09686 132 D -2/ DATA AI1L1A(2)/ -0.36094 62241 01744 81 D -3/ DATA AI1L1A(3)/ -0.68418 47304 59982 0 D -4/ DATA AI1L1A(4)/ -0.12990 08228 50942 6 D -4/ DATA AI1L1A(5)/ -0.24715 21887 05765 D -5/ DATA AI1L1A(6)/ -0.47147 83969 1972 D -6/ DATA AI1L1A(7)/ -0.90208 19982 592 D -7/ DATA AI1L1A(8)/ -0.17304 58637 504 D -7/ DATA AI1L1A(9)/ -0.33232 36701 59 D -8/ DATA AI1L1A(10)/-0.63736 42173 5 D -9/ DATA AI1L1A(11)/-0.12180 23975 6 D -9/ DATA AI1L1A(12)/-0.23173 46832 D -10/ DATA AI1L1A(13)/-0.43906 8833 D -11/ DATA AI1L1A(14)/-0.82847 110 D -12/ DATA AI1L1A(15)/-0.15562 249 D -12/ DATA AI1L1A(16)/-0.29131 12 D -13/ DATA AI1L1A(17)/-0.54396 5 D -14/ DATA AI1L1A(18)/-0.10117 7 D -14/ DATA AI1L1A(19)/-0.18767 D -15/ DATA AI1L1A(20)/-0.3484 D -16/ DATA AI1L1A(21)/-0.643 D -17/ DATA AI1L1A(22)/-0.118 D -17/ DATA AI1L1A(23)/-0.22 D -18/ DATA AI1L1A(24)/-0.4 D -19/ DATA AI1L1A(25)/-0.1 D -19/ C C MACHINE-DEPENDENT CONSTANTS (suitable for IEEE machines) C DATA NTERM1,NTERM2/20,22/ DATA XLOW,XHIGH/2.22044605D-16,1.8981253D9/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) I1ML1 = ZERO RETURN ENDIF C C Code for x <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN I1ML1 = X / TWO RETURN ELSE T = ( SIX * X - FORTY ) / ( X + FORTY ) I1ML1 = CHEVAL(NTERM1,AI1L1,T) * X / TWO RETURN ENDIF ELSE C C Code for x > 16 C IF ( X .GT. XHIGH ) THEN I1ML1 = TWOBPI ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) I1ML1 = CHEVAL(NTERM2,AI1L1A,T) * TWOBPI ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION J0INT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the Bessel C function J0, defined as C C J0INT(x) = {integral 0 to x} J0(t) dt C C The code uses Chebyshev expansions whose coefficients are C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If the value of |x| is too large, it is impossible to C accurately compute the trigonometric functions used. An C error message is printed, and the function returns the C value 1.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used from the array C ARJ01. The recommended value is such that C ABS(ARJ01(NTERM1)) < EPS/100, provided that C C NTERM2 - The no. of terms to be used from the array C ARJ0A1. The recommended value is such that C ABS(ARJ0A1(NTERM2)) < EPS/100, provided that C C NTERM3 - The no. of terms to be used from the array C ARJ0A2. The recommended value is such that C ABS(ARJ0A2(NTERM3)) < EPS/100, provided that C C XLOW - The value of |x| below which J0INT(x) = x to C machine-precision. The recommended value is C sqrt(12*EPSNEG) C C XHIGH - The value of |x| above which it is impossible C to calculate (x-pi/4) accurately. The recommended C value is 1/EPSNEG C C For values of EPS and EPSNEG for various machine/compiler C combinations refer to the file MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C COS , SIN , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 11 JANUARY, 1996 C INTEGER IND,NTERM1,NTERM2,NTERM3 DOUBLE PRECISION ARJ01(0:23),ARJ0A1(0:21),ARJ0A2(0:18), 1 CHEVAL,FIVE12,ONE,ONEHUN,ONE28,PIB41,PIB411,PIB412, 2 PIB42,RT2BPI,SIXTEN,T,TEMP,TWELVE,X,XHIGH,XLOW, 3 XMPI4,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'J0INT '/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,ONE/ 0.0 D 0 , 1.0 D 0 / DATA TWELVE,SIXTEN/ 12.0 D 0 , 16.0 D 0 / DATA ONEHUN,ONE28,FIVE12/ 100.0 D 0 , 128.0 D 0 , 512 D 0 / DATA RT2BPI/0.79788 45608 02865 35588 D 0/ DATA PIB411,PIB412/ 201.0 D 0 , 256.0 D 0/ DATA PIB42/0.24191 33974 48309 61566 D -3/ DATA ARJ01(0)/ 0.38179 27932 16901 73518 D 0/ DATA ARJ01(1)/ -0.21275 63635 05053 21870 D 0/ DATA ARJ01(2)/ 0.16754 21340 72157 94187 D 0/ DATA ARJ01(3)/ -0.12853 20977 21963 98954 D 0/ DATA ARJ01(4)/ 0.10114 40545 57788 47013 D 0/ DATA ARJ01(5)/ -0.91007 95343 20156 8859 D -1/ DATA ARJ01(6)/ 0.64013 45264 65687 3103 D -1/ DATA ARJ01(7)/ -0.30669 63029 92675 4312 D -1/ DATA ARJ01(8)/ 0.10308 36525 32506 4201 D -1/ DATA ARJ01(9)/ -0.25567 06503 99956 918 D -2/ DATA ARJ01(10)/ 0.48832 75580 57983 04 D -3/ DATA ARJ01(11)/-0.74249 35126 03607 7 D -4/ DATA ARJ01(12)/ 0.92226 05637 30861 D -5/ DATA ARJ01(13)/-0.95522 82830 7083 D -6/ DATA ARJ01(14)/ 0.83883 55845 986 D -7/ DATA ARJ01(15)/-0.63318 44888 58 D -8/ DATA ARJ01(16)/ 0.41560 50422 1 D -9/ DATA ARJ01(17)/-0.23955 29307 D -10/ DATA ARJ01(18)/ 0.12228 6885 D -11/ DATA ARJ01(19)/-0.55697 11 D -13/ DATA ARJ01(20)/ 0.22782 0 D -14/ DATA ARJ01(21)/-0.8417 D -16/ DATA ARJ01(22)/ 0.282 D -17/ DATA ARJ01(23)/-0.9 D -19/ DATA ARJ0A1(0)/ 1.24030 13303 75189 70827 D 0/ DATA ARJ0A1(1)/ -0.47812 53536 32280 693 D -2/ DATA ARJ0A1(2)/ 0.66131 48891 70667 8 D -4/ DATA ARJ0A1(3)/ -0.18604 27404 86349 D -5/ DATA ARJ0A1(4)/ 0.83627 35565 080 D -7/ DATA ARJ0A1(5)/ -0.52585 70367 31 D -8/ DATA ARJ0A1(6)/ 0.42606 36325 1 D -9/ DATA ARJ0A1(7)/ -0.42117 61024 D -10/ DATA ARJ0A1(8)/ 0.48894 6426 D -11/ DATA ARJ0A1(9)/ -0.64834 929 D -12/ DATA ARJ0A1(10)/ 0.96172 34 D -13/ DATA ARJ0A1(11)/-0.15703 67 D -13/ DATA ARJ0A1(12)/ 0.27871 2 D -14/ DATA ARJ0A1(13)/-0.53222 D -15/ DATA ARJ0A1(14)/ 0.10844 D -15/ DATA ARJ0A1(15)/-0.2342 D -16/ DATA ARJ0A1(16)/ 0.533 D -17/ DATA ARJ0A1(17)/-0.127 D -17/ DATA ARJ0A1(18)/ 0.32 D -18/ DATA ARJ0A1(19)/-0.8 D -19/ DATA ARJ0A1(20)/ 0.2 D -19/ DATA ARJ0A1(21)/-0.1 D -19/ DATA ARJ0A2(0)/ 1.99616 09630 13416 75339 D 0/ DATA ARJ0A2(1)/ -0.19037 98192 46668 161 D -2/ DATA ARJ0A2(2)/ 0.15397 10927 04422 6 D -4/ DATA ARJ0A2(3)/ -0.31145 08832 8103 D -6/ DATA ARJ0A2(4)/ 0.11108 50971 321 D -7/ DATA ARJ0A2(5)/ -0.58666 78712 3 D -9/ DATA ARJ0A2(6)/ 0.41399 26949 D -10/ DATA ARJ0A2(7)/ -0.36539 8763 D -11/ DATA ARJ0A2(8)/ 0.38557 568 D -12/ DATA ARJ0A2(9)/ -0.47098 00 D -13/ DATA ARJ0A2(10)/ 0.65022 0 D -14/ DATA ARJ0A2(11)/-0.99624 D -15/ DATA ARJ0A2(12)/ 0.16700 D -15/ DATA ARJ0A2(13)/-0.3028 D -16/ DATA ARJ0A2(14)/ 0.589 D -17/ DATA ARJ0A2(15)/-0.122 D -17/ DATA ARJ0A2(16)/ 0.27 D -18/ DATA ARJ0A2(17)/-0.6 D -19/ DATA ARJ0A2(18)/ 0.1 D -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3/22,18,16/ DATA XLOW,XHIGH/3.650024D-8,9.0072D15/ C C Start computation C X = XVALUE IND = 1 IF ( X .LT. ZERO ) THEN X = -X IND = -1 ENDIF C C Error test C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) J0INT = ONE IF ( IND .EQ. -1 ) J0INT = -J0INT RETURN ENDIF C C Code for 0 <= |x| <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN J0INT = X ELSE T = X * X / ONE28 - ONE J0INT = X * CHEVAL(NTERM1,ARJ01,T) ENDIF ELSE C C Code for |x| > 16 C T = FIVE12 / ( X * X ) - ONE PIB41 = PIB411 / PIB412 XMPI4 = ( X - PIB41 ) - PIB42 TEMP = COS(XMPI4) * CHEVAL(NTERM2,ARJ0A1,T) / X TEMP = TEMP - SIN(XMPI4) * CHEVAL(NTERM3,ARJ0A2,T) J0INT = ONE - RT2BPI * TEMP / SQRT(X) ENDIF IF ( IND .EQ. -1 ) J0INT = -J0INT RETURN END DOUBLE PRECISION FUNCTION K0INT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the modified Bessel function C defined by C C K0INT(x) = {integral 0 to x} K0(t) dt C C The code uses Chebyshev expansions, whose coefficients are C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, the function is undefined. An error message is C printed and the function returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array AK0IN1. The C recommended value is such that C ABS(AK0IN1(NTERM1)) < EPS/100, C C NTERM2 - The no. of terms to be used in the array AK0IN2. The C recommended value is such that C ABS(AK0IN2(NTERM2)) < EPS/100, C C NTERM3 - The no. of terms to be used in the array AK0INA. The C recommended value is such that C ABS(AK0INA(NTERM3)) < EPS/100, C C XLOW - The value below which K0INT = x * ( const - ln(x) ) to C machine precision. The recommended value is C sqrt (18*EPSNEG). C C XHIGH - The value above which K0INT = pi/2 to machine precision. C The recommended value is C - log (2*EPSNEG) C C For values of EPS and EPSNEG refer to the file MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 11 JANUARY, 1996 C INTEGER NTERM1,NTERM2,NTERM3 DOUBLE PRECISION AK0IN1(0:15),AK0IN2(0:15),AK0INA(0:27), 1 CHEVAL,CONST1,CONST2,EIGHTN,FVAL,HALF, 2 ONEHUN,PIBY2,RT2BPI,SIX,T,TEMP,TWELVE,X, 3 XHIGH,XLOW,XVALUE,ZERO CHARACTER FNNAME*8,ERRMSG*14 DATA FNNAME/'K0INT '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,SIX/ 0.0 D 0 , 0.5 D 0 , 6.0 D 0 / DATA TWELVE,EIGHTN,ONEHUN/ 12.0 D 0 , 18.0 D 0 , 100.0 D 0 / DATA CONST1/1.11593 15156 58412 44881 D 0/ DATA CONST2/-0.11593 15156 58412 44881 D 0/ DATA PIBY2/1.57079 63267 94896 61923 D 0/ DATA RT2BPI/0.79788 45608 02865 35588 D 0/ DATA AK0IN1/16.79702 71446 47109 59477 D 0, 1 9.79134 68767 68894 07070 D 0, 2 2.80501 31604 43379 39300 D 0, 3 0.45615 62053 18885 02068 D 0, 4 0.47162 24457 07476 0784 D -1, 5 0.33526 51482 69698 289 D -2, 6 0.17335 18119 38747 27 D -3, 7 0.67995 18893 64702 D -5, 8 0.20900 26835 9924 D -6, 9 0.51660 38469 76 D -8, X 0.10485 70833 1 D -9, 1 0.17782 9320 D -11, 2 0.25568 44 D -13, 3 0.31557 D -15, 4 0.338 D -17, 5 0.3 D -19/ DATA AK0IN2/10.76266 55822 78091 74077 D 0, 1 5.62333 47984 99975 11550 D 0, 2 1.43543 66487 92908 67158 D 0, 3 0.21250 41014 37438 96043 D 0, 4 0.20365 37393 10000 9554 D -1, 5 0.13602 35840 95623 632 D -2, 6 0.66753 88699 20909 3 D -4, 7 0.25043 00357 07337 D -5, 8 0.74064 23741 728 D -7, 9 0.17697 47043 14 D -8, X 0.34857 75254 D -10, 1 0.57544 785 D -12, 2 0.80748 1 D -14, 3 0.9747 D -16, 4 0.102 D -17, 5 0.1 D -19/ DATA AK0INA(0)/ 1.91172 06544 50604 53895 D 0/ DATA AK0INA(1)/ -0.41830 64565 76958 1085 D -1/ DATA AK0INA(2)/ 0.21335 25080 68147 486 D -2/ DATA AK0INA(3)/ -0.15859 49728 45041 81 D -3/ DATA AK0INA(4)/ 0.14976 24699 85835 1 D -4/ DATA AK0INA(5)/ -0.16795 59553 22241 D -5/ DATA AK0INA(6)/ 0.21495 47247 8804 D -6/ DATA AK0INA(7)/ -0.30583 56654 790 D -7/ DATA AK0INA(8)/ 0.47494 64133 43 D -8/ DATA AK0INA(9)/ -0.79424 66043 2 D -9/ DATA AK0INA(10)/ 0.14156 55532 5 D -9/ DATA AK0INA(11)/-0.26678 25359 D -10/ DATA AK0INA(12)/ 0.52814 9717 D -11/ DATA AK0INA(13)/-0.10926 3199 D -11/ DATA AK0INA(14)/ 0.23518 838 D -12/ DATA AK0INA(15)/-0.52479 91 D -13/ DATA AK0INA(16)/ 0.12101 91 D -13/ DATA AK0INA(17)/-0.28763 2 D -14/ DATA AK0INA(18)/ 0.70297 D -15/ DATA AK0INA(19)/-0.17631 D -15/ DATA AK0INA(20)/ 0.4530 D -16/ DATA AK0INA(21)/-0.1190 D -16/ DATA AK0INA(22)/ 0.319 D -17/ DATA AK0INA(23)/-0.87 D -18/ DATA AK0INA(24)/ 0.24 D -18/ DATA AK0INA(25)/-0.7 D -19/ DATA AK0INA(26)/ 0.2 D -19/ DATA AK0INA(27)/-0.1 D -19/ C C Machine-dependent values (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3/14,14,23/ DATA XLOW,XHIGH/4.47034836D-8,36.0436534D0/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) K0INT = ZERO RETURN ENDIF C C Code for 0 <= XVALUE <= 6 C IF ( X .LE. SIX ) THEN IF ( X .LT. XLOW ) THEN FVAL = X IF ( X .GT. ZERO ) THEN FVAL = FVAL * ( CONST1 - LOG(X) ) ENDIF K0INT = FVAL ELSE T = ( ( X * X ) / EIGHTN - HALF ) - HALF FVAL = ( CONST2 + LOG(X) ) * CHEVAL(NTERM2,AK0IN2,T) K0INT = X * ( CHEVAL(NTERM1,AK0IN1,T) - FVAL ) ENDIF C C Code for x > 6 C ELSE FVAL = PIBY2 IF ( X .LT. XHIGH ) THEN T = ( TWELVE / X - HALF ) - HALF TEMP = EXP(-X) * CHEVAL(NTERM3,AK0INA,T) FVAL = FVAL - TEMP / ( SQRT(X) * RT2BPI) ENDIF K0INT = FVAL ENDIF RETURN END DOUBLE PRECISION FUNCTION LOBACH(XVALUE) C C DESCRIPTION: C C This function calculates the Lobachewsky function L(x), defined as C C LOBACH(x) = {integral 0 to x} ( -ln ( | cos t | ) dt C C The code uses Chebyshev expansions whose coefficients are given C to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If |x| too large, it is impossible to accurately reduce the C argument to the range [0,pi]. An error message is printed C and the program returns the value 0.0 C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used of the array ARLOB1. C The recommended value is such that C ABS(ARLOB1(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The no. of terms to be used of the array ARLOB2. C The recommended value is such that C ABS(ARLOB2(NTERM2)) < EPS/100 C C XLOW1 - DOUBLE PRECISION - The value below which L(x) = 0.0 to machine-precision. C The recommended value is C cube-root ( 6*XMIN ) C C XLOW2 - DOUBLE PRECISION - The value below which L(x) = x**3/6 to C machine-precision. The recommended value is C sqrt ( 10*EPS ) C C XLOW3 - DOUBLE PRECISION - The value below which C L(pi/2) - L(pi/2-x) = x ( 1 - log(x) ) C to machine-precision. The recommended value is C sqrt ( 18*EPS ) C C XHIGH - DOUBLE PRECISION - The value of |x| above which it is impossible C to accurately reduce the argument. The C recommended value is 1 / EPS. C C For values of EPS, and XMIN, refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: C 11 JANUARY, 1996 C INTEGER INDPI2,INDSGN,NPI,NTERM1,NTERM2 DOUBLE PRECISION ARLOB1(0:15),ARLOB2(0:10), 1 CHEVAL,FVAL,FVAL1,HALF,LBPB21,LBPB22,LOBPIA,LOBPIB, 2 LOBPI1,LOBPI2,ONE,ONEHUN,PI,PIBY2,PIBY21,PIBY22,PIBY4,PI1, 3 PI11,PI12,PI2,SIX,T,TCON,TEN,TWO,X,XCUB,XHIGH,XLOW1, 4 XLOW2,XLOW3,XR,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'LOBACH'/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,HALF/ 0.0 D 0 , 0.5 D 0 / DATA ONE,TWO,SIX/ 1.0 D 0 , 2.0 D 0 , 6.0 D 0 / DATA TEN,ONEHUN/ 10.0 D 0 , 100.0 D 0 / DATA LOBPIA,LOBPIB/ 1115.0 D 0 , 512.0 D 0 / DATA LOBPI2/-1.48284 69639 78694 99311 D -4/ DATA LBPB22/-7.41423 48198 93474 96556 D -5/ DATA PI11,PI12/ 201.0 D 0 , 64.0 D 0 / DATA PI2/9.67653 58979 32384 62643 D -4/ DATA PIBY22/4.83826 79489 66192 31322 D -4/ DATA TCON/3.24227 78765 54808 68620 D 0/ DATA ARLOB1/0.34464 88495 34813 00507 D 0, 1 0.58419 83571 90277 669 D -2, 2 0.19175 02969 46003 30 D -3, 3 0.78725 16064 56769 D -5, 4 0.36507 47741 5804 D -6, 5 0.18302 87272 680 D -7, 6 0.96890 33300 5 D -9, 7 0.53390 55444 D -10, 8 0.30340 8025 D -11, 9 0.17667 875 D -12, X 0.10493 93 D -13, 1 0.63359 D -15, 2 0.3878 D -16, 3 0.240 D -17, 4 0.15 D -18, 5 0.1 D -19/ DATA ARLOB2/2.03459 41803 61328 51087 D 0, 1 0.17351 85882 02740 7681 D -1, 2 0.55162 80426 09052 1 D -4, 3 0.39781 64627 6598 D -6, 4 0.36901 80289 18 D -8, 5 0.38804 09214 D -10, 6 0.44069 698 D -12, 7 0.52767 4 D -14, 8 0.6568 D -16, 9 0.84 D -18, X 0.1 D -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2/13,9/ DATA XLOW1,XLOW2/5.11091385D-103,4.71216091D-8/ DATA XLOW3,XHIGH/6.32202727D-8,4.5035996D15/ C C Start computation C X = ABS ( XVALUE ) INDSGN = 1 IF ( XVALUE .LT. ZERO ) THEN INDSGN = -1 ENDIF C C Error test C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) LOBACH = ZERO RETURN ENDIF C C Reduce argument to [0,pi] C PI1 = PI11/PI12 PI = PI1 + PI2 PIBY2 = PI/TWO PIBY21 = PI1/TWO PIBY4 = PIBY2/TWO NPI = INT ( X / PI ) XR = ( X - NPI * PI1 ) - NPI * PI2 C C Reduce argument to [0,pi/2] C INDPI2 = 0 IF ( XR .GT. PIBY2 ) THEN INDPI2 = 1 XR = ( PI1 - XR ) + PI2 ENDIF C C Code for argument in [0,pi/4] C IF ( XR .LE. PIBY4 ) THEN IF ( XR .LT. XLOW1 ) THEN FVAL = ZERO ELSE XCUB = XR * XR * XR IF ( XR .LT. XLOW2 ) THEN FVAL = XCUB / SIX ELSE T = ( TCON * XR * XR - HALF ) - HALF FVAL = XCUB * CHEVAL(NTERM1,ARLOB1,T) ENDIF ENDIF ELSE C C Code for argument in [pi/4,pi/2] C XR = ( PIBY21 - XR ) + PIBY22 IF ( XR .EQ. ZERO ) THEN FVAL1 = ZERO ELSE IF ( XR .LT. XLOW3 ) THEN FVAL1 = XR * ( ONE - LOG( XR ) ) ELSE T = ( TCON * XR * XR - HALF ) - HALF FVAL1 = XR * ( CHEVAL(NTERM2,ARLOB2,T) - LOG( XR ) ) ENDIF ENDIF LBPB21 = LOBPIA / ( LOBPIB + LOBPIB ) FVAL = ( LBPB21 - FVAL1 ) + LBPB22 ENDIF LOBPI1 = LOBPIA / LOBPIB C C Compute value for argument in [pi/2,pi] C IF ( INDPI2 .EQ. 1 ) THEN FVAL = ( LOBPI1 - FVAL ) + LOBPI2 ENDIF LOBACH = FVAL C C Scale up for arguments > pi C IF ( NPI .GT. 0 ) THEN LOBACH = ( FVAL + NPI * LOBPI2 ) + NPI * LOBPI1 ENDIF IF ( INDSGN .EQ. -1 ) THEN LOBACH = - LOBACH ENDIF RETURN END DOUBLE PRECISION FUNCTION STROM(XVALUE) C C DESCRIPTION: C C This program calculates Stromgren's integral, defined as C C STROM(X) = integral 0 to X { t**7 exp(2t)/[exp(t)-1]**3 } dt C C The code uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ASTROM to be used. C The recommended value is such that C ASTROM(NTERMS) < EPS/100 C C XLOW0 - DOUBLE PRECISION - The value below which STROM = 0.0 to machine C precision. The recommended value is C 5th root of (130*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which STROM = 3*(X**5)/(4*(pi**4)) C to machine precision. The recommended value is C 2*EPSNEG C C EPSLN - DOUBLE PRECISION - The value of ln(EPS). Used to determine the no. C of exponential terms for large X. C C EPNGLN - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent C overflow for large X. C C XHIGH - DOUBLE PRECISION - The value above which C STROM = 196.52 - 15*(x**7)*exp(-x)/(4pi**4) C to machine precision. The recommended value is C 7 / EPS C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 11 JANUARY, 1996 C C INTEGER K1,K2,NTERMS,NUMEXP DOUBLE PRECISION ASTROM(0:26),CHEVAL,EPNGLN,EPSLN,FOUR, 1 F15BP4,HALF,ONE,ONEHUN,ONE30,ONE5LN,PI4B3,RK, 2 SEVEN,SUMEXP,SUM2,T,TWO,VALINF,X,XHIGH, 3 XK,XK1,XLOW0,XLOW1,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'STROM '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA TWO,FOUR,SEVEN/ 2.0 D 0 , 4.0 D 0 , 7.0 D 0 / DATA ONEHUN,ONE30,ONE5LN/ 100.0 D 0 , 130.0 D 0 , 0.4055 D 0 / DATA F15BP4/0.38497 43345 50662 56959 D -1 / DATA PI4B3/1.29878 78804 53365 82982 D 2 / DATA VALINF/196.51956 92086 89882 61257 D 0/ DATA ASTROM(0)/ 0.56556 12087 25391 55290 D 0/ DATA ASTROM(1)/ 0.45557 31969 10178 5525 D -1/ DATA ASTROM(2)/ -0.40395 35875 93686 9170 D -1/ DATA ASTROM(3)/ -0.13339 05720 21486 815 D -2/ DATA ASTROM(4)/ 0.18586 25062 50538 030 D -2/ DATA ASTROM(5)/ -0.46855 55868 05365 9 D -4/ DATA ASTROM(6)/ -0.63434 75643 42294 9 D -4/ DATA ASTROM(7)/ 0.57254 87081 43200 D -5/ DATA ASTROM(8)/ 0.15935 28122 16822 D -5/ DATA ASTROM(9)/ -0.28884 32843 1036 D -6/ DATA ASTROM(10)/-0.24466 33604 801 D -7/ DATA ASTROM(11)/ 0.10072 50382 374 D -7/ DATA ASTROM(12)/-0.12482 98610 4 D -9/ DATA ASTROM(13)/-0.26300 62528 3 D -9/ DATA ASTROM(14)/ 0.24904 07578 D -10/ DATA ASTROM(15)/ 0.48545 4902 D -11/ DATA ASTROM(16)/-0.10537 8913 D -11/ DATA ASTROM(17)/-0.36044 17 D -13/ DATA ASTROM(18)/ 0.29920 78 D -13/ DATA ASTROM(19)/-0.16397 1 D -14/ DATA ASTROM(20)/-0.61061 D -15/ DATA ASTROM(21)/ 0.9335 D -16/ DATA ASTROM(22)/ 0.709 D -17/ DATA ASTROM(23)/-0.291 D -17/ DATA ASTROM(24)/ 0.8 D -19/ DATA ASTROM(25)/ 0.6 D -19/ DATA ASTROM(26)/-0.1 D -19/ C C Machine-dependent constants C DATA NTERMS/23/ DATA XLOW0,XLOW1/7.80293D-62,2.22045D-16/ DATA EPSLN,EPNGLN/-36.0436534D0,-36.7368006D0/ DATA XHIGH/3.1525197D16/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) STROM = ZERO RETURN ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW0 ) THEN STROM = ZERO ELSE IF ( X .LT. XLOW1 ) THEN STROM = (X**5) / PI4B3 ELSE T = ( ( X / TWO ) - HALF ) - HALF STROM = (X**5) * CHEVAL(NTERMS,ASTROM,T) * F15BP4 ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH ) THEN SUMEXP = ONE ELSE NUMEXP = INT( EPSLN / (ONE5LN - X ) ) + 1 IF ( NUMEXP .GT. 1 ) THEN T = EXP( -X ) ELSE T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , 7 SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUM2 = SUM2 * ( RK + ONE ) / TWO SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = SEVEN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. EPNGLN ) THEN STROM = VALINF ELSE STROM = VALINF - EXP(T) * F15BP4 ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION STRVH0(XVALUE) C C C DESCRIPTION: C C This function calculates the value of the Struve function C of order 0, denoted H0(x), for the argument XVALUE, defined C C STRVHO(x) = (2/pi) integral{0 to pi/2} sin(x cos(t)) dt C C H0 also satisfies the second-order equation C C x*D(Df) + Df + x*f = 2x/pi C C The code uses Chebyshev expansions whose coefficients are C given to 20D. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C As the asymptotic expansion of H0 involves the Bessel function C of the second kind Y0, there is a problem for large x, since C we cannot accurately calculate the value of Y0. An error message C is printed and STRVH0 returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array ARRH0. The C recommended value is such that C ABS(ARRH0(NTERM1)) < EPS/100. C C NTERM2 - The no. of terms to be used in the array ARRH0A. The C recommended value is such that C ABS(ARRH0A(NTERM2)) < EPS/100. C C NTERM3 - The no. of terms to be used in the array AY0ASP. The C recommended value is such that C ABS(AY0ASP(NTERM3)) < EPS/100. C C NTERM4 - The no. of terms to be used in the array AY0ASQ. The C recommended value is such that C ABS(AY0ASQ(NTERM4)) < EPS/100. C C XLOW - The value for which H0(x) = 2*x/pi to machine precision, if C abs(x) < XLOW. The recommended value is C XLOW = 3 * SQRT(EPSNEG) C C XHIGH - The value above which we are unable to calculate Y0 with C any reasonable accuracy. An error message is printed and C STRVH0 returns the value 0.0. The recommended value is C XHIGH = 1/EPS. C C For values of EPS and EPSNEG refer to the file MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C ABS, COS, SIN, SQRT. C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C ALLAN J. MACLEOD C DEPT. OF MATHEMATICS AND STATISTICS C UNIVERSITY OF PAISLEY C HIGH ST. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 11 JANUARY, 1996 C C INTEGER INDSGN,NTERM1,NTERM2,NTERM3,NTERM4 DOUBLE PRECISION ARRH0(0:19),ARRH0A(0:20),AY0ASP(0:12), 1 AY0ASQ(0:13),CHEVAL,EIGHT,ELEVEN,HALF,H0AS, 2 ONEHUN,ONE,PIBY4,RT2BPI,SIXTP5,T,THR2P5,TWENTY, 3 TWOBPI,TWO62,X,XHIGH,XLOW,XMP4,XSQ,XVALUE, 4 Y0P,Y0Q,Y0VAL,ZERO CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'STRVH0'/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,HALF,ONE/0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA EIGHT,ELEVEN/8.0 D 0 , 11.0 D 0/ DATA TWENTY,ONEHUN/20.0 D 0 , 100.0 D 0/ DATA SIXTP5,TWO62,THR2P5/60.5 D 0 , 262.0 D 0 , 302.5 D 0/ DATA PIBY4/0.78539 81633 97448 30962 D 0/ DATA RT2BPI/0.79788 45608 02865 35588 D 0/ DATA TWOBPI/0.63661 97723 67581 34308 D 0/ DATA ARRH0(0)/ 0.28696 48739 90132 25740 D 0/ DATA ARRH0(1)/ -0.25405 33268 16183 52305 D 0/ DATA ARRH0(2)/ 0.20774 02673 93238 94439 D 0/ DATA ARRH0(3)/ -0.20364 02956 03865 85140 D 0/ DATA ARRH0(4)/ 0.12888 46908 68661 86016 D 0/ DATA ARRH0(5)/ -0.48256 32815 62226 1202 D -1/ DATA ARRH0(6)/ 0.11686 29347 56900 1242 D -1/ DATA ARRH0(7)/ -0.19811 81356 42418 416 D -2/ DATA ARRH0(8)/ 0.24899 13851 24212 86 D -3/ DATA ARRH0(9)/ -0.24188 27913 78595 0 D -4/ DATA ARRH0(10)/ 0.18743 75479 93431 D -5/ DATA ARRH0(11)/-0.11873 34607 4362 D -6/ DATA ARRH0(12)/ 0.62698 49433 46 D -8/ DATA ARRH0(13)/-0.28045 54679 3 D -9/ DATA ARRH0(14)/ 0.10769 41205 D -10/ DATA ARRH0(15)/-0.35904 793 D -12/ DATA ARRH0(16)/ 0.10494 47 D -13/ DATA ARRH0(17)/-0.27119 D -15/ DATA ARRH0(18)/ 0.624 D -17/ DATA ARRH0(19)/-0.13 D -18/ DATA ARRH0A(0)/ 1.99291 88575 19923 05515 D 0/ DATA ARRH0A(1)/ -0.38423 26687 01456 887 D -2/ DATA ARRH0A(2)/ -0.32871 99371 23530 50 D -3/ DATA ARRH0A(3)/ -0.29411 81203 70340 9 D -4/ DATA ARRH0A(4)/ -0.26731 53519 87066 D -5/ DATA ARRH0A(5)/ -0.24681 03107 5013 D -6/ DATA ARRH0A(6)/ -0.22950 14861 143 D -7/ DATA ARRH0A(7)/ -0.21568 22318 33 D -8/ DATA ARRH0A(8)/ -0.20303 50648 3 D -9/ DATA ARRH0A(9)/ -0.19345 75509 D -10/ DATA ARRH0A(10)/-0.18277 3144 D -11/ DATA ARRH0A(11)/-0.17768 424 D -12/ DATA ARRH0A(12)/-0.16432 96 D -13/ DATA ARRH0A(13)/-0.17156 9 D -14/ DATA ARRH0A(14)/-0.13368 D -15/ DATA ARRH0A(15)/-0.2077 D -16/ DATA ARRH0A(16)/ 0.2 D -19/ DATA ARRH0A(17)/-0.55 D -18/ DATA ARRH0A(18)/ 0.10 D -18/ DATA ARRH0A(19)/-0.4 D -19/ DATA ARRH0A(20)/ 0.1 D -19/ DATA AY0ASP/1.99944 63940 23982 71568 D 0, 1 -0.28650 77864 70319 58 D -3, 2 -0.10050 72797 43762 0 D -4, 3 -0.35835 94100 2463 D -6, 4 -0.12879 65120 531 D -7, 5 -0.46609 48663 6 D -9, 6 -0.16937 69454 D -10, 7 -0.61852 269 D -12, 8 -0.22618 41 D -13, 9 -0.83268 D -15, X -0.3042 D -16, 1 -0.115 D -17, 2 -0.4 D -19/ DATA AY0ASQ/1.99542 68138 68286 04092 D 0, 1 -0.23601 31928 67514 472 D -2, 2 -0.76015 38908 50296 6 D -4, 3 -0.25610 88714 56343 D -5, 4 -0.87502 92185 106 D -7, 5 -0.30430 42121 59 D -8, 6 -0.10621 42831 4 D -9, 7 -0.37737 1479 D -11, 8 -0.13213 687 D -12, 9 -0.48862 1 D -14, X -0.15809 D -15, 1 -0.762 D -17, 2 -0.3 D -19, 3 -0.3 D -19/ C C MACHINE-DEPENDENT CONSTANTS (Suitable for IEEE-arithmetic machines) C DATA NTERM1,NTERM2,NTERM3,NTERM4/18,18,11,11/ DATA XLOW,XHIGH/3.1610136D-8,4.50359963D15/ C C Start computation C X = XVALUE INDSGN = 1 IF ( X .LT. ZERO ) THEN X = -X INDSGN = -1 ENDIF C C Error test C IF ( ABS(XVALUE) .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) STRVH0 = ZERO RETURN ENDIF C C Code for abs(x) <= 11 C IF ( X .LE. ELEVEN ) THEN IF ( X .LT. XLOW ) THEN STRVH0 = TWOBPI * X ELSE T = ( ( X * X ) / SIXTP5 - HALF ) - HALF STRVH0 = TWOBPI * X * CHEVAL ( NTERM1 , ARRH0 , T ) ENDIF ELSE C C Code for abs(x) > 11 C XSQ = X * X T = ( TWO62 - XSQ ) / ( TWENTY + XSQ ) Y0P = CHEVAL ( NTERM3 , AY0ASP , T ) Y0Q = CHEVAL ( NTERM4 , AY0ASQ , T ) / ( EIGHT * X ) XMP4 = X - PIBY4 Y0VAL = Y0P * SIN ( XMP4 ) - Y0Q * COS ( XMP4 ) Y0VAL = Y0VAL * RT2BPI / SQRT ( X ) T = ( THR2P5 - XSQ ) / ( SIXTP5 + XSQ ) H0AS = TWOBPI * CHEVAL ( NTERM2 , ARRH0A , T ) / X STRVH0 = Y0VAL + H0AS ENDIF IF ( INDSGN .EQ. -1 ) STRVH0 = -STRVH0 RETURN END DOUBLE PRECISION FUNCTION STRVH1(XVALUE) C C C DESCRIPTION: C This function calculates the value of the Struve function C of order 1, denoted H1(x), for the argument XVALUE, defined as C C 2 C STRVH1(x) = (2x/pi) integral{0 to pi/2} sin( x cos(t))*sin t dt C C H1 also satisfies the second-order differential equation C C 2 2 2 2 C x * D f + x * Df + (x - 1)f = 2x / pi C C The code uses Chebyshev expansions with the coefficients C given to 20D. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C As the asymptotic expansion of H1 involves the Bessel function C of the second kind Y1, there is a problem for large x, since C we cannot accurately calculate the value of Y1. An error message C is printed and STRVH1 returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array ARRH1. The C recommended value is such that C ABS(ARRH1(NTERM1)) < EPS/100. C C NTERM2 - The no. of terms to be used in the array ARRH1A. The C recommended value is such that C ABS(ARRH1A(NTERM2)) < EPS/100. C C NTERM3 - The no. of terms to be used in the array AY1ASP. The C recommended value is such that C ABS(AY1ASP(NTERM3)) < EPS/100. C C NTERM4 - The no. of terms to be used in the array AY1ASQ. The C recommended value is such that C ABS(AY1ASQ(NTERM4)) < EPS/100. C C XLOW1 - The value of x, below which H1(x) set to zero, if C abs(x) 9 C XSQ = X * X T = ( ONE82 - XSQ ) / ( TWENTY + XSQ ) Y1P = CHEVAL ( NTERM3 , AY1ASP , T ) Y1Q = CHEVAL ( NTERM4 , AY1ASQ , T ) / ( EIGHT * X) XM3P4 = X - THPBY4 Y1VAL = Y1P * SIN ( XM3P4 ) + Y1Q * COS ( XM3P4 ) Y1VAL = Y1VAL * RT2BPI / SQRT ( X ) T = ( TW02P5 - XSQ ) / ( FORTP5 + XSQ ) H1AS = TWOBPI * CHEVAL ( NTERM2 , ARRH1A , T ) STRVH1 = Y1VAL + H1AS ENDIF RETURN END DOUBLE PRECISION FUNCTION STRVL0(XVALUE) C C DESCRIPTION: C C This function calculates the modified Struve function of C order 0, denoted L0(x), defined as the solution of the C second-order equation C C x*D(Df) + Df - x*f = 2x/pi C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If the value of |XVALUE| is too large, the result C would cause an floating-pt overflow. An error message C is printed and the function returns the value of C sign(XVALUE)*XMAX where XMAX is the largest possible C floating-pt argument. C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The no. of terms for the array ARL0. C The recommended value is such that C ABS(ARL0(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The no. of terms for the array ARL0AS. C The recommended value is such that C ABS(ARL0AS(NTERM2)) < EPS/100 C C NTERM3 - INTEGER - The no. of terms for the array AI0ML0. C The recommended value is such that C ABS(AI0ML0(NTERM3)) < EPS/100 C C XLOW - DOUBLE PRECISION - The value of x below which L0(x) = 2*x/pi C to machine precision. The recommended value is C 3*SQRT(EPS) C C XHIGH1 - DOUBLE PRECISION - The value beyond which the Chebyshev series C in the asymptotic expansion of I0 - L0 gives C 1.0 to machine precision. The recommended value C is SQRT( 30/EPSNEG ) C C XHIGH2 - DOUBLE PRECISION - The value beyond which the Chebyshev series C in the asymptotic expansion of I0 gives 1.0 C to machine precision. The recommended value C is 28 / EPSNEG C C XMAX - DOUBLE PRECISION - The value of XMAX, where XMAX is the C largest possible floating-pt argument. C This is used to prevent overflow. C C For values of EPS, EPSNEG and XMAX the user should refer C to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C DR. ALLAN J. MACLEOD C DEPT. OF MATHEMATICS AND STATISTICS C UNIVERSITY OF PAISLEY C HIGH ST. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 12 JANUARY, 1996 C C INTEGER INDSGN,NTERM1,NTERM2,NTERM3 DOUBLE PRECISION ARL0(0:27),ARL0AS(0:15),AI0ML0(0:23), 1 ATEHUN,CHEVAL,CH1,CH2,FOUR,LNR2PI,ONE,ONEHUN, 2 SIXTEN,T,TEST,TWENT4,TWENT8,TWO,TWOBPI,TWO88, 3 X,XHIGH1,XHIGH2,XLOW,XMAX,XVALUE,XSQ,ZERO CHARACTER FNNAME*6,ERRMSG*24 DATA FNNAME/'STRVL0'/ DATA ERRMSG/'ARGUMENT CAUSES OVERFLOW'/ DATA ZERO,ONE,TWO/0.0 D 0 , 1.0 D 0 , 2.0 D 0/ DATA FOUR,SIXTEN/4.0 D 0 , 16.0 D 0/ DATA TWENT4,TWENT8,ONEHUN/24.0 D 0 , 28.0 D 0 , 100.0 D 0/ DATA TWO88,ATEHUN/288.0 D 0 , 800.0 D 0/ DATA LNR2PI/0.91893 85332 04672 74178 D 0/ DATA TWOBPI/0.63661 97723 67581 34308 D 0/ DATA ARL0(0)/ 0.42127 45834 99799 24863 D 0/ DATA ARL0(1)/ -0.33859 53639 12206 12188 D 0/ DATA ARL0(2)/ 0.21898 99481 27107 16064 D 0/ DATA ARL0(3)/ -0.12349 48282 07131 85712 D 0/ DATA ARL0(4)/ 0.62142 09793 86695 8440 D -1/ DATA ARL0(5)/ -0.28178 06028 10954 7545 D -1/ DATA ARL0(6)/ 0.11574 19676 63809 1209 D -1/ DATA ARL0(7)/ -0.43165 85743 06921 179 D -2/ DATA ARL0(8)/ 0.14614 23499 07298 329 D -2/ DATA ARL0(9)/ -0.44794 21180 54614 78 D -3/ DATA ARL0(10)/ 0.12364 74610 59437 61 D -3/ DATA ARL0(11)/-0.30490 28334 79704 4 D -4/ DATA ARL0(12)/ 0.66394 14015 21146 D -5/ DATA ARL0(13)/-0.12553 83577 03889 D -5/ DATA ARL0(14)/ 0.20073 44645 1228 D -6/ DATA ARL0(15)/-0.25882 60170 637 D -7/ DATA ARL0(16)/ 0.24114 37427 58 D -8/ DATA ARL0(17)/-0.10159 67435 2 D -9/ DATA ARL0(18)/-0.12024 30736 D -10/ DATA ARL0(19)/ 0.26290 6137 D -11/ DATA ARL0(20)/-0.15313 190 D -12/ DATA ARL0(21)/-0.15747 60 D -13/ DATA ARL0(22)/ 0.31563 5 D -14/ DATA ARL0(23)/-0.4096 D -16/ DATA ARL0(24)/-0.3620 D -16/ DATA ARL0(25)/ 0.239 D -17/ DATA ARL0(26)/ 0.36 D -18/ DATA ARL0(27)/-0.4 D -19/ DATA ARL0AS(0)/ 2.00861 30823 56058 88600 D 0/ DATA ARL0AS(1)/ 0.40373 79665 00438 470 D -2/ DATA ARL0AS(2)/ -0.25199 48028 65802 67 D -3/ DATA ARL0AS(3)/ 0.16057 36682 81117 6 D -4/ DATA ARL0AS(4)/ -0.10369 21824 73444 D -5/ DATA ARL0AS(5)/ 0.67655 78876 305 D -7/ DATA ARL0AS(6)/ -0.44499 99067 56 D -8/ DATA ARL0AS(7)/ 0.29468 88922 8 D -9/ DATA ARL0AS(8)/ -0.19621 80522 D -10/ DATA ARL0AS(9)/ 0.13133 0306 D -11/ DATA ARL0AS(10)/-0.88191 90 D -13/ DATA ARL0AS(11)/ 0.59537 6 D -14/ DATA ARL0AS(12)/-0.40389 D -15/ DATA ARL0AS(13)/ 0.2651 D -16/ DATA ARL0AS(14)/-0.208 D -17/ DATA ARL0AS(15)/ 0.11 D -18/ DATA AI0ML0(0)/ 2.00326 51024 11606 43125 D 0/ DATA AI0ML0(1)/ 0.19520 68515 76492 081 D -2/ DATA AI0ML0(2)/ 0.38239 52356 99083 28 D -3/ DATA AI0ML0(3)/ 0.75342 80817 05443 6 D -4/ DATA AI0ML0(4)/ 0.14959 57655 89707 8 D -4/ DATA AI0ML0(5)/ 0.29994 05312 10557 D -5/ DATA AI0ML0(6)/ 0.60769 60482 2459 D -6/ DATA AI0ML0(7)/ 0.12399 49554 4506 D -6/ DATA AI0ML0(8)/ 0.25232 62552 649 D -7/ DATA AI0ML0(9)/ 0.50463 48573 32 D -8/ DATA AI0ML0(10)/0.97913 23623 0 D -9/ DATA AI0ML0(11)/0.18389 11524 1 D -9/ DATA AI0ML0(12)/0.33763 09278 D -10/ DATA AI0ML0(13)/0.61117 9703 D -11/ DATA AI0ML0(14)/0.10847 2972 D -11/ DATA AI0ML0(15)/0.18861 271 D -12/ DATA AI0ML0(16)/0.32803 45 D -13/ DATA AI0ML0(17)/0.56564 7 D -14/ DATA AI0ML0(18)/0.93300 D -15/ DATA AI0ML0(19)/0.15881 D -15/ DATA AI0ML0(20)/0.2791 D -16/ DATA AI0ML0(21)/0.389 D -17/ DATA AI0ML0(22)/0.70 D -18/ DATA AI0ML0(23)/0.16 D -18/ C C MACHINE-DEPENDENT VALUES (Suitable for IEEE-arithmetic machines) C DATA NTERM1,NTERM2,NTERM3/25,14,21/ DATA XLOW,XMAX/4.4703484D-8,1.797693D308/ DATA XHIGH1,XHIGH2/5.1982303D8,2.5220158D17/ C C Start computation C X = XVALUE INDSGN = 1 IF ( X .LT. ZERO ) THEN X = -X INDSGN = -1 ENDIF C C Code for |xvalue| <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN STRVL0 = TWOBPI * X ELSE T = ( FOUR * X - TWENT4 ) / ( X + TWENT4 ) STRVL0 = TWOBPI * X * CHEVAL(NTERM1,ARL0,T) * EXP(X) ENDIF ELSE C C Code for |xvalue| > 16 C IF ( X .GT. XHIGH2 ) THEN CH1 = ONE ELSE T = ( X - TWENT8 ) / ( FOUR - X ) CH1 = CHEVAL(NTERM2,ARL0AS,T) ENDIF IF ( X .GT. XHIGH1 ) THEN CH2 = ONE ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) CH2 = CHEVAL(NTERM3,AI0ML0,T) ENDIF TEST = LOG(CH1) - LNR2PI - LOG(X)/TWO + X IF ( TEST .GT. LOG(XMAX) ) THEN CALL ERRPRN(FNNAME,ERRMSG) STRVL0 = XMAX ELSE STRVL0 = EXP(TEST) - TWOBPI * CH2 / X ENDIF ENDIF IF ( INDSGN .EQ. -1 ) STRVL0 = -STRVL0 RETURN END DOUBLE PRECISION FUNCTION STRVL1(XVALUE) C C DESCRIPTION: C C This function calculates the modified Struve function of C order 1, denoted L1(x), defined as the solution of C C x*x*D(Df) + x*Df - (x*x+1)f = 2*x*x/pi C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If the value of |XVALUE| is too large, the result C would cause an floating-pt overflow. An error message C is printed and the function returns the value of C sign(XVALUE)*XMAX where XMAX is the largest possible C floating-pt argument. C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The no. of terms for the array ARL1. C The recommended value is such that C ABS(ARL1(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The no. of terms for the array ARL1AS. C The recommended value is such that C ABS(ARL1AS(NTERM2)) < EPS/100 C C NTERM3 - INTEGER - The no. of terms for the array AI1ML1. C The recommended value is such that C ABS(AI1ML1(NTERM3)) < EPS/100 C C XLOW1 - DOUBLE PRECISION - The value of x below which C L1(x) = 2*x*x/(3*pi) C to machine precision. The recommended C value is SQRT(15*EPS) C C XLOW2 - DOUBLE PRECISION - The value of x below which L1(x) set to 0.0. C This is used to prevent underflow. The C recommended value is C SQRT(5*XMIN) C C XHIGH1 - DOUBLE PRECISION - The value of |x| above which the Chebyshev C series in the asymptotic expansion of I1 C equals 1.0 to machine precision. The C recommended value is SQRT( 30 / EPSNEG ). C C XHIGH2 - DOUBLE PRECISION - The value of |x| above which the Chebyshev C series in the asymptotic expansion of I1 - L1 C equals 1.0 to machine precision. The recommended C value is 30 / EPSNEG. C C XMAX - DOUBLE PRECISION - The value of XMAX, where XMAX is the C largest possible floating-pt argument. C This is used to prevent overflow. C C For values of EPS, EPSNEG, XMIN, and XMAX the user should refer C to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C DR. ALLAN J. MACLEOD C DEPT. OF MATHEMATICS AND STATISTICS C UNIVERSITY OF PAISLEY C HIGH ST. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: C 12 JANUARY, 1996 C C INTEGER NTERM1,NTERM2,NTERM3 DOUBLE PRECISION ARL1(0:26),ARL1AS(0:16),AI1ML1(0:25), 1 ATEHUN,CHEVAL,CH1,CH2,FOUR,LNR2PI, 2 ONE,ONEHUN,PI3BY2,SIXTEN,T,TEST,THIRTY,TWENT4, 3 TWO,TWOBPI,TWO88,X,XHIGH1,XHIGH2,XLOW1,XLOW2, 4 XMAX,XVALUE,XSQ,ZERO CHARACTER FNNAME*6,ERRMSG*24 DATA FNNAME/'STRVL1'/ DATA ERRMSG/'ARGUMENT CAUSES OVERFLOW'/ DATA ZERO,ONE,TWO/0.0 D 0 , 1.0 D 0 , 2.0 D 0/ DATA FOUR,SIXTEN/4.0 D 0 , 16.0 D 0/ DATA TWENT4,THIRTY/24.0 D 0 , 30.0 D 0/ DATA ONEHUN/100.0 D 0/ DATA TWO88,ATEHUN/288.0 D 0 , 800.0 D 0/ DATA LNR2PI/0.91893 85332 04672 74178 D 0/ DATA PI3BY2/4.71238 89803 84689 85769 D 0/ DATA TWOBPI/0.63661 97723 67581 34308 D 0/ DATA ARL1(0)/ 0.38996 02735 12295 38208 D 0/ DATA ARL1(1)/ -0.33658 09610 19757 49366 D 0/ DATA ARL1(2)/ 0.23012 46791 25016 45616 D 0/ DATA ARL1(3)/ -0.13121 59400 79608 32327 D 0/ DATA ARL1(4)/ 0.64259 22289 91284 6518 D -1/ DATA ARL1(5)/ -0.27500 32950 61663 5833 D -1/ DATA ARL1(6)/ 0.10402 34148 63720 8871 D -1/ DATA ARL1(7)/ -0.35053 22949 36388 080 D -2/ DATA ARL1(8)/ 0.10574 84984 21439 717 D -2/ DATA ARL1(9)/ -0.28609 42640 36665 58 D -3/ DATA ARL1(10)/ 0.69257 08785 94220 8 D -4/ DATA ARL1(11)/-0.14896 93951 12271 7 D -4/ DATA ARL1(12)/ 0.28103 55825 97128 D -5/ DATA ARL1(13)/-0.45503 87929 7776 D -6/ DATA ARL1(14)/ 0.60901 71561 770 D -7/ DATA ARL1(15)/-0.62354 37248 08 D -8/ DATA ARL1(16)/ 0.38430 01206 7 D -9/ DATA ARL1(17)/ 0.79054 3916 D -11/ DATA ARL1(18)/-0.48982 4083 D -11/ DATA ARL1(19)/ 0.46356 884 D -12/ DATA ARL1(20)/ 0.68420 5 D -14/ DATA ARL1(21)/-0.56974 8 D -14/ DATA ARL1(22)/ 0.35324 D -15/ DATA ARL1(23)/ 0.4244 D -16/ DATA ARL1(24)/-0.644 D -17/ DATA ARL1(25)/-0.21 D -18/ DATA ARL1(26)/ 0.9 D -19/ DATA ARL1AS(0)/ 1.97540 37844 16523 56868 D 0/ DATA ARL1AS(1)/ -0.11951 30555 08829 4181 D -1/ DATA ARL1AS(2)/ 0.33639 48526 91960 46 D -3/ DATA ARL1AS(3)/ -0.10091 15655 48154 9 D -4/ DATA ARL1AS(4)/ 0.30638 95132 1998 D -6/ DATA ARL1AS(5)/ -0.95370 43703 96 D -8/ DATA ARL1AS(6)/ 0.29524 73555 8 D -9/ DATA ARL1AS(7)/ -0.95107 8318 D -11/ DATA ARL1AS(8)/ 0.28203 667 D -12/ DATA ARL1AS(9)/ -0.11341 75 D -13/ DATA ARL1AS(10)/ 0.147 D -17/ DATA ARL1AS(11)/-0.6232 D -16/ DATA ARL1AS(12)/-0.751 D -17/ DATA ARL1AS(13)/-0.17 D -18/ DATA ARL1AS(14)/ 0.51 D -18/ DATA ARL1AS(15)/ 0.23 D -18/ DATA ARL1AS(16)/ 0.5 D -19/ DATA AI1ML1(0)/ 1.99679 36189 67891 36501 D 0/ DATA AI1ML1(1)/ -0.19066 32614 09686 132 D -2/ DATA AI1ML1(2)/ -0.36094 62241 01744 81 D -3/ DATA AI1ML1(3)/ -0.68418 47304 59982 0 D -4/ DATA AI1ML1(4)/ -0.12990 08228 50942 6 D -4/ DATA AI1ML1(5)/ -0.24715 21887 05765 D -5/ DATA AI1ML1(6)/ -0.47147 83969 1972 D -6/ DATA AI1ML1(7)/ -0.90208 19982 592 D -7/ DATA AI1ML1(8)/ -0.17304 58637 504 D -7/ DATA AI1ML1(9)/ -0.33232 36701 59 D -8/ DATA AI1ML1(10)/-0.63736 42173 5 D -9/ DATA AI1ML1(11)/-0.12180 23975 6 D -9/ DATA AI1ML1(12)/-0.23173 46832 D -10/ DATA AI1ML1(13)/-0.43906 8833 D -11/ DATA AI1ML1(14)/-0.82847 110 D -12/ DATA AI1ML1(15)/-0.15562 249 D -12/ DATA AI1ML1(16)/-0.29131 12 D -13/ DATA AI1ML1(17)/-0.54396 5 D -14/ DATA AI1ML1(18)/-0.10117 7 D -14/ DATA AI1ML1(19)/-0.18767 D -15/ DATA AI1ML1(20)/-0.3484 D -16/ DATA AI1ML1(21)/-0.643 D -17/ DATA AI1ML1(22)/-0.118 D -17/ DATA AI1ML1(23)/-0.22 D -18/ DATA AI1ML1(24)/-0.4 D -19/ DATA AI1ML1(25)/-0.1 D -19/ C C MACHINE-DEPENDENT VALUES (Suitable for IEEE-arithmetic machines) C DATA NTERM1,NTERM2,NTERM3/24,13,22/ DATA XLOW1,XLOW2,XMAX/5.7711949D-8,3.3354714D-154,1.797693D308/ DATA XHIGH1,XHIGH2/5.19823025D8,2.7021597D17/ C C START CALCULATION C X = ABS ( XVALUE ) C C CODE FOR |XVALUE| <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LE. XLOW2 ) THEN STRVL1 = ZERO ELSE XSQ = X * X IF ( X .LT. XLOW1 ) THEN STRVL1 = XSQ / PI3BY2 ELSE T = ( FOUR * X - TWENT4 ) / ( X + TWENT4 ) STRVL1 = XSQ * CHEVAL(NTERM1,ARL1,T) * EXP(X) / PI3BY2 ENDIF ENDIF ELSE C C CODE FOR |XVALUE| > 16 C IF ( X .GT. XHIGH2 ) THEN CH1 = ONE ELSE T = ( X - THIRTY ) / ( TWO - X ) CH1 = CHEVAL(NTERM2,ARL1AS,T) ENDIF IF ( X .GT. XHIGH1 ) THEN CH2 = ONE ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) CH2 = CHEVAL(NTERM3,AI1ML1,T) ENDIF TEST = LOG(CH1) - LNR2PI - LOG(X)/TWO + X IF ( TEST .GT. LOG(XMAX) ) THEN CALL ERRPRN(FNNAME,ERRMSG) STRVL1 = XMAX ELSE STRVL1 = EXP(TEST) - TWOBPI * CH2 ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION SYNCH1(XVALUE) C C DESCRIPTION: C C This function calculates the synchrotron radiation function C defined as C C SYNCH1(x) = x * Integral{x to inf} K(5/3)(t) dt, C C where K(5/3) is a modified Bessel function of order 5/3. C C The code uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C The function is undefined if x < 0.0. If XVALUE < 0.0, C an error message is printed and the function returns C the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms needed from the array C ASYNC1. The recommended value is such that C ABS(ASYNC1(NTERM1)) < EPS/100. C C NTERM2 - INTEGER - The no. of terms needed from the array C ASYNC2. The recommended value is such that C ABS(ASYNC2(NTERM2)) < EPS/100. C C NTERM3 - INTEGER - The no. of terms needed from the array C ASYNCA. The recommended value is such that C ABS(ASYNCA(NTERM3)) < EPS/100. C C XLOW - DOUBLE PRECISION - The value below which C SYNCH1(x) = 2.14952.. * (x**(1/3)) C to machine precision. The recommended value C is sqrt (8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which C SYNCH1(x) = 0.0 C to machine precision. The recommended value C is -8*LN(XMIN)/7 C C XHIGH2 - DOUBLE PRECISION - The value of LN(XMIN). This is used C to prevent underflow in calculations C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: C 12 JANUARY, 1996 C INTEGER NTERM1,NTERM2,NTERM3 DOUBLE PRECISION ASYNC1(0:13),ASYNC2(0:11),ASYNCA(0:24), 1 CHEB1,CHEB2,CHEVAL,CONLOW,EIGHT,FOUR,HALF, 2 LNRTP2,ONE,ONEHUN,PIBRT3,T,THREE,TWELVE,X,XHIGH1, 3 XHIGH2,XLOW,XPOWTH,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'SYNCH1'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA THREE,FOUR/ 3.0 D 0 , 4.0 D 0 / DATA EIGHT,TWELVE/ 8.0 D 0 , 12.0 D 0 / DATA ONEHUN/ 100.0 D 0 / DATA CONLOW/2.14952 82415 34478 63671 D 0/ DATA PIBRT3/1.81379 93642 34217 85059 D 0/ DATA LNRTP2/0.22579 13526 44727 43236 D 0/ DATA ASYNC1/30.36468 29825 01076 27340 D 0, 1 17.07939 52774 08394 57449 D 0, 2 4.56013 21335 45072 88887 D 0, 3 0.54928 12467 30419 97963 D 0, 4 0.37297 60750 69301 1724 D -1, 5 0.16136 24302 01041 242 D -2, 6 0.48191 67721 20370 7 D -4, 7 0.10512 42528 89384 D -5, 8 0.17463 85046 697 D -7, 9 0.22815 48654 4 D -9, X 0.24044 3082 D -11, 1 0.20865 88 D -13, 2 0.15167 D -15, 3 0.94 D -18/ DATA ASYNC2/0.44907 21623 53266 08443 D 0, 1 0.89835 36779 94187 2179 D -1, 2 0.81044 57377 21512 894 D -2, 3 0.42617 16991 08916 19 D -3, 4 0.14760 96312 70746 0 D -4, 5 0.36286 33615 3998 D -6, 6 0.66634 80749 84 D -8, 7 0.94907 71655 D -10, 8 0.10791 2491 D -11, 9 0.10022 01 D -13, X 0.7745 D -16, 1 0.51 D -18/ DATA ASYNCA(0)/ 2.13293 05161 35500 09848 D 0/ DATA ASYNCA(1)/ 0.74135 28649 54200 2401 D -1/ DATA ASYNCA(2)/ 0.86968 09990 99641 978 D -2/ DATA ASYNCA(3)/ 0.11703 82624 87756 921 D -2/ DATA ASYNCA(4)/ 0.16451 05798 61919 15 D -3/ DATA ASYNCA(5)/ 0.24020 10214 20640 3 D -4/ DATA ASYNCA(6)/ 0.35827 75638 93885 D -5/ DATA ASYNCA(7)/ 0.54477 47626 9837 D -6/ DATA ASYNCA(8)/ 0.83880 28561 957 D -7/ DATA ASYNCA(9)/ 0.13069 88268 416 D -7/ DATA ASYNCA(10)/0.20530 99071 44 D -8/ DATA ASYNCA(11)/0.32518 75368 8 D -9/ DATA ASYNCA(12)/0.51791 40412 D -10/ DATA ASYNCA(13)/0.83002 9881 D -11/ DATA ASYNCA(14)/0.13352 7277 D -11/ DATA ASYNCA(15)/0.21591 498 D -12/ DATA ASYNCA(16)/0.34996 73 D -13/ DATA ASYNCA(17)/0.56994 2 D -14/ DATA ASYNCA(18)/0.92906 D -15/ DATA ASYNCA(19)/0.15222 D -15/ DATA ASYNCA(20)/0.2491 D -16/ DATA ASYNCA(21)/0.411 D -17/ DATA ASYNCA(22)/0.67 D -18/ DATA ASYNCA(23)/0.11 D -18/ DATA ASYNCA(24)/0.2 D -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3/12,10,21/ DATA XLOW/2.98023224D-8/ DATA XHIGH1,XHIGH2/809.595907D0,-708.396418D0/ C C Start calculation C X = XVALUE IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) SYNCH1 = ZERO RETURN ENDIF C C Code for 0 <= x <= 4 C IF ( X .LE. FOUR ) THEN XPOWTH = X ** ( ONE / THREE ) IF ( X .LT. XLOW ) THEN SYNCH1 = CONLOW * XPOWTH ELSE T = ( X * X / EIGHT - HALF ) - HALF CHEB1 = CHEVAL(NTERM1,ASYNC1,T) CHEB2 = CHEVAL(NTERM2,ASYNC2,T) T = XPOWTH * CHEB1 - ( XPOWTH**11 ) * CHEB2 SYNCH1 = T - PIBRT3 * X ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN SYNCH1 = ZERO ELSE T = ( TWELVE - X ) / ( X + FOUR ) CHEB1 = CHEVAL(NTERM3,ASYNCA,T) T = LNRTP2 - X + LOG( SQRT(X) * CHEB1 ) IF ( T .LT. XHIGH2 ) THEN SYNCH1 = ZERO ELSE SYNCH1 = EXP(T) ENDIF ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION SYNCH2(XVALUE) C C DESCRIPTION: C C This function calculates the synchrotron radiation function C defined as C C SYNCH2(x) = x * K(2/3)(x) C C where K(2/3) is a modified Bessel function of order 2/3. C C The code uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C The function is undefined if x < 0.0. If XVALUE < 0.0, C an error message is printed and the function returns C the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms needed from the array C ASYNC1. The recommended value is such that C ABS(ASYN21(NTERM1)) < EPS/100. C C NTERM2 - INTEGER - The no. of terms needed from the array C ASYNC2. The recommended value is such that C ABS(ASYN22(NTERM2)) < EPS/100. C C NTERM3 - INTEGER - The no. of terms needed from the array C ASYNCA. The recommended value is such that C ABS(ASYN2A(NTERM3)) < EPS/100. C C XLOW - DOUBLE PRECISION - The value below which C SYNCH2(x) = 1.074764... * (x**(1/3)) C to machine precision. The recommended value C is sqrt (8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which C SYNCH2(x) = 0.0 C to machine precision. The recommended value C is -8*LN(XMIN)/7 C C XHIGH2 - DOUBLE PRECISION - The value of LN(XMIN). This is used C to prevent underflow in calculations C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST UPDATE: C 12 JANUARY, 1996 C INTEGER NTERM1,NTERM2,NTERM3 DOUBLE PRECISION ASYN21(0:14),ASYN22(0:13),ASYN2A(0:18), 1 CHEB1,CHEB2,CHEVAL,CONLOW,EIGHT,FOUR,HALF, 2 LNRTP2,ONE,ONEHUN,T,TEN,THREE,TWO,X,XHIGH1, 3 XHIGH2,XLOW,XPOWTH,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'SYNCH2'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA TWO,THREE,FOUR/ 2.0 D 0 , 3.0 D 0 , 4.0 D 0 / DATA EIGHT,TEN,ONEHUN/ 8.0 D 0 , 10.0 D 0 , 100.0 D 0/ DATA CONLOW/1.07476 41207 67239 31836 D 0/ DATA LNRTP2/0.22579 13526 44727 43236 D 0/ DATA ASYN21/38.61783 99238 43085 48014 D 0, 1 23.03771 55949 63734 59697 D 0, 2 5.38024 99868 33570 59676 D 0, 3 0.61567 93806 99571 07760 D 0, 4 0.40668 80046 68895 5843 D -1, 5 0.17296 27455 26484 141 D -2, 6 0.51061 25883 65769 9 D -4, 7 0.11045 95950 22012 D -5, 8 0.18235 53020 649 D -7, 9 0.23707 69803 4 D -9, X 0.24887 2963 D -11, 1 0.21528 68 D -13, 2 0.15607 D -15, 3 0.96 D -18, 4 0.1 D -19/ DATA ASYN22/7.90631 48270 66080 42875 D 0, 1 3.13534 63612 85342 56841 D 0, 2 0.48548 79477 45371 45380 D 0, 3 0.39481 66758 27237 2337 D -1, 4 0.19661 62233 48088 022 D -2, 5 0.65907 89322 93042 0 D -4, 6 0.15857 56134 98559 D -5, 7 0.28686 53011 233 D -7, 8 0.40412 02359 5 D -9, 9 0.45568 4443 D -11, X 0.42045 90 D -13, 1 0.32326 D -15, 2 0.210 D -17, 3 0.1 D -19/ DATA ASYN2A/2.02033 70941 70713 60032 D 0, 1 0.10956 23712 18074 0443 D -1, 2 0.85423 84730 11467 55 D -3, 3 0.72343 02421 32822 2 D -4, 4 0.63124 42796 26992 D -5, 5 0.56481 93141 1744 D -6, 6 0.51283 24801 375 D -7, 7 0.47196 53291 45 D -8, 8 0.43807 44214 3 D -9, 9 0.41026 81493 D -10, X 0.38623 0721 D -11, 1 0.36613 228 D -12, 2 0.34802 32 D -13, 3 0.33301 0 D -14, 4 0.31856 D -15, 5 0.3074 D -16, 6 0.295 D -17, 7 0.29 D -18, 8 0.3 D -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3/13,12,16/ DATA XLOW/2.98023224D-8/ DATA XHIGH1,XHIGH2/809.595907D0,-708.396418D0/ C C Start calculation C X = XVALUE IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) SYNCH2 = ZERO RETURN ENDIF C C Code for 0 <= x <= 4 C IF ( X .LE. FOUR ) THEN XPOWTH = X ** ( ONE / THREE ) IF ( X .LT. XLOW ) THEN SYNCH2 = CONLOW * XPOWTH ELSE T = ( X * X / EIGHT - HALF ) - HALF CHEB1 = CHEVAL(NTERM1,ASYN21,T) CHEB2 = CHEVAL(NTERM2,ASYN22,T) SYNCH2 = XPOWTH * CHEB1 - ( XPOWTH**5 ) * CHEB2 ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN SYNCH2 = ZERO ELSE T = ( TEN - X ) / ( X + TWO ) CHEB1 = CHEVAL(NTERM3,ASYN2A,T) T = LNRTP2 - X + LOG( SQRT(X) * CHEB1 ) IF ( T .LT. XHIGH2 ) THEN SYNCH2 = ZERO ELSE SYNCH2 = EXP(T) ENDIF ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN02(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 2, defined as C C TRAN02(X) = integral 0 to X { t**2 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW1 - DOUBLE PRECISION - The value below which TRAN02 = x to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large x contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN02 = VALINF - x**2 exp(-x) C The recommended value is 2/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 12 JANUARY, 1996 C C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN02'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 2 , 2.0 D 0 / DATA VALINF/0.32898 68133 69645 28729 D 1/ DATA ATRAN/1.67176 04464 34538 50301 D 0, 1 -0.14773 53599 46794 48986 D 0, 2 0.14821 38199 46936 3384 D -1, 3 -0.14195 33032 63056 126 D -2, 4 0.13065 41324 41570 83 D -3, 5 -0.11715 57958 67579 0 D -4, 6 0.10333 49844 57557 D -5, 7 -0.90191 13042 227 D -7, 8 0.78177 16983 31 D -8, 9 -0.67445 65684 0 D -9, X 0.57994 63945 D -10, 1 -0.49747 6185 D -11, 2 0.42596 097 D -12, 3 -0.36421 89 D -13, 4 0.31108 6 D -14, 5 -0.26547 D -15, 6 0.2264 D -16, 7 -0.193 D -17, 8 0.16 D -18, 9 -0.1 D -19/ C C Machine-dependent constants C DATA NTERMS/17/ DATA XLOW1/2.98023224D-8/ DATA XHIGH1,XHIGH3/36.04365668D0,-36.73680056D0/ DATA XHIGH2/9.00719925D15/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN02 = ZERO RETURN ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW1 ) THEN TRAN02 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN02 = ( X ** ( NUMJN - 1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP(-X) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. XHIGH3 ) THEN TRAN02 = VALINF ELSE TRAN02 = VALINF - EXP(T) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN03(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 3, defined as C C TRAN03(X) = integral 0 to X { t**3 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - DOUBLE PRECISION - The value below which TRAN03 = 0.0 to machine C precision. The recommended value is C square root of (2*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which TRAN03 = X**2/2 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN03 = VALINF - X**3 exp(-X) C The recommended value is 3/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 12 JANUARY, 1996 C C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN03'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 3 , 3.0 D 0 / DATA VALINF/0.72123 41418 95756 57124 D 1/ DATA ATRAN/0.76201 25432 43872 00657 D 0, 1 -0.10567 43877 05058 53250 D 0, 2 0.11977 80848 19657 8097 D -1, 3 -0.12144 01520 36983 073 D -2, 4 0.11550 99769 39285 47 D -3, 5 -0.10581 59921 24422 9 D -4, 6 0.94746 63385 3018 D -6, 7 -0.83622 12128 581 D -7, 8 0.73109 09927 75 D -8, 9 -0.63505 94778 8 D -9, X 0.54911 82819 D -10, 1 -0.47321 3954 D -11, 2 0.40676 948 D -12, 3 -0.34897 06 D -13, 4 0.29892 3 D -14, 5 -0.25574 D -15, 6 0.2186 D -16, 7 -0.187 D -17, 8 0.16 D -18, 9 -0.1 D -19/ C C Machine-dependent constants C DATA NTERMS/17/ DATA XLOW1,XLOW2/2.98023224D-8,2.10953733D-154/ DATA XHIGH1,XHIGH3/36.04365668D0,-36.73680056D0/ DATA XHIGH2/1.35107988D16/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN03 = ZERO RETURN ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN03 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN03 = ( X**(NUMJN-1) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X*X ) / EIGHT ) - HALF ) - HALF TRAN03 = ( X**(NUMJN-1) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT(XHIGH1/X) + 1 T = EXP(-X) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. XHIGH3 ) THEN TRAN03 = VALINF ELSE TRAN03 = VALINF - EXP(T) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN04(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 4, defined as C C TRAN04(X) = integral 0 to X { t**4 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - DOUBLE PRECISION - The value below which TRAN04 = 0.0 to machine C precision. The recommended value is C cube root of (3*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which TRAN04 = X**3/3 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN04 = VALINF - X**4 exp(-X) C The recommended value is 4/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 12 JANUARY, 1996 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN04'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 4 , 4.0 D 0 / DATA VALINF/0.25975 75760 90673 16596 D 2/ DATA ATRAN/0.48075 70994 61511 05786 D 0, 1 -0.81753 78810 32108 3956 D -1, 2 0.10027 00665 97516 2973 D -1, 3 -0.10599 33935 98201 507 D -2, 4 0.10345 06245 03040 53 D -3, 5 -0.96442 70548 58991 D -5, 6 0.87455 44408 5147 D -6, 7 -0.77932 12079 811 D -7, 8 0.68649 88614 10 D -8, 9 -0.59995 71076 4 D -9, X 0.52136 62413 D -10, 1 -0.45118 3819 D -11, 2 0.38921 592 D -12, 3 -0.33493 60 D -13, 4 0.28766 7 D -14, 5 -0.24668 D -15, 6 0.2113 D -16, 7 -0.181 D -17, 8 0.15 D -18, 9 -0.1 D -19/ C C Machine-dependent constants C DATA NTERMS/17/ DATA XLOW1,XLOW2/2.98023224D-8,4.05653502D-103/ DATA XHIGH1,XHIGH3/36.04365668D0,-36.73680056D0/ DATA XHIGH2/1.80143985D16/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN04 = ZERO RETURN ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN04 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN04 = ( X ** ( NUMJN-1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN04 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP ( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE/ ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN04 = VALINF ELSE TRAN04 = VALINF - EXP( T ) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN05(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order n, defined as C C TRAN05(X) = integral 0 to X { t**5 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - DOUBLE PRECISION - The value below which TRAN05 = 0.0 to machine C precision. The recommended value is C 4th root of (4*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which TRAN05 = X**4/4 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN05 = VALINF - X**5 exp(-X) C The recommended value is 5/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 12 JANUARY, 1996 C C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN05'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 5 , 5.0 D 0 / DATA VALINF/0.12443 13306 17204 39116 D 3/ DATA ATRAN/0.34777 77771 33910 78928 D 0, 1 -0.66456 98897 60504 2801 D -1, 2 0.86110 72656 88330 882 D -2, 3 -0.93966 82223 75553 84 D -3, 4 0.93632 48060 81513 4 D -4, 5 -0.88571 31934 08328 D -5, 6 0.81191 49891 4503 D -6, 7 -0.72957 65423 277 D -7, 8 0.64697 14550 45 D -8, 9 -0.56849 02825 5 D -9, X 0.49625 59787 D -10, 1 -0.43109 3996 D -11, 2 0.37310 094 D -12, 3 -0.32197 69 D -13, 4 0.27722 0 D -14, 5 -0.23824 D -15, 6 0.2044 D -16, 7 -0.175 D -17, 8 0.15 D -18, 9 -0.1 D -19/ C C Machine-dependent constants C DATA NTERMS/17/ DATA XLOW1,XLOW2/2.98023224D-8,1.72723372D-77/ DATA XHIGH1,XHIGH3/36.04365668D0,-36.73680056D0/ DATA XHIGH2/2.25179981D16/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN05 = ZERO RETURN ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN05 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN05 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN05 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP ( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG ( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN05 = VALINF ELSE TRAN05 = VALINF - EXP( T ) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN06(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 6, defined as C C TRAN06(X) = integral 0 to X { t**6 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - DOUBLE PRECISION - The value below which TRAN06 = 0.0 to machine C precision. The recommended value is C 5th root of (5*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which TRAN06 = X**5/5 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN06 = VALINF - X**6 exp(-X) C The recommended value is 6/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 12 JANUARY, 1996 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN06'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 6 , 6.0 D 0 / DATA VALINF/0.73248 70046 28803 38059 D 3/ DATA ATRAN/0.27127 33539 78400 08227 D 0, 1 -0.55886 10553 19145 3393 D -1, 2 0.75391 95132 90083 056 D -2, 3 -0.84351 13857 92112 19 D -3, 4 0.85490 98079 67670 2 D -4, 5 -0.81871 54932 93098 D -5, 6 0.75754 24042 7986 D -6, 7 -0.68573 06541 831 D -7, 8 0.61170 03760 31 D -8, 9 -0.54012 70702 4 D -9, X 0.47343 06435 D -10, 1 -0.41270 1055 D -11, 2 0.35825 603 D -12, 3 -0.30997 52 D -13, 4 0.26750 1 D -14, 5 -0.23036 D -15, 6 0.1980 D -16, 7 -0.170 D -17, 8 0.15 D -18, 9 -0.1 D -19/ C C Machine-dependent constants C DATA NTERMS/17/ DATA XLOW1,XLOW2/2.98023224D-8,4.06689432D-62/ DATA XHIGH1,XHIGH3/36.04365668D0,-36.73680056D0/ DATA XHIGH2/2.70215977D16/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN06 = ZERO RETURN ENDIF C C Code for x < = 4 .0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN06 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN06 = ( X ** ( NUMJN-1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN06 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4 .0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP( - X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN06 = VALINF ELSE TRAN06 = VALINF - EXP( T ) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN07(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 7, defined as C C TRAN07(X) = integral 0 to X { t**7 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - DOUBLE PRECISION - The value below which TRAN07 = 0.0 to machine C precision. The recommended value is C 6th root of (6*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which TRAN07 = X**6/6 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN07 = VALINF - X**7 exp(-X) C The recommended value is 7/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 12 JANUARY, 1996 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN07'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0/ DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 7 , 7.0 D 0/ DATA VALINF/0.50820 80358 00489 10473 D 4/ DATA ATRAN/0.22189 25073 40104 04423 D 0, 1 -0.48167 51061 17799 3694 D -1, 2 0.67009 24481 03153 629 D -2, 3 -0.76495 18344 30825 57 D -3, 4 0.78634 85592 34869 0 D -4, 5 -0.76102 51808 87504 D -5, 6 0.70991 69629 9917 D -6, 7 -0.64680 25624 903 D -7, 8 0.58003 92339 60 D -8, 9 -0.51443 37014 9 D -9, X 0.45259 44183 D -10, 1 -0.39580 0363 D -11, 2 0.34453 785 D -12, 3 -0.29882 92 D -13, 4 0.25843 4 D -14, 5 -0.22297 D -15, 6 0.1920 D -16, 7 -0.165 D -17, 8 0.14 D -18, 9 -0.1 D -19/ C C Machine-dependent constants C DATA NTERMS/17/ DATA XLOW1,XLOW2/2.98023224D-8,7.14906557D-52/ DATA XHIGH1,XHIGH3/36.04365668D0,-36.73680056D0/ DATA XHIGH2/3.15251973D16/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN07 = ZERO RETURN ENDIF C C Code for x <= 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN07 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN07 = ( X**(NUMJN-1) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X*X ) / EIGHT ) - HALF ) - HALF TRAN07 = ( X**(NUMJN-1) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1/X ) + 1 T = EXP( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. XHIGH3 ) THEN TRAN07 = VALINF ELSE TRAN07 = VALINF - EXP(T) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN08(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 8, defined as C C TRAN08(X) = integral 0 to X { t**8 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - DOUBLE PRECISION - The value below which TRAN08 = 0.0 to machine C precision. The recommended value is C 7th root of (7*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which TRAN08 = X**7/7 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN08 = VALINF - X**8 exp(-X) C The recommended value is 8/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 12 JANUARY, 1996 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN08'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 8 , 8.0 D 0 / DATA VALINF/0.40484 39900 19011 15764 D 5/ DATA ATRAN/0.18750 69577 40437 19233 D 0, 1 -0.42295 27646 09367 3337 D -1, 2 0.60281 48569 29065 592 D -2, 3 -0.69961 05481 18147 76 D -3, 4 0.72784 82421 29878 9 D -4, 5 -0.71084 62500 50067 D -5, 6 0.66786 70689 0115 D -6, 7 -0.61201 57501 844 D -7, 8 0.55146 52644 74 D -8, 9 -0.49105 30705 2 D -9, X 0.43350 00869 D -10, 1 -0.38021 8700 D -11, 2 0.33182 369 D -12, 3 -0.28845 12 D -13, 4 0.24995 8 D -14, 5 -0.21605 D -15, 6 0.1863 D -16, 7 -0.160 D -17, 8 0.14 D -18, 9 -0.1 D -19/ C C Machine-dependent constants C DATA NTERMS/17/ DATA XLOW1,XLOW2/2.98023224D-8,1.48029723D-44/ DATA XHIGH1,XHIGH3/36.04365668D0,-36.73680056D0/ DATA XHIGH2/3.6028797D16/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN08 = ZERO RETURN ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN08 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN08 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN08 = ( X ** ( NUMJN - 1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP ( - X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN08 = VALINF ELSE TRAN08 = VALINF - EXP( T ) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION TRAN09(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 9, defined as C C TRAN09(X) = integral 0 to X { t**9 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - DOUBLE PRECISION - The value below which TRAN09 = 0.0 to machine C precision. The recommended value is C 8th root of (8*XMIN) C C XLOW1 - DOUBLE PRECISION - The value below which TRAN09 = X**8/8 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - DOUBLE PRECISION - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - DOUBLE PRECISION - The value above which C TRAN09 = VALINF - X**9 exp(-X) C The recommended value is 9/EPS C C XHIGH3 - DOUBLE PRECISION - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 12 JANUARY, 1996 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN DOUBLE PRECISION ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN09'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 D 0 , 0.5 D 0 , 1.0 D 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 D 0 , 8.0 D 0 , 100.0 D 0 / DATA NUMJN,RNUMJN/ 9 , 9.0 D 0 / DATA VALINF/0.36360 88055 88728 71397 D 6/ DATA ATRAN/0.16224 04999 19498 46835 D 0, 1 -0.37683 51452 19593 7773 D -1, 2 0.54766 97159 17719 770 D -2, 3 -0.64443 94500 94495 21 D -3, 4 0.67736 45285 28098 3 D -4, 5 -0.66681 34975 82042 D -5, 6 0.63047 56001 9047 D -6, 7 -0.58074 78663 611 D -7, 8 0.52555 13051 23 D -8, 9 -0.46968 86176 1 D -9, X 0.41593 95065 D -10, 1 -0.36580 8491 D -11, 2 0.32000 794 D -12, 3 -0.27876 51 D -13, 4 0.24201 7 D -14, 5 -0.20953 D -15, 6 0.1810 D -16, 7 -0.156 D -17, 8 0.13 D -18, 9 -0.1 D -19/ C C Machine-dependent constants (for IEEE machines) C DATA NTERMS/17/ DATA XLOW1,XLOW2/2.98023224D-8,4.5321503D-39/ DATA XHIGH1,XHIGH3/36.04365668D0,-36.73680056D0/ DATA XHIGH2/4.05323966D16/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN09 = ZERO RETURN ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN09 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN09 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN09 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T.LT.XHIGH3 ) THEN TRAN09 = VALINF ELSE TRAN09 = VALINF - EXP( T ) ENDIF ENDIF RETURN END DOUBLE PRECISION FUNCTION Y0INT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the Bessel C function Y0, defined as C C Y0INT(x) = {integral 0 to x} Y0(t) dt C C The code uses Chebyshev expansions whose coefficients are C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If x < 0.0, the function is undefined. An error message C is printed and the function returns the value 0.0. C C If the value of x is too large, it is impossible to C accurately compute the trigonometric functions used. An C error message is printed, and the function returns the C value 1.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used from the array C ARJ01. The recommended value is such that C ABS(ARJ01(NTERM1)) < EPS/100 C C NTERM2 - The no. of terms to be used from the array C ARY01. The recommended value is such that C ABS(ARY01(NTERM2)) < EPS/100 C C NTERM3 - The no. of terms to be used from the array C ARY0A1. The recommended value is such that C ABS(ARY0A1(NTERM3)) < EPS/100 C C NTERM4 - The no. of terms to be used from the array C ARY0A2. The recommended value is such that C ABS(ARY0A2(NTERM4)) < EPS/100 C C XLOW - The value of x below which C Y0INT(x) = x*(ln(x) - 0.11593)*2/pi C to machine-precision. The recommended value is C sqrt(9*EPSNEG) C C XHIGH - The value of x above which it is impossible C to calculate (x-pi/4) accurately. The recommended C value is 1/EPSNEG C C For values of EPS and EPSNEG, refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C COS , LOG , SIN , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST REVISION: C 12 JANUARY, 1996 C INTEGER NTERM1,NTERM2,NTERM3,NTERM4 DOUBLE PRECISION ARJ01(0:23),ARY01(0:24),ARY0A1(0:21), 1 ARY0A2(0:18),CHEVAL,FIVE12,GAL2M1,GAMLN2, 2 NINE,ONE,ONEHUN,ONE28,PIB41,PIB411,PIB412, 3 PIB42,RT2BPI,SIXTEN,T,TEMP,TWOBPI,X,XHIGH, 4 XLOW,XMPI4,XVALUE,ZERO CHARACTER FNNAME*6,ERMSG1*14,ERMSG2*18 DATA FNNAME/'Y0INT '/ DATA ERMSG1/'ARGUMENT < 0.0'/ DATA ERMSG2/'ARGUMENT TOO LARGE'/ DATA ZERO,ONE/ 0.0 D 0 , 1.0 D 0 / DATA NINE,SIXTEN/ 9.0 D 0 , 16.0 D 0 / DATA ONEHUN,ONE28,FIVE12/ 100.0 D 0 , 128.0 D 0 , 512.0 D 0 / DATA RT2BPI/0.79788 45608 02865 35588 D 0/ DATA PIB411,PIB412/ 201.0 D 0 , 256.0 D 0/ DATA PIB42/0.24191 33974 48309 61566 D -3/ DATA TWOBPI/0.63661 97723 67581 34308 D 0/ DATA GAL2M1/-1.11593 15156 58412 44881 D 0/ DATA GAMLN2/-0.11593 15156 58412 44881 D 0/ DATA ARJ01(0)/ 0.38179 27932 16901 73518 D 0/ DATA ARJ01(1)/ -0.21275 63635 05053 21870 D 0/ DATA ARJ01(2)/ 0.16754 21340 72157 94187 D 0/ DATA ARJ01(3)/ -0.12853 20977 21963 98954 D 0/ DATA ARJ01(4)/ 0.10114 40545 57788 47013 D 0/ DATA ARJ01(5)/ -0.91007 95343 20156 8859 D -1/ DATA ARJ01(6)/ 0.64013 45264 65687 3103 D -1/ DATA ARJ01(7)/ -0.30669 63029 92675 4312 D -1/ DATA ARJ01(8)/ 0.10308 36525 32506 4201 D -1/ DATA ARJ01(9)/ -0.25567 06503 99956 918 D -2/ DATA ARJ01(10)/ 0.48832 75580 57983 04 D -3/ DATA ARJ01(11)/-0.74249 35126 03607 7 D -4/ DATA ARJ01(12)/ 0.92226 05637 30861 D -5/ DATA ARJ01(13)/-0.95522 82830 7083 D -6/ DATA ARJ01(14)/ 0.83883 55845 986 D -7/ DATA ARJ01(15)/-0.63318 44888 58 D -8/ DATA ARJ01(16)/ 0.41560 50422 1 D -9/ DATA ARJ01(17)/-0.23955 29307 D -10/ DATA ARJ01(18)/ 0.12228 6885 D -11/ DATA ARJ01(19)/-0.55697 11 D -13/ DATA ARJ01(20)/ 0.22782 0 D -14/ DATA ARJ01(21)/-0.8417 D -16/ DATA ARJ01(22)/ 0.282 D -17/ DATA ARJ01(23)/-0.9 D -19/ DATA ARY01(0)/ 0.54492 69630 27243 65490 D 0/ DATA ARY01(1)/ -0.14957 32358 86847 82157 D 0/ DATA ARY01(2)/ 0.11085 63448 62548 42337 D 0/ DATA ARY01(3)/ -0.94953 30018 68377 7109 D -1/ DATA ARY01(4)/ 0.68208 17786 99145 6963 D -1/ DATA ARY01(5)/ -0.10324 65338 33682 00408 D 0/ DATA ARY01(6)/ 0.10625 70328 75344 25491 D 0/ DATA ARY01(7)/ -0.62583 67679 96168 1990 D -1/ DATA ARY01(8)/ 0.23856 45760 33829 3285 D -1/ DATA ARY01(9)/ -0.64486 49130 15404 481 D -2/ DATA ARY01(10)/ 0.13128 70828 91002 331 D -2/ DATA ARY01(11)/-0.20988 08817 49896 40 D -3/ DATA ARY01(12)/ 0.27160 42484 13834 7 D -4/ DATA ARY01(13)/-0.29119 91140 14694 D -5/ DATA ARY01(14)/ 0.26344 33309 3795 D -6/ DATA ARY01(15)/-0.20411 72069 780 D -7/ DATA ARY01(16)/ 0.13712 47813 17 D -8/ DATA ARY01(17)/-0.80706 80792 D -10/ DATA ARY01(18)/ 0.41988 3057 D -11/ DATA ARY01(19)/-0.19459 104 D -12/ DATA ARY01(20)/ 0.80878 2 D -14/ DATA ARY01(21)/-0.30329 D -15/ DATA ARY01(22)/ 0.1032 D -16/ DATA ARY01(23)/-0.32 D -18/ DATA ARY01(24)/ 0.1 D -19/ DATA ARY0A1(0)/ 1.24030 13303 75189 70827 D 0/ DATA ARY0A1(1)/ -0.47812 53536 32280 693 D -2/ DATA ARY0A1(2)/ 0.66131 48891 70667 8 D -4/ DATA ARY0A1(3)/ -0.18604 27404 86349 D -5/ DATA ARY0A1(4)/ 0.83627 35565 080 D -7/ DATA ARY0A1(5)/ -0.52585 70367 31 D -8/ DATA ARY0A1(6)/ 0.42606 36325 1 D -9/ DATA ARY0A1(7)/ -0.42117 61024 D -10/ DATA ARY0A1(8)/ 0.48894 6426 D -11/ DATA ARY0A1(9)/ -0.64834 929 D -12/ DATA ARY0A1(10)/ 0.96172 34 D -13/ DATA ARY0A1(11)/-0.15703 67 D -13/ DATA ARY0A1(12)/ 0.27871 2 D -14/ DATA ARY0A1(13)/-0.53222 D -15/ DATA ARY0A1(14)/ 0.10844 D -15/ DATA ARY0A1(15)/-0.2342 D -16/ DATA ARY0A1(16)/ 0.533 D -17/ DATA ARY0A1(17)/-0.127 D -17/ DATA ARY0A1(18)/ 0.32 D -18/ DATA ARY0A1(19)/-0.8 D -19/ DATA ARY0A1(20)/ 0.2 D -19/ DATA ARY0A1(21)/-0.1 D -19/ DATA ARY0A2(0)/ 1.99616 09630 13416 75339 D 0/ DATA ARY0A2(1)/ -0.19037 98192 46668 161 D -2/ DATA ARY0A2(2)/ 0.15397 10927 04422 6 D -4/ DATA ARY0A2(3)/ -0.31145 08832 8103 D -6/ DATA ARY0A2(4)/ 0.11108 50971 321 D -7/ DATA ARY0A2(5)/ -0.58666 78712 3 D -9/ DATA ARY0A2(6)/ 0.41399 26949 D -10/ DATA ARY0A2(7)/ -0.36539 8763 D -11/ DATA ARY0A2(8)/ 0.38557 568 D -12/ DATA ARY0A2(9)/ -0.47098 00 D -13/ DATA ARY0A2(10)/ 0.65022 0 D -14/ DATA ARY0A2(11)/-0.99624 D -15/ DATA ARY0A2(12)/ 0.16700 D -15/ DATA ARY0A2(13)/-0.3028 D -16/ DATA ARY0A2(14)/ 0.589 D -17/ DATA ARY0A2(15)/-0.122 D -17/ DATA ARY0A2(16)/ 0.27 D -18/ DATA ARY0A2(17)/-0.6 D -19/ DATA ARY0A2(18)/ 0.1 D -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3,NTERM4/22,22,17,15/ DATA XLOW,XHIGH/3.16101364D-8,9.007199256D15/ C C Start computation C X = XVALUE C C First error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERMSG1) Y0INT = ZERO RETURN ENDIF C C Second error test C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERMSG2) Y0INT = ZERO RETURN ENDIF C C Code for 0 <= x <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN IF ( X .EQ. ZERO ) THEN Y0INT = ZERO ELSE Y0INT = ( LOG(X) + GAL2M1 ) * TWOBPI * X ENDIF ELSE T = X * X / ONE28 - ONE TEMP = ( LOG(X) + GAMLN2 ) * CHEVAL(NTERM1,ARJ01,T) TEMP = TEMP - CHEVAL(NTERM2,ARY01,T) Y0INT = TWOBPI * X * TEMP ENDIF ELSE C C Code for x > 16 C T = FIVE12 / ( X * X ) - ONE PIB41 = PIB411 / PIB412 XMPI4 = ( X - PIB41 ) - PIB42 TEMP = SIN(XMPI4) * CHEVAL(NTERM3,ARY0A1,T) / X TEMP = TEMP + COS(XMPI4) * CHEVAL(NTERM4,ARY0A2,T) Y0INT = - RT2BPI * TEMP / SQRT(X) ENDIF RETURN END DOUBLE PRECISION FUNCTION CHEVAL(N,A,T) C C This function evaluates a Chebyshev series, using the C Clenshaw method with Reinsch modification, as analysed C in the paper by Oliver. C C INPUT PARAMETERS C C N - INTEGER - The no. of terms in the sequence C C A - DOUBLE PRECISION ARRAY, dimension 0 to N - The coefficients of C the Chebyshev series C C T - DOUBLE PRECISION - The value at which the series is to be C evaluated C C C REFERENCES C C "An error analysis of the modified Clenshaw method for C evaluating Chebyshev and Fourier series" J. Oliver, C J.I.M.A., vol. 20, 1977, pp379-391 C C C MACHINE-DEPENDENT CONSTANTS: NONE C C C INTRINSIC FUNCTIONS USED; C C ABS C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley , C High St., C PAISLEY, C SCOTLAND C C C LATEST MODIFICATION: 21 December , 1992 C C INTEGER I,N DOUBLE PRECISION A(0:N),D1,D2,HALF,T,TEST,TT,TWO,U0,U1,U2,ZERO DATA ZERO,HALF/ 0.0 D 0 , 0.5 D 0 / DATA TEST,TWO/ 0.6 D 0 , 2.0 D 0 / U1 = ZERO C C If ABS ( T ) < 0.6 use the standard Clenshaw method C IF ( ABS( T ) .LT. TEST ) THEN U0 = ZERO TT = T + T DO 100 I = N , 0 , -1 U2 = U1 U1 = U0 U0 = TT * U1 + A( I ) - U2 100 CONTINUE CHEVAL = ( U0 - U2 ) / TWO ELSE C C If ABS ( T ) > = 0.6 use the Reinsch modification C D1 = ZERO C C T > = 0.6 code C IF ( T .GT. ZERO ) THEN TT = ( T - HALF ) - HALF TT = TT + TT DO 200 I = N , 0 , -1 D2 = D1 U2 = U1 D1 = TT * U2 + A( I ) + D2 U1 = D1 + U2 200 CONTINUE CHEVAL = ( D1 + D2 ) / TWO ELSE C C T < = -0.6 code C TT = ( T + HALF ) + HALF TT = TT + TT DO 300 I = N , 0 , -1 D2 = D1 U2 = U1 D1 = TT * U2 + A( I ) - D2 U1 = D1 - U2 300 CONTINUE CHEVAL = ( D1 - D2 ) / TWO ENDIF ENDIF RETURN END SUBROUTINE ERRPRN(FNNAME,ERRMSG) C C DESCRIPTION: C This subroutine prints out an error message if C an error has occurred in one of the MISCFUN C functions. C C C INPUT PARAMETERS: C C FNNAME - CHARACTER - The name of the function with the error. C C ERRMSG - CHARACTER - The message to be printed out. C C C MACHINE-DEPENDENT PARAMETER: C C OUTSTR - INTEGER - The numerical value of the output C stream to be used for printing the C error message. The subroutine has the C default value OUTSTR = 6. C C C AUTHOR: C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 2 JUNE, 1995 C INTEGER OUTSTR CHARACTER FNNAME*6,ERRMSG*(*) DATA OUTSTR/6/ WRITE(OUTSTR,1000)FNNAME WRITE(OUTSTR,2000)ERRMSG 1000 FORMAT(/5X,'ERROR IN MISCFUN FUNCTION ',A6) 2000 FORMAT(/5X,A50) RETURN END SHAR_EOF fi # end of overwriting check cd .. if test ! -d 'Sp' then mkdir 'Sp' fi cd 'Sp' if test -f 'src_gen.f' then echo shar: will not over-write existing file "'src_gen.f'" else cat << \SHAR_EOF > 'src_gen.f' REAL FUNCTION ABRAM0(XVALUE) C C DESCRIPTION: C This function calculates the Abramowitz function of order 0, C defined as C C ABRAM0(x) = integral{ 0 to infinity } exp( -t*t - x/t ) dt C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C If XVALUE < 0.0, the function prints a message and returns the C value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMF - INTEGER - No. of terms needed for the array AB0F. C Recommended value such that C ABS( AB0F(NTERMF) ) < EPS/100 C C NTERMG - INTEGER - No. of terms needed for array AB0G. C Recommended value such that C ABS( AB0G(NTERMG) ) < EPS/100 C C NTERMH - INTEGER - No. of terms needed for array AB0H. C Recommended value such that C ABS( AB0H(NTERMH) ) < EPS/100 C C NTERMA - INTEGER - No. of terms needed for array AB0AS. C Recommended value such that C ABS( AB0AS(NTERMA) ) < EPS/100 C C XLOW1 - REAL - The value below which C ABRAM0 = root(pi)/2 + X ( ln X - GVAL0 ) C Recommended value is SQRT(2*EPSNEG) C C LNXMIN - REAL - The value of ln XMIN. Used to prevent C exponential underflow for large X. C C For values of EPS, EPSNEG, XMIN refer to the file MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C LOG, EXP, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 16 January, 1996 C C INTEGER NTERMA,NTERMF,NTERMG,NTERMH REAL AB0F(0:8),AB0G(0:8),AB0H(0:8),AB0AS(0:27), & ASLN,ASVAL,CHEVAL,FVAL,GVAL,GVAL0,HALF,HVAL, & LNXMIN,ONEHUN,ONERPI,RTPIB2,RT3BPI,SIX,T, & THREE,TWO,V,X,XLOW1,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*33 DATA FNNAME/'ABRAM0'/ DATA ERRMSG/'FUNCTION CALLED WITH ARGUMENT < 0'/ DATA AB0F/-0.68121 92709 35494 69816 E 0, 1 -0.78867 91981 61492 52495 E 0, 2 0.51215 81776 81881 9543 E -1, 3 -0.71092 35289 45412 96 E -3, 4 0.36868 18085 04287 E -5, 5 -0.91783 23372 37 E -8, 6 0.12702 02563 E -10, 7 -0.10768 88 E -13, 8 0.599 E -17/ DATA AB0G/-0.60506 03943 08682 73190 E 0, 1 -0.41950 39816 32017 79803 E 0, 2 0.17032 65125 19037 0333 E -1, 3 -0.16938 91784 24913 97 E -3, 4 0.67638 08951 9710 E -6, 5 -0.13572 36362 55 E -8, 6 0.15629 7065 E -11, 7 -0.11288 7 E -14, 8 0.55 E -18/ DATA AB0H/1.38202 65523 05749 89705 E 0, 1 -0.30097 92907 39749 04355 E 0, 2 0.79428 88093 64887 241 E -2, 3 -0.64319 10276 84756 3 E -4, 4 0.22549 83068 4374 E -6, 5 -0.41220 96619 5 E -9, 6 0.44185 282 E -12, 7 -0.30123 E -15, 8 0.14 E -18/ DATA AB0AS(0)/ 1.97755 49972 36930 67407 E 0/ DATA AB0AS(1)/ -0.10460 24792 00481 9485 E -1/ DATA AB0AS(2)/ 0.69680 79025 36253 66 E -3/ DATA AB0AS(3)/ -0.58982 98299 99659 9 E -4/ DATA AB0AS(4)/ 0.57716 44553 05320 E -5/ DATA AB0AS(5)/ -0.61523 01336 5756 E -6/ DATA AB0AS(6)/ 0.67853 96884 767 E -7/ DATA AB0AS(7)/ -0.72306 25379 07 E -8/ DATA AB0AS(8)/ 0.63306 62736 5 E -9/ DATA AB0AS(9)/ -0.98945 3793 E -11/ DATA AB0AS(10)/-0.16819 80530 E -10/ DATA AB0AS(11)/ 0.67379 9551 E -11/ DATA AB0AS(12)/-0.20099 7939 E -11/ DATA AB0AS(13)/ 0.54055 903 E -12/ DATA AB0AS(14)/-0.13816 679 E -12/ DATA AB0AS(15)/ 0.34222 05 E -13/ DATA AB0AS(16)/-0.82668 6 E -14/ DATA AB0AS(17)/ 0.19456 6 E -14/ DATA AB0AS(18)/-0.44268 E -15/ DATA AB0AS(19)/ 0.9562 E -16/ DATA AB0AS(20)/-0.1883 E -16/ DATA AB0AS(21)/ 0.301 E -17/ DATA AB0AS(22)/-0.19 E -18/ DATA AB0AS(23)/-0.14 E -18/ DATA AB0AS(24)/ 0.11 E -18/ DATA AB0AS(25)/-0.4 E -19/ DATA AB0AS(26)/ 0.2 E -19/ DATA AB0AS(27)/-0.1 E -19/ DATA ZERO,HALF,TWO/ 0.0 E 0 , 0.5 E 0, 2.0 E 0/ DATA THREE,SIX,ONEHUN/ 3.0 E 0, 6.0 E 0 , 100.0 E 0/ DATA RT3BPI/0.97720 50238 05839 84317 E 0/ DATA RTPIB2/0.88622 69254 52758 01365 E 0/ DATA GVAL0/0.13417 65026 47700 70909 E 0/ DATA ONERPI/0.56418 95835 47756 28695 E 0/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) ABRAM0 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = R1MACH(4) / ONEHUN IF ( X .LE. TWO ) THEN DO 10 NTERMF = 8 , 0 , -1 IF ( ABS(AB0F(NTERMF)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERMG = 8 , 0 , -1 IF ( ABS(AB0G(NTERMG)) .GT. T ) GOTO 29 20 CONTINUE 29 DO 30 NTERMH = 8 , 0 , -1 IF ( ABS(AB0H(NTERMH)) .GT. T ) GOTO 39 30 CONTINUE 39 XLOW1 = SQRT ( TWO * R1MACH(3) ) ELSE DO 40 NTERMA = 27 , 0 , -1 IF ( ABS(AB0AS(NTERMA)) .GT. T ) GOTO 49 40 CONTINUE 49 LNXMIN = LOG(R1MACH(1)) ENDIF C C Code for 0 <= XVALUE <= 2 C IF ( X .LE. TWO ) THEN IF ( X .EQ. ZERO ) THEN ABRAM0 = RTPIB2 RETURN ENDIF IF ( X .LT. XLOW1 ) THEN ABRAM0 = RTPIB2 + X * ( LOG( X ) - GVAL0 ) RETURN ELSE T = ( X * X / TWO - HALF ) - HALF FVAL = CHEVAL( NTERMF,AB0F,T ) GVAL = CHEVAL( NTERMG,AB0G,T ) HVAL = CHEVAL( NTERMH,AB0H,T ) ABRAM0 = FVAL/ONERPI + X * ( LOG( X ) * HVAL- GVAL ) RETURN ENDIF ELSE C C Code for XVALUE > 2 C V = THREE * ( (X / TWO) ** ( TWO / THREE ) ) T = ( SIX/V - HALF ) - HALF ASVAL = CHEVAL( NTERMA,AB0AS,T ) ASLN = LOG( ASVAL / RT3BPI ) - V IF ( ASLN .LT. LNXMIN ) THEN ABRAM0 = ZERO ELSE ABRAM0 = EXP( ASLN ) ENDIF RETURN ENDIF END REAL FUNCTION ABRAM1(XVALUE) C C DESCRIPTION: C This function calculates the Abramowitz function of order 1, C defined as C C ABRAM1(x) = integral{ 0 to infinity } t * exp( -t*t - x/t ) dt C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C If XVALUE < 0.0, the function prints a message and returns the C value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMF - INTEGER - No. of terms needed for the array AB1F. C Recommended value such that C ABS( AB1F(NTERMF) ) < EPS/100 C C NTERMG - INTEGER - No. of terms needed for array AB1G. C Recommended value such that C ABS( AB1G(NTERMG) ) < EPS/100 C C NTERMH - INTEGER - No. of terms needed for array AB1H. C Recommended value such that C ABS( AB1H(NTERMH) ) < EPS/100 C C NTERMA - INTEGER - No. of terms needed for array AB1AS. C Recommended value such that C ABS( AB1AS(NTERMA) ) < EPS/100 C C XLOW - REAL - The value below which C ABRAM1(x) = 0.5 to machine precision. C The recommended value is EPSNEG/2 C C XLOW1 - REAL - The value below which C ABRAM1(x) = (1 - x ( sqrt(pi) + xln(x) ) / 2 C Recommended value is SQRT(2*EPSNEG) C C LNXMIN - REAL - The value of ln XMIN. Used to prevent C exponential underflow for large X. C C For values of EPS, EPSNEG, XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by using C the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C LOG, EXP, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 16 January, 1996 C C INTEGER NTERMA,NTERMF,NTERMG,NTERMH REAL AB1F(0:9),AB1G(0:8),AB1H(0:8),AB1AS(0:27), & ASLN,ASVAL,CHEVAL,FVAL,GVAL,HALF,HVAL, & LNXMIN,ONE,ONEHUN,ONERPI,RT3BPI,SIX,T,THREE,TWO, & V,X,XLOW,XLOW1,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*33 DATA FNNAME/'ABRAM1'/ DATA ERRMSG/'FUNCTION CALLED WITH ARGUMENT < 0'/ DATA AB1F/1.47285 19257 79788 07369 E 0, 1 0.10903 49757 01689 56257 E 0, 2 -0.12430 67536 00565 69753 E 0, 3 0.30619 79468 53493 315 E -2, 4 -0.22184 10323 07651 1 E -4, 5 0.69899 78834 451 E -7, 6 -0.11597 07644 4 E -9, 7 0.11389 776 E -12, 8 -0.7173 E -16, 9 0.3 E -19/ DATA AB1G/0.39791 27794 90545 03528 E 0, 1 -0.29045 28522 64547 20849 E 0, 2 0.10487 84695 46536 3504 E -1, 3 -0.10249 86952 26913 36 E -3, 4 0.41150 27939 9110 E -6, 5 -0.83652 63894 0 E -9, 6 0.97862 595 E -12, 7 -0.71868 E -15, 8 0.35 E -18/ DATA AB1H/0.84150 29215 22749 47030 E 0, 1 -0.77900 50698 77414 3395 E -1, 2 0.13399 24558 78390 993 E -2, 3 -0.80850 39071 52788 E -5, 4 0.22618 58281 728 E -7, 5 -0.34413 95838 E -10, 6 0.31598 58 E -13, 7 -0.1884 E -16, 8 0.1 E -19/ DATA AB1AS(0)/ 2.13013 64342 90655 49448 E 0/ DATA AB1AS(1)/ 0.63715 26795 21853 9933 E -1/ DATA AB1AS(2)/ -0.12933 49174 77510 647 E -2/ DATA AB1AS(3)/ 0.56783 28753 22826 5 E -4/ DATA AB1AS(4)/ -0.27943 49391 77646 E -5/ DATA AB1AS(5)/ 0.56002 14736 787 E -7/ DATA AB1AS(6)/ 0.23920 09242 798 E -7/ DATA AB1AS(7)/ -0.75098 48650 09 E -8/ DATA AB1AS(8)/ 0.17301 53307 76 E -8/ DATA AB1AS(9)/ -0.36648 87795 5 E -9/ DATA AB1AS(10)/ 0.75207 58307 E -10/ DATA AB1AS(11)/-0.15179 90208 E -10/ DATA AB1AS(12)/ 0.30171 3710 E -11/ DATA AB1AS(13)/-0.58596 718 E -12/ DATA AB1AS(14)/ 0.10914 455 E -12/ DATA AB1AS(15)/-0.18705 36 E -13/ DATA AB1AS(16)/ 0.26254 2 E -14/ DATA AB1AS(17)/-0.14627 E -15/ DATA AB1AS(18)/-0.9500 E -16/ DATA AB1AS(19)/ 0.5873 E -16/ DATA AB1AS(20)/-0.2420 E -16/ DATA AB1AS(21)/ 0.868 E -17/ DATA AB1AS(22)/-0.290 E -17/ DATA AB1AS(23)/ 0.93 E -18/ DATA AB1AS(24)/-0.29 E -18/ DATA AB1AS(25)/ 0.9 E -19/ DATA AB1AS(26)/-0.3 E -19/ DATA AB1AS(27)/ 0.1 E -19/ DATA ZERO,HALF,ONE/ 0.0 E 0, 0.5 E 0, 1.0 E 0/ DATA TWO,THREE,SIX/ 2.0 E 0, 3.0 E 0, 6.0 E 0/ DATA ONEHUN/100.0 E 0/ DATA RT3BPI/ 0.97720 50238 05839 84317 E 0/ DATA ONERPI/ 0.56418 95835 47756 28695 E 0/ C C Start calculation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) ABRAM1 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = R1MACH(4) / ONEHUN IF ( X .LE. TWO ) THEN DO 10 NTERMF = 9 , 0 , -1 IF ( ABS(AB1F(NTERMF)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERMG = 8 , 0 , -1 IF ( ABS(AB1G(NTERMG)) .GT. T ) GOTO 29 20 CONTINUE 29 DO 30 NTERMH = 8 , 0 , -1 IF ( ABS(AB1H(NTERMH)) .GT. T ) GOTO 39 30 CONTINUE 39 T = R1MACH(3) XLOW1 = SQRT ( TWO * T ) XLOW = T / TWO ELSE DO 40 NTERMA = 27 , 0 , -1 IF ( ABS(AB1AS(NTERMA)) .GT. T ) GOTO 49 40 CONTINUE 49 LNXMIN = LOG(R1MACH(1)) ENDIF C C Code for 0 <= XVALUE <= 2 C IF ( X .LE. TWO ) THEN IF ( X .EQ. ZERO ) THEN ABRAM1 = HALF RETURN ENDIF IF ( X .LT. XLOW1 ) THEN IF ( X .LT. XLOW ) THEN ABRAM1 = HALF ELSE ABRAM1 = ( ONE - X / ONERPI - X * X * LOG( X ) ) * HALF ENDIF RETURN ELSE T = ( X * X / TWO - HALF ) - HALF FVAL = CHEVAL( NTERMF,AB1F,T ) GVAL = CHEVAL( NTERMG,AB1G,T ) HVAL = CHEVAL( NTERMH,AB1H,T ) ABRAM1 = FVAL - X * ( GVAL / ONERPI + X * LOG( X ) * HVAL ) RETURN ENDIF ELSE C C Code for XVALUE > 2 C V = THREE * ( (X / TWO) ** ( TWO / THREE ) ) T = ( SIX / V - HALF ) - HALF ASVAL = CHEVAL( NTERMA,AB1AS,T ) ASLN = LOG( ASVAL * SQRT ( V / THREE ) / RT3BPI ) - V IF ( ASLN .LT. LNXMIN ) THEN ABRAM1 = ZERO ELSE ABRAM1 = EXP( ASLN ) ENDIF RETURN ENDIF END REAL FUNCTION ABRAM2(XVALUE) C C DESCRIPTION: C This function calculates the Abramowitz function of order 2, C defined as C C ABRAM2(x) = integral{ 0 to infinity } (t**2) * exp( -t*t - x/t ) dt C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C If XVALUE < 0.0, the function prints a message and returns the C value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMF - INTEGER - No. of terms needed for the array AB2F. C Recommended value such that C ABS( AB2F(NTERMF) ) < EPS/100 C C NTERMG - INTEGER - No. of terms needed for array AB2G. C Recommended value such that C ABS( AB2G(NTERMG) ) < EPS/100 C C NTERMH - INTEGER - No. of terms needed for array AB2H. C Recommended value such that C ABS( AB2H(NTERMH) ) < EPS/100 C C NTERMA - INTEGER - No. of terms needed for array AB2AS. C Recommended value such that C ABS( AB2AS(NTERMA) ) < EPS/100 C C XLOW - REAL - The value below which C ABRAM2 = root(pi)/4 to machine precision. C The recommended value is EPSNEG C C XLOW1 - REAL - The value below which C ABRAM2 = root(pi)/4 - x/2 + x**3ln(x)/6 C Recommended value is SQRT(2*EPSNEG) C C LNXMIN - REAL - The value of ln XMIN. Used to prevent C exponential underflow for large X. C C For values of EPS, EPSNEG, XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C LOG, EXP C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 16 January, 1996 C C INTEGER NTERMA,NTERMF,NTERMG,NTERMH REAL AB2F(0:9),AB2G(0:8),AB2H(0:7),AB2AS(0:26), & ASLN,ASVAL,CHEVAL,FVAL,GVAL,HALF,HVAL,LNXMIN, & ONEHUN,ONERPI,RTPIB4,RT3BPI,SIX,T,THREE,TWO, & V,X,XLOW,XLOW1,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*33 DATA FNNAME/'ABRAM2'/ DATA ERRMSG/'FUNCTION CALLED WITH ARGUMENT < 0'/ DATA AB2F/1.03612 16280 42437 13846 E 0, 1 0.19371 24662 67945 70012 E 0, 2 -0.72587 58839 23300 7378 E -1, 3 0.17479 05908 64327 399 E -2, 4 -0.12812 23233 75654 9 E -4, 5 0.41150 18153 651 E -7, 6 -0.69710 47256 E -10, 7 0.69901 83 E -13, 8 -0.4492 E -16, 9 0.2 E -19/ DATA AB2G/1.46290 15719 86307 41150 E 0, 1 0.20189 46688 31540 14317 E 0, 2 -0.29082 92087 99712 9022 E -1, 3 0.47061 04903 52700 50 E -3, 4 -0.25792 20803 59333 E -5, 5 0.65613 37129 46 E -8, 6 -0.91411 0203 E -11, 7 0.77427 6 E -14, 8 -0.429 E -17/ DATA AB2H/0.30117 22501 09104 88881 E 0, 1 -0.15886 67818 31762 3783 E -1, 2 0.19295 93693 55845 26 E -3, 3 -0.90199 58784 9300 E -6, 4 0.20610 50418 37 E -8, 5 -0.26511 1806 E -11, 6 0.21086 4 E -14, 7 -0.111 E -17/ DATA AB2AS(0)/ 2.46492 32530 43348 56893 E 0/ DATA AB2AS(1)/ 0.23142 79742 22489 05432 E 0/ DATA AB2AS(2)/ -0.94068 17301 00857 73 E -3/ DATA AB2AS(3)/ 0.82902 70038 08973 3 E -4/ DATA AB2AS(4)/ -0.88389 47042 45866 E -5/ DATA AB2AS(5)/ 0.10663 85435 67985 E -5/ DATA AB2AS(6)/ -0.13991 12853 8529 E -6/ DATA AB2AS(7)/ 0.19397 93208 445 E -7/ DATA AB2AS(8)/ -0.27704 99383 75 E -8/ DATA AB2AS(9)/ 0.39590 68718 6 E -9/ DATA AB2AS(10)/-0.54083 54342 E -10/ DATA AB2AS(11)/ 0.63554 6076 E -11/ DATA AB2AS(12)/-0.38461 613 E -12/ DATA AB2AS(13)/-0.11696 067 E -12/ DATA AB2AS(14)/ 0.68966 71 E -13/ DATA AB2AS(15)/-0.25031 13 E -13/ DATA AB2AS(16)/ 0.78558 6 E -14/ DATA AB2AS(17)/-0.23033 4 E -14/ DATA AB2AS(18)/ 0.64914 E -15/ DATA AB2AS(19)/-0.17797 E -15/ DATA AB2AS(20)/ 0.4766 E -16/ DATA AB2AS(21)/-0.1246 E -16/ DATA AB2AS(22)/ 0.316 E -17/ DATA AB2AS(23)/-0.77 E -18/ DATA AB2AS(24)/ 0.18 E -18/ DATA AB2AS(25)/-0.4 E -19/ DATA AB2AS(26)/ 0.1 E -19/ DATA ZERO,HALF,TWO/ 0.0 E 0 , 0.5 E 0, 2.0 E 0/ DATA THREE,SIX,ONEHUN/ 3.0 E 0, 6.0 E 0 , 100.0 E 0/ DATA RT3BPI/ 0.97720 50238 05839 84317 E 0/ DATA RTPIB4/ 0.44311 34627 26379 00682 E 0/ DATA ONERPI/ 0.56418 95835 47756 28695 E 0/ C C Start calculation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) ABRAM2 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = R1MACH(4) / ONEHUN IF ( X .LE. TWO ) THEN DO 10 NTERMF = 9 , 0 , -1 IF ( ABS(AB2F(NTERMF)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERMG = 8 , 0 , -1 IF ( ABS(AB2G(NTERMG)) .GT. T ) GOTO 29 20 CONTINUE 29 DO 30 NTERMH = 7 , 0 , -1 IF ( ABS(AB2H(NTERMH)) .GT. T ) GOTO 39 30 CONTINUE 39 XLOW = R1MACH(3) XLOW1 = SQRT ( TWO * XLOW ) ELSE DO 40 NTERMA = 26 , 0 , -1 IF ( ABS(AB2AS(NTERMA)) .GT. T ) GOTO 49 40 CONTINUE 49 LNXMIN = LOG(R1MACH(1)) ENDIF C C Code for 0 <= XVALUE <= 2 C IF ( X .LE. TWO ) THEN IF ( X .EQ. ZERO ) THEN ABRAM2 = RTPIB4 RETURN ENDIF IF ( X .LT. XLOW1 ) THEN IF ( X .LT. XLOW ) THEN ABRAM2 = RTPIB4 ELSE ABRAM2 = RTPIB4 - HALF * X + X * X * X * LOG( X ) / SIX ENDIF RETURN ELSE T = ( X * X / TWO - HALF ) - HALF FVAL = CHEVAL( NTERMF,AB2F,T ) GVAL = CHEVAL( NTERMG,AB2G,T ) HVAL = CHEVAL( NTERMH,AB2H,T ) ABRAM2 = FVAL/ONERPI + X * ( X * X * LOG(X) * HVAL- GVAL ) RETURN ENDIF ELSE C C Code for XVALUE > 2 C V = THREE * ( (X / TWO) ** ( TWO / THREE ) ) T = ( SIX / V - HALF ) - HALF ASVAL = CHEVAL( NTERMA,AB2AS,T ) ASLN = LOG( ASVAL / RT3BPI ) + LOG( V / THREE ) - V IF ( ASLN .LT. LNXMIN ) THEN ABRAM2 = ZERO ELSE ABRAM2 = EXP( ASLN ) ENDIF RETURN ENDIF END REAL FUNCTION AIRINT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the Airy function Ai, C defined as C C AIRINT(x) = {integral 0 to x} Ai(t) dt C C The program uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C C ERROR RETURNS: C C If the argument is too large and negative, it is impossible C to accurately compute the necessary SIN and COS functions. C An error message is printed, and the program returns the C value -2/3 (the value at -infinity). C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C AAINT1. The recommended value is such that C ABS(AAINT1(NTERM1)) < EPS/100, C subject to 1 <= NTERM1 <= 25. C C NTERM2 - INTEGER - The no. of terms to be used from the array C AAINT2. The recommended value is such that C ABS(AAINT2(NTERM2)) < EPS/100, C subject to 1 <= NTERM2 <= 21. C C NTERM3 - INTEGER - The no. of terms to be used from the array C AAINT3. The recommended value is such that C ABS(AAINT3(NTERM3)) < EPS/100, C subject to 1 <= NTERM3 <= 40. C C NTERM4 - INTEGER - The no. of terms to be used from the array C AAINT4. The recommended value is such that C ABS(AAINT4(NTERM4)) < EPS/100, C subject to 1 <= NTERM4 <= 17. C C NTERM5 - INTEGER - The no. of terms to be used from the array C AAINT5. The recommended value is such that C ABS(AAINT5(NTERM5)) < EPS/100, C subject to 1 <= NTERM5 <= 17. C C XLOW1 - REAL - The value such that, if |x| < XLOW1, C AIRINT(x) = x * Ai(0) C to machine precision. The recommended value is C 2 * EPSNEG. C C XHIGH1 - REAL - The value such that, if x > XHIGH1, C AIRINT(x) = 1/3, C to machine precision. The recommended value is C (-1.5*LOG(EPSNEG)) ** (2/3). C C XNEG1 - REAL - The value such that, if x < XNEG1, C the trigonometric functions in the asymptotic C expansion cannot be calculated accurately. C The recommended value is C -(1/((EPS)**2/3)) C C For values of EPS and EPSNEG, refer to the file MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C COS, EXP, SIN, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C Univ. of Paisley, C High St., C Paisley, C SCOTLAND. C PA1 2BE C C (e-mail:macl_ms0@paisley.ac.uk) C C C LATEST REVISION: 18 January, 1996. C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5 REAL AAINT1(0:25),AAINT2(0:21),AAINT3(0:40), 1 AAINT4(0:17),AAINT5(0:17), 2 AIRZER,ARG,CHEVAL,EIGHT,FORTY1,FOUR,FR996,GVAL, 3 HVAL,NINE,NINHUN,ONE,ONEHUN,PIBY4,PITIM6,RT2B3P,T,TEMP, 4 THREE,TWO,X,XHIGH1,XLOW1,XNEG1,XVALUE,Z,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*46 DATA FNNAME/'AIRINT'/ DATA ERRMSG/'FUNCTION TOO NEGATIVE FOR ACCURATE COMPUTATION'/ DATA AAINT1(0)/ 0.37713 51769 46836 95526 E 0/ DATA AAINT1(1)/ -0.13318 86843 24079 47431 E 0/ DATA AAINT1(2)/ 0.31524 97374 78288 4809 E -1/ DATA AAINT1(3)/ -0.31854 30764 36574 077 E -2/ DATA AAINT1(4)/ -0.87398 76469 86219 15 E -3/ DATA AAINT1(5)/ 0.46699 49765 53969 71 E -3/ DATA AAINT1(6)/ -0.95449 36738 98369 2 E -4/ DATA AAINT1(7)/ 0.54270 56871 56716 E -5/ DATA AAINT1(8)/ 0.23949 64062 52188 E -5/ DATA AAINT1(9)/ -0.75690 27020 5649 E -6/ DATA AAINT1(10)/ 0.90501 38584 518 E -7/ DATA AAINT1(11)/ 0.32052 94560 43 E -8/ DATA AAINT1(12)/-0.30382 55364 44 E -8/ DATA AAINT1(13)/ 0.48900 11859 6 E -9/ DATA AAINT1(14)/-0.18398 20572 E -10/ DATA AAINT1(15)/-0.71124 7519 E -11/ DATA AAINT1(16)/ 0.15177 4419 E -11/ DATA AAINT1(17)/-0.10801 922 E -12/ DATA AAINT1(18)/-0.96354 2 E -14/ DATA AAINT1(19)/ 0.31342 5 E -14/ DATA AAINT1(20)/-0.29446 E -15/ DATA AAINT1(21)/-0.477 E -17/ DATA AAINT1(22)/ 0.461 E -17/ DATA AAINT1(23)/-0.53 E -18/ DATA AAINT1(24)/ 0.1 E -19/ DATA AAINT1(25)/ 0.1 E -19/ DATA AAINT2(0)/ 1.92002 52408 19840 09769 E 0/ DATA AAINT2(1)/ -0.42200 49417 25628 7021 E -1/ DATA AAINT2(2)/ -0.23945 77229 65939 223 E -2/ DATA AAINT2(3)/ -0.19564 07048 33529 71 E -3/ DATA AAINT2(4)/ -0.15472 52891 05611 2 E -4/ DATA AAINT2(5)/ -0.14049 01861 37889 E -5/ DATA AAINT2(6)/ -0.12128 01427 1367 E -6/ DATA AAINT2(7)/ -0.11791 86050 192 E -7/ DATA AAINT2(8)/ -0.10431 55787 88 E -8/ DATA AAINT2(9)/ -0.10908 20929 3 E -9/ DATA AAINT2(10)/-0.92963 3045 E -11/ DATA AAINT2(11)/-0.11094 6520 E -11/ DATA AAINT2(12)/-0.78164 83 E -13/ DATA AAINT2(13)/-0.13196 61 E -13/ DATA AAINT2(14)/-0.36823 E -15/ DATA AAINT2(15)/-0.21505 E -15/ DATA AAINT2(16)/ 0.1238 E -16/ DATA AAINT2(17)/-0.557 E -17/ DATA AAINT2(18)/ 0.84 E -18/ DATA AAINT2(19)/-0.21 E -18/ DATA AAINT2(20)/ 0.4 E -19/ DATA AAINT2(21)/-0.1 E -19/ DATA AAINT3(0)/ 0.47985 89326 47910 52053 E 0/ DATA AAINT3(1)/ -0.19272 37512 61696 08863 E 0/ DATA AAINT3(2)/ 0.20511 54129 52542 8189 E -1/ DATA AAINT3(3)/ 0.63320 00070 73248 8786 E -1/ DATA AAINT3(4)/ -0.50933 22261 84575 4082 E -1/ DATA AAINT3(5)/ 0.12844 24078 66166 3016 E -1/ DATA AAINT3(6)/ 0.27601 37088 98947 9413 E -1/ DATA AAINT3(7)/ -0.15470 66673 86664 9507 E -1/ DATA AAINT3(8)/ -0.14968 64655 38931 6026 E -1/ DATA AAINT3(9)/ 0.33661 76141 73574 541 E -2/ DATA AAINT3(10)/ 0.53085 11635 18892 985 E -2/ DATA AAINT3(11)/ 0.41371 22645 85550 81 E -3/ DATA AAINT3(12)/-0.10249 05799 26726 266 E -2/ DATA AAINT3(13)/-0.32508 22167 20258 53 E -3/ DATA AAINT3(14)/ 0.86086 60957 16921 3 E -4/ DATA AAINT3(15)/ 0.66713 67298 12077 5 E -4/ DATA AAINT3(16)/ 0.44920 59993 18095 E -5/ DATA AAINT3(17)/-0.67042 72309 58249 E -5/ DATA AAINT3(18)/-0.19663 65700 85009 E -5/ DATA AAINT3(19)/ 0.22229 67740 7226 E -6/ DATA AAINT3(20)/ 0.22332 22294 9137 E -6/ DATA AAINT3(21)/ 0.28033 13766 457 E -7/ DATA AAINT3(22)/-0.11556 51663 619 E -7/ DATA AAINT3(23)/-0.43306 98217 36 E -8/ DATA AAINT3(24)/-0.62277 77938 E -10/ DATA AAINT3(25)/ 0.26432 66490 3 E -9/ DATA AAINT3(26)/ 0.53338 81114 E -10/ DATA AAINT3(27)/-0.52295 7269 E -11/ DATA AAINT3(28)/-0.38222 9283 E -11/ DATA AAINT3(29)/-0.40958 233 E -12/ DATA AAINT3(30)/ 0.11515 622 E -12/ DATA AAINT3(31)/ 0.38757 66 E -13/ DATA AAINT3(32)/ 0.14028 3 E -14/ DATA AAINT3(33)/-0.14152 6 E -14/ DATA AAINT3(34)/-0.28746 E -15/ DATA AAINT3(35)/ 0.923 E -17/ DATA AAINT3(36)/ 0.1224 E -16/ DATA AAINT3(37)/ 0.157 E -17/ DATA AAINT3(38)/-0.19 E -18/ DATA AAINT3(39)/-0.8 E -19/ DATA AAINT3(40)/-0.1 E -19/ DATA AAINT4/1.99653 30582 85227 30048 E 0, 1 -0.18754 11776 05417 759 E -2, 2 -0.15377 53628 03057 50 E -3, 3 -0.12831 12967 68234 9 E -4, 4 -0.10812 84819 64162 E -5, 5 -0.91821 31174 057 E -7, 6 -0.78416 05909 60 E -8, 7 -0.67292 45387 8 E -9, 8 -0.57963 25198 E -10, 9 -0.50104 0991 E -11, X -0.43420 222 E -12, 1 -0.37743 05 E -13, 2 -0.32847 3 E -14, 3 -0.28700 E -15, 4 -0.2502 E -16, 5 -0.220 E -17, 6 -0.19 E -18, 7 -0.2 E -19/ DATA AAINT5/1.13024 60203 44657 16133 E 0, 1 -0.46471 80646 39872 334 E -2, 2 -0.35137 41338 26932 03 E -3, 3 -0.27681 17872 54518 5 E -4, 4 -0.22205 74525 58107 E -5, 5 -0.18089 14236 5974 E -6, 6 -0.14876 13383 373 E -7, 7 -0.12351 53881 68 E -8, 8 -0.10310 10425 7 E -9, 9 -0.86749 3013 E -11, X -0.73080 054 E -12, 1 -0.62235 61 E -13, 2 -0.52512 8 E -14, 3 -0.45677 E -15, 4 -0.3748 E -16, 5 -0.356 E -17, 6 -0.23 E -18, 7 -0.4 E -19/ DATA ZERO,ONE,TWO/ 0.0 E 0 , 1.0 E 0 , 2.0 E 0 / DATA THREE,FOUR,EIGHT/ 3.0 E 0 , 4.0 E 0 , 8.0 E 0 / DATA NINE,FORTY1,ONEHUN/ 9.0 E 0 , 41.0 E 0 , 100.0 E 0/ DATA NINHUN,FR996/ 900.0 E 0 , 4996.0 E 0 / DATA PIBY4/0.78539 81633 97448 30962 E 0/ DATA PITIM6/18.84955 59215 38759 43078 E 0/ DATA RT2B3P/0.46065 88659 61780 63902 E 0/ DATA AIRZER/0.35502 80538 87817 23926 E 0/ C C Start computation C X = XVALUE C C Compute the machine-dependent constants. C Z = R1MACH(3) XLOW1 = TWO * Z ARG = R1MACH(4) XNEG1 = - ONE / ( ARG ** (TWO/THREE) ) C C Error test ( do not remove ) C IF ( X .LT. XNEG1 ) THEN CALL ERRPRN(FNNAME,ERRMSG) AIRINT = -TWO / THREE RETURN ENDIF C C continue with machine-dependent constants C T = ARG / ONEHUN IF ( X .GE. ZERO ) THEN DO 10 NTERM1 = 25 , 0 , -1 IF ( ABS(AAINT1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 21 , 0 , -1 IF ( ABS(AAINT2(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 XHIGH1 = ( -THREE*LOG(Z)/TWO ) ** (TWO/THREE) ELSE DO 30 NTERM3 = 40 , 0 , -1 IF ( ABS(AAINT3(NTERM3)) .GT. T ) GOTO 39 30 CONTINUE 39 DO 40 NTERM4 = 17 , 0 , -1 IF ( ABS(AAINT4(NTERM4)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM5 = 17 , 0 , -1 IF ( ABS(AAINT5(NTERM5)) .GT. T ) GOTO 59 50 CONTINUE 59 ENDIF C C Code for x >= 0 C IF ( X .GE. ZERO ) THEN IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW1 ) THEN AIRINT = AIRZER * X ELSE T = X / TWO - ONE AIRINT = CHEVAL(NTERM1,AAINT1,T) * X ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN TEMP = ZERO ELSE Z = ( X + X ) * SQRT(X) / THREE TEMP = THREE * Z T = ( FORTY1 - TEMP ) / ( NINE + TEMP ) TEMP = EXP(-Z) * CHEVAL(NTERM2,AAINT2,T) / SQRT(PITIM6*Z) ENDIF AIRINT = ONE / THREE - TEMP ENDIF ELSE C C Code for x < 0 C IF ( X .GE. -EIGHT ) THEN IF ( X .GT. -XLOW1 ) THEN AIRINT = AIRZER * X ELSE T = -X / FOUR - ONE AIRINT = X * CHEVAL(NTERM3,AAINT3,T) ENDIF ELSE Z = - ( X + X ) * SQRT(-X) / THREE ARG = Z + PIBY4 TEMP = NINE * Z * Z T = ( FR996 - TEMP ) / ( NINHUN + TEMP) GVAL = CHEVAL(NTERM4,AAINT4,T) HVAL = CHEVAL(NTERM5,AAINT5,T) TEMP = GVAL * COS(ARG) + HVAL * SIN(ARG) / Z AIRINT = RT2B3P * TEMP / SQRT(Z) - TWO / THREE ENDIF ENDIF RETURN END REAL FUNCTION AIRYGI(XVALUE) C C DESCRIPTION: C C This subroutine computes the modified Airy function Gi(x), C defined as C C AIRYGI(x) = [ Integral{0 to infinity} sin(x*t+t^3/3) dt ] / pi C C The approximation uses Chebyshev expansions with the coefficients C given to 20 decimal places. C C C ERROR RETURNS: C C If x < -XHIGH1*XHIGH1 (see below for definition of XHIGH1), then C the trig. functions needed for the asymptotic expansion of Bi(x) C cannot be computed to any accuracy. An error message is printed C and the code returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C ARGIP1. The recommended value is such that C ABS(ARGIP1(NTERM1)) < EPS/100 C subject to 1 <= NTERM1 <= 30. C C NTERM2 - INTEGER - The no. of terms to be used from the array C ARGIP2. The recommended value is such that C ABS(ARGIP2(NTERM2)) < EPS/100 C subject to 1 <= NTERM2 <= 29. C C NTERM3 - INTEGER - The no. of terms to be used from the array C ARGIN1. The recommended value is such that C ABS(ARGIN1(NTERM3)) < EPS/100 C subject to 1 <= NTERM3 <= 42. C C NTERM4 - INTEGER - The no. of terms to be used from the array C ARBIN1. The recommended value is such that C ABS(ARBIN1(NTERM4)) < EPS/100 C subject to 1 <= NTERM4 <= 10. C C NTERM5 - INTEGER - The no. of terms to be used from the array C ARBIN2. The recommended value is such that C ABS(ARBIN2(NTERM5)) < EPS/100 C subject to 1 <= NTERM5 <= 11. C C NTERM6 - INTEGER - The no. of terms to be used from the array C ARGH2. The recommended value is such that C ABS(ARHIN1(NTERM6)) < EPS/100 C subject to 1 <= NTERM6 <= 15. C C XLOW1 - REAL - The value such that, if -XLOW1 < x < XLOW1, C then AIRYGI = Gi(0) to machine precision. C The recommended value is EPS. C C XHIGH1 - REAL - The value such that, if x > XHIGH1, then C AIRYGI = 1/(Pi*x) to machine precision. C Also used for error test - see above. C The recommended value is C cube root( 2/EPS ). C C XHIGH2 - REAL - The value above which AIRYGI = 0.0. C The recommended value is C 1/(Pi*XMIN). C C XHIGH3 - REAL - The value such that, if x < XHIGH3, C then the Chebyshev expansions for the C asymptotic form of Bi(x) are not needed. C The recommended value is C -8 * cube root( 2/EPSNEG ). C C For values of EPS, EPSNEG, and XMIN refer to the file C MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C COS , SIN , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C Dr. Allan J. Macleod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND. C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST UPDATE: C 18 January, 1996. C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5,NTERM6 REAL ARGIP1(0:30),ARGIP2(0:29),ARGIN1(0:42), 1 ARBIN1(0:10),ARBIN2(0:11),ARHIN1(0:15), 2 ARG,BI,CHEB1,CHEB2,CHEVAL,COSZ,FIVE,FIVE14,FOUR, 3 GIZERO,MINATE,NINE,ONE,ONEBPI,ONEHUN,ONE76,ONE024,PIBY4, 4 RTPIIN,SEVEN,SEVEN2,SINZ,T,TEMP,THREE,TWELHU,TWENT8, 5 X,XCUBE,XHIGH1,XHIGH2,XHIGH3,XLOW1,XMINUS, 6 XVALUE,Z,ZERO,ZETA,R1MACH CHARACTER FNNAME*6,ERRMSG*46 DATA FNNAME/'AIRYGI'/ DATA ERRMSG/'ARGUMENT TOO NEGATIVE FOR ACCURATE COMPUTATION'/ DATA ARGIP1(0)/ 0.26585 77079 50227 45082 E 0/ DATA ARGIP1(1)/ -0.10500 33309 75019 22907 E 0/ DATA ARGIP1(2)/ 0.84134 74753 28454 492 E -2/ DATA ARGIP1(3)/ 0.20210 67387 81343 9541 E -1/ DATA ARGIP1(4)/ -0.15595 76113 86355 2234 E -1/ DATA ARGIP1(5)/ 0.56434 29390 43256 481 E -2/ DATA ARGIP1(6)/ -0.59776 84482 66558 09 E -3/ DATA ARGIP1(7)/ -0.42833 85026 48677 28 E -3/ DATA ARGIP1(8)/ 0.22605 66238 09090 27 E -3/ DATA ARGIP1(9)/ -0.36083 32945 59226 0 E -4/ DATA ARGIP1(10)/-0.78551 89887 88901 E -5/ DATA ARGIP1(11)/ 0.47325 24807 46370 E -5/ DATA ARGIP1(12)/-0.59743 51397 7694 E -6/ DATA ARGIP1(13)/-0.15917 60916 5602 E -6/ DATA ARGIP1(14)/ 0.63361 29065 570 E -7/ DATA ARGIP1(15)/-0.27609 02326 48 E -8/ DATA ARGIP1(16)/-0.25606 41540 85 E -8/ DATA ARGIP1(17)/ 0.47798 67685 6 E -9/ DATA ARGIP1(18)/ 0.44881 31863 E -10/ DATA ARGIP1(19)/-0.23465 08882 E -10/ DATA ARGIP1(20)/ 0.76839 085 E -12/ DATA ARGIP1(21)/ 0.73227 985 E -12/ DATA ARGIP1(22)/-0.85136 87 E -13/ DATA ARGIP1(23)/-0.16302 01 E -13/ DATA ARGIP1(24)/ 0.35676 9 E -14/ DATA ARGIP1(25)/ 0.25001 E -15/ DATA ARGIP1(26)/-0.10859 E -15/ DATA ARGIP1(27)/-0.158 E -17/ DATA ARGIP1(28)/ 0.275 E -17/ DATA ARGIP1(29)/-0.5 E -19/ DATA ARGIP1(30)/-0.6 E -19/ DATA ARGIP2(0)/ 2.00473 71227 58014 86391 E 0/ DATA ARGIP2(1)/ 0.29418 41393 64406 724 E -2/ DATA ARGIP2(2)/ 0.71369 24900 63401 67 E -3/ DATA ARGIP2(3)/ 0.17526 56343 05022 67 E -3/ DATA ARGIP2(4)/ 0.43591 82094 02988 2 E -4/ DATA ARGIP2(5)/ 0.10926 26947 60430 7 E -4/ DATA ARGIP2(6)/ 0.27238 24183 99029 E -5/ DATA ARGIP2(7)/ 0.66230 90094 7687 E -6/ DATA ARGIP2(8)/ 0.15425 32337 0315 E -6/ DATA ARGIP2(9)/ 0.34184 65242 306 E -7/ DATA ARGIP2(10)/ 0.72815 77248 94 E -8/ DATA ARGIP2(11)/ 0.15158 85254 52 E -8/ DATA ARGIP2(12)/ 0.30940 04803 9 E -9/ DATA ARGIP2(13)/ 0.61496 72614 E -10/ DATA ARGIP2(14)/ 0.12028 77045 E -10/ DATA ARGIP2(15)/ 0.23369 0586 E -11/ DATA ARGIP2(16)/ 0.43778 068 E -12/ DATA ARGIP2(17)/ 0.79964 47 E -13/ DATA ARGIP2(18)/ 0.14940 75 E -13/ DATA ARGIP2(19)/ 0.24679 0 E -14/ DATA ARGIP2(20)/ 0.37672 E -15/ DATA ARGIP2(21)/ 0.7701 E -16/ DATA ARGIP2(22)/ 0.354 E -17/ DATA ARGIP2(23)/-0.49 E -18/ DATA ARGIP2(24)/ 0.62 E -18/ DATA ARGIP2(25)/-0.40 E -18/ DATA ARGIP2(26)/-0.1 E -19/ DATA ARGIP2(27)/ 0.2 E -19/ DATA ARGIP2(28)/-0.3 E -19/ DATA ARGIP2(29)/ 0.1 E -19/ DATA ARGIN1(0)/ -0.20118 96505 67320 89130 E 0/ DATA ARGIN1(1)/ -0.72441 75303 32453 0499 E -1/ DATA ARGIN1(2)/ 0.45050 18923 89478 0120 E -1/ DATA ARGIN1(3)/ -0.24221 37112 20787 91099 E 0/ DATA ARGIN1(4)/ 0.27178 84964 36167 8294 E -1/ DATA ARGIN1(5)/ -0.57293 21004 81817 9697 E -1/ DATA ARGIN1(6)/ -0.18382 10786 03377 63587 E 0/ DATA ARGIN1(7)/ 0.77515 46082 14947 5511 E -1/ DATA ARGIN1(8)/ 0.18386 56473 39275 60387 E 0/ DATA ARGIN1(9)/ 0.29215 04250 18556 7173 E -1/ DATA ARGIN1(10)/-0.61422 94846 78801 8811 E -1/ DATA ARGIN1(11)/-0.29993 12505 79461 6238 E -1/ DATA ARGIN1(12)/ 0.58593 71183 27706 636 E -2/ DATA ARGIN1(13)/ 0.82222 16584 97402 529 E -2/ DATA ARGIN1(14)/ 0.13257 98171 66846 893 E -2/ DATA ARGIN1(15)/-0.96248 31076 65651 26 E -3/ DATA ARGIN1(16)/-0.45065 51599 82118 07 E -3/ DATA ARGIN1(17)/ 0.77242 34743 25474 E -5/ DATA ARGIN1(18)/ 0.54818 74134 75805 2 E -4/ DATA ARGIN1(19)/ 0.12458 98039 74287 6 E -4/ DATA ARGIN1(20)/-0.24619 68910 92083 E -5/ DATA ARGIN1(21)/-0.16915 41835 45285 E -5/ DATA ARGIN1(22)/-0.16769 15316 9442 E -6/ DATA ARGIN1(23)/ 0.96365 09337 672 E -7/ DATA ARGIN1(24)/ 0.32533 14928 030 E -7/ DATA ARGIN1(25)/ 0.50918 04231 E -10/ DATA ARGIN1(26)/-0.20918 04535 53 E -8/ DATA ARGIN1(27)/-0.41237 38787 0 E -9/ DATA ARGIN1(28)/ 0.41633 38253 E -10/ DATA ARGIN1(29)/ 0.30325 32117 E -10/ DATA ARGIN1(30)/ 0.34058 0529 E -11/ DATA ARGIN1(31)/-0.88444 592 E -12/ DATA ARGIN1(32)/-0.31639 612 E -12/ DATA ARGIN1(33)/-0.15050 76 E -13/ DATA ARGIN1(34)/ 0.11041 48 E -13/ DATA ARGIN1(35)/ 0.24650 8 E -14/ DATA ARGIN1(36)/-0.3107 E -16/ DATA ARGIN1(37)/-0.9851 E -16/ DATA ARGIN1(38)/-0.1453 E -16/ DATA ARGIN1(39)/ 0.118 E -17/ DATA ARGIN1(40)/ 0.67 E -18/ DATA ARGIN1(41)/ 0.6 E -19/ DATA ARGIN1(42)/-0.1 E -19/ DATA ARBIN1/1.99983 76358 35861 55980 E 0, 1 -0.81046 60923 66941 8 E -4, 2 0.13475 66598 4689 E -6, 3 -0.70855 84714 3 E -9, 4 0.74818 4187 E -11, 5 -0.12902 774 E -12, 6 0.32250 4 E -14, 7 -0.10809 E -15, 8 0.460 E -17, 9 -0.24 E -18, X 0.1 E -19/ DATA ARBIN2/0.13872 35645 38791 20276 E 0, 1 -0.82392 86225 55822 8 E -4, 2 0.26720 91950 9866 E -6, 3 -0.20742 36853 68 E -8, 4 0.28733 92593 E -10, 5 -0.60873 521 E -12, 6 0.17924 89 E -13, 7 -0.68760 E -15, 8 0.3280 E -16, 9 -0.188 E -17, X 0.13 E -18, 1 -0.1 E -19/ DATA ARHIN1/1.99647 72039 97796 50525 E 0, 1 -0.18756 37794 07173 213 E -2, 2 -0.12186 47089 77873 39 E -3, 3 -0.81402 16096 59287 E -5, 4 -0.55050 92595 3537 E -6, 5 -0.37630 08043 303 E -7, 6 -0.25885 83623 65 E -8, 7 -0.17931 82926 5 E -9, 8 -0.12459 16873 E -10, 9 -0.87171 247 E -12, X -0.60849 43 E -13, 1 -0.43117 8 E -14, 2 -0.29787 E -15, 3 -0.2210 E -16, 4 -0.136 E -17, 5 -0.14 E -18/ DATA ZERO,ONE,THREE,FOUR/ 0.0 E 0 , 1.0 E 0 , 3.0 E 0 , 4.0 E 0 / DATA FIVE,SEVEN,MINATE/ 5.0 E 0 , 7.0 E 0 , -8.0 E 0 / DATA NINE,TWENT8,SEVEN2/ 9.0 E 0 , 28.0 E 0 , 72.0 E 0 / DATA ONEHUN,ONE76,FIVE14/ 100.0 E 0 , 176.0 E 0 , 514.0 E 0 / DATA ONE024,TWELHU/ 1024.0 E 0 , 1200.0 E 0 / DATA GIZERO/0.20497 55424 82000 24505 E 0/ DATA ONEBPI/0.31830 98861 83790 67154 E 0/ DATA PIBY4/0.78539 81633 97448 30962 E 0/ DATA RTPIIN/0.56418 95835 47756 28695 E 0/ C C Start computation C X = XVALUE C C Compute the machine-dependent constants. C Z = R1MACH(3) XLOW1 = Z ARG = R1MACH(4) XHIGH1 = ONE / ARG XHIGH1 = ( XHIGH1 + XHIGH1 ) ** (ONE/THREE) C C Error test ( do not remove ) C IF ( X .LT. -XHIGH1*XHIGH1 ) THEN CALL ERRPRN(FNNAME,ERRMSG) AIRYGI = ZERO RETURN ENDIF C C continue with machine-dependent constants C T = ARG / ONEHUN IF ( X .GE. ZERO ) THEN DO 10 NTERM1 = 30 , 0 , -1 IF ( ABS(ARGIP1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 29 , 0 , -1 IF ( ABS(ARGIP2(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 TEMP = FOUR * PIBY4 XHIGH2 = ONE / ( TEMP * R1MACH(1) ) ELSE DO 30 NTERM3 = 42 , 0 , -1 IF ( ABS(ARGIN1(NTERM3)) .GT. T ) GOTO 39 30 CONTINUE 39 DO 40 NTERM4 = 10 , 0 , -1 IF ( ABS(ARBIN1(NTERM4)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM5 = 11 , 0 , -1 IF ( ABS(ARBIN2(NTERM5)) .GT. T ) GOTO 59 50 CONTINUE 59 DO 60 NTERM6 = 15 , 0 , -1 IF ( ABS(ARHIN1(NTERM6)) .GT. T ) GOTO 69 60 CONTINUE 69 TEMP = ONE / Z XHIGH3 = MINATE * ( TEMP + TEMP ) ** (ONE/THREE) ENDIF C C Code for x >= 0.0 C IF ( X .GE. ZERO ) THEN IF ( X .LE. SEVEN ) THEN IF ( X .LT. XLOW1 ) THEN AIRYGI = GIZERO ELSE T = ( NINE * X - TWENT8 ) / ( X + TWENT8 ) AIRYGI = CHEVAL ( NTERM1 , ARGIP1 , T ) ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN IF ( X .GT. XHIGH2 ) THEN AIRYGI = ZERO ELSE AIRYGI = ONEBPI/X ENDIF ELSE XCUBE = X * X * X T = ( TWELHU - XCUBE ) / ( FIVE14 + XCUBE ) AIRYGI = ONEBPI * CHEVAL(NTERM2,ARGIP2,T) / X ENDIF ENDIF ELSE C C Code for x < 0.0 C IF ( X .GE. MINATE ) THEN IF ( X .GT. -XLOW1 ) THEN AIRYGI = GIZERO ELSE T = -( X + FOUR ) / FOUR AIRYGI = CHEVAL(NTERM3,ARGIN1,T) ENDIF ELSE XMINUS = -X T = XMINUS * SQRT(XMINUS) ZETA = ( T + T ) / THREE TEMP = RTPIIN / SQRT(SQRT(XMINUS)) COSZ = COS ( ZETA + PIBY4 ) SINZ = SIN ( ZETA + PIBY4 ) / ZETA XCUBE = X * X * X IF ( X .GT. XHIGH3 ) THEN T = - ( ONE024 / ( XCUBE ) + ONE ) CHEB1 = CHEVAL(NTERM4,ARBIN1,T) CHEB2 = CHEVAL(NTERM5,ARBIN2,T) BI = ( COSZ * CHEB1 + SINZ * CHEB2 ) * TEMP ELSE BI = ( COSZ + SINZ * FIVE / SEVEN2 ) * TEMP ENDIF T = ( XCUBE + TWELHU ) / ( ONE76 - XCUBE ) AIRYGI = BI + CHEVAL(NTERM6,ARHIN1,T) * ONEBPI / X ENDIF ENDIF RETURN END REAL FUNCTION AIRYHI(XVALUE) C C DESCRIPTION: C C This subroutine computes the modified Airy function Hi(x), C defined as C C AIRYHI(x) = [ Integral{0 to infinity} exp(x*t-t^3/3) dt ] / pi C C The approximation uses Chebyshev expansions with the coefficients C given to 20 decimal places. C C C ERROR RETURNS: C C If x > XHIGH1 (see below for definition of XHIGH1), then C the asymptotic expansion of Hi(x) will cause an overflow. C An error message is printed and the code returns the largest C floating-pt number as the result. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C ARHIP. The recommended value is such that C ABS(ARHIP(NTERM1)) < EPS/100 C subject to 1 <= NTERM1 <= 31. C C NTERM2 - INTEGER - The no. of terms to be used from the array C ARBIP. The recommended value is such that C ABS(ARBIP(NTERM2)) < EPS/100 C subject to 1 <= NTERM2 <= 23. C C NTERM3 - INTEGER - The no. of terms to be used from the array C ARGIP. The recommended value is such that C ABS(ARGIP1(NTERM3)) < EPS/100 C subject to 1 <= NTERM3 <= 29. C C NTERM4 - INTEGER - The no. of terms to be used from the array C ARHIN1. The recommended value is such that C ABS(ARHIN1(NTERM4)) < EPS/100 C subject to 1 <= NTERM4 <= 21. C C NTERM5 - INTEGER - The no. of terms to be used from the array C ARHIN2. The recommended value is such that C ABS(ARHIN2(NTERM5)) < EPS/100 C subject to 1 <= NTERM5 <= 15. C C XLOW1 - REAL - The value such that, if -XLOW1 < x < XLOW1, C then AIRYGI = Hi(0) to machine precision. C The recommended value is EPS. C C XHIGH1 - REAL - The value such that, if x > XHIGH1, then C overflow might occur. The recommended value is C computed as follows: C compute Z = 1.5*LOG(XMAX) C XHIGH1 = ( Z + LOG(Z)/4 + LOG(PI)/2 )**(2/3) C C XNEG1 - REAL - The value below which AIRYHI = 0.0. C The recommended value is C -1/(Pi*XMIN). C C XNEG2 - REAL - The value such that, if x < XNEG2, then C AIRYHI = -1/(Pi*x) to machine precision. C The recommended value is C -cube root( 2/EPS ). C C XMAX - REAL - The largest possible floating-pt. number. C This is the value given to the function C if x > XHIGH1. C C For values of EPS, EPSNEG, XMIN and XMAX refer to the file C MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C Dr. Allan J. Macleod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND. C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST UPDATE: C 18 January, 1996. C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5 REAL ARHIP(0:31),ARBIP(0:23),ARGIP1(0:29), 1 ARHIN1(0:21),ARHIN2(0:15), 2 BI,CHEVAL,FIVE14,FOUR,GI,HIZERO,LNRTPI, 3 MINATE,ONE,ONEBPI,ONEHUN,ONE76,SEVEN,T,TEMP, 4 THREE,THRE43,TWELHU,TWELVE,TWO,X,XCUBE, 5 XHIGH1,XLOW1,XMAX,XNEG1,XNEG2,XVALUE, 6 Z,ZERO,ZETA,R1MACH CHARACTER FNNAME*6,ERRMSG*30 DATA FNNAME/'AIRYHI'/ DATA ERRMSG/'ARGUMENT TO FUNCTION TOO LARGE'/ DATA ARHIP(0)/ 1.24013 56256 17628 31114 E 0/ DATA ARHIP(1)/ 0.64856 34197 39265 35804 E 0/ DATA ARHIP(2)/ 0.55236 25259 21149 03246 E 0/ DATA ARHIP(3)/ 0.20975 12207 38575 66794 E 0/ DATA ARHIP(4)/ 0.12025 66911 80523 73568 E 0/ DATA ARHIP(5)/ 0.37682 24931 09539 3785 E -1/ DATA ARHIP(6)/ 0.16510 88671 54807 1651 E -1/ DATA ARHIP(7)/ 0.45592 27552 11570 993 E -2/ DATA ARHIP(8)/ 0.16182 84804 77635 013 E -2/ DATA ARHIP(9)/ 0.40841 28250 81266 63 E -3/ DATA ARHIP(10)/0.12196 47972 13940 51 E -3/ DATA ARHIP(11)/0.28650 64098 65761 0 E -4/ DATA ARHIP(12)/0.74222 15564 24344 E -5/ DATA ARHIP(13)/0.16353 62319 32831 E -5/ DATA ARHIP(14)/0.37713 90818 8749 E -6/ DATA ARHIP(15)/0.78158 00336 008 E -7/ DATA ARHIP(16)/0.16384 47121 370 E -7/ DATA ARHIP(17)/0.31985 76659 92 E -8/ DATA ARHIP(18)/0.61933 90530 7 E -9/ DATA ARHIP(19)/0.11411 16119 1 E -9/ DATA ARHIP(20)/0.20649 23454 E -10/ DATA ARHIP(21)/0.36001 8664 E -11/ DATA ARHIP(22)/0.61401 849 E -12/ DATA ARHIP(23)/0.10162 125 E -12/ DATA ARHIP(24)/0.16437 01 E -13/ DATA ARHIP(25)/0.25908 4 E -14/ DATA ARHIP(26)/0.39931 E -15/ DATA ARHIP(27)/0.6014 E -16/ DATA ARHIP(28)/0.886 E -17/ DATA ARHIP(29)/0.128 E -17/ DATA ARHIP(30)/0.18 E -18/ DATA ARHIP(31)/0.3 E -19/ DATA ARBIP(0)/ 2.00582 13820 97590 64905 E 0/ DATA ARBIP(1)/ 0.29447 84491 70441 549 E -2/ DATA ARBIP(2)/ 0.34897 54514 77535 5 E -4/ DATA ARBIP(3)/ 0.83389 73337 4343 E -6/ DATA ARBIP(4)/ 0.31362 15471 813 E -7/ DATA ARBIP(5)/ 0.16786 53060 15 E -8/ DATA ARBIP(6)/ 0.12217 93405 9 E -9/ DATA ARBIP(7)/ 0.11915 84139 E -10/ DATA ARBIP(8)/ 0.15414 2553 E -11/ DATA ARBIP(9)/ 0.24844 455 E -12/ DATA ARBIP(10)/ 0.42130 12 E -13/ DATA ARBIP(11)/ 0.50529 3 E -14/ DATA ARBIP(12)/-0.60032 E -15/ DATA ARBIP(13)/-0.65474 E -15/ DATA ARBIP(14)/-0.22364 E -15/ DATA ARBIP(15)/-0.3015 E -16/ DATA ARBIP(16)/ 0.959 E -17/ DATA ARBIP(17)/ 0.616 E -17/ DATA ARBIP(18)/ 0.97 E -18/ DATA ARBIP(19)/-0.37 E -18/ DATA ARBIP(20)/-0.21 E -18/ DATA ARBIP(21)/-0.1 E -19/ DATA ARBIP(22)/ 0.2 E -19/ DATA ARBIP(23)/ 0.1 E -19/ DATA ARGIP1(0)/ 2.00473 71227 58014 86391 E 0/ DATA ARGIP1(1)/ 0.29418 41393 64406 724 E -2/ DATA ARGIP1(2)/ 0.71369 24900 63401 67 E -3/ DATA ARGIP1(3)/ 0.17526 56343 05022 67 E -3/ DATA ARGIP1(4)/ 0.43591 82094 02988 2 E -4/ DATA ARGIP1(5)/ 0.10926 26947 60430 7 E -4/ DATA ARGIP1(6)/ 0.27238 24183 99029 E -5/ DATA ARGIP1(7)/ 0.66230 90094 7687 E -6/ DATA ARGIP1(8)/ 0.15425 32337 0315 E -6/ DATA ARGIP1(9)/ 0.34184 65242 306 E -7/ DATA ARGIP1(10)/ 0.72815 77248 94 E -8/ DATA ARGIP1(11)/ 0.15158 85254 52 E -8/ DATA ARGIP1(12)/ 0.30940 04803 9 E -9/ DATA ARGIP1(13)/ 0.61496 72614 E -10/ DATA ARGIP1(14)/ 0.12028 77045 E -10/ DATA ARGIP1(15)/ 0.23369 0586 E -11/ DATA ARGIP1(16)/ 0.43778 068 E -12/ DATA ARGIP1(17)/ 0.79964 47 E -13/ DATA ARGIP1(18)/ 0.14940 75 E -13/ DATA ARGIP1(19)/ 0.24679 0 E -14/ DATA ARGIP1(20)/ 0.37672 E -15/ DATA ARGIP1(21)/ 0.7701 E -16/ DATA ARGIP1(22)/ 0.354 E -17/ DATA ARGIP1(23)/-0.49 E -18/ DATA ARGIP1(24)/ 0.62 E -18/ DATA ARGIP1(25)/-0.40 E -18/ DATA ARGIP1(26)/-0.1 E -19/ DATA ARGIP1(27)/ 0.2 E -19/ DATA ARGIP1(28)/-0.3 E -19/ DATA ARGIP1(29)/ 0.1 E -19/ DATA ARHIN1(0)/ 0.31481 01720 64234 04116 E 0/ DATA ARHIN1(1)/ -0.16414 49921 65889 64341 E 0/ DATA ARHIN1(2)/ 0.61766 51597 73091 3071 E -1/ DATA ARHIN1(3)/ -0.19718 81185 93593 3028 E -1/ DATA ARHIN1(4)/ 0.53690 28300 23331 343 E -2/ DATA ARHIN1(5)/ -0.12497 70684 39663 038 E -2/ DATA ARHIN1(6)/ 0.24835 51559 69949 33 E -3/ DATA ARHIN1(7)/ -0.41870 24096 74663 0 E -4/ DATA ARHIN1(8)/ 0.59094 54379 79124 E -5/ DATA ARHIN1(9)/ -0.68063 54118 4345 E -6/ DATA ARHIN1(10)/ 0.60728 97629 164 E -7/ DATA ARHIN1(11)/-0.36713 03492 42 E -8/ DATA ARHIN1(12)/ 0.70780 17552 E -10/ DATA ARHIN1(13)/ 0.11878 94334 E -10/ DATA ARHIN1(14)/-0.12089 8723 E -11/ DATA ARHIN1(15)/ 0.11896 56 E -13/ DATA ARHIN1(16)/ 0.59412 8 E -14/ DATA ARHIN1(17)/-0.32257 E -15/ DATA ARHIN1(18)/-0.2290 E -16/ DATA ARHIN1(19)/ 0.253 E -17/ DATA ARHIN1(20)/ 0.9 E -19/ DATA ARHIN1(21)/-0.2 E -19/ DATA ARHIN2/1.99647 72039 97796 50525 E 0, 1 -0.18756 37794 07173 213 E -2, 2 -0.12186 47089 77873 39 E -3, 3 -0.81402 16096 59287 E -5, 4 -0.55050 92595 3537 E -6, 5 -0.37630 08043 303 E -7, 6 -0.25885 83623 65 E -8, 7 -0.17931 82926 5 E -9, 8 -0.12459 16873 E -10, 9 -0.87171 247 E -12, X -0.60849 43 E -13, 1 -0.43117 8 E -14, 2 -0.29787 E -15, 3 -0.2210 E -16, 4 -0.136 E -17, 5 -0.14 E -18/ DATA ZERO,ONE,TWO/ 0.0 E 0 , 1.0 E 0 , 2.0 E 0/ DATA THREE,FOUR,SEVEN/ 3.0 E 0 , 4.0 E 0 , 7.0 E 0 / DATA MINATE,TWELVE,ONE76/ -8.0 E 0 , 12.0 E 0 , 176.0 E 0 / DATA THRE43,FIVE14,TWELHU/ 343.0 E 0 , 514.0 E 0 , 1200.0 E 0 / DATA ONEHUN/100.0 E 0/ DATA HIZERO/0.40995 10849 64000 49010 E 0/ DATA LNRTPI/0.57236 49429 24700 08707 E 0/ DATA ONEBPI/0.31830 98861 83790 67154 E 0/ C C Start computation C X = XVALUE C C Compute the machine-dependent constants. C XMAX = R1MACH(2) TEMP = THREE * LOG(XMAX) / TWO ZETA = ( TEMP + LOG(TEMP)/FOUR - LOG(ONEBPI)/TWO ) XHIGH1 = ZETA ** (TWO/THREE) C C Error test ( do not remove ) C IF ( X .GT. XHIGH1 ) THEN CALL ERRPRN(FNNAME,ERRMSG) AIRYHI = XMAX RETURN ENDIF C C continue with machine-dependent constants C Z = R1MACH(3) XLOW1 = Z T = Z / ONEHUN IF ( X .GE. ZERO ) THEN DO 10 NTERM1 = 31 , 0 , -1 IF ( ABS(ARHIP(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 23 , 0 , -1 IF ( ABS(ARBIP(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 DO 30 NTERM3 = 29 , 0 , -1 IF ( ABS(ARGIP1(NTERM3)) .GT. T ) GOTO 39 30 CONTINUE 39 CONTINUE ELSE DO 40 NTERM4 = 21 , 0 , -1 IF ( ABS(ARHIN1(NTERM4)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM5 = 15 , 0 , -1 IF ( ABS(ARHIN2(NTERM5)) .GT. T ) GOTO 59 50 CONTINUE 59 TEMP = ONE / ONEBPI XNEG1 = - ONE / ( TEMP * R1MACH(1) ) XNEG2 = - ( ( TWO / Z ) ** (ONE/THREE) ) ENDIF C C Code for x >= 0.0 C IF ( X .GE. ZERO ) THEN IF ( X .LE. SEVEN ) THEN IF ( X .LT. XLOW1 ) THEN AIRYHI = HIZERO ELSE T = ( X + X ) / SEVEN - ONE TEMP = ( X + X + X ) / TWO AIRYHI = EXP(TEMP) * CHEVAL(NTERM1,ARHIP,T) ENDIF ELSE XCUBE = X * X * X TEMP = SQRT(XCUBE) ZETA = ( TEMP + TEMP ) / THREE T = TWO * ( SQRT(THRE43/XCUBE) ) - ONE TEMP = CHEVAL(NTERM2,ARBIP,T) TEMP = ZETA + LOG(TEMP) - LOG(X) / FOUR - LNRTPI BI = EXP(TEMP) T = ( TWELHU - XCUBE ) / ( XCUBE + FIVE14 ) GI = CHEVAL(NTERM3,ARGIP1,T) * ONEBPI / X AIRYHI = BI - GI ENDIF ELSE C C Code for x < 0.0 C IF ( X .GE. MINATE ) THEN IF ( X .GT. -XLOW1 ) THEN AIRYHI = HIZERO ELSE T = ( FOUR * X + TWELVE ) / ( X - TWELVE ) AIRYHI = CHEVAL(NTERM4,ARHIN1,T) ENDIF ELSE IF ( X .LT. XNEG1 ) THEN AIRYHI = ZERO ELSE IF ( X .LT. XNEG2 ) THEN TEMP = ONE ELSE XCUBE = X * X * X T = ( XCUBE + TWELHU ) / ( ONE76 - XCUBE ) TEMP = CHEVAL(NTERM5,ARHIN2,T) ENDIF AIRYHI = - TEMP * ONEBPI / X ENDIF ENDIF ENDIF RETURN END REAL FUNCTION ATNINT(XVALUE) C C DESCRIPTION: C C The function ATNINT calculates the value of the C inverse-tangent integral defined by C C ATNINT(x) = integral 0 to x ( (arctan t)/t ) dt C C The approximation uses Chebyshev series with the coefficients C given to an accuracy of 20D. C C C ERROR RETURNS: C C There are no error returns from this program. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The no. of terms of the array ATNINTT. C The recommended value is such that C ATNINA(NTERMS) < EPS/100 C C XLOW - REAL - A bound below which ATNINT(x) = x to machine C precision. The recommended value is C sqrt(EPSNEG/2). C C XUPPER - REAL - A bound on x, above which, to machine precision C ATNINT(x) = (pi/2)ln x C The recommended value is 1/EPS. C C For values of EPSNEG and EPS for various machine/compiler C combinations refer to the text file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C ABS , LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , R1MACH C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C PAISLEY C SCOTLAND C C (e-mail macl_ms0@paisley.ac.uk ) C C C LATEST MODIFICATION: 18 January, 1996 C C C INTEGER IND,NTERMS REAL ATNINA(0:22),CHEVAL,HALF,ONE,ONEHUN,T,TWOBPI, & X,XLOW,XUPPER,XVALUE,ZERO,R1MACH DATA ZERO,HALF,ONE/0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA ONEHUN/100.0 E 0/ DATA TWOBPI/0.63661 97723 67581 34308 E 0/ DATA ATNINA(0)/ 1.91040 36129 62359 37512 E 0/ DATA ATNINA(1)/ -0.41763 51437 65674 6940 E -1/ DATA ATNINA(2)/ 0.27539 25507 86367 434 E -2/ DATA ATNINA(3)/ -0.25051 80952 62488 81 E -3/ DATA ATNINA(4)/ 0.26669 81285 12117 1 E -4/ DATA ATNINA(5)/ -0.31189 05141 07001 E -5/ DATA ATNINA(6)/ 0.38833 85313 2249 E -6/ DATA ATNINA(7)/ -0.50572 74584 964 E -7/ DATA ATNINA(8)/ 0.68122 52829 49 E -8/ DATA ATNINA(9)/ -0.94212 56165 4 E -9/ DATA ATNINA(10)/ 0.13307 87881 6 E -9/ DATA ATNINA(11)/-0.19126 78075 E -10/ DATA ATNINA(12)/ 0.27891 2620 E -11/ DATA ATNINA(13)/-0.41174 820 E -12/ DATA ATNINA(14)/ 0.61429 87 E -13/ DATA ATNINA(15)/-0.92492 9 E -14/ DATA ATNINA(16)/ 0.14038 7 E -14/ DATA ATNINA(17)/-0.21460 E -15/ DATA ATNINA(18)/ 0.3301 E -16/ DATA ATNINA(19)/-0.511 E -17/ DATA ATNINA(20)/ 0.79 E -18/ DATA ATNINA(21)/-0.12 E -18/ DATA ATNINA(22)/ 0.2 E -19/ C C Compute the machine-dependent constants. C T = R1MACH(4) / ONEHUN DO 10 NTERMS = 22 , 0 , -1 IF ( ABS(ATNINA(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 T = R1MACH(3) XLOW = SQRT( T / ( ONE + ONE ) ) XUPPER = ONE / T C C Start calculation C IND = 1 X = XVALUE IF ( X .LT. ZERO ) THEN X = -X IND = -1 ENDIF C C Code for X < = 1.0 C IF ( X .LE. ONE ) THEN IF ( X .LT. XLOW ) THEN ATNINT = X ELSE T = X * X T = ( T - HALF ) + ( T - HALF ) ATNINT = X * CHEVAL( NTERMS , ATNINA , T ) ENDIF ELSE C C Code for X > 1.0 C IF ( X .GT. XUPPER ) THEN ATNINT = LOG( X ) / TWOBPI ELSE T = ONE / ( X * X ) T = ( T - HALF ) + ( T - HALF ) ATNINT = LOG( X ) / TWOBPI + CHEVAL( NTERMS,ATNINA,T ) / X ENDIF ENDIF IF ( IND .LT. 0 ) ATNINT = - ATNINT RETURN END REAL FUNCTION BIRINT(XVALUE) C C DESCRIPTION: C This function calculates the integral of the Airy function Bi, defined C C BIRINT(x) = integral{0 to x} Bi(t) dt C C The program uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C C ERROR RETURNS: C C If the function is too large and positive the correct C value would overflow. An error message is printed and the C program returns the value XMAX. C C If the argument is too large and negative, it is impossible C to accurately compute the necessary SIN and COS functions, C for the asymptotic expansion. C An error message is printed, and the program returns the C value 0 (the value at -infinity). C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C ABINT1. The recommended value is such that C ABS(ABINT1(NTERM1)) < EPS/100, C subject to 1 <= NTERM1 <= 36. C C NTERM2 - INTEGER - The no. of terms to be used from the array C ABINT2. The recommended value is such that C ABS(ABINT2(NTERM2)) < EPS/100, C subject to 1 <= NTERM2 <= 37. C C NTERM3 - INTEGER - The no. of terms to be used from the array C ABINT3. The recommended value is such that C ABS(ABINT3(NTERM3)) < EPS/100, C subject to 1 <= NTERM3 <= 37. C C NTERM4 - INTEGER - The no. of terms to be used from the array C ABINT4. The recommended value is such that C ABS(ABINT4(NTERM4)) < EPS/100, C subject to 1 <= NTERM4 <= 20. C C NTERM5 - INTEGER - The no. of terms to be used from the array C ABINT5. The recommended value is such that C ABS(ABINT5(NTERM5)) < EPS/100, C subject to 1 <= NTERM5 <= 20. C C XLOW1 - REAL - The value such that, if |x| < XLOW1, C BIRINT(x) = x * Bi(0) C to machine precision. The recommended value is C 2 * EPSNEG. C C XHIGH1 - REAL - The value such that, if x > XHIGH1, C the function value would overflow. C The recommended value is computed as C z = ln(XMAX) + 0.5ln(ln(XMAX)), C XHIGH1 = (3z/2)^(2/3) C C XNEG1 - REAL - The value such that, if x < XNEG1, C the trigonometric functions in the asymptotic C expansion cannot be calculated accurately. C The recommended value is C -(1/((EPS)**2/3)) C C XMAX - REAL - The value of the largest positive floating-pt C number. Used in giving a value to the function C if x > XHIGH1. C C For values of EPS, EPSNEG, and XMAX see the file MACHCON.TXT. C C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C COS, EXP, LOG, SIN, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C Univ. of Paisley, C High St., C Paisley, C SCOTLAND. C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 18 January, 1996 C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5 REAL ABINT1(0:36),ABINT2(0:37),ABINT3(0:37), 1 ABINT4(0:20),ABINT5(0:20), 2 ARG,BIRZER,CHEVAL,EIGHT,FOUR,F1,F2,NINE,NINHUN, 3 ONE,ONEHUN,ONEPT5,PIBY4,RT2B3P,SIXTEN,SEVEN,T,TEMP, 4 THREE,THR644,X,XLOW1,XHIGH1,XMAX,XNEG1,XVALUE, 5 Z,ZERO,R1MACH CHARACTER FNNAME*6,ERMSG1*31,ERMSG2*31 DATA FNNAME/'BIRINT'/ DATA ERMSG1/'ARGUMENT TOO LARGE AND POSITIVE'/ DATA ERMSG2/'ARGUMENT TOO LARGE AND NEGATIVE'/ DATA ABINT1(0)/ 0.38683 35244 50385 43350 E 0/ DATA ABINT1(1)/ -0.88232 13550 88890 8821 E -1/ DATA ABINT1(2)/ 0.21463 93744 03554 29239 E 0/ DATA ABINT1(3)/ -0.42053 47375 89131 5126 E -1/ DATA ABINT1(4)/ 0.59324 22547 49608 6771 E -1/ DATA ABINT1(5)/ -0.84078 70811 24270 210 E -2/ DATA ABINT1(6)/ 0.87182 47727 78487 955 E -2/ DATA ABINT1(7)/ -0.12191 60019 96134 55 E -3/ DATA ABINT1(8)/ 0.44024 82178 60232 34 E -3/ DATA ABINT1(9)/ 0.27894 68666 63866 78 E -3/ DATA ABINT1(10)/-0.70528 04689 78553 7 E -4/ DATA ABINT1(11)/ 0.59010 80066 77010 0 E -4/ DATA ABINT1(12)/-0.13708 62587 98214 2 E -4/ DATA ABINT1(13)/ 0.50596 25737 49073 E -5/ DATA ABINT1(14)/-0.51598 83776 6735 E -6/ DATA ABINT1(15)/ 0.39751 13123 49 E -8/ DATA ABINT1(16)/ 0.95249 85978 055 E -7/ DATA ABINT1(17)/-0.36814 35887 321 E -7/ DATA ABINT1(18)/ 0.12483 91688 136 E -7/ DATA ABINT1(19)/-0.24909 76191 37 E -8/ DATA ABINT1(20)/ 0.31775 24555 1 E -9/ DATA ABINT1(21)/ 0.54343 65270 E -10/ DATA ABINT1(22)/-0.40245 66915 E -10/ DATA ABINT1(23)/ 0.13938 55527 E -10/ DATA ABINT1(24)/-0.30381 7509 E -11/ DATA ABINT1(25)/ 0.40809 511 E -12/ DATA ABINT1(26)/ 0.16341 16 E -13/ DATA ABINT1(27)/-0.26838 09 E -13/ DATA ABINT1(28)/ 0.89664 1 E -14/ DATA ABINT1(29)/-0.18308 9 E -14/ DATA ABINT1(30)/ 0.21333 E -15/ DATA ABINT1(31)/ 0.1108 E -16/ DATA ABINT1(32)/-0.1276 E -16/ DATA ABINT1(33)/ 0.363 E -17/ DATA ABINT1(34)/-0.62 E -18/ DATA ABINT1(35)/ 0.5 E -19/ DATA ABINT1(36)/ 0.1 E -19/ DATA ABINT2(0)/ 2.04122 07860 25161 35181 E 0/ DATA ABINT2(1)/ 0.21241 33918 62122 1230 E -1/ DATA ABINT2(2)/ 0.66617 59976 67062 76 E -3/ DATA ABINT2(3)/ 0.38420 47982 80825 4 E -4/ DATA ABINT2(4)/ 0.36231 03660 20439 E -5/ DATA ABINT2(5)/ 0.50351 99011 5074 E -6/ DATA ABINT2(6)/ 0.79616 48702 253 E -7/ DATA ABINT2(7)/ 0.71780 84423 36 E -8/ DATA ABINT2(8)/ -0.26777 01591 04 E -8/ DATA ABINT2(9)/ -0.16848 95146 99 E -8/ DATA ABINT2(10)/-0.36811 75725 5 E -9/ DATA ABINT2(11)/ 0.47571 28727 E -10/ DATA ABINT2(12)/ 0.52636 21945 E -10/ DATA ABINT2(13)/ 0.77897 3500 E -11/ DATA ABINT2(14)/-0.46054 6143 E -11/ DATA ABINT2(15)/-0.18343 3736 E -11/ DATA ABINT2(16)/ 0.32191 249 E -12/ DATA ABINT2(17)/ 0.29352 060 E -12/ DATA ABINT2(18)/-0.16579 35 E -13/ DATA ABINT2(19)/-0.44838 08 E -13/ DATA ABINT2(20)/ 0.27907 E -15/ DATA ABINT2(21)/ 0.71192 1 E -14/ DATA ABINT2(22)/-0.1042 E -16/ DATA ABINT2(23)/-0.11959 1 E -14/ DATA ABINT2(24)/ 0.4606 E -16/ DATA ABINT2(25)/ 0.20884 E -15/ DATA ABINT2(26)/-0.2416 E -16/ DATA ABINT2(27)/-0.3638 E -16/ DATA ABINT2(28)/ 0.863 E -17/ DATA ABINT2(29)/ 0.591 E -17/ DATA ABINT2(30)/-0.256 E -17/ DATA ABINT2(31)/-0.77 E -18/ DATA ABINT2(32)/ 0.66 E -18/ DATA ABINT2(33)/ 0.3 E -19/ DATA ABINT2(34)/-0.15 E -18/ DATA ABINT2(35)/ 0.2 E -19/ DATA ABINT2(36)/ 0.3 E -19/ DATA ABINT2(37)/-0.1 E -19/ DATA ABINT3(0)/ 0.31076 96159 86403 49251 E 0/ DATA ABINT3(1)/ -0.27528 84588 74525 42718 E 0/ DATA ABINT3(2)/ 0.17355 96570 61365 43928 E 0/ DATA ABINT3(3)/ -0.55440 17909 49284 3130 E -1/ DATA ABINT3(4)/ -0.22512 65478 29595 0941 E -1/ DATA ABINT3(5)/ 0.41073 47447 81252 1894 E -1/ DATA ABINT3(6)/ 0.98476 12754 64262 480 E -2/ DATA ABINT3(7)/ -0.15556 18141 66604 1932 E -1/ DATA ABINT3(8)/ -0.56087 18707 30279 234 E -2/ DATA ABINT3(9)/ 0.24601 77833 22230 475 E -2/ DATA ABINT3(10)/ 0.16574 03922 92336 978 E -2/ DATA ABINT3(11)/-0.32775 87501 43540 2 E -4/ DATA ABINT3(12)/-0.24434 68086 05149 25 E -3/ DATA ABINT3(13)/-0.50353 05196 15232 1 E -4/ DATA ABINT3(14)/ 0.16302 64722 24785 4 E -4/ DATA ABINT3(15)/ 0.85191 40577 80934 E -5/ DATA ABINT3(16)/ 0.29790 36300 4664 E -6/ DATA ABINT3(17)/-0.64389 70789 6401 E -6/ DATA ABINT3(18)/-0.15046 98814 5803 E -6/ DATA ABINT3(19)/ 0.15870 13535 823 E -7/ DATA ABINT3(20)/ 0.12767 66299 622 E -7/ DATA ABINT3(21)/ 0.14057 85341 99 E -8/ DATA ABINT3(22)/-0.46564 73974 1 E -9/ DATA ABINT3(23)/-0.15682 74879 1 E -9/ DATA ABINT3(24)/-0.40389 3560 E -11/ DATA ABINT3(25)/ 0.66670 8192 E -11/ DATA ABINT3(26)/ 0.12886 9380 E -11/ DATA ABINT3(27)/-0.69686 63 E -13/ DATA ABINT3(28)/-0.62543 19 E -13/ DATA ABINT3(29)/-0.71839 2 E -14/ DATA ABINT3(30)/ 0.11529 6 E -14/ DATA ABINT3(31)/ 0.42276 E -15/ DATA ABINT3(32)/ 0.2493 E -16/ DATA ABINT3(33)/-0.971 E -17/ DATA ABINT3(34)/-0.216 E -17/ DATA ABINT3(35)/-0.2 E -19/ DATA ABINT3(36)/ 0.6 E -19/ DATA ABINT3(37)/ 0.1 E -19/ DATA ABINT4(0)/ 1.99507 95931 33520 47614 E 0/ DATA ABINT4(1)/ -0.27373 63759 70692 738 E -2/ DATA ABINT4(2)/ -0.30897 11308 12858 50 E -3/ DATA ABINT4(3)/ -0.35501 01982 79857 7 E -4/ DATA ABINT4(4)/ -0.41217 92715 20133 E -5/ DATA ABINT4(5)/ -0.48235 89231 6833 E -6/ DATA ABINT4(6)/ -0.56787 30727 927 E -7/ DATA ABINT4(7)/ -0.67187 48103 65 E -8/ DATA ABINT4(8)/ -0.79811 64985 7 E -9/ DATA ABINT4(9)/ -0.95142 71478 E -10/ DATA ABINT4(10)/-0.11374 68966 E -10/ DATA ABINT4(11)/-0.13635 9969 E -11/ DATA ABINT4(12)/-0.16381 418 E -12/ DATA ABINT4(13)/-0.19725 75 E -13/ DATA ABINT4(14)/-0.23784 4 E -14/ DATA ABINT4(15)/-0.28752 E -15/ DATA ABINT4(16)/-0.3475 E -16/ DATA ABINT4(17)/-0.422 E -17/ DATA ABINT4(18)/-0.51 E -18/ DATA ABINT4(19)/-0.6 E -19/ DATA ABINT4(20)/-0.1 E -19/ DATA ABINT5(0)/ 1.12672 08196 17825 66017 E 0/ DATA ABINT5(1)/ -0.67140 55675 25561 198 E -2/ DATA ABINT5(2)/ -0.69812 91801 78329 69 E -3/ DATA ABINT5(3)/ -0.75616 89886 42527 6 E -4/ DATA ABINT5(4)/ -0.83498 55745 10207 E -5/ DATA ABINT5(5)/ -0.93630 29823 2480 E -6/ DATA ABINT5(6)/ -0.10608 55629 6250 E -6/ DATA ABINT5(7)/ -0.12131 28916 741 E -7/ DATA ABINT5(8)/ -0.13963 11297 65 E -8/ DATA ABINT5(9)/ -0.16178 91805 4 E -9/ DATA ABINT5(10)/-0.18823 07907 E -10/ DATA ABINT5(11)/-0.22027 2985 E -11/ DATA ABINT5(12)/-0.25816 189 E -12/ DATA ABINT5(13)/-0.30479 64 E -13/ DATA ABINT5(14)/-0.35837 0 E -14/ DATA ABINT5(15)/-0.42831 E -15/ DATA ABINT5(16)/-0.4993 E -16/ DATA ABINT5(17)/-0.617 E -17/ DATA ABINT5(18)/-0.68 E -18/ DATA ABINT5(19)/-0.10 E -18/ DATA ABINT5(20)/-0.1 E -19/ DATA ZERO,ONE,ONEPT5/ 0.0 E 0 , 1.0 E 0 , 1.5 E 0 / DATA THREE,FOUR,SEVEN/ 3.0 E 0 , 4.0 E 0 , 7.0 E 0 / DATA EIGHT,NINE,SIXTEN/ 8.0 E 0 , 9.0 E 0 , 16.0 E 0 / DATA ONEHUN,NINHUN,THR644/100.0 E 0 , 900.0 E 0 , 3644.0 E 0 / DATA PIBY4/0.78539 81633 97448 30962 E 0/ DATA RT2B3P/0.46065 88659 61780 63902 E 0/ DATA BIRZER/0.61492 66274 46000 73515 E 0/ C C Start computation C X = XVALUE C C Compute the machine-dependent constants. C T = R1MACH(3) F2 = ONE + ONE XNEG1 = -ONE/(T**(F2/THREE)) XMAX = R1MACH(2) F1 = LOG(XMAX) TEMP = F1 + LOG(F1)/F2 XHIGH1 = (THREE*TEMP/F2)**(F2/THREE) C C Error test ( do not remove ) C IF ( X .GT. XHIGH1 ) THEN CALL ERRPRN(FNNAME,ERMSG1) BIRINT = XMAX RETURN ENDIF IF ( X .LT. XNEG1 ) THEN CALL ERRPRN(FNNAME,ERMSG2) BIRINT = ZERO RETURN ENDIF C C continue with machine-dependent constants C XLOW1 = F2 * T T = T / ONEHUN IF ( X .GE. ZERO ) THEN DO 10 NTERM1 = 36 , 0 , -1 IF ( ABS(ABINT1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 37 , 0 , -1 IF ( ABS(ABINT2(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 CONTINUE ELSE DO 30 NTERM3 = 37 , 0 , -1 IF ( ABS(ABINT3(NTERM3)) .GT. T ) GOTO 39 30 CONTINUE 39 DO 40 NTERM4 = 20 , 0 , -1 IF ( ABS(ABINT4(NTERM4)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM5 = 20 , 0 , -1 IF ( ABS(ABINT5(NTERM5)) .GT. T ) GOTO 59 50 CONTINUE 59 ENDIF C C Code for x >= 0.0 C IF ( X .GE. ZERO ) THEN IF ( X .LT. XLOW1 ) THEN BIRINT = BIRZER * X ELSE IF ( X .LE. EIGHT ) THEN T = X / FOUR - ONE BIRINT = X * EXP(ONEPT5*X) * CHEVAL(NTERM1,ABINT1,T) ELSE T = SIXTEN * SQRT(EIGHT/X) / X - ONE Z = ( X + X ) * SQRT(X) / THREE TEMP = RT2B3P * CHEVAL(NTERM2,ABINT2,T) / SQRT(Z) TEMP = Z + LOG(TEMP) BIRINT = EXP(TEMP) ENDIF ENDIF ELSE C C Code for x < 0.0 C IF ( X .GE. -SEVEN ) THEN IF ( X .GT. -XLOW1 ) THEN BIRINT = BIRZER * X ELSE T = - ( X + X ) / SEVEN - ONE BIRINT = X * CHEVAL(NTERM3,ABINT3,T) ENDIF ELSE Z = - ( X + X ) * SQRT(-X) / THREE ARG = Z + PIBY4 TEMP = NINE * Z * Z T = (THR644 - TEMP ) / ( NINHUN + TEMP ) F1 = CHEVAL(NTERM4,ABINT4,T) * SIN(ARG) F2 = CHEVAL(NTERM5,ABINT5,T) * COS(ARG) / Z BIRINT = ( F2 - F1 ) * RT2B3P / SQRT(Z) ENDIF ENDIF RETURN END REAL FUNCTION CLAUSN(XVALUE) C C DESCRIPTION: C C This program calculates Clausen's integral defined by C C CLAUSN(x) = integral 0 to x of (-ln(2*sin(t/2))) dt C C The code uses Chebyshev expansions with the coefficients C given to 20 decimal places. C C C ERROR RETURNS: C C If |x| is too large it is impossible to reduce the argument C to the range [0,2*pi] with any precision. An error message C is printed and the program returns the value 0.0 C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - the no. of terms of the array ACLAUS C to be used. The recommended value is C such that ABS(ACLAUS(NTERMS)) < EPS/100 C subject to 1 <= NTERMS <= 15 C C XSMALL - REAL - the value below which Cl(x) can be C approximated by x (1-ln x). The recommended C value is pi*sqrt(EPSNEG/2). C C XHIGH - REAL - The value of |x| above which we cannot C reliably reduce the argument to [0,2*pi]. C The recommended value is 1/EPS. C C For values of EPS and EPSNEG refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C AINT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St. C PAISLEY C SCOTLAND C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST MODIFICATION: 18 January, 1996 C INTEGER INDX,NTERMS REAL ACLAUS(0:15),CHEVAL,HALF,ONE,ONEHUN,PI,PISQ,T, & TWOPI,TWOPIA,TWOPIB,X,XHIGH,XSMALL,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'CLAUSN'/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,HALF,ONE/0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA ONEHUN/100.0 E 0/ DATA PI/3.14159 26535 89793 2385 E 0/ DATA PISQ/9.86960 44010 89358 6188 E 0/ DATA TWOPI/6.28318 53071 79586 4769 E 0/ DATA TWOPIA,TWOPIB/6.28125 E 0 , 0.19353 07179 58647 69253 E -2/ DATA ACLAUS/2.14269 43637 66688 44709 E 0, 1 0.72332 42812 21257 9245 E -1, 2 0.10164 24750 21151 164 E -2, 3 0.32452 50328 53164 5 E -4, 4 0.13331 51875 71472 E -5, 5 0.62132 40591 653 E -7, 6 0.31300 41353 37 E -8, 7 0.16635 72305 6 E -9, 8 0.91965 9293 E -11, 9 0.52400 462 E -12, X 0.30580 40 E -13, 1 0.18196 9 E -14, 2 0.11004 E -15, 3 0.675 E -17, 4 0.42 E -18, 5 0.3 E -19/ C C Start execution C X = XVALUE C C Compute the machine-dependent constants. C T = R1MACH(3) XHIGH = ONE / T C C Error test ( do not remove ) C IF ( ABS(X) .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) CLAUSN = ZERO RETURN ENDIF C C Continue with machine-dependent constants C XSMALL = PI * SQRT ( HALF * T ) T = T / ONEHUN DO 10 NTERMS = 15 , 0 , -1 IF ( ABS(ACLAUS(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE C C Continue with computation C 19 INDX = 1 IF ( X .LT. ZERO ) THEN X = -X INDX = -1 ENDIF C C Argument reduced using simulated extra precision C IF ( X .GT. TWOPI ) THEN T = AINT( X / TWOPI ) X = ( X - T * TWOPIA ) - T * TWOPIB ENDIF IF ( X .GT. PI ) THEN X = ( TWOPIA - X ) + TWOPIB INDX = -INDX ENDIF C C Set result to zero if X multiple of PI C IF ( X .EQ. ZERO ) THEN CLAUSN = ZERO RETURN ENDIF C C Code for X < XSMALL C IF ( X .LT. XSMALL ) THEN CLAUSN = X * ( ONE - LOG( X ) ) ELSE C C Code for XSMALL < = X < = PI C T = ( X * X ) / PISQ - HALF T = T + T IF ( T .GT. ONE ) T = ONE CLAUSN = X * CHEVAL( NTERMS,ACLAUS,T ) - X * LOG( X ) ENDIF IF ( INDX .LT. 0 ) CLAUSN = -CLAUSN RETURN END REAL FUNCTION DEBYE1(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 1, defined as C C DEBYE1(x) = [Integral {0 to x} t/(exp(t)-1) dt] / x C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB1. C The recommended value is such that C ABS(ADEB1(NTERMS)) < EPS/100 , with C 1 <= NTERMS <= 18 C C XLOW - REAL - The value below which C DEBYE1 = 1 - x/4 + x*x/36 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - REAL - The value above which C DEBYE1 = (pi*pi/(6*x)) - exp(-x)(x+1)/x. C The recommended value is C -LOG(2*EPS) C C XLIM - REAL - The value above which DEBYE1 = pi*pi/(6*x) C The recommended value is C -LOG(XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 18 January, 1996 C INTEGER I,NEXP,NTERMS REAL ADEB1(0:18),CHEVAL,DEBINF,EIGHT,EXPMX,FOUR,HALF, & NINE,ONE,ONEHUN,QUART,RK,SUM,T,THIRT6,X,XK,XLIM,XLOW, & XUPPER,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE1'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,QUART/0.0 E 0 , 0.25 E 0/ DATA HALF,ONE/0.5 E 0 , 1.0 E 0/ DATA FOUR,EIGHT/4.0 E 0 , 8.0 E 0/ DATA NINE,THIRT6,ONEHUN/9.0 E 0 , 36.0 E 0 , 100.0 E 0/ DATA DEBINF/0.60792 71018 54026 62866 E 0/ DATA ADEB1/2.40065 97190 38141 01941 E 0, 1 0.19372 13042 18936 00885 E 0, 2 -0.62329 12455 48957 703 E -2, 3 0.35111 74770 20648 00 E -3, 4 -0.22822 24667 01231 0 E -4, 5 0.15805 46787 50300 E -5, 6 -0.11353 78197 0719 E -6, 7 0.83583 36118 75 E -8, 8 -0.62644 24787 2 E -9, 9 0.47603 34890 E -10, X -0.36574 1540 E -11, 1 0.28354 310 E -12, 2 -0.22147 29 E -13, 3 0.17409 2 E -14, 4 -0.13759 E -15, 5 0.1093 E -16, 6 -0.87 E -18, 7 0.7 E -19, 8 -0.1 E -19/ C C Start computation C X = XVALUE C C Check XVALUE >= 0.0 C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE1 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = R1MACH(3) XLOW = SQRT ( T * EIGHT ) XUPPER = - LOG( T + T ) XLIM = - LOG( R1MACH(1) ) T = T / ONEHUN DO 10 NTERMS = 18 , 0 , -1 IF ( ABS(ADEB1(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE C C Code for x <= 4.0 C 19 IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE1 = ( ( X - NINE ) * X + THIRT6 ) / THIRT6 ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE1 = CHEVAL( NTERMS , ADEB1 , T ) - QUART * X ENDIF ELSE C C Code for x > 4.0 C DEBYE1 = ONE / ( X * DEBINF ) IF ( X .LT. XLIM ) THEN EXPMX = EXP( -X ) IF ( X .GT. XUPPER ) THEN DEBYE1 = DEBYE1 - EXPMX * ( ONE + ONE / X ) ELSE SUM = ZERO RK = AINT( XLIM / X ) NEXP = INT( RK ) XK = RK * X DO 100 I = NEXP,1,-1 T = ( ONE + ONE / XK ) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE DEBYE1 = DEBYE1 - SUM * EXPMX ENDIF ENDIF ENDIF RETURN END REAL FUNCTION DEBYE2(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 1, defined as C C DEBYE2(x) = 2*[Integral {0 to x} t*t/(exp(t)-1) dt] / (x*x) C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB2. C The recommended value is such that C ABS(ADEB2(NTERMS)) < EPS/100, C subject to 1 <= NTERMS <= 18. C C XLOW - REAL - The value below which C DEBYE2 = 1 - x/3 + x*x/24 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - REAL - The value above which C DEBYE2 = (4*zeta(3)/x^2) - 2*exp(-x)(x^2+2x+1)/x^2. C The recommended value is C -LOG(2*EPS) C C XLIM1 - REAL - The value above which DEBYE2 = 4*zeta(3)/x^2 C The recommended value is C -LOG(XMIN) C C XLIM2 - REAL - The value above which DEBYE2 = 0.0 to machine C precision. The recommended value is C SQRT(4.8/XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 18 January, 1996 C INTEGER I,NEXP,NTERMS REAL ADEB2(0:18),CHEVAL,DEBINF,EIGHT,EXPMX,FOUR, & HALF,ONE,ONEHUN,RK,SUM,T,THREE,TWENT4,TWO,X,XK,XLIM1, & XLIM2,XLOW,XUPPER,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE2'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,HALF/0.0 E 0 , 0.5 E 0/ DATA ONE,TWO,THREE/1.0 E 0 , 2.0 E 0 , 3.0 E 0/ DATA FOUR,EIGHT,TWENT4/4.0 E 0 , 8.0 E 0 , 24.0 E 0/ DATA ONEHUN/100.0 E 0/ DATA DEBINF/4.80822 76126 38377 14160 E 0/ DATA ADEB2/2.59438 10232 57077 02826 E 0, 1 0.28633 57204 53071 98337 E 0, 2 -0.10206 26561 58046 7129 E -1, 3 0.60491 09775 34684 35 E -3, 4 -0.40525 76589 50210 4 E -4, 5 0.28633 82632 88107 E -5, 6 -0.20863 94303 0651 E -6, 7 0.15523 78758 264 E -7, 8 -0.11731 28008 66 E -8, 9 0.89735 85888 E -10, X -0.69317 6137 E -11, 1 0.53980 568 E -12, 2 -0.42324 05 E -13, 3 0.33377 8 E -14, 4 -0.26455 E -15, 5 0.2106 E -16, 6 -0.168 E -17, 7 0.13 E -18, 8 -0.1 E -19/ C C Start computation C X = XVALUE C C Check XVALUE >= 0.0 C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE2 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = R1MACH(1) XLIM1 = - LOG( T ) XLIM2 = SQRT( DEBINF ) / SQRT( T ) T = R1MACH(3) XLOW = SQRT ( T * EIGHT ) XUPPER = - LOG( T + T ) T = T / ONEHUN DO 10 NTERMS = 18 , 0 , -1 IF ( ABS(ADEB2(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE C C Code for x <= 4.0 C 19 IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE2 = ( ( X - EIGHT ) * X + TWENT4 ) / TWENT4 ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE2 = CHEVAL ( NTERMS , ADEB2 , T ) - X / THREE ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XLIM2 ) THEN DEBYE2 = ZERO ELSE DEBYE2 = DEBINF / ( X * X ) IF ( X .LT. XLIM1 ) THEN EXPMX = EXP ( -X ) IF ( X .GT. XUPPER ) THEN SUM = ( ( X + TWO ) * X + TWO ) / ( X * X ) ELSE SUM = ZERO RK = AINT ( XLIM1 / X ) NEXP = INT ( RK ) XK = RK * X DO 100 I = NEXP,1,-1 T = ( ONE + TWO / XK + TWO / ( XK*XK ) ) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE ENDIF DEBYE2 = DEBYE2 - TWO * SUM * EXPMX ENDIF ENDIF ENDIF RETURN END REAL FUNCTION DEBYE3(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 3, defined as C C DEBYE3(x) = 3*[Integral {0 to x} t^3/(exp(t)-1) dt] / (x^3) C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB3. C The recommended value is such that C ABS(ADEB3(NTERMS)) < EPS/100, C subject to 1 <= NTERMS <= 18 C C XLOW - REAL - The value below which C DEBYE3 = 1 - 3x/8 + x*x/20 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - REAL - The value above which C DEBYE3 = (18*zeta(4)/x^3) - 3*exp(-x)(x^3+3x^2+6x+6)/x^3. C The recommended value is C -LOG(2*EPS) C C XLIM1 - REAL - The value above which DEBYE3 = 18*zeta(4)/x^3 C The recommended value is C -LOG(XMIN) C C XLIM2 - REAL - The value above which DEBYE3 = 0.0 to machine C precision. The recommended value is C CUBE ROOT(19/XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 18 January, 1996 C INTEGER I,NEXP,NTERMS REAL ADEB3(0:18),CHEVAL,DEBINF,EIGHT,EXPMX,FOUR, & HALF,ONE,ONEHUN,PT375,RK,SEVP5,SIX,SUM,T,THREE,TWENTY,X, & XK,XKI,XLIM1,XLIM2,XLOW,XUPPER,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE3'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,PT375/0.0 E 0 , 0.375 E 0/ DATA HALF,ONE/0.5 E 0 , 1.0 E 0/ DATA THREE,FOUR,SIX/3.0 E 0 , 4.0 E 0 , 6.0 E 0/ DATA SEVP5,EIGHT,TWENTY/7.5 E 0 , 8.0 E 0 , 20.0 E 0/ DATA ONEHUN/100.0 E 0/ DATA DEBINF/0.51329 91127 34216 75946 E -1/ DATA ADEB3/2.70773 70683 27440 94526 E 0, 1 0.34006 81352 11091 75100 E 0, 2 -0.12945 15018 44408 6863 E -1, 3 0.79637 55380 17381 64 E -3, 4 -0.54636 00095 90823 8 E -4, 5 0.39243 01959 88049 E -5, 6 -0.28940 32823 5386 E -6, 7 0.21731 76139 625 E -7, 8 -0.16542 09994 98 E -8, 9 0.12727 96189 2 E -9, X -0.98796 3459 E -11, 1 0.77250 740 E -12, 2 -0.60779 72 E -13, 3 0.48075 9 E -14, 4 -0.38204 E -15, 5 0.3048 E -16, 6 -0.244 E -17, 7 0.20 E -18, 8 -0.2 E -19/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE3 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = R1MACH(1) XLIM1 = - LOG( T ) XK = ONE / THREE XKI = (ONE/DEBINF) ** XK RK = T ** XK XLIM2 = XKI / RK T = R1MACH(3) XLOW = SQRT ( T * EIGHT ) XUPPER = - LOG( T + T ) T = T / ONEHUN DO 10 NTERMS = 18 , 0 , -1 IF ( ABS(ADEB3(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE C C Code for x <= 4.0 C 19 IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE3 = ( ( X - SEVP5 ) * X + TWENTY ) / TWENTY ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE3 = CHEVAL ( NTERMS , ADEB3 , T ) - PT375 * X ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XLIM2 ) THEN DEBYE3 = ZERO ELSE DEBYE3 = ONE / ( DEBINF * X * X * X ) IF ( X .LT. XLIM1 ) THEN EXPMX = EXP ( -X ) IF ( X .GT. XUPPER ) THEN SUM = (((X+THREE)*X+SIX)*X+SIX) / (X*X*X) ELSE SUM = ZERO RK = AINT ( XLIM1 / X ) NEXP = INT ( RK ) XK = RK * X DO 100 I = NEXP,1,-1 XKI = ONE / XK T = (((SIX*XKI+SIX)*XKI+THREE)*XKI+ONE) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE ENDIF DEBYE3 = DEBYE3 - THREE * SUM * EXPMX ENDIF ENDIF ENDIF RETURN END REAL FUNCTION DEBYE4(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 4, defined as C C DEBYE4(x) = 4*[Integral {0 to x} t^4/(exp(t)-1) dt] / (x^4) C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB4. C The recommended value is such that C ABS(ADEB4(NTERMS)) < EPS/100, C subject to 1 <= NTERMS <= 18 C C XLOW - REAL - The value below which C DEBYE4 = 1 - 4x/10 + x*x/18 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - REAL - The value above which C DEBYE4=(96*zeta(5)/x^4)-4*exp(-x)(x^4+4x^2+12x^2+24x+24)/x^4. C The recommended value is C -LOG(2*EPS) C C XLIM1 - REAL - The value above which DEBYE4 = 96*zeta(5)/x^4 C The recommended value is C -LOG(XMIN) C C XLIM2 - REAL - The value above which DEBYE4 = 0.0 to machine C precision. The recommended value is C FOURTH ROOT(99/XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 18 January, 1996 C INTEGER I,NEXP,NTERMS REAL ADEB4(0:18),CHEVAL,DEBINF,EIGHT,EIGHTN,EXPMX,FIVE, 1 FOUR,FORTY5,HALF,ONE,ONEHUN,RK,SUM,T,TWELVE,TWENT4, 2 TWOPT5,X,XK,XKI,XLIM1,XLIM2,XLOW,XUPPER,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE4'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,HALF,ONE/0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA TWOPT5,FOUR,FIVE/2.5 E 0 , 4.0 E 0 , 5.0 E 0/ DATA EIGHT,TWELVE,EIGHTN/8.0 E 0 , 12.0 E 0 , 18.0 E 0/ DATA TWENT4,FORTY5,ONEHUN/24.0 E 0 , 45.0 E 0 , 100.0 E 0/ DATA DEBINF/99.54506 44937 63512 92781 E 0/ DATA ADEB4/2.78186 94150 20523 46008 E 0, 1 0.37497 67835 26892 86364 E 0, 2 -0.14940 90739 90315 8326 E -1, 3 0.94567 98114 37042 74 E -3, 4 -0.66132 91613 89325 5 E -4, 5 0.48156 32982 14449 E -5, 6 -0.35880 83958 7593 E -6, 7 0.27160 11874 160 E -7, 8 -0.20807 09912 23 E -8, 9 0.16093 83869 2 E -9, X -0.12547 09791 E -10, 1 0.98472 647 E -12, 2 -0.77723 69 E -13, 3 0.61648 3 E -14, 4 -0.49107 E -15, 5 0.3927 E -16, 6 -0.315 E -17, 7 0.25 E -18, 8 -0.2 E -19/ C C Start computation C X = XVALUE C C Check XVALUE >= 0.0 C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE4 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = R1MACH(1) XLIM1 = - LOG( T ) RK = ONE / FOUR XK = DEBINF ** RK XKI = T ** RK XLIM2 = XK / XKI T = R1MACH(3) XLOW = SQRT ( T * EIGHT ) XUPPER = - LOG( T + T ) T = T / ONEHUN DO 10 NTERMS = 18 , 0 , -1 IF ( ABS(ADEB4(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE C C Code for x <= 4.0 C 19 IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE4 = ( ( TWOPT5 * X - EIGHTN ) * X + FORTY5 ) / FORTY5 ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE4 = CHEVAL ( NTERMS , ADEB4 , T ) - ( X + X ) / FIVE ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XLIM2 ) THEN DEBYE4 = ZERO ELSE T = X * X DEBYE4 = ( DEBINF / T ) / T IF ( X .LT. XLIM1 ) THEN EXPMX = EXP ( -X ) IF ( X .GT. XUPPER ) THEN SUM = ( ( ( ( X + FOUR ) * X + TWELVE ) * X + & TWENT4 ) * X + TWENT4 ) / ( X * X * X * X ) ELSE SUM = ZERO RK = AINT ( XLIM1 / X ) NEXP = INT ( RK ) XK = RK * X DO 100 I = NEXP,1,-1 XKI = ONE / XK T = ( ( ( ( TWENT4 * XKI + TWENT4 ) * XKI + & TWELVE ) * XKI + FOUR ) * XKI + ONE ) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE ENDIF DEBYE4 = DEBYE4 - FOUR * SUM * EXPMX ENDIF ENDIF ENDIF RETURN END REAL FUNCTION EXP3(XVALUE) C C DESCRIPTION C C This function calculates C C EXP3(X) = integral 0 to X (exp(-t*t*t)) dt C C The code uses Chebyshev expansions, whose coefficients are C given to 20 decimal places. C C C ERROR RETURNS C C If XVALUE < 0, an error message is printed and the function C returns the value 0. C C C MACHINE-DEPENDENT CONSTANTS C C NTERM1 - INTEGER - The no. of terms of the array AEXP3, C The recommended value is such that C AEXP3(NTERM1) < EPS/100. C C NTERM2 - INTEGER - The no. of terms of the array AEXP3A. C The recommended value is such that C AEXP3A(NTERM2) < EPS/100. C C XLOW - REAL - The value below which EXP3(X) = X to machine C precision. The recommended value is C cube root(4*EPSNEG) C C XUPPER - REAL - The value above which EXP3(X) = 0.89297... C to machine precision. The recommended value is C cube root(-ln(EPSNEG)) C C For values of EPS and EPSNEG for various machine/compiler C combinations refer to the file MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED C C EXP, LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR C C DR. ALLAN J. MACLEOD, C DEPARTMENT OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY C SCOTLAND. C C (e-mail macl_ms0@paisley.ac.uk ) C C C LATEST MODIFICATION: 18 January, 1996 C C INTEGER NTERM1,NTERM2 REAL AEXP3(0:24),AEXP3A(0:24),CHEVAL,FOUR,FUNINF,HALF,ONE, & ONEHUN,SIXTEN,T,THREE,TWO,X,XLOW,XUPPER,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'EXP3 '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA TWO,THREE,FOUR/2.0 E 0 , 3.0 E 0 , 4.0 E 0 / DATA SIXTEN,ONEHUN/16.0 E 0 , 100.0 E 0/ DATA FUNINF/0.89297 95115 69249 21122 E 0/ DATA AEXP3(0)/ 1.26919 84142 21126 01434 E 0/ DATA AEXP3(1)/ -0.24884 64463 84140 98226 E 0/ DATA AEXP3(2)/ 0.80526 22071 72310 4125 E -1/ DATA AEXP3(3)/ -0.25772 73325 19683 2934 E -1/ DATA AEXP3(4)/ 0.75998 78873 07377 429 E -2/ DATA AEXP3(5)/ -0.20306 95581 94040 510 E -2/ DATA AEXP3(6)/ 0.49083 45866 99329 17 E -3/ DATA AEXP3(7)/ -0.10768 22391 42020 77 E -3/ DATA AEXP3(8)/ 0.21551 72626 42898 4 E -4/ DATA AEXP3(9)/ -0.39567 05137 38429 E -5/ DATA AEXP3(10)/ 0.66992 40933 8956 E -6/ DATA AEXP3(11)/-0.10513 21808 0703 E -6/ DATA AEXP3(12)/ 0.15362 58019 825 E -7/ DATA AEXP3(13)/-0.20990 96036 36 E -8/ DATA AEXP3(14)/ 0.26921 09538 1 E -9/ DATA AEXP3(15)/-0.32519 52422 E -10/ DATA AEXP3(16)/ 0.37114 8157 E -11/ DATA AEXP3(17)/-0.40136 518 E -12/ DATA AEXP3(18)/ 0.41233 46 E -13/ DATA AEXP3(19)/-0.40337 5 E -14/ DATA AEXP3(20)/ 0.37658 E -15/ DATA AEXP3(21)/-0.3362 E -16/ DATA AEXP3(22)/ 0.288 E -17/ DATA AEXP3(23)/-0.24 E -18/ DATA AEXP3(24)/ 0.2 E -19/ DATA AEXP3A(0)/ 1.92704 64955 06827 37293 E 0/ DATA AEXP3A(1)/ -0.34929 35652 04813 8054 E -1/ DATA AEXP3A(2)/ 0.14503 38371 89830 093 E -2/ DATA AEXP3A(3)/ -0.89253 36718 32790 3 E -4/ DATA AEXP3A(4)/ 0.70542 39219 11838 E -5/ DATA AEXP3A(5)/ -0.66717 27454 7611 E -6/ DATA AEXP3A(6)/ 0.72426 75899 824 E -7/ DATA AEXP3A(7)/ -0.87825 82560 56 E -8/ DATA AEXP3A(8)/ 0.11672 23442 78 E -8/ DATA AEXP3A(9)/ -0.16766 31281 2 E -9/ DATA AEXP3A(10)/ 0.25755 01577 E -10/ DATA AEXP3A(11)/-0.41957 8881 E -11/ DATA AEXP3A(12)/ 0.72010 412 E -12/ DATA AEXP3A(13)/-0.12949 055 E -12/ DATA AEXP3A(14)/ 0.24287 03 E -13/ DATA AEXP3A(15)/-0.47331 1 E -14/ DATA AEXP3A(16)/ 0.95531 E -15/ DATA AEXP3A(17)/-0.19914 E -15/ DATA AEXP3A(18)/ 0.4277 E -16/ DATA AEXP3A(19)/-0.944 E -17/ DATA AEXP3A(20)/ 0.214 E -17/ DATA AEXP3A(21)/-0.50 E -18/ DATA AEXP3A(22)/ 0.12 E -18/ DATA AEXP3A(23)/-0.3 E -19/ DATA AEXP3A(24)/ 0.1 E -19/ C C Start calculation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) EXP3 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C T = R1MACH(3) XLOW = ( FOUR * T ) ** (ONE/THREE) XUPPER = ( -LOG ( T ) ) ** (ONE/THREE) T = T / ONEHUN IF ( X .LE. TWO ) THEN DO 10 NTERM1 = 24 , 0 , -1 IF ( ABS(AEXP3(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 CONTINUE ELSE DO 40 NTERM2 = 24 , 0 , -1 IF ( ABS(AEXP3A(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 ENDIF C C Code for XVALUE < = 2 C IF ( X .LE. TWO ) THEN IF ( X .LT. XLOW ) THEN EXP3 = X ELSE T = ( ( X * X * X / FOUR ) - HALF ) - HALF EXP3 = X * CHEVAL ( NTERM1,AEXP3,T ) ENDIF ELSE C C Code for XVALUE > 2 C IF ( X .GT. XUPPER ) THEN EXP3 = FUNINF ELSE T = ( ( SIXTEN/ ( X * X * X ) ) - HALF ) - HALF T = CHEVAL ( NTERM2,AEXP3A,T ) T = T * EXP ( -X * X * X ) / ( THREE * X * X ) EXP3 = FUNINF - T ENDIF ENDIF RETURN END REAL FUNCTION GOODST(XVALUE) C C DESCRIPTION: C C This function calculates the function defined as C C GOODST(x) = {integral 0 to inf} ( exp(-u*u)/(u+x) ) du C C The code uses Chebyshev expansions whose coefficients are C given to 20 decimal places. C C C ERROR RETURNS: C C If XVALUE <= 0.0, an error message is printed, and the C code returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array AGOST. C The recommended value is such that C AGOST(NTERM1) < EPS/100, C C NTERM2 - The no. of terms to be used in the array AGOSTA. C The recommended value is such that C AGOSTA(NTERM2) < EPS/100, C C XLOW - The value below which f(x) = -(gamma/2) - ln(x) C to machine precision. The recommended value is C EPSNEG C C XHIGH - The value above which f(x) = sqrt(pi)/(2x) to C machine precision. The recommended value is C 2 / EPSNEG C C For values of EPS and EPSNEG refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley. C SCOTLAND. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 18 January, 1996 C C INTEGER NTERM1,NTERM2 REAL AGOST(0:28),AGOSTA(0:23), 1 CHEVAL,FVAL,GAMBY2,HALF,ONE,ONEHUN,RTPIB2,SIX, 2 T,TWO,X,XHIGH,XLOW,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*15 DATA FNNAME/'GOODST'/ DATA ERRMSG/'ARGUMENT <= 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA TWO,SIX/ 2.0 E 0 , 6.0 E 0 / DATA ONEHUN/100.0 E 0/ DATA GAMBY2/0.28860 78324 50766 43030 E 0/ DATA RTPIB2/0.88622 69254 52758 01365 E 0/ DATA AGOST(0)/ 0.63106 56056 03984 46247 E 0/ DATA AGOST(1)/ 0.25051 73779 32167 08827 E 0/ DATA AGOST(2)/ -0.28466 20597 90189 40757 E 0/ DATA AGOST(3)/ 0.87615 87523 94862 3552 E -1/ DATA AGOST(4)/ 0.68260 22672 21252 724 E -2/ DATA AGOST(5)/ -0.10811 29544 19225 4677 E -1/ DATA AGOST(6)/ 0.16910 12441 17152 176 E -2/ DATA AGOST(7)/ 0.50272 98462 26151 86 E -3/ DATA AGOST(8)/ -0.18576 68720 41000 84 E -3/ DATA AGOST(9)/ -0.42870 36741 68474 E -5/ DATA AGOST(10)/ 0.10095 98903 20290 5 E -4/ DATA AGOST(11)/-0.86529 91351 7382 E -6/ DATA AGOST(12)/-0.34983 87432 0734 E -6/ DATA AGOST(13)/ 0.64832 78683 494 E -7/ DATA AGOST(14)/ 0.75759 24985 83 E -8/ DATA AGOST(15)/-0.27793 54243 62 E -8/ DATA AGOST(16)/-0.48302 35135 E -10/ DATA AGOST(17)/ 0.86632 21283 E -10/ DATA AGOST(18)/-0.39433 9687 E -11/ DATA AGOST(19)/-0.20952 9625 E -11/ DATA AGOST(20)/ 0.21501 759 E -12/ DATA AGOST(21)/ 0.39590 15 E -13/ DATA AGOST(22)/-0.69227 9 E -14/ DATA AGOST(23)/-0.54829 E -15/ DATA AGOST(24)/ 0.17108 E -15/ DATA AGOST(25)/ 0.376 E -17/ DATA AGOST(26)/-0.349 E -17/ DATA AGOST(27)/ 0.7 E -19/ DATA AGOST(28)/ 0.6 E -19/ DATA AGOSTA(0)/ 1.81775 46798 47187 58767 E 0/ DATA AGOSTA(1)/ -0.99211 46570 74409 7467 E -1/ DATA AGOSTA(2)/ -0.89405 86452 54819 243 E -2/ DATA AGOSTA(3)/ -0.94955 33127 77267 85 E -3/ DATA AGOSTA(4)/ -0.10971 37996 67596 65 E -3/ DATA AGOSTA(5)/ -0.13466 94539 57859 0 E -4/ DATA AGOSTA(6)/ -0.17274 92743 08265 E -5/ DATA AGOSTA(7)/ -0.22931 38019 9498 E -6/ DATA AGOSTA(8)/ -0.31278 44178 918 E -7/ DATA AGOSTA(9)/ -0.43619 79736 71 E -8/ DATA AGOSTA(10)/-0.61958 46474 3 E -9/ DATA AGOSTA(11)/-0.89379 91276 E -10/ DATA AGOSTA(12)/-0.13065 11094 E -10/ DATA AGOSTA(13)/-0.19316 6876 E -11/ DATA AGOSTA(14)/-0.28844 270 E -12/ DATA AGOSTA(15)/-0.43447 96 E -13/ DATA AGOSTA(16)/-0.65951 8 E -14/ DATA AGOSTA(17)/-0.10080 1 E -14/ DATA AGOSTA(18)/-0.15502 E -15/ DATA AGOSTA(19)/-0.2397 E -16/ DATA AGOSTA(20)/-0.373 E -17/ DATA AGOSTA(21)/-0.58 E -18/ DATA AGOSTA(22)/-0.9 E -19/ DATA AGOSTA(23)/-0.1 E -19/ C C Start computation C X = XVALUE C C Error test C IF ( X .LE. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) GOODST = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C FVAL = R1MACH(3) T = FVAL / ONEHUN IF ( X .LE. TWO ) THEN DO 10 NTERM1 = 28 , 0 , -1 IF ( ABS(AGOST(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW = FVAL ELSE DO 40 NTERM2 = 23 , 0 , -1 IF ( ABS(AGOSTA(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 XHIGH = TWO / FVAL ENDIF C C Computation for 0 < x <= 2 C IF ( X .LE. TWO ) THEN IF ( X .LT. XLOW ) THEN GOODST = - GAMBY2 - LOG(X) ELSE T = ( X - HALF ) - HALF GOODST = CHEVAL(NTERM1,AGOST,T) - EXP(-X*X) * LOG(X) ENDIF ELSE C C Computation for x > 2 C FVAL = RTPIB2 / X IF ( X .GT. XHIGH ) THEN GOODST = FVAL ELSE T = ( SIX - X ) / ( TWO + X ) GOODST = FVAL * CHEVAL(NTERM2,AGOSTA,T) ENDIF ENDIF RETURN END REAL FUNCTION I0INT(XVALUE) C C DESCRIPTION: C This program computes the integral of the modified Bessel C function I0(x) using the definition C C I0INT(x) = {integral 0 to x} I0(t) dt C C The program uses Chebyshev expansions, the coefficients of C which are given to 20 decimal places. C C C ERROR RETURNS: C If |XVALUE| larger than a certain limit, the value of C I0INT would cause an overflow. If such a situation occurs C the programs prints an error message, and returns the C value sign(XVALUE)*XMAX, where XMAX is the largest C acceptable floating-pt. value. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used from the array ARI01. C The recommended value is such that C ABS(ARI01(NTERM1)) < EPS/100 C C NTERM2 - The no. of terms to be used from the array ARI0A. C The recommended value is such that C ABS(ARI0A(NTERM2)) < EPS/100 C C XLOW - The value below which I0INT(x) = x, to machine precision. C The recommended value is C sqrt(12*EPS). C C XHIGH - The value above which overflow will occur. The C recommended value is C ln(XMAX) + 0.5*ln(ln(XMAX)) + ln(2). C C For values of EPS and XMAX refer to the file MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND C PA1 2BE C C (e-mail : macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 18 January, 1996 C INTEGER IND,NTERM1,NTERM2 REAL ARI01(0:28),ARI0A(0:33), 1 ATEEN,CHEVAL,HALF,LNR2PI,ONEHUN,T,TEMP,THREE,THIRT6, 2 X,XHIGH,XLOW,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'I0INT '/ DATA ERRMSG/'SIZE OF ARGUMENT TOO LARGE'/ DATA ZERO,HALF,THREE/ 0.0 E 0 , 0.5 E 0 , 3.0 E 0 / DATA ATEEN,THIRT6,ONEHUN/ 18.0 E 0 , 36.0 E 0 , 100.0 E 0/ DATA LNR2PI/0.91893 85332 04672 74178 E 0/ DATA ARI01(0)/ 0.41227 90692 67815 16801 E 0/ DATA ARI01(1)/ -0.34336 34515 00815 19562 E 0/ DATA ARI01(2)/ 0.22667 58871 57512 42585 E 0/ DATA ARI01(3)/ -0.12608 16471 87422 60032 E 0/ DATA ARI01(4)/ 0.60124 84628 77799 0271 E -1/ DATA ARI01(5)/ -0.24801 20462 91335 8248 E -1/ DATA ARI01(6)/ 0.89277 33895 65563 897 E -2/ DATA ARI01(7)/ -0.28325 37299 36696 605 E -2/ DATA ARI01(8)/ 0.79891 33904 17129 94 E -3/ DATA ARI01(9)/ -0.20053 93366 09648 90 E -3/ DATA ARI01(10)/ 0.44168 16783 01431 3 E -4/ DATA ARI01(11)/-0.82237 70422 46068 E -5/ DATA ARI01(12)/ 0.12005 97942 19015 E -5/ DATA ARI01(13)/-0.11350 86500 4889 E -6/ DATA ARI01(14)/ 0.69606 01446 6 E -9/ DATA ARI01(15)/ 0.18062 27728 36 E -8/ DATA ARI01(16)/-0.26039 48137 0 E -9/ DATA ARI01(17)/-0.16618 8103 E -11/ DATA ARI01(18)/ 0.51050 0232 E -11/ DATA ARI01(19)/-0.41515 879 E -12/ DATA ARI01(20)/-0.73681 38 E -13/ DATA ARI01(21)/ 0.12793 23 E -13/ DATA ARI01(22)/ 0.10324 7 E -14/ DATA ARI01(23)/-0.30379 E -15/ DATA ARI01(24)/-0.1789 E -16/ DATA ARI01(25)/ 0.673 E -17/ DATA ARI01(26)/ 0.44 E -18/ DATA ARI01(27)/-0.14 E -18/ DATA ARI01(28)/-0.1 E -19/ DATA ARI0A(0)/ 2.03739 65457 11432 87070 E 0/ DATA ARI0A(1)/ 0.19176 31647 50331 0248 E -1/ DATA ARI0A(2)/ 0.49923 33451 92881 47 E -3/ DATA ARI0A(3)/ 0.22631 87103 65981 5 E -4/ DATA ARI0A(4)/ 0.15868 21082 85561 E -5/ DATA ARI0A(5)/ 0.16507 85563 6318 E -6/ DATA ARI0A(6)/ 0.23850 58373 640 E -7/ DATA ARI0A(7)/ 0.39298 51823 04 E -8/ DATA ARI0A(8)/ 0.46042 71419 9 E -9/ DATA ARI0A(9)/ -0.70725 58172 E -10/ DATA ARI0A(10)/-0.67471 83961 E -10/ DATA ARI0A(11)/-0.20269 62001 E -10/ DATA ARI0A(12)/-0.87320 338 E -12/ DATA ARI0A(13)/ 0.17552 0014 E -11/ DATA ARI0A(14)/ 0.60383 944 E -12/ DATA ARI0A(15)/-0.39779 83 E -13/ DATA ARI0A(16)/-0.80490 48 E -13/ DATA ARI0A(17)/-0.11589 55 E -13/ DATA ARI0A(18)/ 0.82731 8 E -14/ DATA ARI0A(19)/ 0.28229 0 E -14/ DATA ARI0A(20)/-0.77667 E -15/ DATA ARI0A(21)/-0.48731 E -15/ DATA ARI0A(22)/ 0.7279 E -16/ DATA ARI0A(23)/ 0.7873 E -16/ DATA ARI0A(24)/-0.785 E -17/ DATA ARI0A(25)/-0.1281 E -16/ DATA ARI0A(26)/ 0.121 E -17/ DATA ARI0A(27)/ 0.214 E -17/ DATA ARI0A(28)/-0.27 E -18/ DATA ARI0A(29)/-0.36 E -18/ DATA ARI0A(30)/ 0.7 E -19/ DATA ARI0A(31)/ 0.6 E -19/ DATA ARI0A(32)/-0.2 E -19/ DATA ARI0A(33)/-0.1 E -19/ C C Start computation C IND = 1 X = XVALUE IF ( XVALUE .LT. ZERO ) THEN IND = -1 X = -X ENDIF C C Compute the machine-dependent constants. C T = LOG(R1MACH(2)) XHIGH = T + LOG(T)*HALF - LOG(HALF) C C Error test (do not remove) C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) I0INT = EXP ( XHIGH - LNR2PI - HALF * LOG(XHIGH) ) IF ( IND .EQ. -1 ) I0INT = -I0INT RETURN ENDIF C C Continue with constants C TEMP = R1MACH(3) T = TEMP / ONEHUN IF ( X .LE. ATEEN ) THEN DO 10 NTERM1 = 28 , 0 , -1 IF ( ABS(ARI01(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW = SQRT ( THIRT6 * TEMP / THREE ) ELSE DO 40 NTERM2 = 33 , 0 , -1 IF ( ABS(ARI0A(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 ENDIF C C Code for 0 <= !x! <= 18 C IF ( X .LE. ATEEN ) THEN IF ( X .LT. XLOW ) THEN I0INT = X ELSE T = ( THREE * X - ATEEN ) / ( X + ATEEN ) I0INT = X * EXP(X) * CHEVAL(NTERM1,ARI01,T) ENDIF ELSE C C Code for !x! > 18 C T = ( THIRT6 / X - HALF ) - HALF TEMP = X - HALF*LOG(X) - LNR2PI + LOG(CHEVAL(NTERM2,ARI0A,T)) I0INT = EXP(TEMP) ENDIF IF ( IND .EQ. -1 ) I0INT = -I0INT RETURN END REAL FUNCTION I0ML0(XVALUE) C C DESCRIPTION: C C This program calculates the function I0ML0 defined as C C I0ML0(x) = I0(x) - L0(x) C C where I0(x) is the modified Bessel function of the first kind of C order 0, and L0(x) is the modified Struve function of order 0. C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20D. C C C ERROR RETURNS: C C The coefficients are only suitable for XVALUE >= 0.0. If C XVALUE < 0.0, an error message is printed and the function C returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The number of terms required for the array C AI0L0. The recommended value is such that C ABS(AI0L0(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The number of terms required for the array C AI0L0A. The recommended value is such that C ABS(AI0L0A(NTERM2)) < EPS/100 C C XLOW - REAL - The value below which I0ML0(x) = 1 to machine C precision. The recommended value is C EPSNEG C C XHIGH - REAL - The value above which I0ML0(x) = 2/(pi*x) to C machine precision. The recommended value is C SQRT(800/EPS) C C For values of EPS, and EPSNEG see the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C INTRINSIC FUNCTIONS USED: C C SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C Dr. Allan J. MacLeod C Dept. of Mathematics and Statistics C University of Paisley C High St. C Paisley C SCOTLAND C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 18 January, 1996 C INTEGER NTERM1,NTERM2 REAL AI0L0(0:23),AI0L0A(0:23),ATEHUN,CHEVAL, 1 FORTY,ONE,ONEHUN,SIX,SIXTEN,T,TWOBPI,TWO88,X,XHIGH, 2 XLOW,XSQ,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'I0ML0 '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,ONE/ 0.0 E 0 , 1.0 E 0 / DATA SIX,SIXTEN/ 6.0 E 0 , 16.0 E 0 / DATA FORTY,ONEHUN/ 40.0 E 0 , 100.0 E 0 / DATA TWO88,ATEHUN/ 288.0 E 0 , 800.0 E 0 / DATA TWOBPI/0.63661 97723 67581 34308 E 0/ DATA AI0L0(0)/ 0.52468 73679 14855 99138 E 0/ DATA AI0L0(1)/ -0.35612 46069 96505 86196 E 0/ DATA AI0L0(2)/ 0.20487 20286 40099 27687 E 0/ DATA AI0L0(3)/ -0.10418 64052 04026 93629 E 0/ DATA AI0L0(4)/ 0.46342 11095 54842 9228 E -1/ DATA AI0L0(5)/ -0.17905 87192 40349 8630 E -1/ DATA AI0L0(6)/ 0.59796 86954 81143 177 E -2/ DATA AI0L0(7)/ -0.17177 75476 93565 429 E -2/ DATA AI0L0(8)/ 0.42204 65446 91714 22 E -3/ DATA AI0L0(9)/ -0.87961 78522 09412 5 E -4/ DATA AI0L0(10)/ 0.15354 34234 86922 3 E -4/ DATA AI0L0(11)/-0.21978 07695 84743 E -5/ DATA AI0L0(12)/ 0.24820 68393 6666 E -6/ DATA AI0L0(13)/-0.20327 06035 607 E -7/ DATA AI0L0(14)/ 0.90984 19842 1 E -9/ DATA AI0L0(15)/ 0.25617 93929 E -10/ DATA AI0L0(16)/-0.71060 9790 E -11/ DATA AI0L0(17)/ 0.32716 960 E -12/ DATA AI0L0(18)/ 0.23002 15 E -13/ DATA AI0L0(19)/-0.29210 9 E -14/ DATA AI0L0(20)/-0.3566 E -16/ DATA AI0L0(21)/ 0.1832 E -16/ DATA AI0L0(22)/-0.10 E -18/ DATA AI0L0(23)/-0.11 E -18/ DATA AI0L0A(0)/ 2.00326 51024 11606 43125 E 0/ DATA AI0L0A(1)/ 0.19520 68515 76492 081 E -2/ DATA AI0L0A(2)/ 0.38239 52356 99083 28 E -3/ DATA AI0L0A(3)/ 0.75342 80817 05443 6 E -4/ DATA AI0L0A(4)/ 0.14959 57655 89707 8 E -4/ DATA AI0L0A(5)/ 0.29994 05312 10557 E -5/ DATA AI0L0A(6)/ 0.60769 60482 2459 E -6/ DATA AI0L0A(7)/ 0.12399 49554 4506 E -6/ DATA AI0L0A(8)/ 0.25232 62552 649 E -7/ DATA AI0L0A(9)/ 0.50463 48573 32 E -8/ DATA AI0L0A(10)/0.97913 23623 0 E -9/ DATA AI0L0A(11)/0.18389 11524 1 E -9/ DATA AI0L0A(12)/0.33763 09278 E -10/ DATA AI0L0A(13)/0.61117 9703 E -11/ DATA AI0L0A(14)/0.10847 2972 E -11/ DATA AI0L0A(15)/0.18861 271 E -12/ DATA AI0L0A(16)/0.32803 45 E -13/ DATA AI0L0A(17)/0.56564 7 E -14/ DATA AI0L0A(18)/0.93300 E -15/ DATA AI0L0A(19)/0.15881 E -15/ DATA AI0L0A(20)/0.2791 E -16/ DATA AI0L0A(21)/0.389 E -17/ DATA AI0L0A(22)/0.70 E -18/ DATA AI0L0A(23)/0.16 E -18/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) I0ML0 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C XSQ = R1MACH(3) T = XSQ / ONEHUN IF ( X .LE. SIXTEN ) THEN DO 10 NTERM1 = 23 , 0 , -1 IF ( ABS(AI0L0(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW = XSQ ELSE DO 40 NTERM2 = 23 , 0 , -1 IF ( ABS(AI0L0A(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 XHIGH = SQRT ( ATEHUN / XSQ ) ENDIF C C Code for x <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN I0ML0 = ONE RETURN ELSE T = ( SIX * X - FORTY ) / ( X + FORTY ) I0ML0 = CHEVAL(NTERM1,AI0L0,T) RETURN ENDIF ELSE C C Code for x > 16 C IF ( X .GT. XHIGH ) THEN I0ML0 = TWOBPI / X ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) I0ML0 = CHEVAL(NTERM2,AI0L0A,T) * TWOBPI / X ENDIF ENDIF RETURN END REAL FUNCTION I1ML1(XVALUE) C C DESCRIPTION: C C This program calculates the function I1ML1 defined as C C I1ML1(x) = I1(x) - L1(x) C C where I1(x) is the modified Bessel function of the first kind of C order 1, and L1(x) is the modified Struve function of order 1. C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20D. C C C ERROR RETURNS: C C The coefficients are only suitable for XVALUE >= 0.0. If C XVALUE < 0.0, an error message is printed and the function C returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The number of terms required for the array C AI1L1. The recommended value is such that C ABS(AI1L1(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The number of terms required for the array C AI1L1A. The recommended value is such that C ABS(AI1L1A(NTERM2)) < EPS/100 C C XLOW - REAL - The value below which I1ML1(x) = x/2 to machine C precision. The recommended value is C 2*EPSNEG C C XHIGH - REAL - The value above which I1ML1(x) = 2/pi to C machine precision. The recommended value is C SQRT(800/EPS) C C For values of EPS, and EPSNEG see the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C INTRINSIC FUNCTIONS USED: C C SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C Dr. Allan J. MacLeod C Dept. of Mathematics and Statistics C University of Paisley C High St. C Paisley C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 18 January, 1996 C INTEGER NTERM1,NTERM2 REAL AI1L1(0:23),AI1L1A(0:25),ATEHUN,CHEVAL, 1 FORTY,ONE,ONEHUN,SIX,SIXTEN,T,TWO,TWOBPI,TWO88, 2 X,XHIGH,XLOW,XSQ,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'I1ML1 '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,ONE,TWO/ 0.0 E 0 , 1.0 E 0 , 2.0 E 0 / DATA SIX,SIXTEN,FORTY/ 6.0 E 0 , 16.0 E 0 , 40.0 E 0 / DATA ONEHUN,TWO88,ATEHUN/ 100.0 E 0 , 288.0 E 0 , 800.0 E 0 / DATA TWOBPI/0.63661 97723 67581 34308 E 0/ DATA AI1L1(0)/ 0.67536 36906 23505 76137 E 0/ DATA AI1L1(1)/ -0.38134 97109 72665 59040 E 0/ DATA AI1L1(2)/ 0.17452 17077 51339 43559 E 0/ DATA AI1L1(3)/ -0.70621 05887 23502 5061 E -1/ DATA AI1L1(4)/ 0.25173 41413 55880 3702 E -1/ DATA AI1L1(5)/ -0.78709 85616 06423 321 E -2/ DATA AI1L1(6)/ 0.21481 43686 51922 006 E -2/ DATA AI1L1(7)/ -0.50862 19971 79062 36 E -3/ DATA AI1L1(8)/ 0.10362 60828 04423 30 E -3/ DATA AI1L1(9)/ -0.17954 47212 05724 7 E -4/ DATA AI1L1(10)/ 0.25978 82745 15414 E -5/ DATA AI1L1(11)/-0.30442 40632 4667 E -6/ DATA AI1L1(12)/ 0.27202 39894 766 E -7/ DATA AI1L1(13)/-0.15812 61441 90 E -8/ DATA AI1L1(14)/ 0.18162 09172 E -10/ DATA AI1L1(15)/ 0.64796 7659 E -11/ DATA AI1L1(16)/-0.54113 290 E -12/ DATA AI1L1(17)/-0.30831 1 E -14/ DATA AI1L1(18)/ 0.30563 8 E -14/ DATA AI1L1(19)/-0.9717 E -16/ DATA AI1L1(20)/-0.1422 E -16/ DATA AI1L1(21)/ 0.84 E -18/ DATA AI1L1(22)/ 0.7 E -19/ DATA AI1L1(23)/-0.1 E -19/ DATA AI1L1A(0)/ 1.99679 36189 67891 36501 E 0/ DATA AI1L1A(1)/ -0.19066 32614 09686 132 E -2/ DATA AI1L1A(2)/ -0.36094 62241 01744 81 E -3/ DATA AI1L1A(3)/ -0.68418 47304 59982 0 E -4/ DATA AI1L1A(4)/ -0.12990 08228 50942 6 E -4/ DATA AI1L1A(5)/ -0.24715 21887 05765 E -5/ DATA AI1L1A(6)/ -0.47147 83969 1972 E -6/ DATA AI1L1A(7)/ -0.90208 19982 592 E -7/ DATA AI1L1A(8)/ -0.17304 58637 504 E -7/ DATA AI1L1A(9)/ -0.33232 36701 59 E -8/ DATA AI1L1A(10)/-0.63736 42173 5 E -9/ DATA AI1L1A(11)/-0.12180 23975 6 E -9/ DATA AI1L1A(12)/-0.23173 46832 E -10/ DATA AI1L1A(13)/-0.43906 8833 E -11/ DATA AI1L1A(14)/-0.82847 110 E -12/ DATA AI1L1A(15)/-0.15562 249 E -12/ DATA AI1L1A(16)/-0.29131 12 E -13/ DATA AI1L1A(17)/-0.54396 5 E -14/ DATA AI1L1A(18)/-0.10117 7 E -14/ DATA AI1L1A(19)/-0.18767 E -15/ DATA AI1L1A(20)/-0.3484 E -16/ DATA AI1L1A(21)/-0.643 E -17/ DATA AI1L1A(22)/-0.118 E -17/ DATA AI1L1A(23)/-0.22 E -18/ DATA AI1L1A(24)/-0.4 E -19/ DATA AI1L1A(25)/-0.1 E -19/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) I1ML1 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C XSQ = R1MACH(3) T = XSQ / ONEHUN IF ( X .LE. SIXTEN ) THEN DO 10 NTERM1 = 23 , 0 , -1 IF ( ABS(AI1L1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW = XSQ + XSQ ELSE DO 40 NTERM2 = 25 , 0 , -1 IF ( ABS(AI1L1A(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 XHIGH = SQRT ( ATEHUN / XSQ ) ENDIF C C Code for x <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN I1ML1 = X / TWO RETURN ELSE T = ( SIX * X - FORTY ) / ( X + FORTY ) I1ML1 = CHEVAL(NTERM1,AI1L1,T) * X / TWO RETURN ENDIF ELSE C C Code for x > 16 C IF ( X .GT. XHIGH ) THEN I1ML1 = TWOBPI ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) I1ML1 = CHEVAL(NTERM2,AI1L1A,T) * TWOBPI ENDIF ENDIF RETURN END REAL FUNCTION J0INT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the Bessel C function J0, defined as C C J0INT(x) = {integral 0 to x} J0(t) dt C C The code uses Chebyshev expansions whose coefficients are C given to 20 decimal places. C C C ERROR RETURNS: C C If the value of |x| is too large, it is impossible to C accurately compute the trigonometric functions used. An C error message is printed, and the function returns the C value 1.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used from the array C ARJ01. The recommended value is such that C ABS(ARJ01(NTERM1)) < EPS/100, provided that C C NTERM2 - The no. of terms to be used from the array C ARJ0A1. The recommended value is such that C ABS(ARJ0A1(NTERM2)) < EPS/100, provided that C C NTERM3 - The no. of terms to be used from the array C ARJ0A2. The recommended value is such that C ABS(ARJ0A2(NTERM3)) < EPS/100, provided that C C XLOW - The value of |x| below which J0INT(x) = x to C machine-precision. The recommended value is C sqrt(12*EPSNEG) C C XHIGH - The value of |x| above which it is impossible C to calculate (x-pi/4) accurately. The recommended C value is 1/EPSNEG C C For values of EPS and EPSNEG for various machine/compiler C combinations refer to the file MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C COS , SIN , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 18 January, 1996 C INTEGER IND,NTERM1,NTERM2,NTERM3 REAL ARJ01(0:23),ARJ0A1(0:21),ARJ0A2(0:18), 1 CHEVAL,FIVE12,ONE,ONEHUN,ONE28,PIB41,PIB411,PIB412, 2 PIB42,RT2BPI,SIXTEN,T,TEMP,TWELVE,X,XHIGH,XLOW, 3 XMPI4,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'J0INT '/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,ONE/ 0.0 E 0 , 1.0 E 0 / DATA TWELVE,SIXTEN/ 12.0 E 0 , 16.0 E 0 / DATA ONEHUN,ONE28,FIVE12/ 100.0 E 0 , 128.0 E 0 , 512 E 0 / DATA RT2BPI/0.79788 45608 02865 35588 E 0/ DATA PIB411,PIB412/ 201.0 E 0 , 256.0 E 0/ DATA PIB42/0.24191 33974 48309 61566 E -3/ DATA ARJ01(0)/ 0.38179 27932 16901 73518 E 0/ DATA ARJ01(1)/ -0.21275 63635 05053 21870 E 0/ DATA ARJ01(2)/ 0.16754 21340 72157 94187 E 0/ DATA ARJ01(3)/ -0.12853 20977 21963 98954 E 0/ DATA ARJ01(4)/ 0.10114 40545 57788 47013 E 0/ DATA ARJ01(5)/ -0.91007 95343 20156 8859 E -1/ DATA ARJ01(6)/ 0.64013 45264 65687 3103 E -1/ DATA ARJ01(7)/ -0.30669 63029 92675 4312 E -1/ DATA ARJ01(8)/ 0.10308 36525 32506 4201 E -1/ DATA ARJ01(9)/ -0.25567 06503 99956 918 E -2/ DATA ARJ01(10)/ 0.48832 75580 57983 04 E -3/ DATA ARJ01(11)/-0.74249 35126 03607 7 E -4/ DATA ARJ01(12)/ 0.92226 05637 30861 E -5/ DATA ARJ01(13)/-0.95522 82830 7083 E -6/ DATA ARJ01(14)/ 0.83883 55845 986 E -7/ DATA ARJ01(15)/-0.63318 44888 58 E -8/ DATA ARJ01(16)/ 0.41560 50422 1 E -9/ DATA ARJ01(17)/-0.23955 29307 E -10/ DATA ARJ01(18)/ 0.12228 6885 E -11/ DATA ARJ01(19)/-0.55697 11 E -13/ DATA ARJ01(20)/ 0.22782 0 E -14/ DATA ARJ01(21)/-0.8417 E -16/ DATA ARJ01(22)/ 0.282 E -17/ DATA ARJ01(23)/-0.9 E -19/ DATA ARJ0A1(0)/ 1.24030 13303 75189 70827 E 0/ DATA ARJ0A1(1)/ -0.47812 53536 32280 693 E -2/ DATA ARJ0A1(2)/ 0.66131 48891 70667 8 E -4/ DATA ARJ0A1(3)/ -0.18604 27404 86349 E -5/ DATA ARJ0A1(4)/ 0.83627 35565 080 E -7/ DATA ARJ0A1(5)/ -0.52585 70367 31 E -8/ DATA ARJ0A1(6)/ 0.42606 36325 1 E -9/ DATA ARJ0A1(7)/ -0.42117 61024 E -10/ DATA ARJ0A1(8)/ 0.48894 6426 E -11/ DATA ARJ0A1(9)/ -0.64834 929 E -12/ DATA ARJ0A1(10)/ 0.96172 34 E -13/ DATA ARJ0A1(11)/-0.15703 67 E -13/ DATA ARJ0A1(12)/ 0.27871 2 E -14/ DATA ARJ0A1(13)/-0.53222 E -15/ DATA ARJ0A1(14)/ 0.10844 E -15/ DATA ARJ0A1(15)/-0.2342 E -16/ DATA ARJ0A1(16)/ 0.533 E -17/ DATA ARJ0A1(17)/-0.127 E -17/ DATA ARJ0A1(18)/ 0.32 E -18/ DATA ARJ0A1(19)/-0.8 E -19/ DATA ARJ0A1(20)/ 0.2 E -19/ DATA ARJ0A1(21)/-0.1 E -19/ DATA ARJ0A2(0)/ 1.99616 09630 13416 75339 E 0/ DATA ARJ0A2(1)/ -0.19037 98192 46668 161 E -2/ DATA ARJ0A2(2)/ 0.15397 10927 04422 6 E -4/ DATA ARJ0A2(3)/ -0.31145 08832 8103 E -6/ DATA ARJ0A2(4)/ 0.11108 50971 321 E -7/ DATA ARJ0A2(5)/ -0.58666 78712 3 E -9/ DATA ARJ0A2(6)/ 0.41399 26949 E -10/ DATA ARJ0A2(7)/ -0.36539 8763 E -11/ DATA ARJ0A2(8)/ 0.38557 568 E -12/ DATA ARJ0A2(9)/ -0.47098 00 E -13/ DATA ARJ0A2(10)/ 0.65022 0 E -14/ DATA ARJ0A2(11)/-0.99624 E -15/ DATA ARJ0A2(12)/ 0.16700 E -15/ DATA ARJ0A2(13)/-0.3028 E -16/ DATA ARJ0A2(14)/ 0.589 E -17/ DATA ARJ0A2(15)/-0.122 E -17/ DATA ARJ0A2(16)/ 0.27 E -18/ DATA ARJ0A2(17)/-0.6 E -19/ DATA ARJ0A2(18)/ 0.1 E -19/ C C Start computation C X = XVALUE IND = 1 IF ( X .LT. ZERO ) THEN X = -X IND = -1 ENDIF C C Compute the machine-dependent constants. C TEMP = R1MACH(3) XHIGH = ONE / TEMP C C Error test (do NOT remove) C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) J0INT = ONE IF ( IND .EQ. -1 ) J0INT = -J0INT RETURN ENDIF C C continue with constants C T = TEMP / ONEHUN IF ( X .LE. SIXTEN ) THEN DO 10 NTERM1 = 23 , 0 , -1 IF ( ABS(ARJ01(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW = SQRT ( TWELVE * TEMP ) ELSE DO 40 NTERM2 = 21 , 0 , -1 IF ( ABS(ARJ0A1(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM3 = 18 , 0 , -1 IF ( ABS(ARJ0A2(NTERM3)) .GT. T ) GOTO 59 50 CONTINUE 59 ENDIF C C Code for 0 <= |x| <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN J0INT = X ELSE T = X * X / ONE28 - ONE J0INT = X * CHEVAL(NTERM1,ARJ01,T) ENDIF ELSE C C Code for |x| > 16 C T = FIVE12 / ( X * X ) - ONE PIB41 = PIB411 / PIB412 XMPI4 = ( X - PIB41 ) - PIB42 TEMP = COS(XMPI4) * CHEVAL(NTERM2,ARJ0A1,T) / X TEMP = TEMP - SIN(XMPI4) * CHEVAL(NTERM3,ARJ0A2,T) J0INT = ONE - RT2BPI * TEMP / SQRT(X) ENDIF IF ( IND .EQ. -1 ) J0INT = -J0INT RETURN END REAL FUNCTION K0INT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the modified Bessel function C defined by C C K0INT(x) = {integral 0 to x} K0(t) dt C C The code uses Chebyshev expansions, whose coefficients are C given to 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, the function is undefined. An error message is C printed and the function returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array AK0IN1. The C recommended value is such that C ABS(AK0IN1(NTERM1)) < EPS/100, C C NTERM2 - The no. of terms to be used in the array AK0IN2. The C recommended value is such that C ABS(AK0IN2(NTERM2)) < EPS/100, C C NTERM3 - The no. of terms to be used in the array AK0INA. The C recommended value is such that C ABS(AK0INA(NTERM3)) < EPS/100, C C XLOW - The value below which K0INT = x * ( const - ln(x) ) to C machine precision. The recommended value is C sqrt (18*EPSNEG). C C XHIGH - The value above which K0INT = pi/2 to machine precision. C The recommended value is C - log (2*EPSNEG) C C For values of EPS and EPSNEG refer to the file MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 18 January, 1996 C INTEGER NTERM1,NTERM2,NTERM3 REAL AK0IN1(0:15),AK0IN2(0:15),AK0INA(0:27), 1 CHEVAL,CONST1,CONST2,EIGHTN,FVAL,HALF, 2 ONEHUN,PIBY2,RT2BPI,SIX,T,TEMP,TWELVE,X, 3 XHIGH,XLOW,XVALUE,ZERO,R1MACH CHARACTER FNNAME*8,ERRMSG*14 DATA FNNAME/'K0INT '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,SIX/ 0.0 E 0 , 0.5 E 0 , 6.0 E 0 / DATA TWELVE,EIGHTN,ONEHUN/ 12.0 E 0 , 18.0 E 0 , 100.0 E 0 / DATA CONST1/1.11593 15156 58412 44881 E 0/ DATA CONST2/-0.11593 15156 58412 44881 E 0/ DATA PIBY2/1.57079 63267 94896 61923 E 0/ DATA RT2BPI/0.79788 45608 02865 35588 E 0/ DATA AK0IN1/16.79702 71446 47109 59477 E 0, 1 9.79134 68767 68894 07070 E 0, 2 2.80501 31604 43379 39300 E 0, 3 0.45615 62053 18885 02068 E 0, 4 0.47162 24457 07476 0784 E -1, 5 0.33526 51482 69698 289 E -2, 6 0.17335 18119 38747 27 E -3, 7 0.67995 18893 64702 E -5, 8 0.20900 26835 9924 E -6, 9 0.51660 38469 76 E -8, X 0.10485 70833 1 E -9, 1 0.17782 9320 E -11, 2 0.25568 44 E -13, 3 0.31557 E -15, 4 0.338 E -17, 5 0.3 E -19/ DATA AK0IN2/10.76266 55822 78091 74077 E 0, 1 5.62333 47984 99975 11550 E 0, 2 1.43543 66487 92908 67158 E 0, 3 0.21250 41014 37438 96043 E 0, 4 0.20365 37393 10000 9554 E -1, 5 0.13602 35840 95623 632 E -2, 6 0.66753 88699 20909 3 E -4, 7 0.25043 00357 07337 E -5, 8 0.74064 23741 728 E -7, 9 0.17697 47043 14 E -8, X 0.34857 75254 E -10, 1 0.57544 785 E -12, 2 0.80748 1 E -14, 3 0.9747 E -16, 4 0.102 E -17, 5 0.1 E -19/ DATA AK0INA(0)/ 1.91172 06544 50604 53895 E 0/ DATA AK0INA(1)/ -0.41830 64565 76958 1085 E -1/ DATA AK0INA(2)/ 0.21335 25080 68147 486 E -2/ DATA AK0INA(3)/ -0.15859 49728 45041 81 E -3/ DATA AK0INA(4)/ 0.14976 24699 85835 1 E -4/ DATA AK0INA(5)/ -0.16795 59553 22241 E -5/ DATA AK0INA(6)/ 0.21495 47247 8804 E -6/ DATA AK0INA(7)/ -0.30583 56654 790 E -7/ DATA AK0INA(8)/ 0.47494 64133 43 E -8/ DATA AK0INA(9)/ -0.79424 66043 2 E -9/ DATA AK0INA(10)/ 0.14156 55532 5 E -9/ DATA AK0INA(11)/-0.26678 25359 E -10/ DATA AK0INA(12)/ 0.52814 9717 E -11/ DATA AK0INA(13)/-0.10926 3199 E -11/ DATA AK0INA(14)/ 0.23518 838 E -12/ DATA AK0INA(15)/-0.52479 91 E -13/ DATA AK0INA(16)/ 0.12101 91 E -13/ DATA AK0INA(17)/-0.28763 2 E -14/ DATA AK0INA(18)/ 0.70297 E -15/ DATA AK0INA(19)/-0.17631 E -15/ DATA AK0INA(20)/ 0.4530 E -16/ DATA AK0INA(21)/-0.1190 E -16/ DATA AK0INA(22)/ 0.319 E -17/ DATA AK0INA(23)/-0.87 E -18/ DATA AK0INA(24)/ 0.24 E -18/ DATA AK0INA(25)/-0.7 E -19/ DATA AK0INA(26)/ 0.2 E -19/ DATA AK0INA(27)/-0.1 E -19/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) K0INT = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C TEMP = R1MACH(3) T = TEMP / ONEHUN IF ( X .LE. SIX ) THEN DO 10 NTERM1 = 15 , 0 , -1 IF ( ABS(AK0IN1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 15 , 0 , -1 IF ( ABS(AK0IN2(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 XLOW = SQRT ( EIGHTN * TEMP ) ELSE DO 40 NTERM3 = 27 , 0 , -1 IF ( ABS(AK0INA(NTERM3)) .GT. T ) GOTO 49 40 CONTINUE 49 XHIGH = - LOG ( TEMP + TEMP ) ENDIF C C Code for 0 <= XVALUE <= 6 C IF ( X .LE. SIX ) THEN IF ( X .LT. XLOW ) THEN FVAL = X IF ( X .GT. ZERO ) THEN FVAL = FVAL * ( CONST1 - LOG(X) ) ENDIF K0INT = FVAL ELSE T = ( ( X * X ) / EIGHTN - HALF ) - HALF FVAL = ( CONST2 + LOG(X) ) * CHEVAL(NTERM2,AK0IN2,T) K0INT = X * ( CHEVAL(NTERM1,AK0IN1,T) - FVAL ) ENDIF C C Code for x > 6 C ELSE FVAL = PIBY2 IF ( X .LT. XHIGH ) THEN T = ( TWELVE / X - HALF ) - HALF TEMP = EXP(-X) * CHEVAL(NTERM3,AK0INA,T) FVAL = FVAL - TEMP / ( SQRT(X) * RT2BPI) ENDIF K0INT = FVAL ENDIF RETURN END REAL FUNCTION LOBACH(XVALUE) C C DESCRIPTION: C C This function calculates the Lobachewsky function L(x), defined as C C LOBACH(x) = {integral 0 to x} ( -ln ( | cos t | ) dt C C The code uses Chebyshev expansions whose coefficients are given C to 20 decimal places. C C C ERROR RETURNS: C C If |x| too large, it is impossible to accurately reduce the C argument to the range [0,pi]. An error message is printed C and the program returns the value 0.0 C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used of the array ARLOB1. C The recommended value is such that C ABS(ARLOB1(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The no. of terms to be used of the array ARLOB2. C The recommended value is such that C ABS(ARLOB2(NTERM2)) < EPS/100 C C XLOW1 - REAL - The value below which L(x) = 0.0 to machine-precision. C The recommended value is C cube-root ( 6*XMIN ) C C XLOW2 - REAL - The value below which L(x) = x**3/6 to C machine-precision. The recommended value is C sqrt ( 10*EPS ) C C XLOW3 - REAL - The value below which C L(pi/2) - L(pi/2-x) = x ( 1 - log(x) ) C to machine-precision. The recommended value is C sqrt ( 18*EPS ) C C XHIGH - REAL - The value of |x| above which it is impossible C to accurately reduce the argument. The C recommended value is 1 / EPS. C C For values of EPS, and XMIN, refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: C 18 January, 1996 C INTEGER INDPI2,INDSGN,NPI,NTERM1,NTERM2 REAL ARLOB1(0:15),ARLOB2(0:10), 1 CHEVAL,FVAL,FVAL1,HALF,LBPB21,LBPB22,LOBPIA,LOBPIB, 2 LOBPI1,LOBPI2,ONE,ONEHUN,PI,PIBY2,PIBY21,PIBY22,PIBY4,PI1, 3 PI11,PI12,PI2,SIX,T,TCON,TEN,TWO,X,XCUB,XHIGH,XLOW1, 4 XLOW2,XLOW3,XR,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'LOBACH'/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,HALF/ 0.0 E 0 , 0.5 E 0 / DATA ONE,TWO,SIX/ 1.0 E 0 , 2.0 E 0 , 6.0 E 0 / DATA TEN,ONEHUN/ 10.0 E 0 , 100.0 E 0 / DATA LOBPIA,LOBPIB/ 1115.0 E 0 , 512.0 E 0 / DATA LOBPI2/-1.48284 69639 78694 99311 E -4/ DATA LBPB22/-7.41423 48198 93474 96556 E -5/ DATA PI11,PI12/ 201.0 E 0 , 64.0 E 0 / DATA PI2/9.67653 58979 32384 62643 E -4/ DATA PIBY22/4.83826 79489 66192 31322 E -4/ DATA TCON/3.24227 78765 54808 68620 E 0/ DATA ARLOB1/0.34464 88495 34813 00507 E 0, 1 0.58419 83571 90277 669 E -2, 2 0.19175 02969 46003 30 E -3, 3 0.78725 16064 56769 E -5, 4 0.36507 47741 5804 E -6, 5 0.18302 87272 680 E -7, 6 0.96890 33300 5 E -9, 7 0.53390 55444 E -10, 8 0.30340 8025 E -11, 9 0.17667 875 E -12, X 0.10493 93 E -13, 1 0.63359 E -15, 2 0.3878 E -16, 3 0.240 E -17, 4 0.15 E -18, 5 0.1 E -19/ DATA ARLOB2/2.03459 41803 61328 51087 E 0, 1 0.17351 85882 02740 7681 E -1, 2 0.55162 80426 09052 1 E -4, 3 0.39781 64627 6598 E -6, 4 0.36901 80289 18 E -8, 5 0.38804 09214 E -10, 6 0.44069 698 E -12, 7 0.52767 4 E -14, 8 0.6568 E -16, 9 0.84 E -18, X 0.1 E -19/ C C Start computation C X = ABS ( XVALUE ) INDSGN = 1 IF ( XVALUE .LT. ZERO ) THEN INDSGN = -1 ENDIF C C Compute the machine-dependent constants. C XR = R1MACH(3) XHIGH = ONE / XR C C Error test ( do NOT remove ) C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) LOBACH = ZERO RETURN ENDIF C C continue with constants C T = XR / ONEHUN DO 10 NTERM1 = 15 , 0 , -1 IF ( ABS(ARLOB1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 10 , 0 , -1 IF ( ABS(ARLOB2(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 XLOW1 = ( SIX * R1MACH(1) ) ** (TWO/SIX) XLOW2 = SQRT ( TEN * XR ) T = TWO * TEN - TWO XLOW3 = SQRT ( T * XR ) C C Reduce argument to [0,pi] C PI1 = PI11/PI12 PI = PI1 + PI2 PIBY2 = PI/TWO PIBY21 = PI1/TWO PIBY4 = PIBY2/TWO NPI = INT ( X / PI ) XR = ( X - NPI * PI1 ) - NPI * PI2 C C Reduce argument to [0,pi/2] C INDPI2 = 0 IF ( XR .GT. PIBY2 ) THEN INDPI2 = 1 XR = ( PI1 - XR ) + PI2 ENDIF C C Code for argument in [0,pi/4] C IF ( XR .LE. PIBY4 ) THEN IF ( XR .LT. XLOW1 ) THEN FVAL = ZERO ELSE XCUB = XR * XR * XR IF ( XR .LT. XLOW2 ) THEN FVAL = XCUB / SIX ELSE T = ( TCON * XR * XR - HALF ) - HALF FVAL = XCUB * CHEVAL(NTERM1,ARLOB1,T) ENDIF ENDIF ELSE C C Code for argument in [pi/4,pi/2] C XR = ( PIBY21 - XR ) + PIBY22 IF ( XR .EQ. ZERO ) THEN FVAL1 = ZERO ELSE IF ( XR .LT. XLOW3 ) THEN FVAL1 = XR * ( ONE - LOG( XR ) ) ELSE T = ( TCON * XR * XR - HALF ) - HALF FVAL1 = XR * ( CHEVAL(NTERM2,ARLOB2,T) - LOG( XR ) ) ENDIF ENDIF LBPB21 = LOBPIA / ( LOBPIB + LOBPIB ) FVAL = ( LBPB21 - FVAL1 ) + LBPB22 ENDIF LOBPI1 = LOBPIA / LOBPIB C C Compute value for argument in [pi/2,pi] C IF ( INDPI2 .EQ. 1 ) THEN FVAL = ( LOBPI1 - FVAL ) + LOBPI2 ENDIF LOBACH = FVAL C C Scale up for arguments > pi C IF ( NPI .GT. 0 ) THEN LOBACH = ( FVAL + NPI * LOBPI2 ) + NPI * LOBPI1 ENDIF IF ( INDSGN .EQ. -1 ) THEN LOBACH = - LOBACH ENDIF RETURN END REAL FUNCTION STROM(XVALUE) C C DESCRIPTION: C C This program calculates Stromgren's integral, defined as C C STROM(X) = integral 0 to X { t**7 exp(2t)/[exp(t)-1]**3 } dt C C The code uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ASTROM to be used. C The recommended value is such that C ASTROM(NTERMS) < EPS/100 C C XLOW0 - REAL - The value below which STROM = 0.0 to machine C precision. The recommended value is C 5th root of (130*XMIN) C C XLOW1 - REAL - The value below which STROM = 3*(X**5)/(4*(pi**4)) C to machine precision. The recommended value is C 2*EPSNEG C C EPSLN - REAL - The value of ln(EPS). Used to determine the no. C of exponential terms for large X. C C EPNGLN - REAL - The value of ln(EPSNEG). Used to prevent C overflow for large X. C C XHIGH - REAL - The value above which C STROM = 196.52 - 15*(x**7)*exp(-x)/(4pi**4) C to machine precision. The recommended value is C 7 / EPS C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 18 January, 1996 C C INTEGER K1,K2,NTERMS,NUMEXP REAL ASTROM(0:26),CHEVAL,EPNGLN,EPSLN,FOUR, 1 F15BP4,HALF,ONE,ONEHUN,ONE30,ONE5LN,PI4B3,RK, 2 SEVEN,SUMEXP,SUM2,T,TWO,VALINF,X,XHIGH, 3 XK,XK1,XLOW0,XLOW1,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'STROM '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA TWO,FOUR,SEVEN/ 2.0 E 0 , 4.0 E 0 , 7.0 E 0 / DATA ONEHUN,ONE30,ONE5LN/ 100.0 E 0 , 130.0 E 0 , 0.4055 E 0 / DATA F15BP4/0.38497 43345 50662 56959 E -1 / DATA PI4B3/1.29878 78804 53365 82982 E 2 / DATA VALINF/196.51956 92086 89882 61257 E 0/ DATA ASTROM(0)/ 0.56556 12087 25391 55290 E 0/ DATA ASTROM(1)/ 0.45557 31969 10178 5525 E -1/ DATA ASTROM(2)/ -0.40395 35875 93686 9170 E -1/ DATA ASTROM(3)/ -0.13339 05720 21486 815 E -2/ DATA ASTROM(4)/ 0.18586 25062 50538 030 E -2/ DATA ASTROM(5)/ -0.46855 55868 05365 9 E -4/ DATA ASTROM(6)/ -0.63434 75643 42294 9 E -4/ DATA ASTROM(7)/ 0.57254 87081 43200 E -5/ DATA ASTROM(8)/ 0.15935 28122 16822 E -5/ DATA ASTROM(9)/ -0.28884 32843 1036 E -6/ DATA ASTROM(10)/-0.24466 33604 801 E -7/ DATA ASTROM(11)/ 0.10072 50382 374 E -7/ DATA ASTROM(12)/-0.12482 98610 4 E -9/ DATA ASTROM(13)/-0.26300 62528 3 E -9/ DATA ASTROM(14)/ 0.24904 07578 E -10/ DATA ASTROM(15)/ 0.48545 4902 E -11/ DATA ASTROM(16)/-0.10537 8913 E -11/ DATA ASTROM(17)/-0.36044 17 E -13/ DATA ASTROM(18)/ 0.29920 78 E -13/ DATA ASTROM(19)/-0.16397 1 E -14/ DATA ASTROM(20)/-0.61061 E -15/ DATA ASTROM(21)/ 0.9335 E -16/ DATA ASTROM(22)/ 0.709 E -17/ DATA ASTROM(23)/-0.291 E -17/ DATA ASTROM(24)/ 0.8 E -19/ DATA ASTROM(25)/ 0.6 E -19/ DATA ASTROM(26)/-0.1 E -19/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) STROM = ZERO RETURN ENDIF C C Compute the machine-dependent constants. C XK = R1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 26 , 0 , -1 IF ( ABS(ASTROM(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW0 = ( ONE30 * R1MACH(1) ) ** (ONE/(SEVEN-TWO)) XLOW1 = TWO * XK ELSE EPSLN = LOG ( R1MACH(4) ) EPNGLN = LOG ( XK ) XHIGH = SEVEN / XK ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW0 ) THEN STROM = ZERO ELSE IF ( X .LT. XLOW1 ) THEN STROM = (X**5) / PI4B3 ELSE T = ( ( X / TWO ) - HALF ) - HALF STROM = (X**5) * CHEVAL(NTERMS,ASTROM,T) * F15BP4 ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH ) THEN SUMEXP = ONE ELSE NUMEXP = INT( EPSLN / (ONE5LN - X ) ) + 1 IF ( NUMEXP .GT. 1 ) THEN T = EXP( -X ) ELSE T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , 7 SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUM2 = SUM2 * ( RK + ONE ) / TWO SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = SEVEN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. EPNGLN ) THEN STROM = VALINF ELSE STROM = VALINF - EXP(T) * F15BP4 ENDIF ENDIF RETURN END REAL FUNCTION STRVH0(XVALUE) C C C DESCRIPTION: C C This function calculates the value of the Struve function C of order 0, denoted H0(x), for the argument XVALUE, defined C C STRVHO(x) = (2/pi) integral{0 to pi/2} sin(x cos(t)) dt C C H0 also satisfies the second-order equation C C x*D(Df) + Df + x*f = 2x/pi C C The code uses Chebyshev expansions whose coefficients are C given to 20D. C C C ERROR RETURNS: C C As the asymptotic expansion of H0 involves the Bessel function C of the second kind Y0, there is a problem for large x, since C we cannot accurately calculate the value of Y0. An error message C is printed and STRVH0 returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array ARRH0. The C recommended value is such that C ABS(ARRH0(NTERM1)) < EPS/100. C C NTERM2 - The no. of terms to be used in the array ARRH0A. The C recommended value is such that C ABS(ARRH0A(NTERM2)) < EPS/100. C C NTERM3 - The no. of terms to be used in the array AY0ASP. The C recommended value is such that C ABS(AY0ASP(NTERM3)) < EPS/100. C C NTERM4 - The no. of terms to be used in the array AY0ASQ. The C recommended value is such that C ABS(AY0ASQ(NTERM4)) < EPS/100. C C XLOW - The value for which H0(x) = 2*x/pi to machine precision, if C abs(x) < XLOW. The recommended value is C XLOW = 3 * SQRT(EPSNEG) C C XHIGH - The value above which we are unable to calculate Y0 with C any reasonable accuracy. An error message is printed and C STRVH0 returns the value 0.0. The recommended value is C XHIGH = 1/EPS. C C For values of EPS and EPSNEG refer to the file MACHCON.TXT. C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C ABS, COS, SIN, SQRT. C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C ALLAN J. MACLEOD C DEPT. OF MATHEMATICS AND STATISTICS C UNIVERSITY OF PAISLEY C HIGH ST. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 18 January, 1996 C C INTEGER INDSGN,NTERM1,NTERM2,NTERM3,NTERM4 REAL ARRH0(0:19),ARRH0A(0:20),AY0ASP(0:12), 1 AY0ASQ(0:13),CHEVAL,EIGHT,ELEVEN,HALF,H0AS, 2 ONEHUN,ONE,PIBY4,RT2BPI,SIXTP5,T,THR2P5,TWENTY, 3 TWOBPI,TWO62,X,XHIGH,XLOW,XMP4,XSQ,XVALUE, 4 Y0P,Y0Q,Y0VAL,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'STRVH0'/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,HALF,ONE/0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA EIGHT,ELEVEN/8.0 E 0 , 11.0 E 0/ DATA TWENTY,ONEHUN/20.0 E 0 , 100.0 E 0/ DATA SIXTP5,TWO62,THR2P5/60.5 E 0 , 262.0 E 0 , 302.5 E 0/ DATA PIBY4/0.78539 81633 97448 30962 E 0/ DATA RT2BPI/0.79788 45608 02865 35588 E 0/ DATA TWOBPI/0.63661 97723 67581 34308 E 0/ DATA ARRH0(0)/ 0.28696 48739 90132 25740 E 0/ DATA ARRH0(1)/ -0.25405 33268 16183 52305 E 0/ DATA ARRH0(2)/ 0.20774 02673 93238 94439 E 0/ DATA ARRH0(3)/ -0.20364 02956 03865 85140 E 0/ DATA ARRH0(4)/ 0.12888 46908 68661 86016 E 0/ DATA ARRH0(5)/ -0.48256 32815 62226 1202 E -1/ DATA ARRH0(6)/ 0.11686 29347 56900 1242 E -1/ DATA ARRH0(7)/ -0.19811 81356 42418 416 E -2/ DATA ARRH0(8)/ 0.24899 13851 24212 86 E -3/ DATA ARRH0(9)/ -0.24188 27913 78595 0 E -4/ DATA ARRH0(10)/ 0.18743 75479 93431 E -5/ DATA ARRH0(11)/-0.11873 34607 4362 E -6/ DATA ARRH0(12)/ 0.62698 49433 46 E -8/ DATA ARRH0(13)/-0.28045 54679 3 E -9/ DATA ARRH0(14)/ 0.10769 41205 E -10/ DATA ARRH0(15)/-0.35904 793 E -12/ DATA ARRH0(16)/ 0.10494 47 E -13/ DATA ARRH0(17)/-0.27119 E -15/ DATA ARRH0(18)/ 0.624 E -17/ DATA ARRH0(19)/-0.13 E -18/ DATA ARRH0A(0)/ 1.99291 88575 19923 05515 E 0/ DATA ARRH0A(1)/ -0.38423 26687 01456 887 E -2/ DATA ARRH0A(2)/ -0.32871 99371 23530 50 E -3/ DATA ARRH0A(3)/ -0.29411 81203 70340 9 E -4/ DATA ARRH0A(4)/ -0.26731 53519 87066 E -5/ DATA ARRH0A(5)/ -0.24681 03107 5013 E -6/ DATA ARRH0A(6)/ -0.22950 14861 143 E -7/ DATA ARRH0A(7)/ -0.21568 22318 33 E -8/ DATA ARRH0A(8)/ -0.20303 50648 3 E -9/ DATA ARRH0A(9)/ -0.19345 75509 E -10/ DATA ARRH0A(10)/-0.18277 3144 E -11/ DATA ARRH0A(11)/-0.17768 424 E -12/ DATA ARRH0A(12)/-0.16432 96 E -13/ DATA ARRH0A(13)/-0.17156 9 E -14/ DATA ARRH0A(14)/-0.13368 E -15/ DATA ARRH0A(15)/-0.2077 E -16/ DATA ARRH0A(16)/ 0.2 E -19/ DATA ARRH0A(17)/-0.55 E -18/ DATA ARRH0A(18)/ 0.10 E -18/ DATA ARRH0A(19)/-0.4 E -19/ DATA ARRH0A(20)/ 0.1 E -19/ DATA AY0ASP/1.99944 63940 23982 71568 E 0, 1 -0.28650 77864 70319 58 E -3, 2 -0.10050 72797 43762 0 E -4, 3 -0.35835 94100 2463 E -6, 4 -0.12879 65120 531 E -7, 5 -0.46609 48663 6 E -9, 6 -0.16937 69454 E -10, 7 -0.61852 269 E -12, 8 -0.22618 41 E -13, 9 -0.83268 E -15, X -0.3042 E -16, 1 -0.115 E -17, 2 -0.4 E -19/ DATA AY0ASQ/1.99542 68138 68286 04092 E 0, 1 -0.23601 31928 67514 472 E -2, 2 -0.76015 38908 50296 6 E -4, 3 -0.25610 88714 56343 E -5, 4 -0.87502 92185 106 E -7, 5 -0.30430 42121 59 E -8, 6 -0.10621 42831 4 E -9, 7 -0.37737 1479 E -11, 8 -0.13213 687 E -12, 9 -0.48862 1 E -14, X -0.15809 E -15, 1 -0.762 E -17, 2 -0.3 E -19, 3 -0.3 E -19/ C C Start computation C X = XVALUE INDSGN = 1 IF ( X .LT. ZERO ) THEN X = -X INDSGN = -1 ENDIF C C Compute the machine-dependent constants. C H0AS = R1MACH(3) XHIGH = ONE / R1MACH(4) C C Error test ( do NOT remove ) C IF ( ABS(XVALUE) .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) STRVH0 = ZERO RETURN ENDIF C C continue with machine constants C T = H0AS / ONEHUN IF ( X .LE. ELEVEN ) THEN DO 10 NTERM1 = 19 , 0 , -1 IF ( ABS(ARRH0(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 Y0P = SQRT ( H0AS ) XLOW = Y0P + Y0P + Y0P ELSE DO 40 NTERM2 = 20 , 0 , -1 IF ( ABS(ARRH0A(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM3 = 12 , 0 , -1 IF ( ABS(AY0ASP(NTERM3)) .GT. T ) GOTO 59 50 CONTINUE 59 DO 60 NTERM4 = 13 , 0 , -1 IF ( ABS(AY0ASQ(NTERM4)) .GT. T ) GOTO 69 60 CONTINUE 69 ENDIF C C Code for abs(x) <= 11 C IF ( X .LE. ELEVEN ) THEN IF ( X .LT. XLOW ) THEN STRVH0 = TWOBPI * X ELSE T = ( ( X * X ) / SIXTP5 - HALF ) - HALF STRVH0 = TWOBPI * X * CHEVAL ( NTERM1 , ARRH0 , T ) ENDIF ELSE C C Code for abs(x) > 11 C XSQ = X * X T = ( TWO62 - XSQ ) / ( TWENTY + XSQ ) Y0P = CHEVAL ( NTERM3 , AY0ASP , T ) Y0Q = CHEVAL ( NTERM4 , AY0ASQ , T ) / ( EIGHT * X ) XMP4 = X - PIBY4 Y0VAL = Y0P * SIN ( XMP4 ) - Y0Q * COS ( XMP4 ) Y0VAL = Y0VAL * RT2BPI / SQRT ( X ) T = ( THR2P5 - XSQ ) / ( SIXTP5 + XSQ ) H0AS = TWOBPI * CHEVAL ( NTERM2 , ARRH0A , T ) / X STRVH0 = Y0VAL + H0AS ENDIF IF ( INDSGN .EQ. -1 ) STRVH0 = -STRVH0 RETURN END REAL FUNCTION STRVH1(XVALUE) C C C DESCRIPTION: C This function calculates the value of the Struve function C of order 1, denoted H1(x), for the argument XVALUE, defined as C C 2 C STRVH1(x) = (2x/pi) integral{0 to pi/2} sin( x cos(t))*sin t dt C C H1 also satisfies the second-order differential equation C C 2 2 2 2 C x * D f + x * Df + (x - 1)f = 2x / pi C C The code uses Chebyshev expansions with the coefficients C given to 20D. C C C ERROR RETURNS: C As the asymptotic expansion of H1 involves the Bessel function C of the second kind Y1, there is a problem for large x, since C we cannot accurately calculate the value of Y1. An error message C is printed and STRVH1 returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array ARRH1. The C recommended value is such that C ABS(ARRH1(NTERM1)) < EPS/100. C C NTERM2 - The no. of terms to be used in the array ARRH1A. The C recommended value is such that C ABS(ARRH1A(NTERM2)) < EPS/100. C C NTERM3 - The no. of terms to be used in the array AY1ASP. The C recommended value is such that C ABS(AY1ASP(NTERM3)) < EPS/100. C C NTERM4 - The no. of terms to be used in the array AY1ASQ. The C recommended value is such that C ABS(AY1ASQ(NTERM4)) < EPS/100. C C XLOW1 - The value of x, below which H1(x) set to zero, if C abs(x) 9 C XSQ = X * X T = ( ONE82 - XSQ ) / ( TWENTY + XSQ ) Y1P = CHEVAL ( NTERM3 , AY1ASP , T ) Y1Q = CHEVAL ( NTERM4 , AY1ASQ , T ) / ( EIGHT * X) XM3P4 = X - THPBY4 Y1VAL = Y1P * SIN ( XM3P4 ) + Y1Q * COS ( XM3P4 ) Y1VAL = Y1VAL * RT2BPI / SQRT ( X ) T = ( TW02P5 - XSQ ) / ( FORTP5 + XSQ ) H1AS = TWOBPI * CHEVAL ( NTERM2 , ARRH1A , T ) STRVH1 = Y1VAL + H1AS ENDIF RETURN END REAL FUNCTION STRVL0(XVALUE) C C DESCRIPTION: C C This function calculates the modified Struve function of C order 0, denoted L0(x), defined as the solution of the C second-order equation C C x*D(Df) + Df - x*f = 2x/pi C C C ERROR RETURNS: C C If the value of |XVALUE| is too large, the result C would cause an floating-pt overflow. An error message C is printed and the function returns the value of C sign(XVALUE)*XMAX where XMAX is the largest possible C floating-pt argument. C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The no. of terms for the array ARL0. C The recommended value is such that C ABS(ARL0(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The no. of terms for the array ARL0AS. C The recommended value is such that C ABS(ARL0AS(NTERM2)) < EPS/100 C C NTERM3 - INTEGER - The no. of terms for the array AI0ML0. C The recommended value is such that C ABS(AI0ML0(NTERM3)) < EPS/100 C C XLOW - REAL - The value of x below which L0(x) = 2*x/pi C to machine precision. The recommended value is C 3*SQRT(EPS) C C XHIGH1 - REAL - The value beyond which the Chebyshev series C in the asymptotic expansion of I0 - L0 gives C 1.0 to machine precision. The recommended value C is SQRT( 30/EPSNEG ) C C XHIGH2 - REAL - The value beyond which the Chebyshev series C in the asymptotic expansion of I0 gives 1.0 C to machine precision. The recommended value C is 28 / EPSNEG C C XMAX - REAL - The value of XMAX, where XMAX is the C largest possible floating-pt argument. C This is used to prevent overflow. C C For values of EPS, EPSNEG and XMAX the user should refer C to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C DR. ALLAN J. MACLEOD C DEPT. OF MATHEMATICS AND STATISTICS C UNIVERSITY OF PAISLEY C HIGH ST. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 18 January, 1996 C INTEGER INDSGN,NTERM1,NTERM2,NTERM3 REAL ARL0(0:27),ARL0AS(0:15),AI0ML0(0:23), 1 ATEHUN,CHEVAL,CH1,CH2,FOUR,LNR2PI,ONE,ONEHUN, 2 SIXTEN,T,TEST,TWENT4,TWENT8,TWO,TWOBPI,TWO88, 3 X,XHIGH1,XHIGH2,XLOW,XMAX,XVALUE,XSQ,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*24 DATA FNNAME/'STRVL0'/ DATA ERRMSG/'ARGUMENT CAUSES OVERFLOW'/ DATA ZERO,ONE,TWO/0.0 E 0 , 1.0 E 0 , 2.0 E 0/ DATA FOUR,SIXTEN/4.0 E 0 , 16.0 E 0/ DATA TWENT4,TWENT8,ONEHUN/24.0 E 0 , 28.0 E 0 , 100.0 E 0/ DATA TWO88,ATEHUN/288.0 E 0 , 800.0 E 0/ DATA LNR2PI/0.91893 85332 04672 74178 E 0/ DATA TWOBPI/0.63661 97723 67581 34308 E 0/ DATA ARL0(0)/ 0.42127 45834 99799 24863 E 0/ DATA ARL0(1)/ -0.33859 53639 12206 12188 E 0/ DATA ARL0(2)/ 0.21898 99481 27107 16064 E 0/ DATA ARL0(3)/ -0.12349 48282 07131 85712 E 0/ DATA ARL0(4)/ 0.62142 09793 86695 8440 E -1/ DATA ARL0(5)/ -0.28178 06028 10954 7545 E -1/ DATA ARL0(6)/ 0.11574 19676 63809 1209 E -1/ DATA ARL0(7)/ -0.43165 85743 06921 179 E -2/ DATA ARL0(8)/ 0.14614 23499 07298 329 E -2/ DATA ARL0(9)/ -0.44794 21180 54614 78 E -3/ DATA ARL0(10)/ 0.12364 74610 59437 61 E -3/ DATA ARL0(11)/-0.30490 28334 79704 4 E -4/ DATA ARL0(12)/ 0.66394 14015 21146 E -5/ DATA ARL0(13)/-0.12553 83577 03889 E -5/ DATA ARL0(14)/ 0.20073 44645 1228 E -6/ DATA ARL0(15)/-0.25882 60170 637 E -7/ DATA ARL0(16)/ 0.24114 37427 58 E -8/ DATA ARL0(17)/-0.10159 67435 2 E -9/ DATA ARL0(18)/-0.12024 30736 E -10/ DATA ARL0(19)/ 0.26290 6137 E -11/ DATA ARL0(20)/-0.15313 190 E -12/ DATA ARL0(21)/-0.15747 60 E -13/ DATA ARL0(22)/ 0.31563 5 E -14/ DATA ARL0(23)/-0.4096 E -16/ DATA ARL0(24)/-0.3620 E -16/ DATA ARL0(25)/ 0.239 E -17/ DATA ARL0(26)/ 0.36 E -18/ DATA ARL0(27)/-0.4 E -19/ DATA ARL0AS(0)/ 2.00861 30823 56058 88600 E 0/ DATA ARL0AS(1)/ 0.40373 79665 00438 470 E -2/ DATA ARL0AS(2)/ -0.25199 48028 65802 67 E -3/ DATA ARL0AS(3)/ 0.16057 36682 81117 6 E -4/ DATA ARL0AS(4)/ -0.10369 21824 73444 E -5/ DATA ARL0AS(5)/ 0.67655 78876 305 E -7/ DATA ARL0AS(6)/ -0.44499 99067 56 E -8/ DATA ARL0AS(7)/ 0.29468 88922 8 E -9/ DATA ARL0AS(8)/ -0.19621 80522 E -10/ DATA ARL0AS(9)/ 0.13133 0306 E -11/ DATA ARL0AS(10)/-0.88191 90 E -13/ DATA ARL0AS(11)/ 0.59537 6 E -14/ DATA ARL0AS(12)/-0.40389 E -15/ DATA ARL0AS(13)/ 0.2651 E -16/ DATA ARL0AS(14)/-0.208 E -17/ DATA ARL0AS(15)/ 0.11 E -18/ DATA AI0ML0(0)/ 2.00326 51024 11606 43125 E 0/ DATA AI0ML0(1)/ 0.19520 68515 76492 081 E -2/ DATA AI0ML0(2)/ 0.38239 52356 99083 28 E -3/ DATA AI0ML0(3)/ 0.75342 80817 05443 6 E -4/ DATA AI0ML0(4)/ 0.14959 57655 89707 8 E -4/ DATA AI0ML0(5)/ 0.29994 05312 10557 E -5/ DATA AI0ML0(6)/ 0.60769 60482 2459 E -6/ DATA AI0ML0(7)/ 0.12399 49554 4506 E -6/ DATA AI0ML0(8)/ 0.25232 62552 649 E -7/ DATA AI0ML0(9)/ 0.50463 48573 32 E -8/ DATA AI0ML0(10)/0.97913 23623 0 E -9/ DATA AI0ML0(11)/0.18389 11524 1 E -9/ DATA AI0ML0(12)/0.33763 09278 E -10/ DATA AI0ML0(13)/0.61117 9703 E -11/ DATA AI0ML0(14)/0.10847 2972 E -11/ DATA AI0ML0(15)/0.18861 271 E -12/ DATA AI0ML0(16)/0.32803 45 E -13/ DATA AI0ML0(17)/0.56564 7 E -14/ DATA AI0ML0(18)/0.93300 E -15/ DATA AI0ML0(19)/0.15881 E -15/ DATA AI0ML0(20)/0.2791 E -16/ DATA AI0ML0(21)/0.389 E -17/ DATA AI0ML0(22)/0.70 E -18/ DATA AI0ML0(23)/0.16 E -18/ C C Start computation C X = XVALUE INDSGN = 1 IF ( X .LT. ZERO ) THEN X = -X INDSGN = -1 ENDIF C C Compute the machine-dependent constants. C TEST = R1MACH(3) T = TEST / ONEHUN IF ( X .LE. SIXTEN ) THEN DO 10 NTERM1 = 27 , 0 , -1 IF ( ABS(ARL0(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW = ( ONE + TWO ) * SQRT ( TEST ) ELSE DO 40 NTERM2 = 15 , 0 , -1 IF ( ABS(ARL0AS(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM3 = 23 , 0 , -1 IF ( ABS(AI0ML0(NTERM3)) .GT. T ) GOTO 59 50 CONTINUE 59 XMAX = R1MACH(2) XHIGH1 = SQRT ( ( TWENT8 + TWO ) / TEST ) XHIGH2 = TWENT8 / TEST ENDIF C C Code for |xvalue| <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN STRVL0 = TWOBPI * X ELSE T = ( FOUR * X - TWENT4 ) / ( X + TWENT4 ) STRVL0 = TWOBPI * X * CHEVAL(NTERM1,ARL0,T) * EXP(X) ENDIF ELSE C C Code for |xvalue| > 16 C IF ( X .GT. XHIGH2 ) THEN CH1 = ONE ELSE T = ( X - TWENT8 ) / ( FOUR - X ) CH1 = CHEVAL(NTERM2,ARL0AS,T) ENDIF IF ( X .GT. XHIGH1 ) THEN CH2 = ONE ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) CH2 = CHEVAL(NTERM3,AI0ML0,T) ENDIF TEST = LOG(CH1) - LNR2PI - LOG(X)/TWO + X IF ( TEST .GT. LOG(XMAX) ) THEN CALL ERRPRN(FNNAME,ERRMSG) STRVL0 = XMAX ELSE STRVL0 = EXP(TEST) - TWOBPI * CH2 / X ENDIF ENDIF IF ( INDSGN .EQ. -1 ) STRVL0 = -STRVL0 RETURN END REAL FUNCTION STRVL1(XVALUE) C C DESCRIPTION: C C This function calculates the modified Struve function of C order 1, denoted L1(x), defined as the solution of C C x*x*D(Df) + x*Df - (x*x+1)f = 2*x*x/pi C C C ERROR RETURNS: C C If the value of |XVALUE| is too large, the result C would cause an floating-pt overflow. An error message C is printed and the function returns the value of C sign(XVALUE)*XMAX where XMAX is the largest possible C floating-pt argument. C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The no. of terms for the array ARL1. C The recommended value is such that C ABS(ARL1(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The no. of terms for the array ARL1AS. C The recommended value is such that C ABS(ARL1AS(NTERM2)) < EPS/100 C C NTERM3 - INTEGER - The no. of terms for the array AI1ML1. C The recommended value is such that C ABS(AI1ML1(NTERM3)) < EPS/100 C C XLOW1 - REAL - The value of x below which L1(x) = 2*x*x/(3*pi) C to machine precision. The recommended value is C SQRT(15*EPS) C C XLOW2 - REAL - The value of x below which L1(x) set to 0.0. C This is used to prevent underflow. The C recommended value is C SQRT(5*XMIN) C C XHIGH1 - REAL - The value of |x| above which the Chebyshev C series in the asymptotic expansion of I1 C equals 1.0 to machine precision. The C recommended value is SQRT( 30 / EPSNEG ). C C XHIGH2 - REAL - The value of |x| above which the Chebyshev C series in the asymptotic expansion of I1 - L1 C equals 1.0 to machine precision. The recommended C value is 30 / EPSNEG. C C XMAX - REAL - The value of XMAX, where XMAX is the C largest possible floating-pt argument. C This is used to prevent overflow. C C For values of EPS, EPSNEG, XMIN, and XMAX the user should refer C to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN, R1MACH C C C AUTHOR: C DR. ALLAN J. MACLEOD C DEPT. OF MATHEMATICS AND STATISTICS C UNIVERSITY OF PAISLEY C HIGH ST. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: C 18 January, 1996 C C INTEGER NTERM1,NTERM2,NTERM3 REAL ARL1(0:26),ARL1AS(0:16),AI1ML1(0:25), 1 ATEHUN,CHEVAL,CH1,CH2,FOUR,LNR2PI, 2 ONE,ONEHUN,PI3BY2,SIXTEN,T,TEST,THIRTY,TWENT4, 3 TWO,TWOBPI,TWO88,X,XHIGH1,XHIGH2,XLOW1,XLOW2, 4 XMAX,XVALUE,XSQ,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*24 DATA FNNAME/'STRVL1'/ DATA ERRMSG/'ARGUMENT CAUSES OVERFLOW'/ DATA ZERO,ONE,TWO/0.0 E 0 , 1.0 E 0 , 2.0 E 0/ DATA FOUR,SIXTEN/4.0 E 0 , 16.0 E 0/ DATA TWENT4,THIRTY/24.0 E 0 , 30.0 E 0/ DATA ONEHUN/100.0 E 0/ DATA TWO88,ATEHUN/288.0 E 0 , 800.0 E 0/ DATA LNR2PI/0.91893 85332 04672 74178 E 0/ DATA PI3BY2/4.71238 89803 84689 85769 E 0/ DATA TWOBPI/0.63661 97723 67581 34308 E 0/ DATA ARL1(0)/ 0.38996 02735 12295 38208 E 0/ DATA ARL1(1)/ -0.33658 09610 19757 49366 E 0/ DATA ARL1(2)/ 0.23012 46791 25016 45616 E 0/ DATA ARL1(3)/ -0.13121 59400 79608 32327 E 0/ DATA ARL1(4)/ 0.64259 22289 91284 6518 E -1/ DATA ARL1(5)/ -0.27500 32950 61663 5833 E -1/ DATA ARL1(6)/ 0.10402 34148 63720 8871 E -1/ DATA ARL1(7)/ -0.35053 22949 36388 080 E -2/ DATA ARL1(8)/ 0.10574 84984 21439 717 E -2/ DATA ARL1(9)/ -0.28609 42640 36665 58 E -3/ DATA ARL1(10)/ 0.69257 08785 94220 8 E -4/ DATA ARL1(11)/-0.14896 93951 12271 7 E -4/ DATA ARL1(12)/ 0.28103 55825 97128 E -5/ DATA ARL1(13)/-0.45503 87929 7776 E -6/ DATA ARL1(14)/ 0.60901 71561 770 E -7/ DATA ARL1(15)/-0.62354 37248 08 E -8/ DATA ARL1(16)/ 0.38430 01206 7 E -9/ DATA ARL1(17)/ 0.79054 3916 E -11/ DATA ARL1(18)/-0.48982 4083 E -11/ DATA ARL1(19)/ 0.46356 884 E -12/ DATA ARL1(20)/ 0.68420 5 E -14/ DATA ARL1(21)/-0.56974 8 E -14/ DATA ARL1(22)/ 0.35324 E -15/ DATA ARL1(23)/ 0.4244 E -16/ DATA ARL1(24)/-0.644 E -17/ DATA ARL1(25)/-0.21 E -18/ DATA ARL1(26)/ 0.9 E -19/ DATA ARL1AS(0)/ 1.97540 37844 16523 56868 E 0/ DATA ARL1AS(1)/ -0.11951 30555 08829 4181 E -1/ DATA ARL1AS(2)/ 0.33639 48526 91960 46 E -3/ DATA ARL1AS(3)/ -0.10091 15655 48154 9 E -4/ DATA ARL1AS(4)/ 0.30638 95132 1998 E -6/ DATA ARL1AS(5)/ -0.95370 43703 96 E -8/ DATA ARL1AS(6)/ 0.29524 73555 8 E -9/ DATA ARL1AS(7)/ -0.95107 8318 E -11/ DATA ARL1AS(8)/ 0.28203 667 E -12/ DATA ARL1AS(9)/ -0.11341 75 E -13/ DATA ARL1AS(10)/ 0.147 E -17/ DATA ARL1AS(11)/-0.6232 E -16/ DATA ARL1AS(12)/-0.751 E -17/ DATA ARL1AS(13)/-0.17 E -18/ DATA ARL1AS(14)/ 0.51 E -18/ DATA ARL1AS(15)/ 0.23 E -18/ DATA ARL1AS(16)/ 0.5 E -19/ DATA AI1ML1(0)/ 1.99679 36189 67891 36501 E 0/ DATA AI1ML1(1)/ -0.19066 32614 09686 132 E -2/ DATA AI1ML1(2)/ -0.36094 62241 01744 81 E -3/ DATA AI1ML1(3)/ -0.68418 47304 59982 0 E -4/ DATA AI1ML1(4)/ -0.12990 08228 50942 6 E -4/ DATA AI1ML1(5)/ -0.24715 21887 05765 E -5/ DATA AI1ML1(6)/ -0.47147 83969 1972 E -6/ DATA AI1ML1(7)/ -0.90208 19982 592 E -7/ DATA AI1ML1(8)/ -0.17304 58637 504 E -7/ DATA AI1ML1(9)/ -0.33232 36701 59 E -8/ DATA AI1ML1(10)/-0.63736 42173 5 E -9/ DATA AI1ML1(11)/-0.12180 23975 6 E -9/ DATA AI1ML1(12)/-0.23173 46832 E -10/ DATA AI1ML1(13)/-0.43906 8833 E -11/ DATA AI1ML1(14)/-0.82847 110 E -12/ DATA AI1ML1(15)/-0.15562 249 E -12/ DATA AI1ML1(16)/-0.29131 12 E -13/ DATA AI1ML1(17)/-0.54396 5 E -14/ DATA AI1ML1(18)/-0.10117 7 E -14/ DATA AI1ML1(19)/-0.18767 E -15/ DATA AI1ML1(20)/-0.3484 E -16/ DATA AI1ML1(21)/-0.643 E -17/ DATA AI1ML1(22)/-0.118 E -17/ DATA AI1ML1(23)/-0.22 E -18/ DATA AI1ML1(24)/-0.4 E -19/ DATA AI1ML1(25)/-0.1 E -19/ C C START CALCULATION C X = ABS ( XVALUE ) C C Compute the machine-dependent constants. C TEST = R1MACH(3) T = TEST / ONEHUN IF ( X .LE. SIXTEN ) THEN DO 10 NTERM1 = 26 , 0 , -1 IF ( ABS(ARL1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT ( THIRTY * TEST / TWO ) XLOW2 = SQRT ( (FOUR + ONE) * R1MACH(1) ) ELSE DO 40 NTERM2 = 16 , 0 , -1 IF ( ABS(ARL1AS(NTERM2)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM3 = 25 , 0 , -1 IF ( ABS(AI1ML1(NTERM3)) .GT. T ) GOTO 59 50 CONTINUE 59 XMAX = R1MACH(2) XHIGH2 = THIRTY / TEST XHIGH1 = SQRT ( XHIGH2 ) ENDIF C C CODE FOR |XVALUE| <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LE. XLOW2 ) THEN STRVL1 = ZERO ELSE XSQ = X * X IF ( X .LT. XLOW1 ) THEN STRVL1 = XSQ / PI3BY2 ELSE T = ( FOUR * X - TWENT4 ) / ( X + TWENT4 ) STRVL1 = XSQ * CHEVAL(NTERM1,ARL1,T) * EXP(X) / PI3BY2 ENDIF ENDIF ELSE C C CODE FOR |XVALUE| > 16 C IF ( X .GT. XHIGH2 ) THEN CH1 = ONE ELSE T = ( X - THIRTY ) / ( TWO - X ) CH1 = CHEVAL(NTERM2,ARL1AS,T) ENDIF IF ( X .GT. XHIGH1 ) THEN CH2 = ONE ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) CH2 = CHEVAL(NTERM3,AI1ML1,T) ENDIF TEST = LOG(CH1) - LNR2PI - LOG(X)/TWO + X IF ( TEST .GT. LOG(XMAX) ) THEN CALL ERRPRN(FNNAME,ERRMSG) STRVL1 = XMAX ELSE STRVL1 = EXP(TEST) - TWOBPI * CH2 ENDIF ENDIF RETURN END REAL FUNCTION SYNCH1(XVALUE) C C DESCRIPTION: C C This function calculates the synchrotron radiation function C defined as C C SYNCH1(x) = x * Integral{x to inf} K(5/3)(t) dt, C C where K(5/3) is a modified Bessel function of order 5/3. C C The code uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C C ERROR RETURNS: C C The function is undefined if x < 0.0. If XVALUE < 0.0, C an error message is printed and the function returns C the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms needed from the array C ASYNC1. The recommended value is such that C ABS(ASYNC1(NTERM1)) < EPS/100. C C NTERM2 - INTEGER - The no. of terms needed from the array C ASYNC2. The recommended value is such that C ABS(ASYNC2(NTERM2)) < EPS/100. C C NTERM3 - INTEGER - The no. of terms needed from the array C ASYNCA. The recommended value is such that C ABS(ASYNCA(NTERM3)) < EPS/100. C C XLOW - REAL - The value below which C SYNCH1(x) = 2.14952.. * (x**(1/3)) C to machine precision. The recommended value C is sqrt (8*EPSNEG) C C XHIGH1 - REAL - The value above which C SYNCH1(x) = 0.0 C to machine precision. The recommended value C is -8*LN(XMIN)/7 C C XHIGH2 - REAL - The value of LN(XMIN). This is used C to prevent underflow in calculations C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. For double-precision functions C R1MACH should be replaced by D1MACH. C C For IEEE arithmetic machines, the precise values of the C constants are given in DATA statements. Thus the section C computing these constants can be removed and the DATA C statements un-commented. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: C 16 June, 1995 C INTEGER NTERM1,NTERM2,NTERM3 REAL ASYNC1(0:13),ASYNC2(0:11),ASYNCA(0:24), 1 CHEB1,CHEB2,CHEVAL,CONLOW,EIGHT,FOUR,HALF, 2 LNRTP2,ONE,ONEHUN,PIBRT3,T,THREE,TWELVE,X,XHIGH1, 3 XHIGH2,XLOW,XPOWTH,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'SYNCH1'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA THREE,FOUR/ 3.0 E 0 , 4.0 E 0 / DATA EIGHT,TWELVE/ 8.0 E 0 , 12.0 E 0 / DATA ONEHUN/ 100.0 E 0 / DATA CONLOW/2.14952 82415 34478 63671 E 0/ DATA PIBRT3/1.81379 93642 34217 85059 E 0/ DATA LNRTP2/0.22579 13526 44727 43236 E 0/ DATA ASYNC1/30.36468 29825 01076 27340 E 0, 1 17.07939 52774 08394 57449 E 0, 2 4.56013 21335 45072 88887 E 0, 3 0.54928 12467 30419 97963 E 0, 4 0.37297 60750 69301 1724 E -1, 5 0.16136 24302 01041 242 E -2, 6 0.48191 67721 20370 7 E -4, 7 0.10512 42528 89384 E -5, 8 0.17463 85046 697 E -7, 9 0.22815 48654 4 E -9, X 0.24044 3082 E -11, 1 0.20865 88 E -13, 2 0.15167 E -15, 3 0.94 E -18/ DATA ASYNC2/0.44907 21623 53266 08443 E 0, 1 0.89835 36779 94187 2179 E -1, 2 0.81044 57377 21512 894 E -2, 3 0.42617 16991 08916 19 E -3, 4 0.14760 96312 70746 0 E -4, 5 0.36286 33615 3998 E -6, 6 0.66634 80749 84 E -8, 7 0.94907 71655 E -10, 8 0.10791 2491 E -11, 9 0.10022 01 E -13, X 0.7745 E -16, 1 0.51 E -18/ DATA ASYNCA(0)/ 2.13293 05161 35500 09848 E 0/ DATA ASYNCA(1)/ 0.74135 28649 54200 2401 E -1/ DATA ASYNCA(2)/ 0.86968 09990 99641 978 E -2/ DATA ASYNCA(3)/ 0.11703 82624 87756 921 E -2/ DATA ASYNCA(4)/ 0.16451 05798 61919 15 E -3/ DATA ASYNCA(5)/ 0.24020 10214 20640 3 E -4/ DATA ASYNCA(6)/ 0.35827 75638 93885 E -5/ DATA ASYNCA(7)/ 0.54477 47626 9837 E -6/ DATA ASYNCA(8)/ 0.83880 28561 957 E -7/ DATA ASYNCA(9)/ 0.13069 88268 416 E -7/ DATA ASYNCA(10)/0.20530 99071 44 E -8/ DATA ASYNCA(11)/0.32518 75368 8 E -9/ DATA ASYNCA(12)/0.51791 40412 E -10/ DATA ASYNCA(13)/0.83002 9881 E -11/ DATA ASYNCA(14)/0.13352 7277 E -11/ DATA ASYNCA(15)/0.21591 498 E -12/ DATA ASYNCA(16)/0.34996 73 E -13/ DATA ASYNCA(17)/0.56994 2 E -14/ DATA ASYNCA(18)/0.92906 E -15/ DATA ASYNCA(19)/0.15222 E -15/ DATA ASYNCA(20)/0.2491 E -16/ DATA ASYNCA(21)/0.411 E -17/ DATA ASYNCA(22)/0.67 E -18/ DATA ASYNCA(23)/0.11 E -18/ DATA ASYNCA(24)/0.2 E -19/ CIEEE CIEEE Machine-dependent constants (suitable for IEEE machines) CIEEE CIEEE DATA NTERM1,NTERM2,NTERM3/9,7,11/ CIEEE DATA XLOW,XHIGH1,XHIGH2/6.905E-4,99.809E0,-87.3327E0/ CIEEE C C Start calculation C X = XVALUE IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) SYNCH1 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. For IEEE machines C this section can be removed and the DATA statement values C given above used. C CHEB1 = R1MACH(3) T = CHEB1 / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERM1 = 13 , 0 , -1 IF ( ABS(ASYNC1(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 11 , 0 , -1 IF ( ABS(ASYNC2(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 XLOW = SQRT ( EIGHT * CHEB1 ) ELSE DO 40 NTERM3 = 24 , 0 , -1 IF ( ABS(ASYNCA(NTERM3)) .GT. T ) GOTO 49 40 CONTINUE 49 XHIGH2 = LOG(R1MACH(1)) XHIGH1 = -EIGHT * XHIGH2 / ( EIGHT - ONE ) ENDIF C C Code for 0 <= x <= 4 C IF ( X .LE. FOUR ) THEN XPOWTH = X ** ( ONE / THREE ) IF ( X .LT. XLOW ) THEN SYNCH1 = CONLOW * XPOWTH ELSE T = ( X * X / EIGHT - HALF ) - HALF CHEB1 = CHEVAL(NTERM1,ASYNC1,T) CHEB2 = CHEVAL(NTERM2,ASYNC2,T) T = XPOWTH * CHEB1 - ( XPOWTH**11 ) * CHEB2 SYNCH1 = T - PIBRT3 * X ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN SYNCH1 = ZERO ELSE T = ( TWELVE - X ) / ( X + FOUR ) CHEB1 = CHEVAL(NTERM3,ASYNCA,T) T = LNRTP2 - X + LOG( SQRT(X) * CHEB1 ) IF ( T .LT. XHIGH2 ) THEN SYNCH1 = ZERO ELSE SYNCH1 = EXP(T) ENDIF ENDIF ENDIF RETURN END REAL FUNCTION SYNCH2(XVALUE) C C DESCRIPTION: C C This function calculates the synchrotron radiation function C defined as C C SYNCH2(x) = x * K(2/3)(x) C C where K(2/3) is a modified Bessel function of order 2/3. C C The code uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C C ERROR RETURNS: C C The function is undefined if x < 0.0. If XVALUE < 0.0, C an error message is printed and the function returns C the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms needed from the array C ASYNC1. The recommended value is such that C ABS(ASYN21(NTERM1)) < EPS/100. C C NTERM2 - INTEGER - The no. of terms needed from the array C ASYNC2. The recommended value is such that C ABS(ASYN22(NTERM2)) < EPS/100. C C NTERM3 - INTEGER - The no. of terms needed from the array C ASYNCA. The recommended value is such that C ABS(ASYN2A(NTERM3)) < EPS/100. C C XLOW - REAL - The value below which C SYNCH2(x) = 1.074764... * (x**(1/3)) C to machine precision. The recommended value C is sqrt (8*EPSNEG) C C XHIGH1 - REAL - The value above which C SYNCH2(x) = 0.0 C to machine precision. The recommended value C is -8*LN(XMIN)/7 C C XHIGH2 - REAL - The value of LN(XMIN). This is used C to prevent underflow in calculations C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. For double-precision functions C R1MACH should be replaced by D1MACH. C C For IEEE arithmetic machines, the precise values of the C constants are given in DATA statements. Thus the section C computing these constants can be removed and the DATA C statements un-commented. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST UPDATE: C 16 June, 1995 C INTEGER NTERM1,NTERM2,NTERM3 REAL ASYN21(0:14),ASYN22(0:13),ASYN2A(0:18), 1 CHEB1,CHEB2,CHEVAL,CONLOW,EIGHT,FOUR,HALF, 2 LNRTP2,ONE,ONEHUN,T,TEN,THREE,TWO,X,XHIGH1, 3 XHIGH2,XLOW,XPOWTH,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'SYNCH2'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA TWO,THREE,FOUR/ 2.0 E 0 , 3.0 E 0 , 4.0 E 0 / DATA EIGHT,TEN,ONEHUN/ 8.0 E 0 , 10.0 E 0 , 100.0 E 0/ DATA CONLOW/1.07476 41207 67239 31836 E 0/ DATA LNRTP2/0.22579 13526 44727 43236 E 0/ DATA ASYN21/38.61783 99238 43085 48014 E 0, 1 23.03771 55949 63734 59697 E 0, 2 5.38024 99868 33570 59676 E 0, 3 0.61567 93806 99571 07760 E 0, 4 0.40668 80046 68895 5843 E -1, 5 0.17296 27455 26484 141 E -2, 6 0.51061 25883 65769 9 E -4, 7 0.11045 95950 22012 E -5, 8 0.18235 53020 649 E -7, 9 0.23707 69803 4 E -9, X 0.24887 2963 E -11, 1 0.21528 68 E -13, 2 0.15607 E -15, 3 0.96 E -18, 4 0.1 E -19/ DATA ASYN22/7.90631 48270 66080 42875 E 0, 1 3.13534 63612 85342 56841 E 0, 2 0.48548 79477 45371 45380 E 0, 3 0.39481 66758 27237 2337 E -1, 4 0.19661 62233 48088 022 E -2, 5 0.65907 89322 93042 0 E -4, 6 0.15857 56134 98559 E -5, 7 0.28686 53011 233 E -7, 8 0.40412 02359 5 E -9, 9 0.45568 4443 E -11, X 0.42045 90 E -13, 1 0.32326 E -15, 2 0.210 E -17, 3 0.1 E -19/ DATA ASYN2A/2.02033 70941 70713 60032 E 0, 1 0.10956 23712 18074 0443 E -1, 2 0.85423 84730 11467 55 E -3, 3 0.72343 02421 32822 2 E -4, 4 0.63124 42796 26992 E -5, 5 0.56481 93141 1744 E -6, 6 0.51283 24801 375 E -7, 7 0.47196 53291 45 E -8, 8 0.43807 44214 3 E -9, 9 0.41026 81493 E -10, X 0.38623 0721 E -11, 1 0.36613 228 E -12, 2 0.34802 32 E -13, 3 0.33301 0 E -14, 4 0.31856 E -15, 5 0.3074 E -16, 6 0.295 E -17, 7 0.29 E -18, 8 0.3 E -19/ CIEEE CIEEE Machine-dependent constants (suitable for IEEE machines) CIEEE CIEEE DATA NTERM1,NTERM2,NTERM3/9,8,8/ CIEEE DATA XLOW,XHIGH1,XHIGH2/6.905E-4,99.809E0,-87.3327E0/ CIEEE C C Start calculation C X = XVALUE IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) SYNCH2 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. For IEEE machines C this section can be removed and the DATA statement values C given above used. C CHEB1 = R1MACH(3) T = CHEB1 / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERM1 = 14 , 0 , -1 IF ( ABS(ASYN21(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 13 , 0 , -1 IF ( ABS(ASYN22(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 XLOW = SQRT ( EIGHT * CHEB1 ) ELSE DO 40 NTERM3 = 18 , 0 , -1 IF ( ABS(ASYN2A(NTERM3)) .GT. T ) GOTO 49 40 CONTINUE 49 XHIGH2 = LOG(R1MACH(1)) XHIGH1 = -EIGHT * XHIGH2 / ( EIGHT - ONE ) ENDIF C C Code for 0 <= x <= 4 C IF ( X .LE. FOUR ) THEN XPOWTH = X ** ( ONE / THREE ) IF ( X .LT. XLOW ) THEN SYNCH2 = CONLOW * XPOWTH ELSE T = ( X * X / EIGHT - HALF ) - HALF CHEB1 = CHEVAL(NTERM1,ASYN21,T) CHEB2 = CHEVAL(NTERM2,ASYN22,T) SYNCH2 = XPOWTH * CHEB1 - ( XPOWTH**5 ) * CHEB2 ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN SYNCH2 = ZERO ELSE T = ( TEN - X ) / ( X + TWO ) CHEB1 = CHEVAL(NTERM3,ASYN2A,T) T = LNRTP2 - X + LOG( SQRT(X) * CHEB1 ) IF ( T .LT. XHIGH2 ) THEN SYNCH2 = ZERO ELSE SYNCH2 = EXP(T) ENDIF ENDIF ENDIF RETURN END REAL FUNCTION TRAN02(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 2, defined as C C TRAN02(X) = integral 0 to X { t**2 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW1 - REAL - The value below which TRAN02 = x to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large x contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN02 = VALINF - x**2 exp(-x) C The recommended value is 2/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. For double-precision functions C R1MACH should be replaced by D1MACH. C C For IEEE arithmetic machines, the precise values of the C constants are given in DATA statements. Thus the section C computing these constants can be removed and the DATA C statements un-commented. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN02'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 2 , 2.0 E 0 / DATA VALINF/0.32898 68133 69645 28729 E 1/ DATA ATRAN/1.67176 04464 34538 50301 E 0, 1 -0.14773 53599 46794 48986 E 0, 2 0.14821 38199 46936 3384 E -1, 3 -0.14195 33032 63056 126 E -2, 4 0.13065 41324 41570 83 E -3, 5 -0.11715 57958 67579 0 E -4, 6 0.10333 49844 57557 E -5, 7 -0.90191 13042 227 E -7, 8 0.78177 16983 31 E -8, 9 -0.67445 65684 0 E -9, X 0.57994 63945 E -10, 1 -0.49747 6185 E -11, 2 0.42596 097 E -12, 3 -0.36421 89 E -13, 4 0.31108 6 E -14, 5 -0.26547 E -15, 6 0.2264 E -16, 7 -0.193 E -17, 8 0.16 E -18, 9 -0.1 E -19/ CIEEE CIEEE Machine-dependent constants CIEEE CIEEE DATA NTERMS/9/ CIEEE DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ CIEEE DATA XHIGH2/1.681E7/ CIEEE C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN02 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. For IEEE machines C this section can be removed and the DATA statement values C given above used. C XK = R1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) ELSE XHIGH1 = - LOG(R1MACH(4)) XHIGH2 = ONE / (HALF * XK) XHIGH3 = LOG(XK) ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW1 ) THEN TRAN02 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN02 = ( X ** ( NUMJN - 1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP(-X) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. XHIGH3 ) THEN TRAN02 = VALINF ELSE TRAN02 = VALINF - EXP(T) ENDIF ENDIF RETURN END REAL FUNCTION TRAN03(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 3, defined as C C TRAN03(X) = integral 0 to X { t**3 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - REAL - The value below which TRAN03 = 0.0 to machine C precision. The recommended value is C square root of (2*XMIN) C C XLOW1 - REAL - The value below which TRAN03 = X**2/2 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN03 = VALINF - X**3 exp(-X) C The recommended value is 3/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. For double-precision functions C R1MACH should be replaced by D1MACH. C C For IEEE arithmetic machines, the precise values of the C constants are given in DATA statements. Thus the section C computing these constants can be removed and the DATA C statements un-commented. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN03'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 3 , 3.0 E 0 / DATA VALINF/0.72123 41418 95756 57124 E 1/ DATA ATRAN/0.76201 25432 43872 00657 E 0, 1 -0.10567 43877 05058 53250 E 0, 2 0.11977 80848 19657 8097 E -1, 3 -0.12144 01520 36983 073 E -2, 4 0.11550 99769 39285 47 E -3, 5 -0.10581 59921 24422 9 E -4, 6 0.94746 63385 3018 E -6, 7 -0.83622 12128 581 E -7, 8 0.73109 09927 75 E -8, 9 -0.63505 94778 8 E -9, X 0.54911 82819 E -10, 1 -0.47321 3954 E -11, 2 0.40676 948 E -12, 3 -0.34897 06 E -13, 4 0.29892 3 E -14, 5 -0.25574 E -15, 6 0.2186 E -16, 7 -0.187 E -17, 8 0.16 E -18, 9 -0.1 E -19/ CIEEE CIEEE Machine-dependent constants CIEEE CIEEE DATA NTERMS/9/ CIEEE DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ CIEEE DATA XLOW2,XHIGH2/1.54E-19,2.521E7/ CIEEE C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN03 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. For IEEE machines C this section can be removed and the DATA statement values C given above used. C XK = R1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) XLOW2 = SQRT( R1MACH(1) / HALF ) ELSE XHIGH1 = - LOG(R1MACH(4)) XHIGH2 = RNUMJN / XK XHIGH3 = LOG(XK) ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN03 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN03 = ( X**(NUMJN-1) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X*X ) / EIGHT ) - HALF ) - HALF TRAN03 = ( X**(NUMJN-1) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT(XHIGH1/X) + 1 T = EXP(-X) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. XHIGH3 ) THEN TRAN03 = VALINF ELSE TRAN03 = VALINF - EXP(T) ENDIF ENDIF RETURN END REAL FUNCTION TRAN04(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 4, defined as C C TRAN04(X) = integral 0 to X { t**4 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - REAL - The value below which TRAN04 = 0.0 to machine C precision. The recommended value is C cube root of (3*XMIN) C C XLOW1 - REAL - The value below which TRAN04 = X**3/3 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN04 = VALINF - X**4 exp(-X) C The recommended value is 4/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. For double-precision functions C R1MACH should be replaced by D1MACH. C C For IEEE arithmetic machines, the precise values of the C constants are given in DATA statements. Thus the section C computing these constants can be removed and the DATA C statements un-commented. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN04'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 4 , 4.0 E 0 / DATA VALINF/0.25975 75760 90673 16596 E 2/ DATA ATRAN/0.48075 70994 61511 05786 E 0, 1 -0.81753 78810 32108 3956 E -1, 2 0.10027 00665 97516 2973 E -1, 3 -0.10599 33935 98201 507 E -2, 4 0.10345 06245 03040 53 E -3, 5 -0.96442 70548 58991 E -5, 6 0.87455 44408 5147 E -6, 7 -0.77932 12079 811 E -7, 8 0.68649 88614 10 E -8, 9 -0.59995 71076 4 E -9, X 0.52136 62413 E -10, 1 -0.45118 3819 E -11, 2 0.38921 592 E -12, 3 -0.33493 60 E -13, 4 0.28766 7 E -14, 5 -0.24668 E -15, 6 0.2113 E -16, 7 -0.181 E -17, 8 0.15 E -18, 9 -0.1 E -19/ CIEEE CIEEE Machine-dependent constants CIEEE CIEEE DATA NTERMS/9/ CIEEE DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ CIEEE DATA XLOW2,XHIGH2/3.2835E-13,3.36E7/ CIEEE C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN04 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. For IEEE machines C this section can be removed and the DATA statement values C given above used. C XK = R1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) XK1 = RNUMJN - ONE XLOW2 = ( XK1 * R1MACH(1) ) ** (ONE/XK1) ELSE XHIGH1 = - LOG(R1MACH(4)) XHIGH2 = RNUMJN / XK XHIGH3 = LOG(XK) ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN04 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN04 = ( X ** ( NUMJN-1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN04 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP ( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE/ ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN04 = VALINF ELSE TRAN04 = VALINF - EXP( T ) ENDIF ENDIF RETURN END REAL FUNCTION TRAN05(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order n, defined as C C TRAN05(X) = integral 0 to X { t**5 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - REAL - The value below which TRAN05 = 0.0 to machine C precision. The recommended value is C 4th root of (4*XMIN) C C XLOW1 - REAL - The value below which TRAN05 = X**4/4 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN05 = VALINF - X**5 exp(-X) C The recommended value is 5/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. For double-precision functions C R1MACH should be replaced by D1MACH. C C For IEEE arithmetic machines, the precise values of the C constants are given in DATA statements. Thus the section C computing these constants can be removed and the DATA C statements un-commented. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN05'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 5 , 5.0 E 0 / DATA VALINF/0.12443 13306 17204 39116 E 3/ DATA ATRAN/0.34777 77771 33910 78928 E 0, 1 -0.66456 98897 60504 2801 E -1, 2 0.86110 72656 88330 882 E -2, 3 -0.93966 82223 75553 84 E -3, 4 0.93632 48060 81513 4 E -4, 5 -0.88571 31934 08328 E -5, 6 0.81191 49891 4503 E -6, 7 -0.72957 65423 277 E -7, 8 0.64697 14550 45 E -8, 9 -0.56849 02825 5 E -9, X 0.49625 59787 E -10, 1 -0.43109 3996 E -11, 2 0.37310 094 E -12, 3 -0.32197 69 E -13, 4 0.27722 0 E -14, 5 -0.23824 E -15, 6 0.2044 E -16, 7 -0.175 E -17, 8 0.15 E -18, 9 -0.1 E -19/ CIEEE CIEEE Machine-dependent constants CIEEE CIEEE DATA NTERMS/9/ CIEEE DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ CIEEE DATA XLOW2,XHIGH2/4.6611E-10,4.202E7/ CIEEE C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN05 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. For IEEE machines C this section can be removed and the DATA statement values C given above used. C XK = R1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) XK1 = RNUMJN - ONE XLOW2 = ( XK1 * R1MACH(1) ) ** (ONE/XK1) ELSE XHIGH1 = - LOG(R1MACH(4)) XHIGH2 = RNUMJN / XK XHIGH3 = LOG(XK) ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN05 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN05 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN05 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP ( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG ( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN05 = VALINF ELSE TRAN05 = VALINF - EXP( T ) ENDIF ENDIF RETURN END REAL FUNCTION TRAN06(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 6, defined as C C TRAN06(X) = integral 0 to X { t**6 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - REAL - The value below which TRAN06 = 0.0 to machine C precision. The recommended value is C 5th root of (5*XMIN) C C XLOW1 - REAL - The value below which TRAN06 = X**5/5 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN06 = VALINF - X**6 exp(-X) C The recommended value is 6/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. For double-precision functions C R1MACH should be replaced by D1MACH. C C For IEEE arithmetic machines, the precise values of the C constants are given in DATA statements. Thus the section C computing these constants can be removed and the DATA C statements un-commented. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN06'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 6 , 6.0 E 0 / DATA VALINF/0.73248 70046 28803 38059 E 3/ DATA ATRAN/0.27127 33539 78400 08227 E 0, 1 -0.55886 10553 19145 3393 E -1, 2 0.75391 95132 90083 056 E -2, 3 -0.84351 13857 92112 19 E -3, 4 0.85490 98079 67670 2 E -4, 5 -0.81871 54932 93098 E -5, 6 0.75754 24042 7986 E -6, 7 -0.68573 06541 831 E -7, 8 0.61170 03760 31 E -8, 9 -0.54012 70702 4 E -9, X 0.47343 06435 E -10, 1 -0.41270 1055 E -11, 2 0.35825 603 E -12, 3 -0.30997 52 E -13, 4 0.26750 1 E -14, 5 -0.23036 E -15, 6 0.1980 E -16, 7 -0.170 E -17, 8 0.15 E -18, 9 -0.1 E -19/ CIEEE CIEEE Machine-dependent constants CIEEE CIEEE DATA NTERMS/9/ CIEEE DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ CIEEE DATA XLOW2,XHIGH2/3.5824E-8,5.042E7/ CIEEE C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN06 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. For IEEE machines C this section can be removed and the DATA statement values C given above used. C XK = R1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) XK1 = RNUMJN - ONE XLOW2 = ( XK1 * R1MACH(1) ) ** (ONE/XK1) ELSE XHIGH1 = - LOG(R1MACH(4)) XHIGH2 = RNUMJN / XK XHIGH3 = LOG(XK) ENDIF C C Code for x < = 4 .0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN06 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN06 = ( X ** ( NUMJN-1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN06 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4 .0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP( - X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN06 = VALINF ELSE TRAN06 = VALINF - EXP( T ) ENDIF ENDIF RETURN END REAL FUNCTION TRAN07(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 7, defined as C C TRAN07(X) = integral 0 to X { t**7 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - REAL - The value below which TRAN07 = 0.0 to machine C precision. The recommended value is C 6th root of (6*XMIN) C C XLOW1 - REAL - The value below which TRAN07 = X**6/6 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN07 = VALINF - X**7 exp(-X) C The recommended value is 7/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. For double-precision functions C R1MACH should be replaced by D1MACH. C C For IEEE arithmetic machines, the precise values of the C constants are given in DATA statements. Thus the section C computing these constants can be removed and the DATA C statements un-commented. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN07'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 7 , 7.0 E 0/ DATA VALINF/0.50820 80358 00489 10473 E 4/ DATA ATRAN/0.22189 25073 40104 04423 E 0, 1 -0.48167 51061 17799 3694 E -1, 2 0.67009 24481 03153 629 E -2, 3 -0.76495 18344 30825 57 E -3, 4 0.78634 85592 34869 0 E -4, 5 -0.76102 51808 87504 E -5, 6 0.70991 69629 9917 E -6, 7 -0.64680 25624 903 E -7, 8 0.58003 92339 60 E -8, 9 -0.51443 37014 9 E -9, X 0.45259 44183 E -10, 1 -0.39580 0363 E -11, 2 0.34453 785 E -12, 3 -0.29882 92 E -13, 4 0.25843 4 E -14, 5 -0.22297 E -15, 6 0.1920 E -16, 7 -0.165 E -17, 8 0.14 E -18, 9 -0.1 E -19/ CIEEE CIEEE Machine-dependent constants CIEEE CIEEE DATA NTERMS/9/ CIEEE DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ CIEEE DATA XLOW2,XHIGH2/6.432E-7,5.882E7/ CIEEE C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN07 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. For IEEE machines C this section can be removed and the DATA statement values C given above used. C XK = R1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) XK1 = RNUMJN - ONE XLOW2 = ( XK1 * R1MACH(1) ) ** (ONE/XK1) ELSE XHIGH1 = - LOG(R1MACH(4)) XHIGH2 = RNUMJN / XK XHIGH3 = LOG(XK) ENDIF C C Code for x <= 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN07 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN07 = ( X**(NUMJN-1) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X*X ) / EIGHT ) - HALF ) - HALF TRAN07 = ( X**(NUMJN-1) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1/X ) + 1 T = EXP( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. XHIGH3 ) THEN TRAN07 = VALINF ELSE TRAN07 = VALINF - EXP(T) ENDIF ENDIF RETURN END REAL FUNCTION TRAN08(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 8, defined as C C TRAN08(X) = integral 0 to X { t**8 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - REAL - The value below which TRAN08 = 0.0 to machine C precision. The recommended value is C 7th root of (7*XMIN) C C XLOW1 - REAL - The value below which TRAN08 = X**7/7 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN08 = VALINF - X**8 exp(-X) C The recommended value is 8/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. For double-precision functions C R1MACH should be replaced by D1MACH. C C For IEEE arithmetic machines, the precise values of the C constants are given in DATA statements. Thus the section C computing these constants can be removed and the DATA C statements un-commented. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN08'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 8 , 8.0 E 0 / DATA VALINF/0.40484 39900 19011 15764 E 5/ DATA ATRAN/0.18750 69577 40437 19233 E 0, 1 -0.42295 27646 09367 3337 E -1, 2 0.60281 48569 29065 592 E -2, 3 -0.69961 05481 18147 76 E -3, 4 0.72784 82421 29878 9 E -4, 5 -0.71084 62500 50067 E -5, 6 0.66786 70689 0115 E -6, 7 -0.61201 57501 844 E -7, 8 0.55146 52644 74 E -8, 9 -0.49105 30705 2 E -9, X 0.43350 00869 E -10, 1 -0.38021 8700 E -11, 2 0.33182 369 E -12, 3 -0.28845 12 E -13, 4 0.24995 8 E -14, 5 -0.21605 E -15, 6 0.1863 E -16, 7 -0.160 E -17, 8 0.14 E -18, 9 -0.1 E -19/ CIEEE CIEEE Machine-dependent constants CIEEE CIEEE DATA NTERMS/9/ CIEEE DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ CIEEE DATA XLOW2,XHIGH2/5.04E-6,6.723E7/ CIEEE C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN08 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. For IEEE machines C this section can be removed and the DATA statement values C given above used. C XK = R1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) XK1 = RNUMJN - ONE XLOW2 = ( XK1 * R1MACH(1) ) ** (ONE/XK1) ELSE XHIGH1 = - LOG(R1MACH(4)) XHIGH2 = RNUMJN / XK XHIGH3 = LOG(XK) ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN08 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN08 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN08 = ( X ** ( NUMJN - 1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP ( - X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN08 = VALINF ELSE TRAN08 = VALINF - EXP( T ) ENDIF ENDIF RETURN END REAL FUNCTION TRAN09(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 9, defined as C C TRAN09(X) = integral 0 to X { t**9 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - REAL - The value below which TRAN09 = 0.0 to machine C precision. The recommended value is C 8th root of (8*XMIN) C C XLOW1 - REAL - The value below which TRAN09 = X**8/8 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN09 = VALINF - X**9 exp(-X) C The recommended value is 9/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. For double-precision functions C R1MACH should be replaced by D1MACH. C C For IEEE arithmetic machines, the precise values of the C constants are given in DATA statements. Thus the section C computing these constants can be removed and the DATA C statements un-commented. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN09'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 9 , 9.0 E 0 / DATA VALINF/0.36360 88055 88728 71397 E 6/ DATA ATRAN/0.16224 04999 19498 46835 E 0, 1 -0.37683 51452 19593 7773 E -1, 2 0.54766 97159 17719 770 E -2, 3 -0.64443 94500 94495 21 E -3, 4 0.67736 45285 28098 3 E -4, 5 -0.66681 34975 82042 E -5, 6 0.63047 56001 9047 E -6, 7 -0.58074 78663 611 E -7, 8 0.52555 13051 23 E -8, 9 -0.46968 86176 1 E -9, X 0.41593 95065 E -10, 1 -0.36580 8491 E -11, 2 0.32000 794 E -12, 3 -0.27876 51 E -13, 4 0.24201 7 E -14, 5 -0.20953 E -15, 6 0.1810 E -16, 7 -0.156 E -17, 8 0.13 E -18, 9 -0.1 E -19/ CIEEE CIEEE Machine-dependent constants (for IEEE machines) CIEEE CIEEE DATA NTERMS/9/ CIEEE DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ CIEEE DATA XLOW2,XHIGH2/2.3544E-5,7.563E7/ CIEEE C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN09 = ZERO RETURN ENDIF C C Compute the machine-dependent constants. For IEEE machines C this section can be removed and the DATA statement values C given above used. C XK = R1MACH(3) T = XK / ONEHUN IF ( X .LE. FOUR ) THEN DO 10 NTERMS = 19 , 0 , -1 IF ( ABS(ATRAN(NTERMS)) .GT. T ) GOTO 19 10 CONTINUE 19 XLOW1 = SQRT( EIGHT * XK ) XK1 = RNUMJN - ONE XLOW2 = ( XK1 * R1MACH(1) ) ** (ONE/XK1) ELSE XHIGH1 = - LOG(R1MACH(4)) XHIGH2 = RNUMJN / XK XHIGH3 = LOG(XK) ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN09 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN09 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN09 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T.LT.XHIGH3 ) THEN TRAN09 = VALINF ELSE TRAN09 = VALINF - EXP( T ) ENDIF ENDIF RETURN END REAL FUNCTION Y0INT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the Bessel C function Y0, defined as C C Y0INT(x) = {integral 0 to x} Y0(t) dt C C The code uses Chebyshev expansions whose coefficients are C given to 20 decimal places. C C C ERROR RETURNS: C C If x < 0.0, the function is undefined. An error message C is printed and the function returns the value 0.0. C C If the value of x is too large, it is impossible to C accurately compute the trigonometric functions used. An C error message is printed, and the function returns the C value 1.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used from the array C ARJ01. The recommended value is such that C ABS(ARJ01(NTERM1)) < EPS/100 C C NTERM2 - The no. of terms to be used from the array C ARY01. The recommended value is such that C ABS(ARY01(NTERM2)) < EPS/100 C C NTERM3 - The no. of terms to be used from the array C ARY0A1. The recommended value is such that C ABS(ARY0A1(NTERM3)) < EPS/100 C C NTERM4 - The no. of terms to be used from the array C ARY0A2. The recommended value is such that C ABS(ARY0A2(NTERM4)) < EPS/100 C C XLOW - The value of x below which C Y0INT(x) = x*(ln(x) - 0.11593)*2/pi C to machine-precision. The recommended value is C sqrt(9*EPSNEG) C C XHIGH - The value of x above which it is impossible C to calculate (x-pi/4) accurately. The recommended C value is 1/EPSNEG C C For values of EPS and EPSNEG, refer to the file MACHCON.TXT C C The machine-dependent constants are computed internally by C using the R1MACH subroutine. For double-precision functions C R1MACH should be replaced by D1MACH. C C For IEEE arithmetic machines, the precise values of the C constants are given in DATA statements. Thus the section C computing these constants can be removed and the DATA C statements un-commented. C C C INTRINSIC FUNCTIONS USED: C C COS , LOG , SIN , SQRT C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST REVISION: C 19 June, 1995 C INTEGER NTERM1,NTERM2,NTERM3,NTERM4 REAL ARJ01(0:23),ARY01(0:24),ARY0A1(0:21), 1 ARY0A2(0:18),CHEVAL,FIVE12,GAL2M1,GAMLN2, 2 NINE,ONE,ONEHUN,ONE28,PIB41,PIB411,PIB412, 3 PIB42,RT2BPI,SIXTEN,T,TEMP,TWOBPI,X,XHIGH, 4 XLOW,XMPI4,XVALUE,ZERO,R1MACH CHARACTER FNNAME*6,ERMSG1*14,ERMSG2*18 DATA FNNAME/'Y0INT '/ DATA ERMSG1/'ARGUMENT < 0.0'/ DATA ERMSG2/'ARGUMENT TOO LARGE'/ DATA ZERO,ONE/ 0.0 E 0 , 1.0 E 0 / DATA NINE,SIXTEN/ 9.0 E 0 , 16.0 E 0 / DATA ONEHUN,ONE28,FIVE12/ 100.0 E 0 , 128.0 E 0 , 512.0 E 0 / DATA RT2BPI/0.79788 45608 02865 35588 E 0/ DATA PIB411,PIB412/ 201.0 E 0 , 256.0 E 0/ DATA PIB42/0.24191 33974 48309 61566 E -3/ DATA TWOBPI/0.63661 97723 67581 34308 E 0/ DATA GAL2M1/-1.11593 15156 58412 44881 E 0/ DATA GAMLN2/-0.11593 15156 58412 44881 E 0/ DATA ARJ01(0)/ 0.38179 27932 16901 73518 E 0/ DATA ARJ01(1)/ -0.21275 63635 05053 21870 E 0/ DATA ARJ01(2)/ 0.16754 21340 72157 94187 E 0/ DATA ARJ01(3)/ -0.12853 20977 21963 98954 E 0/ DATA ARJ01(4)/ 0.10114 40545 57788 47013 E 0/ DATA ARJ01(5)/ -0.91007 95343 20156 8859 E -1/ DATA ARJ01(6)/ 0.64013 45264 65687 3103 E -1/ DATA ARJ01(7)/ -0.30669 63029 92675 4312 E -1/ DATA ARJ01(8)/ 0.10308 36525 32506 4201 E -1/ DATA ARJ01(9)/ -0.25567 06503 99956 918 E -2/ DATA ARJ01(10)/ 0.48832 75580 57983 04 E -3/ DATA ARJ01(11)/-0.74249 35126 03607 7 E -4/ DATA ARJ01(12)/ 0.92226 05637 30861 E -5/ DATA ARJ01(13)/-0.95522 82830 7083 E -6/ DATA ARJ01(14)/ 0.83883 55845 986 E -7/ DATA ARJ01(15)/-0.63318 44888 58 E -8/ DATA ARJ01(16)/ 0.41560 50422 1 E -9/ DATA ARJ01(17)/-0.23955 29307 E -10/ DATA ARJ01(18)/ 0.12228 6885 E -11/ DATA ARJ01(19)/-0.55697 11 E -13/ DATA ARJ01(20)/ 0.22782 0 E -14/ DATA ARJ01(21)/-0.8417 E -16/ DATA ARJ01(22)/ 0.282 E -17/ DATA ARJ01(23)/-0.9 E -19/ DATA ARY01(0)/ 0.54492 69630 27243 65490 E 0/ DATA ARY01(1)/ -0.14957 32358 86847 82157 E 0/ DATA ARY01(2)/ 0.11085 63448 62548 42337 E 0/ DATA ARY01(3)/ -0.94953 30018 68377 7109 E -1/ DATA ARY01(4)/ 0.68208 17786 99145 6963 E -1/ DATA ARY01(5)/ -0.10324 65338 33682 00408 E 0/ DATA ARY01(6)/ 0.10625 70328 75344 25491 E 0/ DATA ARY01(7)/ -0.62583 67679 96168 1990 E -1/ DATA ARY01(8)/ 0.23856 45760 33829 3285 E -1/ DATA ARY01(9)/ -0.64486 49130 15404 481 E -2/ DATA ARY01(10)/ 0.13128 70828 91002 331 E -2/ DATA ARY01(11)/-0.20988 08817 49896 40 E -3/ DATA ARY01(12)/ 0.27160 42484 13834 7 E -4/ DATA ARY01(13)/-0.29119 91140 14694 E -5/ DATA ARY01(14)/ 0.26344 33309 3795 E -6/ DATA ARY01(15)/-0.20411 72069 780 E -7/ DATA ARY01(16)/ 0.13712 47813 17 E -8/ DATA ARY01(17)/-0.80706 80792 E -10/ DATA ARY01(18)/ 0.41988 3057 E -11/ DATA ARY01(19)/-0.19459 104 E -12/ DATA ARY01(20)/ 0.80878 2 E -14/ DATA ARY01(21)/-0.30329 E -15/ DATA ARY01(22)/ 0.1032 E -16/ DATA ARY01(23)/-0.32 E -18/ DATA ARY01(24)/ 0.1 E -19/ DATA ARY0A1(0)/ 1.24030 13303 75189 70827 E 0/ DATA ARY0A1(1)/ -0.47812 53536 32280 693 E -2/ DATA ARY0A1(2)/ 0.66131 48891 70667 8 E -4/ DATA ARY0A1(3)/ -0.18604 27404 86349 E -5/ DATA ARY0A1(4)/ 0.83627 35565 080 E -7/ DATA ARY0A1(5)/ -0.52585 70367 31 E -8/ DATA ARY0A1(6)/ 0.42606 36325 1 E -9/ DATA ARY0A1(7)/ -0.42117 61024 E -10/ DATA ARY0A1(8)/ 0.48894 6426 E -11/ DATA ARY0A1(9)/ -0.64834 929 E -12/ DATA ARY0A1(10)/ 0.96172 34 E -13/ DATA ARY0A1(11)/-0.15703 67 E -13/ DATA ARY0A1(12)/ 0.27871 2 E -14/ DATA ARY0A1(13)/-0.53222 E -15/ DATA ARY0A1(14)/ 0.10844 E -15/ DATA ARY0A1(15)/-0.2342 E -16/ DATA ARY0A1(16)/ 0.533 E -17/ DATA ARY0A1(17)/-0.127 E -17/ DATA ARY0A1(18)/ 0.32 E -18/ DATA ARY0A1(19)/-0.8 E -19/ DATA ARY0A1(20)/ 0.2 E -19/ DATA ARY0A1(21)/-0.1 E -19/ DATA ARY0A2(0)/ 1.99616 09630 13416 75339 E 0/ DATA ARY0A2(1)/ -0.19037 98192 46668 161 E -2/ DATA ARY0A2(2)/ 0.15397 10927 04422 6 E -4/ DATA ARY0A2(3)/ -0.31145 08832 8103 E -6/ DATA ARY0A2(4)/ 0.11108 50971 321 E -7/ DATA ARY0A2(5)/ -0.58666 78712 3 E -9/ DATA ARY0A2(6)/ 0.41399 26949 E -10/ DATA ARY0A2(7)/ -0.36539 8763 E -11/ DATA ARY0A2(8)/ 0.38557 568 E -12/ DATA ARY0A2(9)/ -0.47098 00 E -13/ DATA ARY0A2(10)/ 0.65022 0 E -14/ DATA ARY0A2(11)/-0.99624 E -15/ DATA ARY0A2(12)/ 0.16700 E -15/ DATA ARY0A2(13)/-0.3028 E -16/ DATA ARY0A2(14)/ 0.589 E -17/ DATA ARY0A2(15)/-0.122 E -17/ DATA ARY0A2(16)/ 0.27 E -18/ DATA ARY0A2(17)/-0.6 E -19/ DATA ARY0A2(18)/ 0.1 E -19/ CIEEE CIEEE Machine-dependent constants (suitable for IEEE machines) CIEEE CIEEE DATA NTERM1,NTERM2,NTERM3,NTERM4/16,16,6,5/ CIEEE DATA XLOW,XHIGH/7.3242E-4,8388608.0E0/ CIEEE C C Start computation C X = XVALUE C C First error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERMSG1) Y0INT = ZERO RETURN ENDIF C C Compute the machine-dependent constants. For IEEE machines C this section can be removed and the DATA statement values C given above used. C TEMP = R1MACH(3) XHIGH = ONE / TEMP C C Second error test ( do NOT remove ) C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERMSG2) Y0INT = ZERO RETURN ENDIF C C continue with machine constants C T = TEMP / ONEHUN IF ( X .LE. SIXTEN ) THEN DO 10 NTERM1 = 23 , 0 , -1 IF ( ABS(ARJ01(NTERM1)) .GT. T ) GOTO 19 10 CONTINUE 19 DO 20 NTERM2 = 24 , 0 , -1 IF ( ABS(ARY01(NTERM2)) .GT. T ) GOTO 29 20 CONTINUE 29 XLOW = SQRT ( NINE * TEMP ) ELSE DO 40 NTERM3 = 21 , 0 , -1 IF ( ABS(ARY0A1(NTERM3)) .GT. T ) GOTO 49 40 CONTINUE 49 DO 50 NTERM4 = 18 , 0 , -1 IF ( ABS(ARY0A2(NTERM4)) .GT. T ) GOTO 59 50 CONTINUE 59 ENDIF C C Code for 0 <= x <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN IF ( X .EQ. ZERO ) THEN Y0INT = ZERO ELSE Y0INT = ( LOG(X) + GAL2M1 ) * TWOBPI * X ENDIF ELSE T = X * X / ONE28 - ONE TEMP = ( LOG(X) + GAMLN2 ) * CHEVAL(NTERM1,ARJ01,T) TEMP = TEMP - CHEVAL(NTERM2,ARY01,T) Y0INT = TWOBPI * X * TEMP ENDIF ELSE C C Code for x > 16 C T = FIVE12 / ( X * X ) - ONE PIB41 = PIB411 / PIB412 XMPI4 = ( X - PIB41 ) - PIB42 TEMP = SIN(XMPI4) * CHEVAL(NTERM3,ARY0A1,T) / X TEMP = TEMP + COS(XMPI4) * CHEVAL(NTERM4,ARY0A2,T) Y0INT = - RT2BPI * TEMP / SQRT(X) ENDIF RETURN END REAL FUNCTION CHEVAL(N,A,T) C C This function evaluates a Chebyshev series, using the C Clenshaw method with Reinsch modification, as analysed C in the paper by Oliver. C C INPUT PARAMETERS C C N - INTEGER - The no. of terms in the sequence C C A - REAL ARRAY, dimension 0 to N - The coefficients of C the Chebyshev series C C T - REAL - The value at which the series is to be C evaluated C C C REFERENCES C C "An error analysis of the modified Clenshaw method for C evaluating Chebyshev and Fourier series" J. Oliver, C J.I.M.A., vol. 20, 1977, pp379-391 C C C MACHINE-DEPENDENT CONSTANTS: NONE C C C INTRINSIC FUNCTIONS USED; C C ABS C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley , C High St., C PAISLEY, C SCOTLAND C C C LATEST MODIFICATION: 21 December , 1992 C C INTEGER I,N REAL A(0:N),D1,D2,HALF,T,TEST,TT,TWO,U0,U1,U2,ZERO DATA ZERO,HALF/ 0.0 E 0 , 0.5 E 0 / DATA TEST,TWO/ 0.6 E 0 , 2.0 E 0 / U1 = ZERO C C If ABS ( T ) < 0.6 use the standard Clenshaw method C IF ( ABS( T ) .LT. TEST ) THEN U0 = ZERO TT = T + T DO 100 I = N , 0 , -1 U2 = U1 U1 = U0 U0 = TT * U1 + A( I ) - U2 100 CONTINUE CHEVAL = ( U0 - U2 ) / TWO ELSE C C If ABS ( T ) > = 0.6 use the Reinsch modification C D1 = ZERO C C T > = 0.6 code C IF ( T .GT. ZERO ) THEN TT = ( T - HALF ) - HALF TT = TT + TT DO 200 I = N , 0 , -1 D2 = D1 U2 = U1 D1 = TT * U2 + A( I ) + D2 U1 = D1 + U2 200 CONTINUE CHEVAL = ( D1 + D2 ) / TWO ELSE C C T < = -0.6 code C TT = ( T + HALF ) + HALF TT = TT + TT DO 300 I = N , 0 , -1 D2 = D1 U2 = U1 D1 = TT * U2 + A( I ) - D2 U1 = D1 - U2 300 CONTINUE CHEVAL = ( D1 - D2 ) / TWO ENDIF ENDIF RETURN END REAL FUNCTION R1MACH(I) C C SINGLE-PRECISION MACHINE CONSTANTS C C R1MACH(1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. C C R1MACH(2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. C C R1MACH(3) = B**(-T), THE SMALLEST RELATIVE SPACING. C C R1MACH(4) = B**(1-T), THE LARGEST RELATIVE SPACING. C C R1MACH(5) = LOG10(B) C C TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, C THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY C REMOVING THE C FROM COLUMN 1. C C WHERE POSSIBLE, OCTAL OR HEXADECIMAL CONSTANTS HAVE BEEN USED C TO SPECIFY THE CONSTANTS EXACTLY WHICH HAS IN SOME CASES C REQUIRED THE USE OF EQUIVALENT INTEGER ARRAYS. C INTEGER I INTEGER SMALL(2) INTEGER LARGE(2) INTEGER RIGHT(2) INTEGER DIVER(2) INTEGER LOG10(2) C REAL RMACH(5) C EQUIVALENCE (RMACH(1),SMALL(1)) EQUIVALENCE (RMACH(2),LARGE(1)) EQUIVALENCE (RMACH(3),RIGHT(1)) EQUIVALENCE (RMACH(4),DIVER(1)) EQUIVALENCE (RMACH(5),LOG10(1)) C C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. C C DATA RMACH(1) / Z400800000 / C DATA RMACH(2) / Z5FFFFFFFF / C DATA RMACH(3) / Z4E9800000 / C DATA RMACH(4) / Z4EA800000 / C DATA RMACH(5) / Z500E730E8 / C C MACHINE CONSTANTS FOR THE BURROUGHS 5700/6700/7700 SYSTEMS. C C DATA RMACH(1) / O1771000000000000 / C DATA RMACH(2) / O0777777777777777 / C DATA RMACH(3) / O1311000000000000 / C DATA RMACH(4) / O1301000000000000 / C DATA RMACH(5) / O1157163034761675 / C C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES. C C DATA RMACH(1) / 00014000000000000000B / C DATA RMACH(2) / 37767777777777777777B / C DATA RMACH(3) / 16404000000000000000B / C DATA RMACH(4) / 16414000000000000000B / C DATA RMACH(5) / 17164642023241175720B / C C MACHINE CONSTANTS FOR THE CRAY 1 C C DATA RMACH(1) / 200004000000000000000B / C DATA RMACH(2) / 577777777777777777777B / C DATA RMACH(3) / 377214000000000000000B / C DATA RMACH(4) / 377224000000000000000B / C DATA RMACH(5) / 377774642023241175720B / C C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 C C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD - C STATIC RMACH(5) C C DATA SMALL/20K,0/,LARGE/77777K,177777K/ C DATA RIGHT/35420K,0/,DIVER/36020K,0/ C DATA LOG10/40423K,42023K/ C C MACHINE CONSTANTS FOR THE HARRIS 220 C C DATA SMALL(1),SMALL(2) / '20000000, '00000201 / C DATA LARGE(1),LARGE(2) / '37777777, '00000177 / C DATA RIGHT(1),RIGHT(2) / '20000000, '00000352 / C DATA DIVER(1),DIVER(2) / '20000000, '00000353 / C DATA LOG10(1),LOG10(2) / '23210115, '00000377 / C C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES. C C DATA RMACH(1) / O402400000000 / C DATA RMACH(2) / O376777777777 / C DATA RMACH(3) / O714400000000 / C DATA RMACH(4) / O716400000000 / C DATA RMACH(5) / O776464202324 / C C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, C THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. C C DATA RMACH(1) / Z00100000 / C DATA RMACH(2) / Z7FFFFFFF / C DATA RMACH(3) / Z3B100000 / C DATA RMACH(4) / Z3C100000 / C DATA RMACH(5) / Z41134413 / C C MACHINE CONSTANTS FOR IEEE MACHINES C DATA SMALL(1)/8388608/ DATA LARGE(1)/2139095039/ DATA RIGHT(1)/864026624/ DATA DIVER(1)/872415232/ DATA LOG10(1)/1050288283/ C C MACHINE CONSTANTS FOR THE PDP-10 (KA OR KI PROCESSOR). C C DATA RMACH(1) / "000400000000 / C DATA RMACH(2) / "377777777777 / C DATA RMACH(3) / "146400000000 / C DATA RMACH(4) / "147400000000 / C DATA RMACH(5) / "177464202324 / C C MACHINE CONSTANTS FOR PDP-11 FORTRAN'S SUPPORTING C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). C C DATA SMALL(1) / 8388608 / C DATA LARGE(1) / 2147483647 / C DATA RIGHT(1) / 880803840 / C DATA DIVER(1) / 889192448 / C DATA LOG10(1) / 1067065499 / C C DATA RMACH(1) / O00040000000 / C DATA RMACH(2) / O17777777777 / C DATA RMACH(3) / O06440000000 / C DATA RMACH(4) / O06500000000 / C DATA RMACH(5) / O07746420233 / C C MACHINE CONSTANTS FOR PDP-11 FORTRAN'S SUPPORTING C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). C C DATA SMALL(1),SMALL(2) / 128, 0 / C DATA LARGE(1),LARGE(2) / 32767, -1 / C DATA RIGHT(1),RIGHT(2) / 13440, 0 / C DATA DIVER(1),DIVER(2) / 13568, 0 / C DATA LOG10(1),LOG10(2) / 16282, 8347 / C C DATA SMALL(1),SMALL(2) / O000200, O000000 / C DATA LARGE(1),LARGE(2) / O077777, O177777 / C DATA RIGHT(1),RIGHT(2) / O032200, O000000 / C DATA DIVER(1),DIVER(2) / O032400, O000000 / C DATA LOG10(1),LOG10(2) / O037632, O020233 / C C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. C C DATA RMACH(1) / O000400000000 / C DATA RMACH(2) / O377777777777 / C DATA RMACH(3) / O146400000000 / C DATA RMACH(4) / O147400000000 / C DATA RMACH(5) / O177464202324 / C C IF (I .LT. 1 .OR. I .GT. 5) C 1 CALL SETERR(24HR1MACH - I OUT OF BOUNDS,24,1,2) C R1MACH = RMACH(I) RETURN C END SUBROUTINE ERRPRN(FNNAME,ERRMSG) C C DESCRIPTION: C This subroutine prints out an error message if C an error has occurred in one of the MISCFUN C functions. C C C INPUT PARAMETERS: C C FNNAME - CHARACTER - The name of the function with the error. C C ERRMSG - CHARACTER - The message to be printed out. C C C MACHINE-DEPENDENT PARAMETER: C C OUTSTR - INTEGER - The numerical value of the output C stream to be used for printing the C error message. The subroutine has the C default value OUTSTR = 6. C C C AUTHOR: C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 2 JUNE, 1995 C INTEGER OUTSTR CHARACTER FNNAME*6,ERRMSG*(*) DATA OUTSTR/6/ WRITE(OUTSTR,1000)FNNAME WRITE(OUTSTR,2000)ERRMSG 1000 FORMAT(/5X,'ERROR IN MISCFUN FUNCTION ',A6) 2000 FORMAT(/5X,A50) RETURN END SHAR_EOF fi # end of overwriting check if test -f 'src_ieee.f' then echo shar: will not over-write existing file "'src_ieee.f'" else cat << \SHAR_EOF > 'src_ieee.f' REAL FUNCTION ABRAM0(XVALUE) C C DESCRIPTION: C This function calculates the Abramowitz function of order 0, C defined as C C ABRAM0(x) = integral{ 0 to infinity } exp( -t*t - x/t ) dt C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C ERROR RETURNS: C If XVALUE < 0.0, the function prints a message and returns the C value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMF - INTEGER - No. of terms needed for the array AB0F. C Recommended value such that C ABS( AB0F(NTERMF) ) < EPS/100 C C NTERMG - INTEGER - No. of terms needed for array AB0G. C Recommended value such that C ABS( AB0G(NTERMG) ) < EPS/100 C C NTERMH - INTEGER - No. of terms needed for array AB0H. C Recommended value such that C ABS( AB0H(NTERMH) ) < EPS/100 C C NTERMA - INTEGER - No. of terms needed for array AB0AS. C Recommended value such that C ABS( AB0AS(NTERMA) ) < EPS/100 C C XLOW1 - REAL - The value below which C ABRAM0 = root(pi)/2 + X ( ln X - GVAL0 ) C Recommended value is SQRT(2*EPSNEG) C C LNXMIN - REAL - The value of ln XMIN. Used to prevent C exponential underflow for large X. C C For values of EPS, EPSNEG, XMIN refer to the file MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C LOG, EXP, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 7 JUNE, 1995 C C INTEGER NTERMA,NTERMF,NTERMG,NTERMH REAL AB0F(0:8),AB0G(0:8),AB0H(0:8),AB0AS(0:27), & ASLN,ASVAL,CHEVAL,FVAL,GVAL,GVAL0,HALF,HVAL, & LNXMIN,ONEHUN,ONERPI,RTPIB2,RT3BPI,SIX,T, & THREE,TWO,V,X,XLOW1,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*33 DATA FNNAME/'ABRAM0'/ DATA ERRMSG/'FUNCTION CALLED WITH ARGUMENT < 0'/ DATA AB0F/-0.68121 92709 35494 69816 E 0, 1 -0.78867 91981 61492 52495 E 0, 2 0.51215 81776 81881 9543 E -1, 3 -0.71092 35289 45412 96 E -3, 4 0.36868 18085 04287 E -5, 5 -0.91783 23372 37 E -8, 6 0.12702 02563 E -10, 7 -0.10768 88 E -13, 8 0.599 E -17/ DATA AB0G/-0.60506 03943 08682 73190 E 0, 1 -0.41950 39816 32017 79803 E 0, 2 0.17032 65125 19037 0333 E -1, 3 -0.16938 91784 24913 97 E -3, 4 0.67638 08951 9710 E -6, 5 -0.13572 36362 55 E -8, 6 0.15629 7065 E -11, 7 -0.11288 7 E -14, 8 0.55 E -18/ DATA AB0H/1.38202 65523 05749 89705 E 0, 1 -0.30097 92907 39749 04355 E 0, 2 0.79428 88093 64887 241 E -2, 3 -0.64319 10276 84756 3 E -4, 4 0.22549 83068 4374 E -6, 5 -0.41220 96619 5 E -9, 6 0.44185 282 E -12, 7 -0.30123 E -15, 8 0.14 E -18/ DATA AB0AS(0)/ 1.97755 49972 36930 67407 E 0/ DATA AB0AS(1)/ -0.10460 24792 00481 9485 E -1/ DATA AB0AS(2)/ 0.69680 79025 36253 66 E -3/ DATA AB0AS(3)/ -0.58982 98299 99659 9 E -4/ DATA AB0AS(4)/ 0.57716 44553 05320 E -5/ DATA AB0AS(5)/ -0.61523 01336 5756 E -6/ DATA AB0AS(6)/ 0.67853 96884 767 E -7/ DATA AB0AS(7)/ -0.72306 25379 07 E -8/ DATA AB0AS(8)/ 0.63306 62736 5 E -9/ DATA AB0AS(9)/ -0.98945 3793 E -11/ DATA AB0AS(10)/-0.16819 80530 E -10/ DATA AB0AS(11)/ 0.67379 9551 E -11/ DATA AB0AS(12)/-0.20099 7939 E -11/ DATA AB0AS(13)/ 0.54055 903 E -12/ DATA AB0AS(14)/-0.13816 679 E -12/ DATA AB0AS(15)/ 0.34222 05 E -13/ DATA AB0AS(16)/-0.82668 6 E -14/ DATA AB0AS(17)/ 0.19456 6 E -14/ DATA AB0AS(18)/-0.44268 E -15/ DATA AB0AS(19)/ 0.9562 E -16/ DATA AB0AS(20)/-0.1883 E -16/ DATA AB0AS(21)/ 0.301 E -17/ DATA AB0AS(22)/-0.19 E -18/ DATA AB0AS(23)/-0.14 E -18/ DATA AB0AS(24)/ 0.11 E -18/ DATA AB0AS(25)/-0.4 E -19/ DATA AB0AS(26)/ 0.2 E -19/ DATA AB0AS(27)/-0.1 E -19/ DATA ZERO,HALF,TWO/ 0.0 E 0 , 0.5 E 0, 2.0 E 0/ DATA THREE,SIX,ONEHUN/ 3.0 E 0, 6.0 E 0 , 100.0 E 0/ DATA RT3BPI/0.97720 50238 05839 84317 E 0/ DATA RTPIB2/0.88622 69254 52758 01365 E 0/ DATA GVAL0/0.13417 65026 47700 70909 E 0/ DATA ONERPI/0.56418 95835 47756 28695 E 0/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERMF,NTERMG,NTERMH,NTERMA/5,5,4,7/ DATA XLOW1,LNXMIN/3.4525E-4,-87.3327E0/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) ABRAM0 = ZERO RETURN ENDIF C C Code for 0 <= XVALUE <= 2 C IF ( X .LE. TWO ) THEN IF ( X .EQ. ZERO ) THEN ABRAM0 = RTPIB2 RETURN ENDIF IF ( X .LT. XLOW1 ) THEN ABRAM0 = RTPIB2 + X * ( LOG( X ) - GVAL0 ) RETURN ELSE T = ( X * X / TWO - HALF ) - HALF FVAL = CHEVAL( NTERMF,AB0F,T ) GVAL = CHEVAL( NTERMG,AB0G,T ) HVAL = CHEVAL( NTERMH,AB0H,T ) ABRAM0 = FVAL/ONERPI + X * ( LOG( X ) * HVAL- GVAL ) RETURN ENDIF ELSE C C Code for XVALUE > 2 C V = THREE * ( (X / TWO) ** ( TWO / THREE ) ) T = ( SIX/V - HALF ) - HALF ASVAL = CHEVAL( NTERMA,AB0AS,T ) ASLN = LOG( ASVAL / RT3BPI ) - V IF ( ASLN .LT. LNXMIN ) THEN ABRAM0 = ZERO ELSE ABRAM0 = EXP( ASLN ) ENDIF RETURN ENDIF END REAL FUNCTION ABRAM1(XVALUE) C C DESCRIPTION: C This function calculates the Abramowitz function of order 1, C defined as C C ABRAM1(x) = integral{ 0 to infinity } t * exp( -t*t - x/t ) dt C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C If XVALUE < 0.0, the function prints a message and returns the C value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMF - INTEGER - No. of terms needed for the array AB1F. C Recommended value such that C ABS( AB1F(NTERMF) ) < EPS/100 C C NTERMG - INTEGER - No. of terms needed for array AB1G. C Recommended value such that C ABS( AB1G(NTERMG) ) < EPS/100 C C NTERMH - INTEGER - No. of terms needed for array AB1H. C Recommended value such that C ABS( AB1H(NTERMH) ) < EPS/100 C C NTERMA - INTEGER - No. of terms needed for array AB1AS. C Recommended value such that C ABS( AB1AS(NTERMA) ) < EPS/100 C C XLOW - REAL - The value below which C ABRAM1(x) = 0.5 to machine precision. C The recommended value is EPSNEG/2 C C XLOW1 - REAL - The value below which C ABRAM1(x) = (1 - x ( sqrt(pi) + xln(x) ) / 2 C Recommended value is SQRT(2*EPSNEG) C C LNXMIN - REAL - The value of ln XMIN. Used to prevent C exponential underflow for large X. C C For values of EPS, EPSNEG, XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C LOG, EXP, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 7 JUNE, 1995 C C INTEGER NTERMA,NTERMF,NTERMG,NTERMH REAL AB1F(0:9),AB1G(0:8),AB1H(0:8),AB1AS(0:27), & ASLN,ASVAL,CHEVAL,FVAL,GVAL,HALF,HVAL, & LNXMIN,ONE,ONEHUN,ONERPI,RT3BPI,SIX,T,THREE,TWO, & V,X,XLOW,XLOW1,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*33 DATA FNNAME/'ABRAM1'/ DATA ERRMSG/'FUNCTION CALLED WITH ARGUMENT < 0'/ DATA AB1F/1.47285 19257 79788 07369 E 0, 1 0.10903 49757 01689 56257 E 0, 2 -0.12430 67536 00565 69753 E 0, 3 0.30619 79468 53493 315 E -2, 4 -0.22184 10323 07651 1 E -4, 5 0.69899 78834 451 E -7, 6 -0.11597 07644 4 E -9, 7 0.11389 776 E -12, 8 -0.7173 E -16, 9 0.3 E -19/ DATA AB1G/0.39791 27794 90545 03528 E 0, 1 -0.29045 28522 64547 20849 E 0, 2 0.10487 84695 46536 3504 E -1, 3 -0.10249 86952 26913 36 E -3, 4 0.41150 27939 9110 E -6, 5 -0.83652 63894 0 E -9, 6 0.97862 595 E -12, 7 -0.71868 E -15, 8 0.35 E -18/ DATA AB1H/0.84150 29215 22749 47030 E 0, 1 -0.77900 50698 77414 3395 E -1, 2 0.13399 24558 78390 993 E -2, 3 -0.80850 39071 52788 E -5, 4 0.22618 58281 728 E -7, 5 -0.34413 95838 E -10, 6 0.31598 58 E -13, 7 -0.1884 E -16, 8 0.1 E -19/ DATA AB1AS(0)/ 2.13013 64342 90655 49448 E 0/ DATA AB1AS(1)/ 0.63715 26795 21853 9933 E -1/ DATA AB1AS(2)/ -0.12933 49174 77510 647 E -2/ DATA AB1AS(3)/ 0.56783 28753 22826 5 E -4/ DATA AB1AS(4)/ -0.27943 49391 77646 E -5/ DATA AB1AS(5)/ 0.56002 14736 787 E -7/ DATA AB1AS(6)/ 0.23920 09242 798 E -7/ DATA AB1AS(7)/ -0.75098 48650 09 E -8/ DATA AB1AS(8)/ 0.17301 53307 76 E -8/ DATA AB1AS(9)/ -0.36648 87795 5 E -9/ DATA AB1AS(10)/ 0.75207 58307 E -10/ DATA AB1AS(11)/-0.15179 90208 E -10/ DATA AB1AS(12)/ 0.30171 3710 E -11/ DATA AB1AS(13)/-0.58596 718 E -12/ DATA AB1AS(14)/ 0.10914 455 E -12/ DATA AB1AS(15)/-0.18705 36 E -13/ DATA AB1AS(16)/ 0.26254 2 E -14/ DATA AB1AS(17)/-0.14627 E -15/ DATA AB1AS(18)/-0.9500 E -16/ DATA AB1AS(19)/ 0.5873 E -16/ DATA AB1AS(20)/-0.2420 E -16/ DATA AB1AS(21)/ 0.868 E -17/ DATA AB1AS(22)/-0.290 E -17/ DATA AB1AS(23)/ 0.93 E -18/ DATA AB1AS(24)/-0.29 E -18/ DATA AB1AS(25)/ 0.9 E -19/ DATA AB1AS(26)/-0.3 E -19/ DATA AB1AS(27)/ 0.1 E -19/ DATA ZERO,HALF,ONE/ 0.0 E 0, 0.5 E 0, 1.0 E 0/ DATA TWO,THREE,SIX/ 2.0 E 0, 3.0 E 0, 6.0 E 0/ DATA ONEHUN/100.0 E 0/ DATA RT3BPI/ 0.97720 50238 05839 84317 E 0/ DATA ONERPI/ 0.56418 95835 47756 28695 E 0/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERMF,NTERMG,NTERMH,NTERMA/6,5,5,9/ DATA XLOW,XLOW1,LNXMIN/2.98E-8,3.4525E-4,-87.3327E0/ C C Start calculation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) ABRAM1 = ZERO RETURN ENDIF C C Code for 0 <= XVALUE <= 2 C IF ( X .LE. TWO ) THEN IF ( X .EQ. ZERO ) THEN ABRAM1 = HALF RETURN ENDIF IF ( X .LT. XLOW1 ) THEN IF ( X .LT. XLOW ) THEN ABRAM1 = HALF ELSE ABRAM1 = ( ONE - X / ONERPI - X * X * LOG( X ) ) * HALF ENDIF RETURN ELSE T = ( X * X / TWO - HALF ) - HALF FVAL = CHEVAL( NTERMF,AB1F,T ) GVAL = CHEVAL( NTERMG,AB1G,T ) HVAL = CHEVAL( NTERMH,AB1H,T ) ABRAM1 = FVAL - X * ( GVAL / ONERPI + X * LOG( X ) * HVAL ) RETURN ENDIF ELSE C C Code for XVALUE > 2 C V = THREE * ( (X / TWO) ** ( TWO / THREE ) ) T = ( SIX / V - HALF ) - HALF ASVAL = CHEVAL( NTERMA,AB1AS,T ) ASLN = LOG( ASVAL * SQRT ( V / THREE ) / RT3BPI ) - V IF ( ASLN .LT. LNXMIN ) THEN ABRAM1 = ZERO ELSE ABRAM1 = EXP( ASLN ) ENDIF RETURN ENDIF END REAL FUNCTION ABRAM2(XVALUE) C C DESCRIPTION: C This function calculates the Abramowitz function of order 2, C defined as C C ABRAM2(x) = integral{ 0 to infinity } (t**2) * exp( -t*t - x/t ) dt C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C ERROR RETURNS: C If XVALUE < 0.0, the function prints a message and returns the C value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMF - INTEGER - No. of terms needed for the array AB2F. C Recommended value such that C ABS( AB2F(NTERMF) ) < EPS/100 C C NTERMG - INTEGER - No. of terms needed for array AB2G. C Recommended value such that C ABS( AB2G(NTERMG) ) < EPS/100 C C NTERMH - INTEGER - No. of terms needed for array AB2H. C Recommended value such that C ABS( AB2H(NTERMH) ) < EPS/100 C C NTERMA - INTEGER - No. of terms needed for array AB2AS. C Recommended value such that C ABS( AB2AS(NTERMA) ) < EPS/100 C C XLOW - REAL - The value below which C ABRAM2 = root(pi)/4 to machine precision. C The recommended value is EPSNEG C C XLOW1 - REAL - The value below which C ABRAM2 = root(pi)/4 - x/2 + x**3ln(x)/6 C Recommended value is SQRT(2*EPSNEG) C C LNXMIN - REAL - The value of ln XMIN. Used to prevent C exponential underflow for large X. C C For values of EPS, EPSNEG, XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C LOG, EXP C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 7 JUNE , 1995 C C INTEGER NTERMA,NTERMF,NTERMG,NTERMH REAL AB2F(0:9),AB2G(0:8),AB2H(0:7),AB2AS(0:26), & ASLN,ASVAL,CHEVAL,FVAL,GVAL,HALF,HVAL,LNXMIN, & ONEHUN,ONERPI,RTPIB4,RT3BPI,SIX,T,THREE,TWO, & V,X,XLOW,XLOW1,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*33 DATA FNNAME/'ABRAM2'/ DATA ERRMSG/'FUNCTION CALLED WITH ARGUMENT < 0'/ DATA AB2F/1.03612 16280 42437 13846 E 0, 1 0.19371 24662 67945 70012 E 0, 2 -0.72587 58839 23300 7378 E -1, 3 0.17479 05908 64327 399 E -2, 4 -0.12812 23233 75654 9 E -4, 5 0.41150 18153 651 E -7, 6 -0.69710 47256 E -10, 7 0.69901 83 E -13, 8 -0.4492 E -16, 9 0.2 E -19/ DATA AB2G/1.46290 15719 86307 41150 E 0, 1 0.20189 46688 31540 14317 E 0, 2 -0.29082 92087 99712 9022 E -1, 3 0.47061 04903 52700 50 E -3, 4 -0.25792 20803 59333 E -5, 5 0.65613 37129 46 E -8, 6 -0.91411 0203 E -11, 7 0.77427 6 E -14, 8 -0.429 E -17/ DATA AB2H/0.30117 22501 09104 88881 E 0, 1 -0.15886 67818 31762 3783 E -1, 2 0.19295 93693 55845 26 E -3, 3 -0.90199 58784 9300 E -6, 4 0.20610 50418 37 E -8, 5 -0.26511 1806 E -11, 6 0.21086 4 E -14, 7 -0.111 E -17/ DATA AB2AS(0)/ 2.46492 32530 43348 56893 E 0/ DATA AB2AS(1)/ 0.23142 79742 22489 05432 E 0/ DATA AB2AS(2)/ -0.94068 17301 00857 73 E -3/ DATA AB2AS(3)/ 0.82902 70038 08973 3 E -4/ DATA AB2AS(4)/ -0.88389 47042 45866 E -5/ DATA AB2AS(5)/ 0.10663 85435 67985 E -5/ DATA AB2AS(6)/ -0.13991 12853 8529 E -6/ DATA AB2AS(7)/ 0.19397 93208 445 E -7/ DATA AB2AS(8)/ -0.27704 99383 75 E -8/ DATA AB2AS(9)/ 0.39590 68718 6 E -9/ DATA AB2AS(10)/-0.54083 54342 E -10/ DATA AB2AS(11)/ 0.63554 6076 E -11/ DATA AB2AS(12)/-0.38461 613 E -12/ DATA AB2AS(13)/-0.11696 067 E -12/ DATA AB2AS(14)/ 0.68966 71 E -13/ DATA AB2AS(15)/-0.25031 13 E -13/ DATA AB2AS(16)/ 0.78558 6 E -14/ DATA AB2AS(17)/-0.23033 4 E -14/ DATA AB2AS(18)/ 0.64914 E -15/ DATA AB2AS(19)/-0.17797 E -15/ DATA AB2AS(20)/ 0.4766 E -16/ DATA AB2AS(21)/-0.1246 E -16/ DATA AB2AS(22)/ 0.316 E -17/ DATA AB2AS(23)/-0.77 E -18/ DATA AB2AS(24)/ 0.18 E -18/ DATA AB2AS(25)/-0.4 E -19/ DATA AB2AS(26)/ 0.1 E -19/ DATA ZERO,HALF,TWO/ 0.0 E 0 , 0.5 E 0, 2.0 E 0/ DATA THREE,SIX,ONEHUN/ 3.0 E 0, 6.0 E 0 , 100.0 E 0/ DATA RT3BPI/ 0.97720 50238 05839 84317 E 0/ DATA RTPIB4/ 0.44311 34627 26379 00682 E 0/ DATA ONERPI/ 0.56418 95835 47756 28695 E 0/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERMF,NTERMG,NTERMH,NTERMA/6,6,5,10/ DATA XLOW,XLOW1,LNXMIN/5.96E-8,3.4525E-4, -87.3327E0/ C C Start calculation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) ABRAM2 = ZERO RETURN ENDIF C C Code for 0 <= XVALUE <= 2 C IF ( X .LE. TWO ) THEN IF ( X .EQ. ZERO ) THEN ABRAM2 = RTPIB4 RETURN ENDIF IF ( X .LT. XLOW1 ) THEN IF ( X .LT. XLOW ) THEN ABRAM2 = RTPIB4 ELSE ABRAM2 = RTPIB4 - HALF * X + X * X * X * LOG( X ) / SIX ENDIF RETURN ELSE T = ( X * X / TWO - HALF ) - HALF FVAL = CHEVAL( NTERMF,AB2F,T ) GVAL = CHEVAL( NTERMG,AB2G,T ) HVAL = CHEVAL( NTERMH,AB2H,T ) ABRAM2 = FVAL/ONERPI + X * ( X * X * LOG(X) * HVAL- GVAL ) RETURN ENDIF ELSE C C Code for XVALUE > 2 C V = THREE * ( (X / TWO) ** ( TWO / THREE ) ) T = ( SIX / V - HALF ) - HALF ASVAL = CHEVAL( NTERMA,AB2AS,T ) ASLN = LOG( ASVAL / RT3BPI ) + LOG( V / THREE ) - V IF ( ASLN .LT. LNXMIN ) THEN ABRAM2 = ZERO ELSE ABRAM2 = EXP( ASLN ) ENDIF RETURN ENDIF END REAL FUNCTION AIRINT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the Airy function Ai, C defined as C C AIRINT(x) = {integral 0 to x} Ai(t) dt C C The program uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If the argument is too large and negative, it is impossible C to accurately compute the necessary SIN and COS functions. C An error message is printed, and the program returns the C value -2/3 (the value at -infinity). C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C AAINT1. The recommended value is such that C ABS(AAINT1(NTERM1)) < EPS/100, C subject to 1 <= NTERM1 <= 25. C C NTERM2 - INTEGER - The no. of terms to be used from the array C AAINT2. The recommended value is such that C ABS(AAINT2(NTERM2)) < EPS/100, C subject to 1 <= NTERM2 <= 21. C C NTERM3 - INTEGER - The no. of terms to be used from the array C AAINT3. The recommended value is such that C ABS(AAINT3(NTERM3)) < EPS/100, C subject to 1 <= NTERM3 <= 40. C C NTERM4 - INTEGER - The no. of terms to be used from the array C AAINT4. The recommended value is such that C ABS(AAINT4(NTERM4)) < EPS/100, C subject to 1 <= NTERM4 <= 17. C C NTERM5 - INTEGER - The no. of terms to be used from the array C AAINT5. The recommended value is such that C ABS(AAINT5(NTERM5)) < EPS/100, C subject to 1 <= NTERM5 <= 17. C C XLOW1 - REAL - The value such that, if |x| < XLOW1, C AIRINT(x) = x * Ai(0) C to machine precision. The recommended value is C 2 * EPSNEG. C C XHIGH1 - REAL - The value such that, if x > XHIGH1, C AIRINT(x) = 1/3, C to machine precision. The recommended value is C (-1.5*LOG(EPSNEG)) ** (2/3). C C XNEG1 - REAL - The value such that, if x < XNEG1, C the trigonometric functions in the asymptotic C expansion cannot be calculated accurately. C The recommended value is C -(1/((EPS)**2/3)) C C For values of EPS and EPSNEG, refer to the file MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C COS, EXP, SIN, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C Univ. of Paisley, C High St., C Paisley, C SCOTLAND. C PA1 2BE C C (e-mail:macl_ms0@paisley.ac.uk) C C C LATEST REVISION: 7 JUNE, 1995. C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5 REAL AAINT1(0:25),AAINT2(0:21),AAINT3(0:40), 1 AAINT4(0:17),AAINT5(0:17), 2 AIRZER,ARG,CHEVAL,EIGHT,FORTY1,FOUR,FR996,GVAL, 3 HVAL,NINE,NINHUN,ONE,ONEHUN,PIBY4,PITIM6,RT2B3P,T,TEMP, 4 THREE,TWO,X,XHIGH1,XLOW1,XNEG1,XVALUE,Z,ZERO CHARACTER FNNAME*6,ERRMSG*46 DATA FNNAME/'AIRINT'/ DATA ERRMSG/'FUNCTION TOO NEGATIVE FOR ACCURATE COMPUTATION'/ DATA AAINT1(0)/ 0.37713 51769 46836 95526 E 0/ DATA AAINT1(1)/ -0.13318 86843 24079 47431 E 0/ DATA AAINT1(2)/ 0.31524 97374 78288 4809 E -1/ DATA AAINT1(3)/ -0.31854 30764 36574 077 E -2/ DATA AAINT1(4)/ -0.87398 76469 86219 15 E -3/ DATA AAINT1(5)/ 0.46699 49765 53969 71 E -3/ DATA AAINT1(6)/ -0.95449 36738 98369 2 E -4/ DATA AAINT1(7)/ 0.54270 56871 56716 E -5/ DATA AAINT1(8)/ 0.23949 64062 52188 E -5/ DATA AAINT1(9)/ -0.75690 27020 5649 E -6/ DATA AAINT1(10)/ 0.90501 38584 518 E -7/ DATA AAINT1(11)/ 0.32052 94560 43 E -8/ DATA AAINT1(12)/-0.30382 55364 44 E -8/ DATA AAINT1(13)/ 0.48900 11859 6 E -9/ DATA AAINT1(14)/-0.18398 20572 E -10/ DATA AAINT1(15)/-0.71124 7519 E -11/ DATA AAINT1(16)/ 0.15177 4419 E -11/ DATA AAINT1(17)/-0.10801 922 E -12/ DATA AAINT1(18)/-0.96354 2 E -14/ DATA AAINT1(19)/ 0.31342 5 E -14/ DATA AAINT1(20)/-0.29446 E -15/ DATA AAINT1(21)/-0.477 E -17/ DATA AAINT1(22)/ 0.461 E -17/ DATA AAINT1(23)/-0.53 E -18/ DATA AAINT1(24)/ 0.1 E -19/ DATA AAINT1(25)/ 0.1 E -19/ DATA AAINT2(0)/ 1.92002 52408 19840 09769 E 0/ DATA AAINT2(1)/ -0.42200 49417 25628 7021 E -1/ DATA AAINT2(2)/ -0.23945 77229 65939 223 E -2/ DATA AAINT2(3)/ -0.19564 07048 33529 71 E -3/ DATA AAINT2(4)/ -0.15472 52891 05611 2 E -4/ DATA AAINT2(5)/ -0.14049 01861 37889 E -5/ DATA AAINT2(6)/ -0.12128 01427 1367 E -6/ DATA AAINT2(7)/ -0.11791 86050 192 E -7/ DATA AAINT2(8)/ -0.10431 55787 88 E -8/ DATA AAINT2(9)/ -0.10908 20929 3 E -9/ DATA AAINT2(10)/-0.92963 3045 E -11/ DATA AAINT2(11)/-0.11094 6520 E -11/ DATA AAINT2(12)/-0.78164 83 E -13/ DATA AAINT2(13)/-0.13196 61 E -13/ DATA AAINT2(14)/-0.36823 E -15/ DATA AAINT2(15)/-0.21505 E -15/ DATA AAINT2(16)/ 0.1238 E -16/ DATA AAINT2(17)/-0.557 E -17/ DATA AAINT2(18)/ 0.84 E -18/ DATA AAINT2(19)/-0.21 E -18/ DATA AAINT2(20)/ 0.4 E -19/ DATA AAINT2(21)/-0.1 E -19/ DATA AAINT3(0)/ 0.47985 89326 47910 52053 E 0/ DATA AAINT3(1)/ -0.19272 37512 61696 08863 E 0/ DATA AAINT3(2)/ 0.20511 54129 52542 8189 E -1/ DATA AAINT3(3)/ 0.63320 00070 73248 8786 E -1/ DATA AAINT3(4)/ -0.50933 22261 84575 4082 E -1/ DATA AAINT3(5)/ 0.12844 24078 66166 3016 E -1/ DATA AAINT3(6)/ 0.27601 37088 98947 9413 E -1/ DATA AAINT3(7)/ -0.15470 66673 86664 9507 E -1/ DATA AAINT3(8)/ -0.14968 64655 38931 6026 E -1/ DATA AAINT3(9)/ 0.33661 76141 73574 541 E -2/ DATA AAINT3(10)/ 0.53085 11635 18892 985 E -2/ DATA AAINT3(11)/ 0.41371 22645 85550 81 E -3/ DATA AAINT3(12)/-0.10249 05799 26726 266 E -2/ DATA AAINT3(13)/-0.32508 22167 20258 53 E -3/ DATA AAINT3(14)/ 0.86086 60957 16921 3 E -4/ DATA AAINT3(15)/ 0.66713 67298 12077 5 E -4/ DATA AAINT3(16)/ 0.44920 59993 18095 E -5/ DATA AAINT3(17)/-0.67042 72309 58249 E -5/ DATA AAINT3(18)/-0.19663 65700 85009 E -5/ DATA AAINT3(19)/ 0.22229 67740 7226 E -6/ DATA AAINT3(20)/ 0.22332 22294 9137 E -6/ DATA AAINT3(21)/ 0.28033 13766 457 E -7/ DATA AAINT3(22)/-0.11556 51663 619 E -7/ DATA AAINT3(23)/-0.43306 98217 36 E -8/ DATA AAINT3(24)/-0.62277 77938 E -10/ DATA AAINT3(25)/ 0.26432 66490 3 E -9/ DATA AAINT3(26)/ 0.53338 81114 E -10/ DATA AAINT3(27)/-0.52295 7269 E -11/ DATA AAINT3(28)/-0.38222 9283 E -11/ DATA AAINT3(29)/-0.40958 233 E -12/ DATA AAINT3(30)/ 0.11515 622 E -12/ DATA AAINT3(31)/ 0.38757 66 E -13/ DATA AAINT3(32)/ 0.14028 3 E -14/ DATA AAINT3(33)/-0.14152 6 E -14/ DATA AAINT3(34)/-0.28746 E -15/ DATA AAINT3(35)/ 0.923 E -17/ DATA AAINT3(36)/ 0.1224 E -16/ DATA AAINT3(37)/ 0.157 E -17/ DATA AAINT3(38)/-0.19 E -18/ DATA AAINT3(39)/-0.8 E -19/ DATA AAINT3(40)/-0.1 E -19/ DATA AAINT4/1.99653 30582 85227 30048 E 0, 1 -0.18754 11776 05417 759 E -2, 2 -0.15377 53628 03057 50 E -3, 3 -0.12831 12967 68234 9 E -4, 4 -0.10812 84819 64162 E -5, 5 -0.91821 31174 057 E -7, 6 -0.78416 05909 60 E -8, 7 -0.67292 45387 8 E -9, 8 -0.57963 25198 E -10, 9 -0.50104 0991 E -11, X -0.43420 222 E -12, 1 -0.37743 05 E -13, 2 -0.32847 3 E -14, 3 -0.28700 E -15, 4 -0.2502 E -16, 5 -0.220 E -17, 6 -0.19 E -18, 7 -0.2 E -19/ DATA AAINT5/1.13024 60203 44657 16133 E 0, 1 -0.46471 80646 39872 334 E -2, 2 -0.35137 41338 26932 03 E -3, 3 -0.27681 17872 54518 5 E -4, 4 -0.22205 74525 58107 E -5, 5 -0.18089 14236 5974 E -6, 6 -0.14876 13383 373 E -7, 7 -0.12351 53881 68 E -8, 8 -0.10310 10425 7 E -9, 9 -0.86749 3013 E -11, X -0.73080 054 E -12, 1 -0.62235 61 E -13, 2 -0.52512 8 E -14, 3 -0.45677 E -15, 4 -0.3748 E -16, 5 -0.356 E -17, 6 -0.23 E -18, 7 -0.4 E -19/ DATA ZERO,ONE,TWO/ 0.0 E 0 , 1.0 E 0 , 2.0 E 0 / DATA THREE,FOUR,EIGHT/ 3.0 E 0 , 4.0 E 0 , 8.0 E 0 / DATA NINE,FORTY1,ONEHUN/ 9.0 E 0 , 41.0 E 0 , 100.0 E 0/ DATA NINHUN,FR996/ 900.0 E 0 , 4996.0 E 0 / DATA PIBY4/0.78539 81633 97448 30962 E 0/ DATA PITIM6/18.84955 59215 38759 43078 E 0/ DATA RT2B3P/0.46065 88659 61780 63902 E 0/ DATA AIRZER/0.35502 80538 87817 23926 E 0/ C C Machine-dependant constants (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3,NTERM4,NTERM5/13,9,24,7,8/ DATA XLOW1,XHIGH1,XNEG1/1.19E-7,8.53926E0,-41333.5E0/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. XNEG1 ) THEN CALL ERRPRN(FNNAME,ERRMSG) AIRINT = -TWO / THREE RETURN ENDIF C C Code for x >= 0 C IF ( X .GE. ZERO ) THEN IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW1 ) THEN AIRINT = AIRZER * X ELSE T = X / TWO - ONE AIRINT = CHEVAL(NTERM1,AAINT1,T) * X ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN TEMP = ZERO ELSE Z = ( X + X ) * SQRT(X) / THREE TEMP = THREE * Z T = ( FORTY1 - TEMP ) / ( NINE + TEMP ) TEMP = EXP(-Z) * CHEVAL(NTERM2,AAINT2,T) / SQRT(PITIM6*Z) ENDIF AIRINT = ONE / THREE - TEMP ENDIF ELSE C C Code for x < 0 C IF ( X .GE. -EIGHT ) THEN IF ( X .GT. -XLOW1 ) THEN AIRINT = AIRZER * X ELSE T = -X / FOUR - ONE AIRINT = X * CHEVAL(NTERM3,AAINT3,T) ENDIF ELSE Z = - ( X + X ) * SQRT(-X) / THREE ARG = Z + PIBY4 TEMP = NINE * Z * Z T = ( FR996 - TEMP ) / ( NINHUN + TEMP) GVAL = CHEVAL(NTERM4,AAINT4,T) HVAL = CHEVAL(NTERM5,AAINT5,T) TEMP = GVAL * COS(ARG) + HVAL * SIN(ARG) / Z AIRINT = RT2B3P * TEMP / SQRT(Z) - TWO / THREE ENDIF ENDIF RETURN END REAL FUNCTION AIRYGI(XVALUE) C C DESCRIPTION: C C This subroutine computes the modified Airy function Gi(x), C defined as C C AIRYGI(x) = [ Integral{0 to infinity} sin(x*t+t^3/3) dt ] / pi C C The approximation uses Chebyshev expansions with the coefficients C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If x < -XHIGH1*XHIGH1 (see below for definition of XHIGH1), then C the trig. functions needed for the asymptotic expansion of Bi(x) C cannot be computed to any accuracy. An error message is printed C and the code returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C ARGIP1. The recommended value is such that C ABS(ARGIP1(NTERM1)) < EPS/100 C subject to 1 <= NTERM1 <= 30. C C NTERM2 - INTEGER - The no. of terms to be used from the array C ARGIP2. The recommended value is such that C ABS(ARGIP2(NTERM2)) < EPS/100 C subject to 1 <= NTERM2 <= 29. C C NTERM3 - INTEGER - The no. of terms to be used from the array C ARGIN1. The recommended value is such that C ABS(ARGIN1(NTERM3)) < EPS/100 C subject to 1 <= NTERM3 <= 42. C C NTERM4 - INTEGER - The no. of terms to be used from the array C ARBIN1. The recommended value is such that C ABS(ARBIN1(NTERM4)) < EPS/100 C subject to 1 <= NTERM4 <= 10. C C NTERM5 - INTEGER - The no. of terms to be used from the array C ARBIN2. The recommended value is such that C ABS(ARBIN2(NTERM5)) < EPS/100 C subject to 1 <= NTERM5 <= 11. C C NTERM6 - INTEGER - The no. of terms to be used from the array C ARGH2. The recommended value is such that C ABS(ARHIN1(NTERM6)) < EPS/100 C subject to 1 <= NTERM6 <= 15. C C XLOW1 - REAL - The value such that, if -XLOW1 < x < XLOW1, C then AIRYGI = Gi(0) to machine precision. C The recommended value is EPS. C C XHIGH1 - REAL - The value such that, if x > XHIGH1, then C AIRYGI = 1/(Pi*x) to machine precision. C Also used for error test - see above. C The recommended value is C cube root( 2/EPS ). C C XHIGH2 - REAL - The value above which AIRYGI = 0.0. C The recommended value is C 1/(Pi*XMIN). C C XHIGH3 - REAL - The value such that, if x < XHIGH3, C then the Chebyshev expansions for the C asymptotic form of Bi(x) are not needed. C The recommended value is C -8 * cube root( 2/EPSNEG ). C C For values of EPS, EPSNEG, and XMIN refer to the file C MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C COS , SIN , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. Macleod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND. C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST UPDATE: C 8 JUNE, 1995. C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5,NTERM6 REAL ARGIP1(0:30),ARGIP2(0:29),ARGIN1(0:42), 1 ARBIN1(0:10),ARBIN2(0:11),ARHIN1(0:15), 2 BI,CHEB1,CHEB2,CHEVAL,COSZ,FIVE,FIVE14,FOUR, 3 GIZERO,MINATE,NINE,ONE,ONEBPI,ONEHUN,ONE76,ONE024,PIBY4, 4 RTPIIN,SEVEN,SEVEN2,SINZ,T,TEMP,THREE,TWELHU,TWENT8, 5 X,XCUBE,XHIGH1,XHIGH2,XHIGH3,XLOW1,XMINUS, 6 XVALUE,ZERO,ZETA CHARACTER FNNAME*6,ERRMSG*46 DATA FNNAME/'AIRYGI'/ DATA ERRMSG/'ARGUMENT TOO NEGATIVE FOR ACCURATE COMPUTATION'/ DATA ARGIP1(0)/ 0.26585 77079 50227 45082 E 0/ DATA ARGIP1(1)/ -0.10500 33309 75019 22907 E 0/ DATA ARGIP1(2)/ 0.84134 74753 28454 492 E -2/ DATA ARGIP1(3)/ 0.20210 67387 81343 9541 E -1/ DATA ARGIP1(4)/ -0.15595 76113 86355 2234 E -1/ DATA ARGIP1(5)/ 0.56434 29390 43256 481 E -2/ DATA ARGIP1(6)/ -0.59776 84482 66558 09 E -3/ DATA ARGIP1(7)/ -0.42833 85026 48677 28 E -3/ DATA ARGIP1(8)/ 0.22605 66238 09090 27 E -3/ DATA ARGIP1(9)/ -0.36083 32945 59226 0 E -4/ DATA ARGIP1(10)/-0.78551 89887 88901 E -5/ DATA ARGIP1(11)/ 0.47325 24807 46370 E -5/ DATA ARGIP1(12)/-0.59743 51397 7694 E -6/ DATA ARGIP1(13)/-0.15917 60916 5602 E -6/ DATA ARGIP1(14)/ 0.63361 29065 570 E -7/ DATA ARGIP1(15)/-0.27609 02326 48 E -8/ DATA ARGIP1(16)/-0.25606 41540 85 E -8/ DATA ARGIP1(17)/ 0.47798 67685 6 E -9/ DATA ARGIP1(18)/ 0.44881 31863 E -10/ DATA ARGIP1(19)/-0.23465 08882 E -10/ DATA ARGIP1(20)/ 0.76839 085 E -12/ DATA ARGIP1(21)/ 0.73227 985 E -12/ DATA ARGIP1(22)/-0.85136 87 E -13/ DATA ARGIP1(23)/-0.16302 01 E -13/ DATA ARGIP1(24)/ 0.35676 9 E -14/ DATA ARGIP1(25)/ 0.25001 E -15/ DATA ARGIP1(26)/-0.10859 E -15/ DATA ARGIP1(27)/-0.158 E -17/ DATA ARGIP1(28)/ 0.275 E -17/ DATA ARGIP1(29)/-0.5 E -19/ DATA ARGIP1(30)/-0.6 E -19/ DATA ARGIP2(0)/ 2.00473 71227 58014 86391 E 0/ DATA ARGIP2(1)/ 0.29418 41393 64406 724 E -2/ DATA ARGIP2(2)/ 0.71369 24900 63401 67 E -3/ DATA ARGIP2(3)/ 0.17526 56343 05022 67 E -3/ DATA ARGIP2(4)/ 0.43591 82094 02988 2 E -4/ DATA ARGIP2(5)/ 0.10926 26947 60430 7 E -4/ DATA ARGIP2(6)/ 0.27238 24183 99029 E -5/ DATA ARGIP2(7)/ 0.66230 90094 7687 E -6/ DATA ARGIP2(8)/ 0.15425 32337 0315 E -6/ DATA ARGIP2(9)/ 0.34184 65242 306 E -7/ DATA ARGIP2(10)/ 0.72815 77248 94 E -8/ DATA ARGIP2(11)/ 0.15158 85254 52 E -8/ DATA ARGIP2(12)/ 0.30940 04803 9 E -9/ DATA ARGIP2(13)/ 0.61496 72614 E -10/ DATA ARGIP2(14)/ 0.12028 77045 E -10/ DATA ARGIP2(15)/ 0.23369 0586 E -11/ DATA ARGIP2(16)/ 0.43778 068 E -12/ DATA ARGIP2(17)/ 0.79964 47 E -13/ DATA ARGIP2(18)/ 0.14940 75 E -13/ DATA ARGIP2(19)/ 0.24679 0 E -14/ DATA ARGIP2(20)/ 0.37672 E -15/ DATA ARGIP2(21)/ 0.7701 E -16/ DATA ARGIP2(22)/ 0.354 E -17/ DATA ARGIP2(23)/-0.49 E -18/ DATA ARGIP2(24)/ 0.62 E -18/ DATA ARGIP2(25)/-0.40 E -18/ DATA ARGIP2(26)/-0.1 E -19/ DATA ARGIP2(27)/ 0.2 E -19/ DATA ARGIP2(28)/-0.3 E -19/ DATA ARGIP2(29)/ 0.1 E -19/ DATA ARGIN1(0)/ -0.20118 96505 67320 89130 E 0/ DATA ARGIN1(1)/ -0.72441 75303 32453 0499 E -1/ DATA ARGIN1(2)/ 0.45050 18923 89478 0120 E -1/ DATA ARGIN1(3)/ -0.24221 37112 20787 91099 E 0/ DATA ARGIN1(4)/ 0.27178 84964 36167 8294 E -1/ DATA ARGIN1(5)/ -0.57293 21004 81817 9697 E -1/ DATA ARGIN1(6)/ -0.18382 10786 03377 63587 E 0/ DATA ARGIN1(7)/ 0.77515 46082 14947 5511 E -1/ DATA ARGIN1(8)/ 0.18386 56473 39275 60387 E 0/ DATA ARGIN1(9)/ 0.29215 04250 18556 7173 E -1/ DATA ARGIN1(10)/-0.61422 94846 78801 8811 E -1/ DATA ARGIN1(11)/-0.29993 12505 79461 6238 E -1/ DATA ARGIN1(12)/ 0.58593 71183 27706 636 E -2/ DATA ARGIN1(13)/ 0.82222 16584 97402 529 E -2/ DATA ARGIN1(14)/ 0.13257 98171 66846 893 E -2/ DATA ARGIN1(15)/-0.96248 31076 65651 26 E -3/ DATA ARGIN1(16)/-0.45065 51599 82118 07 E -3/ DATA ARGIN1(17)/ 0.77242 34743 25474 E -5/ DATA ARGIN1(18)/ 0.54818 74134 75805 2 E -4/ DATA ARGIN1(19)/ 0.12458 98039 74287 6 E -4/ DATA ARGIN1(20)/-0.24619 68910 92083 E -5/ DATA ARGIN1(21)/-0.16915 41835 45285 E -5/ DATA ARGIN1(22)/-0.16769 15316 9442 E -6/ DATA ARGIN1(23)/ 0.96365 09337 672 E -7/ DATA ARGIN1(24)/ 0.32533 14928 030 E -7/ DATA ARGIN1(25)/ 0.50918 04231 E -10/ DATA ARGIN1(26)/-0.20918 04535 53 E -8/ DATA ARGIN1(27)/-0.41237 38787 0 E -9/ DATA ARGIN1(28)/ 0.41633 38253 E -10/ DATA ARGIN1(29)/ 0.30325 32117 E -10/ DATA ARGIN1(30)/ 0.34058 0529 E -11/ DATA ARGIN1(31)/-0.88444 592 E -12/ DATA ARGIN1(32)/-0.31639 612 E -12/ DATA ARGIN1(33)/-0.15050 76 E -13/ DATA ARGIN1(34)/ 0.11041 48 E -13/ DATA ARGIN1(35)/ 0.24650 8 E -14/ DATA ARGIN1(36)/-0.3107 E -16/ DATA ARGIN1(37)/-0.9851 E -16/ DATA ARGIN1(38)/-0.1453 E -16/ DATA ARGIN1(39)/ 0.118 E -17/ DATA ARGIN1(40)/ 0.67 E -18/ DATA ARGIN1(41)/ 0.6 E -19/ DATA ARGIN1(42)/-0.1 E -19/ DATA ARBIN1/1.99983 76358 35861 55980 E 0, 1 -0.81046 60923 66941 8 E -4, 2 0.13475 66598 4689 E -6, 3 -0.70855 84714 3 E -9, 4 0.74818 4187 E -11, 5 -0.12902 774 E -12, 6 0.32250 4 E -14, 7 -0.10809 E -15, 8 0.460 E -17, 9 -0.24 E -18, X 0.1 E -19/ DATA ARBIN2/0.13872 35645 38791 20276 E 0, 1 -0.82392 86225 55822 8 E -4, 2 0.26720 91950 9866 E -6, 3 -0.20742 36853 68 E -8, 4 0.28733 92593 E -10, 5 -0.60873 521 E -12, 6 0.17924 89 E -13, 7 -0.68760 E -15, 8 0.3280 E -16, 9 -0.188 E -17, X 0.13 E -18, 1 -0.1 E -19/ DATA ARHIN1/1.99647 72039 97796 50525 E 0, 1 -0.18756 37794 07173 213 E -2, 2 -0.12186 47089 77873 39 E -3, 3 -0.81402 16096 59287 E -5, 4 -0.55050 92595 3537 E -6, 5 -0.37630 08043 303 E -7, 6 -0.25885 83623 65 E -8, 7 -0.17931 82926 5 E -9, 8 -0.12459 16873 E -10, 9 -0.87171 247 E -12, X -0.60849 43 E -13, 1 -0.43117 8 E -14, 2 -0.29787 E -15, 3 -0.2210 E -16, 4 -0.136 E -17, 5 -0.14 E -18/ DATA ZERO,ONE,THREE,FOUR/ 0.0 E 0 , 1.0 E 0 , 3.0 E 0 , 4.0 E 0 / DATA FIVE,SEVEN,MINATE/ 5.0 E 0 , 7.0 E 0 , -8.0 E 0 / DATA NINE,TWENT8,SEVEN2/ 9.0 E 0 , 28.0 E 0 , 72.0 E 0 / DATA ONEHUN,ONE76,FIVE14/ 100.0 E 0 , 176.0 E 0 , 514.0 E 0 / DATA ONE024,TWELHU/ 1024.0 E 0 , 1200.0 E 0 / DATA GIZERO/0.20497 55424 82000 24505 E 0/ DATA ONEBPI/0.31830 98861 83790 67154 E 0/ DATA PIBY4/0.78539 81633 97448 30962 E 0/ DATA RTPIIN/0.56418 95835 47756 28695 E 0/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3/17,12,27/ DATA NTERM4,NTERM5,NTERM6/3,3,7/ DATA XLOW1,XHIGH1/1.19E-7,256.15E0/ DATA XHIGH2,XHIGH3/2.6975E37,-2580.386E0/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. -XHIGH1*XHIGH1 ) THEN CALL ERRPRN(FNNAME,ERRMSG) AIRYGI = ZERO RETURN ENDIF C C Code for x >= 0.0 C IF ( X .GE. ZERO ) THEN IF ( X .LE. SEVEN ) THEN IF ( X .LT. XLOW1 ) THEN AIRYGI = GIZERO ELSE T = ( NINE * X - TWENT8 ) / ( X + TWENT8 ) AIRYGI = CHEVAL ( NTERM1 , ARGIP1 , T ) ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN IF ( X .GT. XHIGH2 ) THEN AIRYGI = ZERO ELSE AIRYGI = ONEBPI/X ENDIF ELSE XCUBE = X * X * X T = ( TWELHU - XCUBE ) / ( FIVE14 + XCUBE ) AIRYGI = ONEBPI * CHEVAL(NTERM2,ARGIP2,T) / X ENDIF ENDIF ELSE C C Code for x < 0.0 C IF ( X .GE. MINATE ) THEN IF ( X .GT. -XLOW1 ) THEN AIRYGI = GIZERO ELSE T = -( X + FOUR ) / FOUR AIRYGI = CHEVAL(NTERM3,ARGIN1,T) ENDIF ELSE XMINUS = -X T = XMINUS * SQRT(XMINUS) ZETA = ( T + T ) / THREE TEMP = RTPIIN / SQRT(SQRT(XMINUS)) COSZ = COS ( ZETA + PIBY4 ) SINZ = SIN ( ZETA + PIBY4 ) / ZETA XCUBE = X * X * X IF ( X .GT. XHIGH3 ) THEN T = - ( ONE024 / ( XCUBE ) + ONE ) CHEB1 = CHEVAL(NTERM4,ARBIN1,T) CHEB2 = CHEVAL(NTERM5,ARBIN2,T) BI = ( COSZ * CHEB1 + SINZ * CHEB2 ) * TEMP ELSE BI = ( COSZ + SINZ * FIVE / SEVEN2 ) * TEMP ENDIF T = ( XCUBE + TWELHU ) / ( ONE76 - XCUBE ) AIRYGI = BI + CHEVAL(NTERM6,ARHIN1,T) * ONEBPI / X ENDIF ENDIF RETURN END REAL FUNCTION AIRYHI(XVALUE) C C DESCRIPTION: C C This subroutine computes the modified Airy function Hi(x), C defined as C C AIRYHI(x) = [ Integral{0 to infinity} exp(x*t-t^3/3) dt ] / pi C C The approximation uses Chebyshev expansions with the coefficients C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If x > XHIGH1 (see below for definition of XHIGH1), then C the asymptotic expansion of Hi(x) will cause an overflow. C An error message is printed and the code returns the largest C floating-pt number as the result. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C ARHIP. The recommended value is such that C ABS(ARHIP(NTERM1)) < EPS/100 C subject to 1 <= NTERM1 <= 31. C C NTERM2 - INTEGER - The no. of terms to be used from the array C ARBIP. The recommended value is such that C ABS(ARBIP(NTERM2)) < EPS/100 C subject to 1 <= NTERM2 <= 23. C C NTERM3 - INTEGER - The no. of terms to be used from the array C ARGIP. The recommended value is such that C ABS(ARGIP1(NTERM3)) < EPS/100 C subject to 1 <= NTERM3 <= 29. C C NTERM4 - INTEGER - The no. of terms to be used from the array C ARHIN1. The recommended value is such that C ABS(ARHIN1(NTERM4)) < EPS/100 C subject to 1 <= NTERM4 <= 21. C C NTERM5 - INTEGER - The no. of terms to be used from the array C ARHIN2. The recommended value is such that C ABS(ARHIN2(NTERM5)) < EPS/100 C subject to 1 <= NTERM5 <= 15. C C XLOW1 - REAL - The value such that, if -XLOW1 < x < XLOW1, C then AIRYGI = Hi(0) to machine precision. C The recommended value is EPS. C C XHIGH1 - REAL - The value such that, if x > XHIGH1, then C overflow might occur. The recommended value is C computed as follows: C compute Z = 1.5*LOG(XMAX) C XHIGH1 = ( Z + LOG(Z)/4 + LOG(PI)/2 )**(2/3) C C XNEG1 - REAL - The value below which AIRYHI = 0.0. C The recommended value is C -1/(Pi*XMIN). C C XNEG2 - REAL - The value such that, if x < XNEG2, then C AIRYHI = -1/(Pi*x) to machine precision. C The recommended value is C -cube root( 2/EPS ). C C XMAX - REAL - The largest possible floating-pt. number. C This is the value given to the function C if x > XHIGH1. C C For values of EPS, EPSNEG, XMIN and XMAX refer to the file C MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. Macleod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND. C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST UPDATE: C 8 JUNE, 1995. C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5 REAL ARHIP(0:31),ARBIP(0:23),ARGIP1(0:29), 1 ARHIN1(0:21),ARHIN2(0:15), 2 BI,CHEVAL,FIVE14,FOUR,GI,HIZERO,LNRTPI, 3 MINATE,ONE,ONEBPI,ONEHUN,ONE76,SEVEN,T,TEMP, 4 THREE,THRE43,TWELHU,TWELVE,TWO,X,XCUBE, 5 XHIGH1,XLOW1,XMAX,XNEG1,XNEG2,XVALUE, 6 ZERO,ZETA CHARACTER FNNAME*6,ERRMSG*30 DATA FNNAME/'AIRYHI'/ DATA ERRMSG/'ARGUMENT TO FUNCTION TOO LARGE'/ DATA ARHIP(0)/ 1.24013 56256 17628 31114 E 0/ DATA ARHIP(1)/ 0.64856 34197 39265 35804 E 0/ DATA ARHIP(2)/ 0.55236 25259 21149 03246 E 0/ DATA ARHIP(3)/ 0.20975 12207 38575 66794 E 0/ DATA ARHIP(4)/ 0.12025 66911 80523 73568 E 0/ DATA ARHIP(5)/ 0.37682 24931 09539 3785 E -1/ DATA ARHIP(6)/ 0.16510 88671 54807 1651 E -1/ DATA ARHIP(7)/ 0.45592 27552 11570 993 E -2/ DATA ARHIP(8)/ 0.16182 84804 77635 013 E -2/ DATA ARHIP(9)/ 0.40841 28250 81266 63 E -3/ DATA ARHIP(10)/0.12196 47972 13940 51 E -3/ DATA ARHIP(11)/0.28650 64098 65761 0 E -4/ DATA ARHIP(12)/0.74222 15564 24344 E -5/ DATA ARHIP(13)/0.16353 62319 32831 E -5/ DATA ARHIP(14)/0.37713 90818 8749 E -6/ DATA ARHIP(15)/0.78158 00336 008 E -7/ DATA ARHIP(16)/0.16384 47121 370 E -7/ DATA ARHIP(17)/0.31985 76659 92 E -8/ DATA ARHIP(18)/0.61933 90530 7 E -9/ DATA ARHIP(19)/0.11411 16119 1 E -9/ DATA ARHIP(20)/0.20649 23454 E -10/ DATA ARHIP(21)/0.36001 8664 E -11/ DATA ARHIP(22)/0.61401 849 E -12/ DATA ARHIP(23)/0.10162 125 E -12/ DATA ARHIP(24)/0.16437 01 E -13/ DATA ARHIP(25)/0.25908 4 E -14/ DATA ARHIP(26)/0.39931 E -15/ DATA ARHIP(27)/0.6014 E -16/ DATA ARHIP(28)/0.886 E -17/ DATA ARHIP(29)/0.128 E -17/ DATA ARHIP(30)/0.18 E -18/ DATA ARHIP(31)/0.3 E -19/ DATA ARBIP(0)/ 2.00582 13820 97590 64905 E 0/ DATA ARBIP(1)/ 0.29447 84491 70441 549 E -2/ DATA ARBIP(2)/ 0.34897 54514 77535 5 E -4/ DATA ARBIP(3)/ 0.83389 73337 4343 E -6/ DATA ARBIP(4)/ 0.31362 15471 813 E -7/ DATA ARBIP(5)/ 0.16786 53060 15 E -8/ DATA ARBIP(6)/ 0.12217 93405 9 E -9/ DATA ARBIP(7)/ 0.11915 84139 E -10/ DATA ARBIP(8)/ 0.15414 2553 E -11/ DATA ARBIP(9)/ 0.24844 455 E -12/ DATA ARBIP(10)/ 0.42130 12 E -13/ DATA ARBIP(11)/ 0.50529 3 E -14/ DATA ARBIP(12)/-0.60032 E -15/ DATA ARBIP(13)/-0.65474 E -15/ DATA ARBIP(14)/-0.22364 E -15/ DATA ARBIP(15)/-0.3015 E -16/ DATA ARBIP(16)/ 0.959 E -17/ DATA ARBIP(17)/ 0.616 E -17/ DATA ARBIP(18)/ 0.97 E -18/ DATA ARBIP(19)/-0.37 E -18/ DATA ARBIP(20)/-0.21 E -18/ DATA ARBIP(21)/-0.1 E -19/ DATA ARBIP(22)/ 0.2 E -19/ DATA ARBIP(23)/ 0.1 E -19/ DATA ARGIP1(0)/ 2.00473 71227 58014 86391 E 0/ DATA ARGIP1(1)/ 0.29418 41393 64406 724 E -2/ DATA ARGIP1(2)/ 0.71369 24900 63401 67 E -3/ DATA ARGIP1(3)/ 0.17526 56343 05022 67 E -3/ DATA ARGIP1(4)/ 0.43591 82094 02988 2 E -4/ DATA ARGIP1(5)/ 0.10926 26947 60430 7 E -4/ DATA ARGIP1(6)/ 0.27238 24183 99029 E -5/ DATA ARGIP1(7)/ 0.66230 90094 7687 E -6/ DATA ARGIP1(8)/ 0.15425 32337 0315 E -6/ DATA ARGIP1(9)/ 0.34184 65242 306 E -7/ DATA ARGIP1(10)/ 0.72815 77248 94 E -8/ DATA ARGIP1(11)/ 0.15158 85254 52 E -8/ DATA ARGIP1(12)/ 0.30940 04803 9 E -9/ DATA ARGIP1(13)/ 0.61496 72614 E -10/ DATA ARGIP1(14)/ 0.12028 77045 E -10/ DATA ARGIP1(15)/ 0.23369 0586 E -11/ DATA ARGIP1(16)/ 0.43778 068 E -12/ DATA ARGIP1(17)/ 0.79964 47 E -13/ DATA ARGIP1(18)/ 0.14940 75 E -13/ DATA ARGIP1(19)/ 0.24679 0 E -14/ DATA ARGIP1(20)/ 0.37672 E -15/ DATA ARGIP1(21)/ 0.7701 E -16/ DATA ARGIP1(22)/ 0.354 E -17/ DATA ARGIP1(23)/-0.49 E -18/ DATA ARGIP1(24)/ 0.62 E -18/ DATA ARGIP1(25)/-0.40 E -18/ DATA ARGIP1(26)/-0.1 E -19/ DATA ARGIP1(27)/ 0.2 E -19/ DATA ARGIP1(28)/-0.3 E -19/ DATA ARGIP1(29)/ 0.1 E -19/ DATA ARHIN1(0)/ 0.31481 01720 64234 04116 E 0/ DATA ARHIN1(1)/ -0.16414 49921 65889 64341 E 0/ DATA ARHIN1(2)/ 0.61766 51597 73091 3071 E -1/ DATA ARHIN1(3)/ -0.19718 81185 93593 3028 E -1/ DATA ARHIN1(4)/ 0.53690 28300 23331 343 E -2/ DATA ARHIN1(5)/ -0.12497 70684 39663 038 E -2/ DATA ARHIN1(6)/ 0.24835 51559 69949 33 E -3/ DATA ARHIN1(7)/ -0.41870 24096 74663 0 E -4/ DATA ARHIN1(8)/ 0.59094 54379 79124 E -5/ DATA ARHIN1(9)/ -0.68063 54118 4345 E -6/ DATA ARHIN1(10)/ 0.60728 97629 164 E -7/ DATA ARHIN1(11)/-0.36713 03492 42 E -8/ DATA ARHIN1(12)/ 0.70780 17552 E -10/ DATA ARHIN1(13)/ 0.11878 94334 E -10/ DATA ARHIN1(14)/-0.12089 8723 E -11/ DATA ARHIN1(15)/ 0.11896 56 E -13/ DATA ARHIN1(16)/ 0.59412 8 E -14/ DATA ARHIN1(17)/-0.32257 E -15/ DATA ARHIN1(18)/-0.2290 E -16/ DATA ARHIN1(19)/ 0.253 E -17/ DATA ARHIN1(20)/ 0.9 E -19/ DATA ARHIN1(21)/-0.2 E -19/ DATA ARHIN2/1.99647 72039 97796 50525 E 0, 1 -0.18756 37794 07173 213 E -2, 2 -0.12186 47089 77873 39 E -3, 3 -0.81402 16096 59287 E -5, 4 -0.55050 92595 3537 E -6, 5 -0.37630 08043 303 E -7, 6 -0.25885 83623 65 E -8, 7 -0.17931 82926 5 E -9, 8 -0.12459 16873 E -10, 9 -0.87171 247 E -12, X -0.60849 43 E -13, 1 -0.43117 8 E -14, 2 -0.29787 E -15, 3 -0.2210 E -16, 4 -0.136 E -17, 5 -0.14 E -18/ DATA ZERO,ONE,TWO/ 0.0 E 0 , 1.0 E 0 , 2.0 E 0/ DATA THREE,FOUR,SEVEN/ 3.0 E 0 , 4.0 E 0 , 7.0 E 0 / DATA MINATE,TWELVE,ONE76/ -8.0 E 0 , 12.0 E 0 , 176.0 E 0 / DATA THRE43,FIVE14,TWELHU/ 343.0 E 0 , 514.0 E 0 , 1200.0 E 0 / DATA ONEHUN/100.0 E 0/ DATA HIZERO/0.40995 10849 64000 49010 E 0/ DATA LNRTPI/0.57236 49429 24700 08707 E 0/ DATA ONEBPI/0.31830 98861 83790 67154 E 0/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3,NTERM4,NTERM5/19,6,12,12,7/ DATA XLOW1,XHIGH1/1.19E-7,26.247E0/ DATA XNEG1,XNEG2,XMAX/-2.69754E37,-256.15E0,3.40E38/ C C Start computation C X = XVALUE C C Error test C IF ( X .GT. XHIGH1 ) THEN CALL ERRPRN(FNNAME,ERRMSG) AIRYHI = XMAX RETURN ENDIF C C Code for x >= 0.0 C IF ( X .GE. ZERO ) THEN IF ( X .LE. SEVEN ) THEN IF ( X .LT. XLOW1 ) THEN AIRYHI = HIZERO ELSE T = ( X + X ) / SEVEN - ONE TEMP = ( X + X + X ) / TWO AIRYHI = EXP(TEMP) * CHEVAL(NTERM1,ARHIP,T) ENDIF ELSE XCUBE = X * X * X TEMP = SQRT(XCUBE) ZETA = ( TEMP + TEMP ) / THREE T = TWO * ( SQRT(THRE43/XCUBE) ) - ONE TEMP = CHEVAL(NTERM2,ARBIP,T) TEMP = ZETA + LOG(TEMP) - LOG(X) / FOUR - LNRTPI BI = EXP(TEMP) T = ( TWELHU - XCUBE ) / ( XCUBE + FIVE14 ) GI = CHEVAL(NTERM3,ARGIP1,T) * ONEBPI / X AIRYHI = BI - GI ENDIF ELSE C C Code for x < 0.0 C IF ( X .GE. MINATE ) THEN IF ( X .GT. -XLOW1 ) THEN AIRYHI = HIZERO ELSE T = ( FOUR * X + TWELVE ) / ( X - TWELVE ) AIRYHI = CHEVAL(NTERM4,ARHIN1,T) ENDIF ELSE IF ( X .LT. XNEG1 ) THEN AIRYHI = ZERO ELSE IF ( X .LT. XNEG2 ) THEN TEMP = ONE ELSE XCUBE = X * X * X T = ( XCUBE + TWELHU ) / ( ONE76 - XCUBE ) TEMP = CHEVAL(NTERM5,ARHIN2,T) ENDIF AIRYHI = - TEMP * ONEBPI / X ENDIF ENDIF ENDIF RETURN END REAL FUNCTION ATNINT(XVALUE) C C DESCRIPTION: C C The function ATNINT calculates the value of the C inverse-tangent integral defined by C C ATNINT(x) = integral 0 to x ( (arctan t)/t ) dt C C The approximation uses Chebyshev series with the coefficients C given to an accuracy of 20D. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C There are no error returns from this program. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The no. of terms of the array ATNINTT. C The recommended value is such that C ATNINA(NTERMS) < EPS/100 C C XLOW - REAL - A bound below which ATNINT(x) = x to machine C precision. The recommended value is C sqrt(EPSNEG/2). C C XUPPER - REAL - A bound on x, above which, to machine precision C ATNINT(x) = (pi/2)ln x C The recommended value is 1/EPS. C C For values of EPSNEG and EPS for various machine/compiler C combinations refer to the text file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C ABS , LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C PAISLEY C SCOTLAND C C (e-mail macl_ms0@paisley.ac.uk ) C C C LATEST MODIFICATION: 9 June , 1995 C C C INTEGER IND,NTERMS REAL ATNINA(0:22),CHEVAL,HALF,ONE,ONEHUN,T,TWOBPI, & X,XLOW,XUPPER,XVALUE,ZERO DATA ZERO,HALF,ONE/0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA ONEHUN/100.0 E 0/ DATA TWOBPI/0.63661 97723 67581 34308 E 0/ DATA ATNINA(0)/ 1.91040 36129 62359 37512 E 0/ DATA ATNINA(1)/ -0.41763 51437 65674 6940 E -1/ DATA ATNINA(2)/ 0.27539 25507 86367 434 E -2/ DATA ATNINA(3)/ -0.25051 80952 62488 81 E -3/ DATA ATNINA(4)/ 0.26669 81285 12117 1 E -4/ DATA ATNINA(5)/ -0.31189 05141 07001 E -5/ DATA ATNINA(6)/ 0.38833 85313 2249 E -6/ DATA ATNINA(7)/ -0.50572 74584 964 E -7/ DATA ATNINA(8)/ 0.68122 52829 49 E -8/ DATA ATNINA(9)/ -0.94212 56165 4 E -9/ DATA ATNINA(10)/ 0.13307 87881 6 E -9/ DATA ATNINA(11)/-0.19126 78075 E -10/ DATA ATNINA(12)/ 0.27891 2620 E -11/ DATA ATNINA(13)/-0.41174 820 E -12/ DATA ATNINA(14)/ 0.61429 87 E -13/ DATA ATNINA(15)/-0.92492 9 E -14/ DATA ATNINA(16)/ 0.14038 7 E -14/ DATA ATNINA(17)/-0.21460 E -15/ DATA ATNINA(18)/ 0.3301 E -16/ DATA ATNINA(19)/-0.511 E -17/ DATA ATNINA(20)/ 0.79 E -18/ DATA ATNINA(21)/-0.12 E -18/ DATA ATNINA(22)/ 0.2 E -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERMS/9/ DATA XLOW,XUPPER/4.89E-4,8.4E6/ C C Start calculation C IND = 1 X = XVALUE IF ( X .LT. ZERO ) THEN X = -X IND = -1 ENDIF C C Code for X < = 1.0 C IF ( X .LE. ONE ) THEN IF ( X .LT. XLOW ) THEN ATNINT = X ELSE T = X * X T = ( T - HALF ) + ( T - HALF ) ATNINT = X * CHEVAL( NTERMS , ATNINA , T ) ENDIF ELSE C C Code for X > 1.0 C IF ( X .GT. XUPPER ) THEN ATNINT = LOG( X ) / TWOBPI ELSE T = ONE / ( X * X ) T = ( T - HALF ) + ( T - HALF ) ATNINT = LOG( X ) / TWOBPI + CHEVAL( NTERMS,ATNINA,T ) / X ENDIF ENDIF IF ( IND .LT. 0 ) ATNINT = - ATNINT RETURN END REAL FUNCTION BIRINT(XVALUE) C C DESCRIPTION: C This function calculates the integral of the Airy function Bi, defined C C BIRINT(x) = integral{0 to x} Bi(t) dt C C The program uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If the function is too large and positive the correct C value would overflow. An error message is printed and the C program returns the value XMAX. C C If the argument is too large and negative, it is impossible C to accurately compute the necessary SIN and COS functions, C for the asymptotic expansion. C An error message is printed, and the program returns the C value 0 (the value at -infinity). C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used from the array C ABINT1. The recommended value is such that C ABS(ABINT1(NTERM1)) < EPS/100, C subject to 1 <= NTERM1 <= 36. C C NTERM2 - INTEGER - The no. of terms to be used from the array C ABINT2. The recommended value is such that C ABS(ABINT2(NTERM2)) < EPS/100, C subject to 1 <= NTERM2 <= 37. C C NTERM3 - INTEGER - The no. of terms to be used from the array C ABINT3. The recommended value is such that C ABS(ABINT3(NTERM3)) < EPS/100, C subject to 1 <= NTERM3 <= 37. C C NTERM4 - INTEGER - The no. of terms to be used from the array C ABINT4. The recommended value is such that C ABS(ABINT4(NTERM4)) < EPS/100, C subject to 1 <= NTERM4 <= 20. C C NTERM5 - INTEGER - The no. of terms to be used from the array C ABINT5. The recommended value is such that C ABS(ABINT5(NTERM5)) < EPS/100, C subject to 1 <= NTERM5 <= 20. C C XLOW1 - REAL - The value such that, if |x| < XLOW1, C BIRINT(x) = x * Bi(0) C to machine precision. The recommended value is C 2 * EPSNEG. C C XHIGH1 - REAL - The value such that, if x > XHIGH1, C the function value would overflow. C The recommended value is computed as C z = ln(XMAX) + 0.5ln(ln(XMAX)), C XHIGH1 = (3z/2)^(2/3) C C XNEG1 - REAL - The value such that, if x < XNEG1, C the trigonometric functions in the asymptotic C expansion cannot be calculated accurately. C The recommended value is C -(1/((EPS)**2/3)) C C XMAX - REAL - The value of the largest positive floating-pt C number. Used in giving a value to the function C if x > XHIGH1. C C For values of EPS, EPSNEG, and XMAX see the file MACHCON.TXT. C C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C COS, EXP, LOG, SIN, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C Univ. of Paisley, C High St., C Paisley, C SCOTLAND. C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 9 JUNE, 1995. C INTEGER NTERM1,NTERM2,NTERM3,NTERM4,NTERM5 REAL ABINT1(0:36),ABINT2(0:37),ABINT3(0:37), 1 ABINT4(0:20),ABINT5(0:20), 2 ARG,BIRZER,CHEVAL,EIGHT,FOUR,F1,F2,NINE,NINHUN, 3 ONE,ONEHUN,ONEPT5,PIBY4,RT2B3P,SIXTEN,SEVEN,T,TEMP, 4 THREE,THR644,X,XLOW1,XHIGH1,XMAX,XNEG1,XVALUE, 5 Z,ZERO CHARACTER FNNAME*6,ERMSG1*31,ERMSG2*31 DATA FNNAME/'BIRINT'/ DATA ERMSG1/'ARGUMENT TOO LARGE AND POSITIVE'/ DATA ERMSG2/'ARGUMENT TOO LARGE AND NEGATIVE'/ DATA ABINT1(0)/ 0.38683 35244 50385 43350 E 0/ DATA ABINT1(1)/ -0.88232 13550 88890 8821 E -1/ DATA ABINT1(2)/ 0.21463 93744 03554 29239 E 0/ DATA ABINT1(3)/ -0.42053 47375 89131 5126 E -1/ DATA ABINT1(4)/ 0.59324 22547 49608 6771 E -1/ DATA ABINT1(5)/ -0.84078 70811 24270 210 E -2/ DATA ABINT1(6)/ 0.87182 47727 78487 955 E -2/ DATA ABINT1(7)/ -0.12191 60019 96134 55 E -3/ DATA ABINT1(8)/ 0.44024 82178 60232 34 E -3/ DATA ABINT1(9)/ 0.27894 68666 63866 78 E -3/ DATA ABINT1(10)/-0.70528 04689 78553 7 E -4/ DATA ABINT1(11)/ 0.59010 80066 77010 0 E -4/ DATA ABINT1(12)/-0.13708 62587 98214 2 E -4/ DATA ABINT1(13)/ 0.50596 25737 49073 E -5/ DATA ABINT1(14)/-0.51598 83776 6735 E -6/ DATA ABINT1(15)/ 0.39751 13123 49 E -8/ DATA ABINT1(16)/ 0.95249 85978 055 E -7/ DATA ABINT1(17)/-0.36814 35887 321 E -7/ DATA ABINT1(18)/ 0.12483 91688 136 E -7/ DATA ABINT1(19)/-0.24909 76191 37 E -8/ DATA ABINT1(20)/ 0.31775 24555 1 E -9/ DATA ABINT1(21)/ 0.54343 65270 E -10/ DATA ABINT1(22)/-0.40245 66915 E -10/ DATA ABINT1(23)/ 0.13938 55527 E -10/ DATA ABINT1(24)/-0.30381 7509 E -11/ DATA ABINT1(25)/ 0.40809 511 E -12/ DATA ABINT1(26)/ 0.16341 16 E -13/ DATA ABINT1(27)/-0.26838 09 E -13/ DATA ABINT1(28)/ 0.89664 1 E -14/ DATA ABINT1(29)/-0.18308 9 E -14/ DATA ABINT1(30)/ 0.21333 E -15/ DATA ABINT1(31)/ 0.1108 E -16/ DATA ABINT1(32)/-0.1276 E -16/ DATA ABINT1(33)/ 0.363 E -17/ DATA ABINT1(34)/-0.62 E -18/ DATA ABINT1(35)/ 0.5 E -19/ DATA ABINT1(36)/ 0.1 E -19/ DATA ABINT2(0)/ 2.04122 07860 25161 35181 E 0/ DATA ABINT2(1)/ 0.21241 33918 62122 1230 E -1/ DATA ABINT2(2)/ 0.66617 59976 67062 76 E -3/ DATA ABINT2(3)/ 0.38420 47982 80825 4 E -4/ DATA ABINT2(4)/ 0.36231 03660 20439 E -5/ DATA ABINT2(5)/ 0.50351 99011 5074 E -6/ DATA ABINT2(6)/ 0.79616 48702 253 E -7/ DATA ABINT2(7)/ 0.71780 84423 36 E -8/ DATA ABINT2(8)/ -0.26777 01591 04 E -8/ DATA ABINT2(9)/ -0.16848 95146 99 E -8/ DATA ABINT2(10)/-0.36811 75725 5 E -9/ DATA ABINT2(11)/ 0.47571 28727 E -10/ DATA ABINT2(12)/ 0.52636 21945 E -10/ DATA ABINT2(13)/ 0.77897 3500 E -11/ DATA ABINT2(14)/-0.46054 6143 E -11/ DATA ABINT2(15)/-0.18343 3736 E -11/ DATA ABINT2(16)/ 0.32191 249 E -12/ DATA ABINT2(17)/ 0.29352 060 E -12/ DATA ABINT2(18)/-0.16579 35 E -13/ DATA ABINT2(19)/-0.44838 08 E -13/ DATA ABINT2(20)/ 0.27907 E -15/ DATA ABINT2(21)/ 0.71192 1 E -14/ DATA ABINT2(22)/-0.1042 E -16/ DATA ABINT2(23)/-0.11959 1 E -14/ DATA ABINT2(24)/ 0.4606 E -16/ DATA ABINT2(25)/ 0.20884 E -15/ DATA ABINT2(26)/-0.2416 E -16/ DATA ABINT2(27)/-0.3638 E -16/ DATA ABINT2(28)/ 0.863 E -17/ DATA ABINT2(29)/ 0.591 E -17/ DATA ABINT2(30)/-0.256 E -17/ DATA ABINT2(31)/-0.77 E -18/ DATA ABINT2(32)/ 0.66 E -18/ DATA ABINT2(33)/ 0.3 E -19/ DATA ABINT2(34)/-0.15 E -18/ DATA ABINT2(35)/ 0.2 E -19/ DATA ABINT2(36)/ 0.3 E -19/ DATA ABINT2(37)/-0.1 E -19/ DATA ABINT3(0)/ 0.31076 96159 86403 49251 E 0/ DATA ABINT3(1)/ -0.27528 84588 74525 42718 E 0/ DATA ABINT3(2)/ 0.17355 96570 61365 43928 E 0/ DATA ABINT3(3)/ -0.55440 17909 49284 3130 E -1/ DATA ABINT3(4)/ -0.22512 65478 29595 0941 E -1/ DATA ABINT3(5)/ 0.41073 47447 81252 1894 E -1/ DATA ABINT3(6)/ 0.98476 12754 64262 480 E -2/ DATA ABINT3(7)/ -0.15556 18141 66604 1932 E -1/ DATA ABINT3(8)/ -0.56087 18707 30279 234 E -2/ DATA ABINT3(9)/ 0.24601 77833 22230 475 E -2/ DATA ABINT3(10)/ 0.16574 03922 92336 978 E -2/ DATA ABINT3(11)/-0.32775 87501 43540 2 E -4/ DATA ABINT3(12)/-0.24434 68086 05149 25 E -3/ DATA ABINT3(13)/-0.50353 05196 15232 1 E -4/ DATA ABINT3(14)/ 0.16302 64722 24785 4 E -4/ DATA ABINT3(15)/ 0.85191 40577 80934 E -5/ DATA ABINT3(16)/ 0.29790 36300 4664 E -6/ DATA ABINT3(17)/-0.64389 70789 6401 E -6/ DATA ABINT3(18)/-0.15046 98814 5803 E -6/ DATA ABINT3(19)/ 0.15870 13535 823 E -7/ DATA ABINT3(20)/ 0.12767 66299 622 E -7/ DATA ABINT3(21)/ 0.14057 85341 99 E -8/ DATA ABINT3(22)/-0.46564 73974 1 E -9/ DATA ABINT3(23)/-0.15682 74879 1 E -9/ DATA ABINT3(24)/-0.40389 3560 E -11/ DATA ABINT3(25)/ 0.66670 8192 E -11/ DATA ABINT3(26)/ 0.12886 9380 E -11/ DATA ABINT3(27)/-0.69686 63 E -13/ DATA ABINT3(28)/-0.62543 19 E -13/ DATA ABINT3(29)/-0.71839 2 E -14/ DATA ABINT3(30)/ 0.11529 6 E -14/ DATA ABINT3(31)/ 0.42276 E -15/ DATA ABINT3(32)/ 0.2493 E -16/ DATA ABINT3(33)/-0.971 E -17/ DATA ABINT3(34)/-0.216 E -17/ DATA ABINT3(35)/-0.2 E -19/ DATA ABINT3(36)/ 0.6 E -19/ DATA ABINT3(37)/ 0.1 E -19/ DATA ABINT4(0)/ 1.99507 95931 33520 47614 E 0/ DATA ABINT4(1)/ -0.27373 63759 70692 738 E -2/ DATA ABINT4(2)/ -0.30897 11308 12858 50 E -3/ DATA ABINT4(3)/ -0.35501 01982 79857 7 E -4/ DATA ABINT4(4)/ -0.41217 92715 20133 E -5/ DATA ABINT4(5)/ -0.48235 89231 6833 E -6/ DATA ABINT4(6)/ -0.56787 30727 927 E -7/ DATA ABINT4(7)/ -0.67187 48103 65 E -8/ DATA ABINT4(8)/ -0.79811 64985 7 E -9/ DATA ABINT4(9)/ -0.95142 71478 E -10/ DATA ABINT4(10)/-0.11374 68966 E -10/ DATA ABINT4(11)/-0.13635 9969 E -11/ DATA ABINT4(12)/-0.16381 418 E -12/ DATA ABINT4(13)/-0.19725 75 E -13/ DATA ABINT4(14)/-0.23784 4 E -14/ DATA ABINT4(15)/-0.28752 E -15/ DATA ABINT4(16)/-0.3475 E -16/ DATA ABINT4(17)/-0.422 E -17/ DATA ABINT4(18)/-0.51 E -18/ DATA ABINT4(19)/-0.6 E -19/ DATA ABINT4(20)/-0.1 E -19/ DATA ABINT5(0)/ 1.12672 08196 17825 66017 E 0/ DATA ABINT5(1)/ -0.67140 55675 25561 198 E -2/ DATA ABINT5(2)/ -0.69812 91801 78329 69 E -3/ DATA ABINT5(3)/ -0.75616 89886 42527 6 E -4/ DATA ABINT5(4)/ -0.83498 55745 10207 E -5/ DATA ABINT5(5)/ -0.93630 29823 2480 E -6/ DATA ABINT5(6)/ -0.10608 55629 6250 E -6/ DATA ABINT5(7)/ -0.12131 28916 741 E -7/ DATA ABINT5(8)/ -0.13963 11297 65 E -8/ DATA ABINT5(9)/ -0.16178 91805 4 E -9/ DATA ABINT5(10)/-0.18823 07907 E -10/ DATA ABINT5(11)/-0.22027 2985 E -11/ DATA ABINT5(12)/-0.25816 189 E -12/ DATA ABINT5(13)/-0.30479 64 E -13/ DATA ABINT5(14)/-0.35837 0 E -14/ DATA ABINT5(15)/-0.42831 E -15/ DATA ABINT5(16)/-0.4993 E -16/ DATA ABINT5(17)/-0.617 E -17/ DATA ABINT5(18)/-0.68 E -18/ DATA ABINT5(19)/-0.10 E -18/ DATA ABINT5(20)/-0.1 E -19/ DATA ZERO,ONE,ONEPT5/ 0.0 E 0 , 1.0 E 0 , 1.5 E 0 / DATA THREE,FOUR,SEVEN/ 3.0 E 0 , 4.0 E 0 , 7.0 E 0 / DATA EIGHT,NINE,SIXTEN/ 8.0 E 0 , 9.0 E 0 , 16.0 E 0 / DATA ONEHUN,NINHUN,THR644/100.0 E 0 , 900.0 E 0 , 3644.0 E 0 / DATA PIBY4/0.78539 81633 97448 30962 E 0/ DATA RT2B3P/0.46065 88659 61780 63902 E 0/ DATA BIRZER/0.61492 66274 46000 73515 E 0/ C C Machine-dependent parameters (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3,NTERM4,NTERM5/20,10,23,8,9/ DATA XLOW1,XHIGH1/1.19E-7,26.50389E0/ DATA XNEG1,XMAX/-41333.485E0,3.40E38/ C C Start computation C X = XVALUE C C Error test C IF ( X .GT. XHIGH1 ) THEN CALL ERRPRN(FNNAME,ERMSG1) BIRINT = XMAX RETURN ENDIF IF ( X .LT. XNEG1 ) THEN CALL ERRPRN(FNNAME,ERMSG2) BIRINT = ZERO RETURN ENDIF C C Code for x >= 0.0 C IF ( X .GE. ZERO ) THEN IF ( X .LT. XLOW1 ) THEN BIRINT = BIRZER * X ELSE IF ( X .LE. EIGHT ) THEN T = X / FOUR - ONE BIRINT = X * EXP(ONEPT5*X) * CHEVAL(NTERM1,ABINT1,T) ELSE T = SIXTEN * SQRT(EIGHT/X) / X - ONE Z = ( X + X ) * SQRT(X) / THREE TEMP = RT2B3P * CHEVAL(NTERM2,ABINT2,T) / SQRT(Z) TEMP = Z + LOG(TEMP) BIRINT = EXP(TEMP) ENDIF ENDIF ELSE C C Code for x < 0.0 C IF ( X .GE. -SEVEN ) THEN IF ( X .GT. -XLOW1 ) THEN BIRINT = BIRZER * X ELSE T = - ( X + X ) / SEVEN - ONE BIRINT = X * CHEVAL(NTERM3,ABINT3,T) ENDIF ELSE Z = - ( X + X ) * SQRT(-X) / THREE ARG = Z + PIBY4 TEMP = NINE * Z * Z T = (THR644 - TEMP ) / ( NINHUN + TEMP ) F1 = CHEVAL(NTERM4,ABINT4,T) * SIN(ARG) F2 = CHEVAL(NTERM5,ABINT5,T) * COS(ARG) / Z BIRINT = ( F2 - F1 ) * RT2B3P / SQRT(Z) ENDIF ENDIF RETURN END REAL FUNCTION CLAUSN(XVALUE) C C DESCRIPTION: C C This program calculates Clausen's integral defined by C C CLAUSN(x) = integral 0 to x of (-ln(2*sin(t/2))) dt C C The code uses Chebyshev expansions with the coefficients C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If |x| is too large it is impossible to reduce the argument C to the range [0,2*pi] with any precision. An error message C is printed and the program returns the value 0.0 C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - the no. of terms of the array ACLAUS C to be used. The recommended value is C such that ABS(ACLAUS(NTERMS)) < EPS/100 C subject to 1 <= NTERMS <= 15 C C XSMALL - REAL - the value below which Cl(x) can be C approximated by x (1-ln x). The recommended C value is pi*sqrt(EPSNEG/2). C C XHIGH - REAL - The value of |x| above which we cannot C reliably reduce the argument to [0,2*pi]. C The recommended value is 1/EPS. C C For values of EPS and EPSNEG refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C AINT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St. C PAISLEY C SCOTLAND C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST MODIFICATION: 9 JUNE , 1995 C INTEGER INDX,NTERMS REAL ACLAUS(0:15),CHEVAL,HALF,ONE,ONEHUN,PI,PISQ,T, & TWOPI,TWOPIA,TWOPIB,X,XHIGH,XSMALL,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'CLAUSN'/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,HALF,ONE/0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA ONEHUN/100.0 E 0/ DATA PI/3.14159 26535 89793 2385 E 0/ DATA PISQ/9.86960 44010 89358 6188 E 0/ DATA TWOPI/6.28318 53071 79586 4769 E 0/ DATA TWOPIA,TWOPIB/6.28125 E 0 , 0.19353 07179 58647 69253 E -2/ DATA ACLAUS/2.14269 43637 66688 44709 E 0, 1 0.72332 42812 21257 9245 E -1, 2 0.10164 24750 21151 164 E -2, 3 0.32452 50328 53164 5 E -4, 4 0.13331 51875 71472 E -5, 5 0.62132 40591 653 E -7, 6 0.31300 41353 37 E -8, 7 0.16635 72305 6 E -9, 8 0.91965 9293 E -11, 9 0.52400 462 E -12, X 0.30580 40 E -13, 1 0.18196 9 E -14, 2 0.11004 E -15, 3 0.675 E -17, 4 0.42 E -18, 5 0.3 E -19/ C C Set machine-dependent constants (suitable for IEEE machines) C DATA NTERMS/7/ DATA XSMALL,XHIGH/0.55E-3,8388608.0E0/ C C Start execution C X = XVALUE C C Error test C IF ( ABS(X) .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) CLAUSN = ZERO RETURN ENDIF INDX = 1 IF ( X .LT. ZERO ) THEN X = -X INDX = -1 ENDIF C C Argument reduced using simulated extra precision C IF ( X .GT. TWOPI ) THEN T = AINT( X / TWOPI ) X = ( X - T * TWOPIA ) - T * TWOPIB ENDIF IF ( X .GT. PI ) THEN X = ( TWOPIA - X ) + TWOPIB INDX = -INDX ENDIF C C Set result to zero if X multiple of PI C IF ( X .EQ. ZERO ) THEN CLAUSN = ZERO RETURN ENDIF C C Code for X < XSMALL C IF ( X .LT. XSMALL ) THEN CLAUSN = X * ( ONE - LOG( X ) ) ELSE C C Code for XSMALL < = X < = PI C T = ( X * X ) / PISQ - HALF T = T + T IF ( T .GT. ONE ) T = ONE CLAUSN = X * CHEVAL( NTERMS,ACLAUS,T ) - X * LOG( X ) ENDIF IF ( INDX .LT. 0 ) CLAUSN = -CLAUSN RETURN END REAL FUNCTION DEBYE1(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 1, defined as C C DEBYE1(x) = [Integral {0 to x} t/(exp(t)-1) dt] / x C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB1. C The recommended value is such that C ABS(ADEB1(NTERMS)) < EPS/100 , with C 1 <= NTERMS <= 18 C C XLOW - REAL - The value below which C DEBYE1 = 1 - x/4 + x*x/36 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - REAL - The value above which C DEBYE1 = (pi*pi/(6*x)) - exp(-x)(x+1)/x. C The recommended value is C -LOG(2*EPS) C C XLIM - REAL - The value above which DEBYE1 = pi*pi/(6*x) C The recommended value is C -LOG(XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 9 JUNE, 1995 C INTEGER I,NEXP,NTERMS REAL ADEB1(0:18),CHEVAL,DEBINF,EIGHT,EXPMX,FOUR,HALF, & NINE,ONE,ONEHUN,QUART,RK,SUM,T,THIRT6,X,XK,XLIM,XLOW, & XUPPER,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE1'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,QUART/0.0 E 0 , 0.25 E 0/ DATA HALF,ONE/0.5 E 0 , 1.0 E 0/ DATA FOUR,EIGHT/4.0 E 0 , 8.0 E 0/ DATA NINE,THIRT6,ONEHUN/9.0 E 0 , 36.0 E 0 , 100.0 E 0/ DATA DEBINF/0.60792 71018 54026 62866 E 0/ DATA ADEB1/2.40065 97190 38141 01941 E 0, 1 0.19372 13042 18936 00885 E 0, 2 -0.62329 12455 48957 703 E -2, 3 0.35111 74770 20648 00 E -3, 4 -0.22822 24667 01231 0 E -4, 5 0.15805 46787 50300 E -5, 6 -0.11353 78197 0719 E -6, 7 0.83583 36118 75 E -8, 8 -0.62644 24787 2 E -9, 9 0.47603 34890 E -10, X -0.36574 1540 E -11, 1 0.28354 310 E -12, 2 -0.22147 29 E -13, 3 0.17409 2 E -14, 4 -0.13759 E -15, 5 0.1093 E -16, 6 -0.87 E -18, 7 0.7 E -19, 8 -0.1 E -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA XLOW,XUPPER,XLIM/6.905E-4,15.9251E0,87.33E0/ DATA NTERMS/9/ C C Start computation C X = XVALUE C C Check XVALUE >= 0.0 C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE1 = ZERO RETURN ENDIF C C Code for x <= 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE1 = ( ( X - NINE ) * X + THIRT6 ) / THIRT6 ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE1 = CHEVAL( NTERMS , ADEB1 , T ) - QUART * X ENDIF ELSE C C Code for x > 4.0 C DEBYE1 = ONE / ( X * DEBINF ) IF ( X .LT. XLIM ) THEN EXPMX = EXP( -X ) IF ( X .GT. XUPPER ) THEN DEBYE1 = DEBYE1 - EXPMX * ( ONE + ONE / X ) ELSE SUM = ZERO RK = AINT( XLIM / X ) NEXP = INT( RK ) XK = RK * X DO 100 I = NEXP,1,-1 T = ( ONE + ONE / XK ) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE DEBYE1 = DEBYE1 - SUM * EXPMX ENDIF ENDIF ENDIF RETURN END REAL FUNCTION DEBYE2(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 1, defined as C C DEBYE2(x) = 2*[Integral {0 to x} t*t/(exp(t)-1) dt] / (x*x) C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB2. C The recommended value is such that C ABS(ADEB2(NTERMS)) < EPS/100, C subject to 1 <= NTERMS <= 18. C C XLOW - REAL - The value below which C DEBYE2 = 1 - x/3 + x*x/24 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - REAL - The value above which C DEBYE2 = (4*zeta(3)/x^2) - 2*exp(-x)(x^2+2x+1)/x^2. C The recommended value is C -LOG(2*EPS) C C XLIM1 - REAL - The value above which DEBYE2 = 4*zeta(3)/x^2 C The recommended value is C -LOG(XMIN) C C XLIM2 - REAL - The value above which DEBYE2 = 0.0 to machine C precision. The recommended value is C SQRT(4.8/XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 9 JUNE, 1995 C INTEGER I,NEXP,NTERMS REAL ADEB2(0:18),CHEVAL,DEBINF,EIGHT,EXPMX,FOUR, & HALF,ONE,ONEHUN,RK,SUM,T,THREE,TWENT4,TWO,X,XK,XLIM1, & XLIM2,XLOW,XUPPER,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE2'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,HALF/0.0 E 0 , 0.5 E 0/ DATA ONE,TWO,THREE/1.0 E 0 , 2.0 E 0 , 3.0 E 0/ DATA FOUR,EIGHT,TWENT4/4.0 E 0 , 8.0 E 0 , 24.0 E 0/ DATA ONEHUN/100.0 E 0/ DATA DEBINF/4.80822 76126 38377 14160 E 0/ DATA ADEB2/2.59438 10232 57077 02826 E 0, 1 0.28633 57204 53071 98337 E 0, 2 -0.10206 26561 58046 7129 E -1, 3 0.60491 09775 34684 35 E -3, 4 -0.40525 76589 50210 4 E -4, 5 0.28633 82632 88107 E -5, 6 -0.20863 94303 0651 E -6, 7 0.15523 78758 264 E -7, 8 -0.11731 28008 66 E -8, 9 0.89735 85888 E -10, X -0.69317 6137 E -11, 1 0.53980 568 E -12, 2 -0.42324 05 E -13, 3 0.33377 8 E -14, 4 -0.26455 E -15, 5 0.2106 E -16, 6 -0.168 E -17, 7 0.13 E -18, 8 -0.1 E -19/ C C Machine-dependent constants C DATA XLOW,XUPPER/6.905E-4,15.9251E0/ DATA XLIM1,XLIM2/87.33E0,2.0168E19/ DATA NTERMS/9/ C C Start computation C X = XVALUE C C Check XVALUE >= 0.0 C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE2 = ZERO RETURN ENDIF C C Code for x <= 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE2 = ( ( X - EIGHT ) * X + TWENT4 ) / TWENT4 ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE2 = CHEVAL ( NTERMS , ADEB2 , T ) - X / THREE ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XLIM2 ) THEN DEBYE2 = ZERO ELSE DEBYE2 = DEBINF / ( X * X ) IF ( X .LT. XLIM1 ) THEN EXPMX = EXP ( -X ) IF ( X .GT. XUPPER ) THEN SUM = ( ( X + TWO ) * X + TWO ) / ( X * X ) ELSE SUM = ZERO RK = AINT ( XLIM1 / X ) NEXP = INT ( RK ) XK = RK * X DO 100 I = NEXP,1,-1 T = ( ONE + TWO / XK + TWO / ( XK*XK ) ) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE ENDIF DEBYE2 = DEBYE2 - TWO * SUM * EXPMX ENDIF ENDIF ENDIF RETURN END REAL FUNCTION DEBYE3(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 3, defined as C C DEBYE3(x) = 3*[Integral {0 to x} t^3/(exp(t)-1) dt] / (x^3) C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB3. C The recommended value is such that C ABS(ADEB3(NTERMS)) < EPS/100, C subject to 1 <= NTERMS <= 18 C C XLOW - REAL - The value below which C DEBYE3 = 1 - 3x/8 + x*x/20 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - REAL - The value above which C DEBYE3 = (18*zeta(4)/x^3) - 3*exp(-x)(x^3+3x^2+6x+6)/x^3. C The recommended value is C -LOG(2*EPS) C C XLIM1 - REAL - The value above which DEBYE3 = 18*zeta(4)/x^3 C The recommended value is C -LOG(XMIN) C C XLIM2 - REAL - The value above which DEBYE3 = 0.0 to machine C precision. The recommended value is C CUBE ROOT(19/XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 9 JUNE, 1995 C INTEGER I,NEXP,NTERMS REAL ADEB3(0:18),CHEVAL,DEBINF,EIGHT,EXPMX,FOUR, & HALF,ONE,ONEHUN,PT375,RK,SEVP5,SIX,SUM,T,THREE,TWENTY,X, & XK,XKI,XLIM1,XLIM2,XLOW,XUPPER,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE3'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,PT375/0.0 E 0 , 0.375 E 0/ DATA HALF,ONE/0.5 E 0 , 1.0 E 0/ DATA THREE,FOUR,SIX/3.0 E 0 , 4.0 E 0 , 6.0 E 0/ DATA SEVP5,EIGHT,TWENTY/7.5 E 0 , 8.0 E 0 , 20.0 E 0/ DATA ONEHUN/100.0 E 0/ DATA DEBINF/0.51329 91127 34216 75946 E -1/ DATA ADEB3/2.70773 70683 27440 94526 E 0, 1 0.34006 81352 11091 75100 E 0, 2 -0.12945 15018 44408 6863 E -1, 3 0.79637 55380 17381 64 E -3, 4 -0.54636 00095 90823 8 E -4, 5 0.39243 01959 88049 E -5, 6 -0.28940 32823 5386 E -6, 7 0.21731 76139 625 E -7, 8 -0.16542 09994 98 E -8, 9 0.12727 96189 2 E -9, X -0.98796 3459 E -11, 1 0.77250 740 E -12, 2 -0.60779 72 E -13, 3 0.48075 9 E -14, 4 -0.38204 E -15, 5 0.3048 E -16, 6 -0.244 E -17, 7 0.20 E -18, 8 -0.2 E -19/ C C Machine-dependent constants C DATA XLOW,XUPPER/6.905E-4,15.9251E0/ DATA XLIM1,XLIM2/87.33E0,1.172E13/ DATA NTERMS/9/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE3 = ZERO RETURN ENDIF C C Code for x <= 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE3 = ( ( X - SEVP5 ) * X + TWENTY ) / TWENTY ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE3 = CHEVAL ( NTERMS , ADEB3 , T ) - PT375 * X ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XLIM2 ) THEN DEBYE3 = ZERO ELSE DEBYE3 = ONE / ( DEBINF * X * X * X ) IF ( X .LT. XLIM1 ) THEN EXPMX = EXP ( -X ) IF ( X .GT. XUPPER ) THEN SUM = (((X+THREE)*X+SIX)*X+SIX) / (X*X*X) ELSE SUM = ZERO RK = AINT ( XLIM1 / X ) NEXP = INT ( RK ) XK = RK * X DO 100 I = NEXP,1,-1 XKI = ONE / XK T = (((SIX*XKI+SIX)*XKI+THREE)*XKI+ONE) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE ENDIF DEBYE3 = DEBYE3 - THREE * SUM * EXPMX ENDIF ENDIF ENDIF RETURN END REAL FUNCTION DEBYE4(XVALUE) C C C DEFINITION: C C This program calculates the Debye function of order 4, defined as C C DEBYE4(x) = 4*[Integral {0 to x} t^4/(exp(t)-1) dt] / (x^4) C C The code uses Chebyshev series whose coefficients C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0 an error message is printed and the C function returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERMS - INTEGER - The no. of elements of the array ADEB4. C The recommended value is such that C ABS(ADEB4(NTERMS)) < EPS/100, C subject to 1 <= NTERMS <= 18 C C XLOW - REAL - The value below which C DEBYE4 = 1 - 4x/10 + x*x/18 to machine precision. C The recommended value is C SQRT(8*EPSNEG) C C XUPPER - REAL - The value above which C DEBYE4=(96*zeta(5)/x^4)-4*exp(-x)(x^4+4x^2+12x^2+24x+24)/x^4. C The recommended value is C -LOG(2*EPS) C C XLIM1 - REAL - The value above which DEBYE4 = 96*zeta(5)/x^4 C The recommended value is C -LOG(XMIN) C C XLIM2 - REAL - The value above which DEBYE4 = 0.0 to machine C precision. The recommended value is C FOURTH ROOT(99/XMIN) C C For values of EPS, EPSNEG, and XMIN see the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C AINT , EXP , INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley C High St. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: 9 JUNE, 1995 C INTEGER I,NEXP,NTERMS REAL ADEB4(0:18),CHEVAL,DEBINF,EIGHT,EIGHTN,EXPMX,FIVE, 1 FOUR,FORTY5,HALF,ONE,ONEHUN,RK,SUM,T,TWELVE,TWENT4, 2 TWOPT5,X,XK,XKI,XLIM1,XLIM2,XLOW,XUPPER,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*17 DATA FNNAME/'DEBYE4'/ DATA ERRMSG/'ARGUMENT NEGATIVE'/ DATA ZERO,HALF,ONE/0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA TWOPT5,FOUR,FIVE/2.5 E 0 , 4.0 E 0 , 5.0 E 0/ DATA EIGHT,TWELVE,EIGHTN/8.0 E 0 , 12.0 E 0 , 18.0 E 0/ DATA TWENT4,FORTY5,ONEHUN/24.0 E 0 , 45.0 E 0 , 100.0 E 0/ DATA DEBINF/99.54506 44937 63512 92781 E 0/ DATA ADEB4/2.78186 94150 20523 46008 E 0, 1 0.37497 67835 26892 86364 E 0, 2 -0.14940 90739 90315 8326 E -1, 3 0.94567 98114 37042 74 E -3, 4 -0.66132 91613 89325 5 E -4, 5 0.48156 32982 14449 E -5, 6 -0.35880 83958 7593 E -6, 7 0.27160 11874 160 E -7, 8 -0.20807 09912 23 E -8, 9 0.16093 83869 2 E -9, X -0.12547 09791 E -10, 1 0.98472 647 E -12, 2 -0.77723 69 E -13, 3 0.61648 3 E -14, 4 -0.49107 E -15, 5 0.3927 E -16, 6 -0.315 E -17, 7 0.25 E -18, 8 -0.2 E -19/ C C Machine-dependent constants C DATA XLOW,XUPPER/6.905E-4,15.9251E0/ DATA XLIM1,XLIM2/87.33E0,9.5705E9/ DATA NTERMS/9/ C C Start computation C X = XVALUE C C Check XVALUE >= 0.0 C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) DEBYE4 = ZERO RETURN ENDIF C C Code for x <= 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW ) THEN DEBYE4 = ( ( TWOPT5 * X - EIGHTN ) * X + FORTY5 ) / FORTY5 ELSE T = ( ( X * X / EIGHT ) - HALF ) - HALF DEBYE4 = CHEVAL ( NTERMS , ADEB4 , T ) - ( X + X ) / FIVE ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XLIM2 ) THEN DEBYE4 = ZERO ELSE T = X * X DEBYE4 = ( DEBINF / T ) / T IF ( X .LT. XLIM1 ) THEN EXPMX = EXP ( -X ) IF ( X .GT. XUPPER ) THEN SUM = ( ( ( ( X + FOUR ) * X + TWELVE ) * X + & TWENT4 ) * X + TWENT4 ) / ( X * X * X * X ) ELSE SUM = ZERO RK = AINT ( XLIM1 / X ) NEXP = INT ( RK ) XK = RK * X DO 100 I = NEXP,1,-1 XKI = ONE / XK T = ( ( ( ( TWENT4 * XKI + TWENT4 ) * XKI + & TWELVE ) * XKI + FOUR ) * XKI + ONE ) / RK SUM = SUM * EXPMX + T RK = RK - ONE XK = XK - X 100 CONTINUE ENDIF DEBYE4 = DEBYE4 - FOUR * SUM * EXPMX ENDIF ENDIF ENDIF RETURN END REAL FUNCTION EXP3(XVALUE) C C DESCRIPTION C C This function calculates C C EXP3(X) = integral 0 to X (exp(-t*t*t)) dt C C The code uses Chebyshev expansions, whose coefficients are C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS C C If XVALUE < 0, an error message is printed and the function C returns the value 0. C C C MACHINE-DEPENDENT CONSTANTS C C NTERM1 - INTEGER - The no. of terms of the array AEXP3, C The recommended value is such that C AEXP3(NTERM1) < EPS/100. C C NTERM2 - INTEGER - The no. of terms of the array AEXP3A. C The recommended value is such that C AEXP3A(NTERM2) < EPS/100. C C XLOW - REAL - The value below which EXP3(X) = X to machine C precision. The recommended value is C cube root(4*EPSNEG) C C XUPPER - REAL - The value above which EXP3(X) = 0.89297... C to machine precision. The recommended value is C cube root(-ln(EPSNEG)) C C For values of EPS and EPSNEG for various machine/compiler C combinations refer to the file MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED C C EXP, LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR C C DR. ALLAN J. MACLEOD, C DEPARTMENT OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY C SCOTLAND. C C (e-mail macl_ms0@paisley.ac.uk ) C C C LATEST MODIFICATION: 13 June, 1995 C C INTEGER NTERM1,NTERM2 REAL AEXP3(0:24),AEXP3A(0:24),CHEVAL,FOUR,FUNINF,HALF,ONE, & ONEHUN,SIXTEN,T,THREE,TWO,X,XLOW,XUPPER,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'EXP3 '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA TWO,THREE,FOUR/2.0 E 0 , 3.0 E 0 , 4.0 E 0 / DATA SIXTEN,ONEHUN/16.0 E 0 , 100.0 E 0/ DATA FUNINF/0.89297 95115 69249 21122 E 0/ DATA AEXP3(0)/ 1.26919 84142 21126 01434 E 0/ DATA AEXP3(1)/ -0.24884 64463 84140 98226 E 0/ DATA AEXP3(2)/ 0.80526 22071 72310 4125 E -1/ DATA AEXP3(3)/ -0.25772 73325 19683 2934 E -1/ DATA AEXP3(4)/ 0.75998 78873 07377 429 E -2/ DATA AEXP3(5)/ -0.20306 95581 94040 510 E -2/ DATA AEXP3(6)/ 0.49083 45866 99329 17 E -3/ DATA AEXP3(7)/ -0.10768 22391 42020 77 E -3/ DATA AEXP3(8)/ 0.21551 72626 42898 4 E -4/ DATA AEXP3(9)/ -0.39567 05137 38429 E -5/ DATA AEXP3(10)/ 0.66992 40933 8956 E -6/ DATA AEXP3(11)/-0.10513 21808 0703 E -6/ DATA AEXP3(12)/ 0.15362 58019 825 E -7/ DATA AEXP3(13)/-0.20990 96036 36 E -8/ DATA AEXP3(14)/ 0.26921 09538 1 E -9/ DATA AEXP3(15)/-0.32519 52422 E -10/ DATA AEXP3(16)/ 0.37114 8157 E -11/ DATA AEXP3(17)/-0.40136 518 E -12/ DATA AEXP3(18)/ 0.41233 46 E -13/ DATA AEXP3(19)/-0.40337 5 E -14/ DATA AEXP3(20)/ 0.37658 E -15/ DATA AEXP3(21)/-0.3362 E -16/ DATA AEXP3(22)/ 0.288 E -17/ DATA AEXP3(23)/-0.24 E -18/ DATA AEXP3(24)/ 0.2 E -19/ DATA AEXP3A(0)/ 1.92704 64955 06827 37293 E 0/ DATA AEXP3A(1)/ -0.34929 35652 04813 8054 E -1/ DATA AEXP3A(2)/ 0.14503 38371 89830 093 E -2/ DATA AEXP3A(3)/ -0.89253 36718 32790 3 E -4/ DATA AEXP3A(4)/ 0.70542 39219 11838 E -5/ DATA AEXP3A(5)/ -0.66717 27454 7611 E -6/ DATA AEXP3A(6)/ 0.72426 75899 824 E -7/ DATA AEXP3A(7)/ -0.87825 82560 56 E -8/ DATA AEXP3A(8)/ 0.11672 23442 78 E -8/ DATA AEXP3A(9)/ -0.16766 31281 2 E -9/ DATA AEXP3A(10)/ 0.25755 01577 E -10/ DATA AEXP3A(11)/-0.41957 8881 E -11/ DATA AEXP3A(12)/ 0.72010 412 E -12/ DATA AEXP3A(13)/-0.12949 055 E -12/ DATA AEXP3A(14)/ 0.24287 03 E -13/ DATA AEXP3A(15)/-0.47331 1 E -14/ DATA AEXP3A(16)/ 0.95531 E -15/ DATA AEXP3A(17)/-0.19914 E -15/ DATA AEXP3A(18)/ 0.4277 E -16/ DATA AEXP3A(19)/-0.944 E -17/ DATA AEXP3A(20)/ 0.214 E -17/ DATA AEXP3A(21)/-0.50 E -18/ DATA AEXP3A(22)/ 0.12 E -18/ DATA AEXP3A(23)/-0.3 E -19/ DATA AEXP3A(24)/ 0.1 E -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA XLOW,XUPPER/6.20E-3,2.5528E0/ DATA NTERM1,NTERM2/13,8/ C C Start calculation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) EXP3 = ZERO RETURN ENDIF C C Code for XVALUE < = 2 C IF ( X .LE. TWO ) THEN IF ( X .LT. XLOW ) THEN EXP3 = X ELSE T = ( ( X * X * X / FOUR ) - HALF ) - HALF EXP3 = X * CHEVAL ( NTERM1,AEXP3,T ) ENDIF ELSE C C Code for XVALUE > 2 C IF ( X .GT. XUPPER ) THEN EXP3 = FUNINF ELSE T = ( ( SIXTEN/ ( X * X * X ) ) - HALF ) - HALF T = CHEVAL ( NTERM2,AEXP3A,T ) T = T * EXP ( -X * X * X ) / ( THREE * X * X ) EXP3 = FUNINF - T ENDIF ENDIF RETURN END REAL FUNCTION GOODST(XVALUE) C C DESCRIPTION: C C This function calculates the function defined as C C GOODST(x) = {integral 0 to inf} ( exp(-u*u)/(u+x) ) du C C The code uses Chebyshev expansions whose coefficients are C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE <= 0.0, an error message is printed, and the C code returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array AGOST. C The recommended value is such that C AGOST(NTERM1) < EPS/100, C C NTERM2 - The no. of terms to be used in the array AGOSTA. C The recommended value is such that C AGOSTA(NTERM2) < EPS/100, C C XLOW - The value below which f(x) = -(gamma/2) - ln(x) C to machine precision. The recommended value is C EPSNEG C C XHIGH - The value above which f(x) = sqrt(pi)/(2x) to C machine precision. The recommended value is C 2 / EPSNEG C C For values of EPS and EPSNEG refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley. C SCOTLAND. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 12 JUNE, 1995 C C INTEGER NTERM1,NTERM2 REAL AGOST(0:28),AGOSTA(0:23), 1 CHEVAL,FVAL,GAMBY2,HALF,ONE,ONEHUN,RTPIB2,SIX, 2 T,TWO,X,XHIGH,XLOW,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*15 DATA FNNAME/'GOODST'/ DATA ERRMSG/'ARGUMENT <= 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA TWO,SIX/ 2.0 E 0 , 6.0 E 0 / DATA ONEHUN/100.0 E 0/ DATA GAMBY2/0.28860 78324 50766 43030 E 0/ DATA RTPIB2/0.88622 69254 52758 01365 E 0/ DATA AGOST(0)/ 0.63106 56056 03984 46247 E 0/ DATA AGOST(1)/ 0.25051 73779 32167 08827 E 0/ DATA AGOST(2)/ -0.28466 20597 90189 40757 E 0/ DATA AGOST(3)/ 0.87615 87523 94862 3552 E -1/ DATA AGOST(4)/ 0.68260 22672 21252 724 E -2/ DATA AGOST(5)/ -0.10811 29544 19225 4677 E -1/ DATA AGOST(6)/ 0.16910 12441 17152 176 E -2/ DATA AGOST(7)/ 0.50272 98462 26151 86 E -3/ DATA AGOST(8)/ -0.18576 68720 41000 84 E -3/ DATA AGOST(9)/ -0.42870 36741 68474 E -5/ DATA AGOST(10)/ 0.10095 98903 20290 5 E -4/ DATA AGOST(11)/-0.86529 91351 7382 E -6/ DATA AGOST(12)/-0.34983 87432 0734 E -6/ DATA AGOST(13)/ 0.64832 78683 494 E -7/ DATA AGOST(14)/ 0.75759 24985 83 E -8/ DATA AGOST(15)/-0.27793 54243 62 E -8/ DATA AGOST(16)/-0.48302 35135 E -10/ DATA AGOST(17)/ 0.86632 21283 E -10/ DATA AGOST(18)/-0.39433 9687 E -11/ DATA AGOST(19)/-0.20952 9625 E -11/ DATA AGOST(20)/ 0.21501 759 E -12/ DATA AGOST(21)/ 0.39590 15 E -13/ DATA AGOST(22)/-0.69227 9 E -14/ DATA AGOST(23)/-0.54829 E -15/ DATA AGOST(24)/ 0.17108 E -15/ DATA AGOST(25)/ 0.376 E -17/ DATA AGOST(26)/-0.349 E -17/ DATA AGOST(27)/ 0.7 E -19/ DATA AGOST(28)/ 0.6 E -19/ DATA AGOSTA(0)/ 1.81775 46798 47187 58767 E 0/ DATA AGOSTA(1)/ -0.99211 46570 74409 7467 E -1/ DATA AGOSTA(2)/ -0.89405 86452 54819 243 E -2/ DATA AGOSTA(3)/ -0.94955 33127 77267 85 E -3/ DATA AGOSTA(4)/ -0.10971 37996 67596 65 E -3/ DATA AGOSTA(5)/ -0.13466 94539 57859 0 E -4/ DATA AGOSTA(6)/ -0.17274 92743 08265 E -5/ DATA AGOSTA(7)/ -0.22931 38019 9498 E -6/ DATA AGOSTA(8)/ -0.31278 44178 918 E -7/ DATA AGOSTA(9)/ -0.43619 79736 71 E -8/ DATA AGOSTA(10)/-0.61958 46474 3 E -9/ DATA AGOSTA(11)/-0.89379 91276 E -10/ DATA AGOSTA(12)/-0.13065 11094 E -10/ DATA AGOSTA(13)/-0.19316 6876 E -11/ DATA AGOSTA(14)/-0.28844 270 E -12/ DATA AGOSTA(15)/-0.43447 96 E -13/ DATA AGOSTA(16)/-0.65951 8 E -14/ DATA AGOSTA(17)/-0.10080 1 E -14/ DATA AGOSTA(18)/-0.15502 E -15/ DATA AGOSTA(19)/-0.2397 E -16/ DATA AGOSTA(20)/-0.373 E -17/ DATA AGOSTA(21)/-0.58 E -18/ DATA AGOSTA(22)/-0.9 E -19/ DATA AGOSTA(23)/-0.1 E -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2/15,10/ DATA XLOW,XHIGH/5.96E-8,33554432.0E0/ C C Start computation C X = XVALUE C C Error test C IF ( X .LE. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) GOODST = ZERO RETURN ENDIF C C Computation for 0 < x <= 2 C IF ( X .LE. TWO ) THEN IF ( X .LT. XLOW ) THEN GOODST = - GAMBY2 - LOG(X) ELSE T = ( X - HALF ) - HALF GOODST = CHEVAL(NTERM1,AGOST,T) - EXP(-X*X) * LOG(X) ENDIF ELSE C C Computation for x > 2 C FVAL = RTPIB2 / X IF ( X .GT. XHIGH ) THEN GOODST = FVAL ELSE T = ( SIX - X ) / ( TWO + X ) GOODST = FVAL * CHEVAL(NTERM2,AGOSTA,T) ENDIF ENDIF RETURN END REAL FUNCTION I0INT(XVALUE) C C DESCRIPTION: C This program computes the integral of the modified Bessel C function I0(x) using the definition C C I0INT(x) = {integral 0 to x} I0(t) dt C C The program uses Chebyshev expansions, the coefficients of C which are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If |XVALUE| larger than a certain limit, the value of C I0INT would cause an overflow. If such a situation occurs C the programs prints an error message, and returns the C value sign(XVALUE)*XMAX, where XMAX is the largest C acceptable floating-pt. value. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used from the array ARI01. C The recommended value is such that C ABS(ARI01(NTERM1)) < EPS/100 C C NTERM2 - The no. of terms to be used from the array ARI0A. C The recommended value is such that C ABS(ARI0A(NTERM2)) < EPS/100 C C XLOW - The value below which I0INT(x) = x, to machine precision. C The recommended value is C sqrt(12*EPS). C C XHIGH - The value above which overflow will occur. The C recommended value is C ln(XMAX) + 0.5*ln(ln(XMAX)) + ln(2). C C For values of EPS and XMAX refer to the file MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND C PA1 2BE C C (e-mail : macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 13 June, 1995 C INTEGER IND,NTERM1,NTERM2 REAL ARI01(0:28),ARI0A(0:33), 1 ATEEN,CHEVAL,HALF,LNR2PI,ONEHUN,T,TEMP,THREE,THIRT6, 2 X,XHIGH,XLOW,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'I0INT '/ DATA ERRMSG/'SIZE OF ARGUMENT TOO LARGE'/ DATA ZERO,HALF,THREE/ 0.0 E 0 , 0.5 E 0 , 3.0 E 0 / DATA ATEEN,THIRT6,ONEHUN/ 18.0 E 0 , 36.0 E 0 , 100.0 E 0/ DATA LNR2PI/0.91893 85332 04672 74178 E 0/ DATA ARI01(0)/ 0.41227 90692 67815 16801 E 0/ DATA ARI01(1)/ -0.34336 34515 00815 19562 E 0/ DATA ARI01(2)/ 0.22667 58871 57512 42585 E 0/ DATA ARI01(3)/ -0.12608 16471 87422 60032 E 0/ DATA ARI01(4)/ 0.60124 84628 77799 0271 E -1/ DATA ARI01(5)/ -0.24801 20462 91335 8248 E -1/ DATA ARI01(6)/ 0.89277 33895 65563 897 E -2/ DATA ARI01(7)/ -0.28325 37299 36696 605 E -2/ DATA ARI01(8)/ 0.79891 33904 17129 94 E -3/ DATA ARI01(9)/ -0.20053 93366 09648 90 E -3/ DATA ARI01(10)/ 0.44168 16783 01431 3 E -4/ DATA ARI01(11)/-0.82237 70422 46068 E -5/ DATA ARI01(12)/ 0.12005 97942 19015 E -5/ DATA ARI01(13)/-0.11350 86500 4889 E -6/ DATA ARI01(14)/ 0.69606 01446 6 E -9/ DATA ARI01(15)/ 0.18062 27728 36 E -8/ DATA ARI01(16)/-0.26039 48137 0 E -9/ DATA ARI01(17)/-0.16618 8103 E -11/ DATA ARI01(18)/ 0.51050 0232 E -11/ DATA ARI01(19)/-0.41515 879 E -12/ DATA ARI01(20)/-0.73681 38 E -13/ DATA ARI01(21)/ 0.12793 23 E -13/ DATA ARI01(22)/ 0.10324 7 E -14/ DATA ARI01(23)/-0.30379 E -15/ DATA ARI01(24)/-0.1789 E -16/ DATA ARI01(25)/ 0.673 E -17/ DATA ARI01(26)/ 0.44 E -18/ DATA ARI01(27)/-0.14 E -18/ DATA ARI01(28)/-0.1 E -19/ DATA ARI0A(0)/ 2.03739 65457 11432 87070 E 0/ DATA ARI0A(1)/ 0.19176 31647 50331 0248 E -1/ DATA ARI0A(2)/ 0.49923 33451 92881 47 E -3/ DATA ARI0A(3)/ 0.22631 87103 65981 5 E -4/ DATA ARI0A(4)/ 0.15868 21082 85561 E -5/ DATA ARI0A(5)/ 0.16507 85563 6318 E -6/ DATA ARI0A(6)/ 0.23850 58373 640 E -7/ DATA ARI0A(7)/ 0.39298 51823 04 E -8/ DATA ARI0A(8)/ 0.46042 71419 9 E -9/ DATA ARI0A(9)/ -0.70725 58172 E -10/ DATA ARI0A(10)/-0.67471 83961 E -10/ DATA ARI0A(11)/-0.20269 62001 E -10/ DATA ARI0A(12)/-0.87320 338 E -12/ DATA ARI0A(13)/ 0.17552 0014 E -11/ DATA ARI0A(14)/ 0.60383 944 E -12/ DATA ARI0A(15)/-0.39779 83 E -13/ DATA ARI0A(16)/-0.80490 48 E -13/ DATA ARI0A(17)/-0.11589 55 E -13/ DATA ARI0A(18)/ 0.82731 8 E -14/ DATA ARI0A(19)/ 0.28229 0 E -14/ DATA ARI0A(20)/-0.77667 E -15/ DATA ARI0A(21)/-0.48731 E -15/ DATA ARI0A(22)/ 0.7279 E -16/ DATA ARI0A(23)/ 0.7873 E -16/ DATA ARI0A(24)/-0.785 E -17/ DATA ARI0A(25)/-0.1281 E -16/ DATA ARI0A(26)/ 0.121 E -17/ DATA ARI0A(27)/ 0.214 E -17/ DATA ARI0A(28)/-0.27 E -18/ DATA ARI0A(29)/-0.36 E -18/ DATA ARI0A(30)/ 0.7 E -19/ DATA ARI0A(31)/ 0.6 E -19/ DATA ARI0A(32)/-0.2 E -19/ DATA ARI0A(33)/-0.1 E -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2/16,8/ DATA XLOW,XHIGH/1.196E-3,90.96E0/ C C Start computation C IND = 1 X = XVALUE IF ( XVALUE .LT. ZERO ) THEN IND = -1 X = -X ENDIF C C Error test C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) I0INT = EXP ( XHIGH - LNR2PI - HALF * LOG(XHIGH) ) IF ( IND .EQ. -1 ) I0INT = -I0INT RETURN ENDIF C C Code for 0 <= !x! <= 18 C IF ( X .LE. ATEEN ) THEN IF ( X .LT. XLOW ) THEN I0INT = X ELSE T = ( THREE * X - ATEEN ) / ( X + ATEEN ) I0INT = X * EXP(X) * CHEVAL(NTERM1,ARI01,T) ENDIF ELSE C C Code for !x! > 18 C T = ( THIRT6 / X - HALF ) - HALF TEMP = X - HALF*LOG(X) - LNR2PI + LOG(CHEVAL(NTERM2,ARI0A,T)) I0INT = EXP(TEMP) ENDIF IF ( IND .EQ. -1 ) I0INT = -I0INT RETURN END REAL FUNCTION I0ML0(XVALUE) C C DESCRIPTION: C C This program calculates the function I0ML0 defined as C C I0ML0(x) = I0(x) - L0(x) C C where I0(x) is the modified Bessel function of the first kind of C order 0, and L0(x) is the modified Struve function of order 0. C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20D. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C The coefficients are only suitable for XVALUE >= 0.0. If C XVALUE < 0.0, an error message is printed and the function C returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The number of terms required for the array C AI0L0. The recommended value is such that C ABS(AI0L0(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The number of terms required for the array C AI0L0A. The recommended value is such that C ABS(AI0L0A(NTERM2)) < EPS/100 C C XLOW - REAL - The value below which I0ML0(x) = 1 to machine C precision. The recommended value is C EPSNEG C C XHIGH - REAL - The value above which I0ML0(x) = 2/(pi*x) to C machine precision. The recommended value is C SQRT(800/EPS) C C For values of EPS, and EPSNEG see the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod C Dept. of Mathematics and Statistics C University of Paisley C High St. C Paisley C SCOTLAND C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 13 June, 1995 C INTEGER NTERM1,NTERM2 REAL AI0L0(0:23),AI0L0A(0:23),ATEHUN,CHEVAL, 1 FORTY,ONE,ONEHUN,SIX,SIXTEN,T,TWOBPI,TWO88,X,XHIGH, 2 XLOW,XSQ,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'I0ML0 '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,ONE/ 0.0 E 0 , 1.0 E 0 / DATA SIX,SIXTEN/ 6.0 E 0 , 16.0 E 0 / DATA FORTY,ONEHUN/ 40.0 E 0 , 100.0 E 0 / DATA TWO88,ATEHUN/ 288.0 E 0 , 800.0 E 0 / DATA TWOBPI/0.63661 97723 67581 34308 E 0/ DATA AI0L0(0)/ 0.52468 73679 14855 99138 E 0/ DATA AI0L0(1)/ -0.35612 46069 96505 86196 E 0/ DATA AI0L0(2)/ 0.20487 20286 40099 27687 E 0/ DATA AI0L0(3)/ -0.10418 64052 04026 93629 E 0/ DATA AI0L0(4)/ 0.46342 11095 54842 9228 E -1/ DATA AI0L0(5)/ -0.17905 87192 40349 8630 E -1/ DATA AI0L0(6)/ 0.59796 86954 81143 177 E -2/ DATA AI0L0(7)/ -0.17177 75476 93565 429 E -2/ DATA AI0L0(8)/ 0.42204 65446 91714 22 E -3/ DATA AI0L0(9)/ -0.87961 78522 09412 5 E -4/ DATA AI0L0(10)/ 0.15354 34234 86922 3 E -4/ DATA AI0L0(11)/-0.21978 07695 84743 E -5/ DATA AI0L0(12)/ 0.24820 68393 6666 E -6/ DATA AI0L0(13)/-0.20327 06035 607 E -7/ DATA AI0L0(14)/ 0.90984 19842 1 E -9/ DATA AI0L0(15)/ 0.25617 93929 E -10/ DATA AI0L0(16)/-0.71060 9790 E -11/ DATA AI0L0(17)/ 0.32716 960 E -12/ DATA AI0L0(18)/ 0.23002 15 E -13/ DATA AI0L0(19)/-0.29210 9 E -14/ DATA AI0L0(20)/-0.3566 E -16/ DATA AI0L0(21)/ 0.1832 E -16/ DATA AI0L0(22)/-0.10 E -18/ DATA AI0L0(23)/-0.11 E -18/ DATA AI0L0A(0)/ 2.00326 51024 11606 43125 E 0/ DATA AI0L0A(1)/ 0.19520 68515 76492 081 E -2/ DATA AI0L0A(2)/ 0.38239 52356 99083 28 E -3/ DATA AI0L0A(3)/ 0.75342 80817 05443 6 E -4/ DATA AI0L0A(4)/ 0.14959 57655 89707 8 E -4/ DATA AI0L0A(5)/ 0.29994 05312 10557 E -5/ DATA AI0L0A(6)/ 0.60769 60482 2459 E -6/ DATA AI0L0A(7)/ 0.12399 49554 4506 E -6/ DATA AI0L0A(8)/ 0.25232 62552 649 E -7/ DATA AI0L0A(9)/ 0.50463 48573 32 E -8/ DATA AI0L0A(10)/0.97913 23623 0 E -9/ DATA AI0L0A(11)/0.18389 11524 1 E -9/ DATA AI0L0A(12)/0.33763 09278 E -10/ DATA AI0L0A(13)/0.61117 9703 E -11/ DATA AI0L0A(14)/0.10847 2972 E -11/ DATA AI0L0A(15)/0.18861 271 E -12/ DATA AI0L0A(16)/0.32803 45 E -13/ DATA AI0L0A(17)/0.56564 7 E -14/ DATA AI0L0A(18)/0.93300 E -15/ DATA AI0L0A(19)/0.15881 E -15/ DATA AI0L0A(20)/0.2791 E -16/ DATA AI0L0A(21)/0.389 E -17/ DATA AI0L0A(22)/0.70 E -18/ DATA AI0L0A(23)/0.16 E -18/ C C MACHINE-DEPENDENT CONSTANTS (suitable for IEEE-arithmetic machines) C DATA NTERM1,NTERM2/14,11/ DATA XLOW,XHIGH/5.96E-8,81992.1E0/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) I0ML0 = ZERO RETURN ENDIF C C Code for x <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN I0ML0 = ONE RETURN ELSE T = ( SIX * X - FORTY ) / ( X + FORTY ) I0ML0 = CHEVAL(NTERM1,AI0L0,T) RETURN ENDIF ELSE C C Code for x > 16 C IF ( X .GT. XHIGH ) THEN I0ML0 = TWOBPI / X ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) I0ML0 = CHEVAL(NTERM2,AI0L0A,T) * TWOBPI / X ENDIF ENDIF RETURN END REAL FUNCTION I1ML1(XVALUE) C C DESCRIPTION: C C This program calculates the function I1ML1 defined as C C I1ML1(x) = I1(x) - L1(x) C C where I1(x) is the modified Bessel function of the first kind of C order 1, and L1(x) is the modified Struve function of order 1. C C The code uses Chebyshev expansions with the coefficients C given to an accuracy of 20D. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C The coefficients are only suitable for XVALUE >= 0.0. If C XVALUE < 0.0, an error message is printed and the function C returns the value 0.0 C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The number of terms required for the array C AI1L1. The recommended value is such that C ABS(AI1L1(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The number of terms required for the array C AI1L1A. The recommended value is such that C ABS(AI1L1A(NTERM2)) < EPS/100 C C XLOW - REAL - The value below which I1ML1(x) = x/2 to machine C precision. The recommended value is C 2*EPSNEG C C XHIGH - REAL - The value above which I1ML1(x) = 2/pi to C machine precision. The recommended value is C SQRT(800/EPS) C C For values of EPS, and EPSNEG see the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod C Dept. of Mathematics and Statistics C University of Paisley C High St. C Paisley C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 14 JUNE 1995 C INTEGER NTERM1,NTERM2 REAL AI1L1(0:23),AI1L1A(0:25),ATEHUN,CHEVAL, 1 FORTY,ONE,ONEHUN,SIX,SIXTEN,T,TWO,TWOBPI,TWO88, 2 X,XHIGH,XLOW,XSQ,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'I1ML1 '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,ONE,TWO/ 0.0 E 0 , 1.0 E 0 , 2.0 E 0 / DATA SIX,SIXTEN,FORTY/ 6.0 E 0 , 16.0 E 0 , 40.0 E 0 / DATA ONEHUN,TWO88,ATEHUN/ 100.0 E 0 , 288.0 E 0 , 800.0 E 0 / DATA TWOBPI/0.63661 97723 67581 34308 E 0/ DATA AI1L1(0)/ 0.67536 36906 23505 76137 E 0/ DATA AI1L1(1)/ -0.38134 97109 72665 59040 E 0/ DATA AI1L1(2)/ 0.17452 17077 51339 43559 E 0/ DATA AI1L1(3)/ -0.70621 05887 23502 5061 E -1/ DATA AI1L1(4)/ 0.25173 41413 55880 3702 E -1/ DATA AI1L1(5)/ -0.78709 85616 06423 321 E -2/ DATA AI1L1(6)/ 0.21481 43686 51922 006 E -2/ DATA AI1L1(7)/ -0.50862 19971 79062 36 E -3/ DATA AI1L1(8)/ 0.10362 60828 04423 30 E -3/ DATA AI1L1(9)/ -0.17954 47212 05724 7 E -4/ DATA AI1L1(10)/ 0.25978 82745 15414 E -5/ DATA AI1L1(11)/-0.30442 40632 4667 E -6/ DATA AI1L1(12)/ 0.27202 39894 766 E -7/ DATA AI1L1(13)/-0.15812 61441 90 E -8/ DATA AI1L1(14)/ 0.18162 09172 E -10/ DATA AI1L1(15)/ 0.64796 7659 E -11/ DATA AI1L1(16)/-0.54113 290 E -12/ DATA AI1L1(17)/-0.30831 1 E -14/ DATA AI1L1(18)/ 0.30563 8 E -14/ DATA AI1L1(19)/-0.9717 E -16/ DATA AI1L1(20)/-0.1422 E -16/ DATA AI1L1(21)/ 0.84 E -18/ DATA AI1L1(22)/ 0.7 E -19/ DATA AI1L1(23)/-0.1 E -19/ DATA AI1L1A(0)/ 1.99679 36189 67891 36501 E 0/ DATA AI1L1A(1)/ -0.19066 32614 09686 132 E -2/ DATA AI1L1A(2)/ -0.36094 62241 01744 81 E -3/ DATA AI1L1A(3)/ -0.68418 47304 59982 0 E -4/ DATA AI1L1A(4)/ -0.12990 08228 50942 6 E -4/ DATA AI1L1A(5)/ -0.24715 21887 05765 E -5/ DATA AI1L1A(6)/ -0.47147 83969 1972 E -6/ DATA AI1L1A(7)/ -0.90208 19982 592 E -7/ DATA AI1L1A(8)/ -0.17304 58637 504 E -7/ DATA AI1L1A(9)/ -0.33232 36701 59 E -8/ DATA AI1L1A(10)/-0.63736 42173 5 E -9/ DATA AI1L1A(11)/-0.12180 23975 6 E -9/ DATA AI1L1A(12)/-0.23173 46832 E -10/ DATA AI1L1A(13)/-0.43906 8833 E -11/ DATA AI1L1A(14)/-0.82847 110 E -12/ DATA AI1L1A(15)/-0.15562 249 E -12/ DATA AI1L1A(16)/-0.29131 12 E -13/ DATA AI1L1A(17)/-0.54396 5 E -14/ DATA AI1L1A(18)/-0.10117 7 E -14/ DATA AI1L1A(19)/-0.18767 E -15/ DATA AI1L1A(20)/-0.3484 E -16/ DATA AI1L1A(21)/-0.643 E -17/ DATA AI1L1A(22)/-0.118 E -17/ DATA AI1L1A(23)/-0.22 E -18/ DATA AI1L1A(24)/-0.4 E -19/ DATA AI1L1A(25)/-0.1 E -19/ C C MACHINE-DEPENDENT CONSTANTS (suitable for IEEE machines) C DATA NTERM1,NTERM2/14,11/ DATA XLOW,XHIGH/1.19E-7,81992.1E0/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) I1ML1 = ZERO RETURN ENDIF C C Code for x <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN I1ML1 = X / TWO RETURN ELSE T = ( SIX * X - FORTY ) / ( X + FORTY ) I1ML1 = CHEVAL(NTERM1,AI1L1,T) * X / TWO RETURN ENDIF ELSE C C Code for x > 16 C IF ( X .GT. XHIGH ) THEN I1ML1 = TWOBPI ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) I1ML1 = CHEVAL(NTERM2,AI1L1A,T) * TWOBPI ENDIF ENDIF RETURN END REAL FUNCTION J0INT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the Bessel C function J0, defined as C C J0INT(x) = {integral 0 to x} J0(t) dt C C The code uses Chebyshev expansions whose coefficients are C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If the value of |x| is too large, it is impossible to C accurately compute the trigonometric functions used. An C error message is printed, and the function returns the C value 1.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used from the array C ARJ01. The recommended value is such that C ABS(ARJ01(NTERM1)) < EPS/100, provided that C C NTERM2 - The no. of terms to be used from the array C ARJ0A1. The recommended value is such that C ABS(ARJ0A1(NTERM2)) < EPS/100, provided that C C NTERM3 - The no. of terms to be used from the array C ARJ0A2. The recommended value is such that C ABS(ARJ0A2(NTERM3)) < EPS/100, provided that C C XLOW - The value of |x| below which J0INT(x) = x to C machine-precision. The recommended value is C sqrt(12*EPSNEG) C C XHIGH - The value of |x| above which it is impossible C to calculate (x-pi/4) accurately. The recommended C value is 1/EPSNEG C C For values of EPS and EPSNEG for various machine/compiler C combinations refer to the file MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C COS , SIN , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 14 June, 1995 C INTEGER IND,NTERM1,NTERM2,NTERM3 REAL ARJ01(0:23),ARJ0A1(0:21),ARJ0A2(0:18), 1 CHEVAL,FIVE12,ONE,ONEHUN,ONE28,PIB41,PIB411,PIB412, 2 PIB42,RT2BPI,SIXTEN,T,TEMP,TWELVE,X,XHIGH,XLOW, 3 XMPI4,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'J0INT '/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,ONE/ 0.0 E 0 , 1.0 E 0 / DATA TWELVE,SIXTEN/ 12.0 E 0 , 16.0 E 0 / DATA ONEHUN,ONE28,FIVE12/ 100.0 E 0 , 128.0 E 0 , 512 E 0 / DATA RT2BPI/0.79788 45608 02865 35588 E 0/ DATA PIB411,PIB412/ 201.0 E 0 , 256.0 E 0/ DATA PIB42/0.24191 33974 48309 61566 E -3/ DATA ARJ01(0)/ 0.38179 27932 16901 73518 E 0/ DATA ARJ01(1)/ -0.21275 63635 05053 21870 E 0/ DATA ARJ01(2)/ 0.16754 21340 72157 94187 E 0/ DATA ARJ01(3)/ -0.12853 20977 21963 98954 E 0/ DATA ARJ01(4)/ 0.10114 40545 57788 47013 E 0/ DATA ARJ01(5)/ -0.91007 95343 20156 8859 E -1/ DATA ARJ01(6)/ 0.64013 45264 65687 3103 E -1/ DATA ARJ01(7)/ -0.30669 63029 92675 4312 E -1/ DATA ARJ01(8)/ 0.10308 36525 32506 4201 E -1/ DATA ARJ01(9)/ -0.25567 06503 99956 918 E -2/ DATA ARJ01(10)/ 0.48832 75580 57983 04 E -3/ DATA ARJ01(11)/-0.74249 35126 03607 7 E -4/ DATA ARJ01(12)/ 0.92226 05637 30861 E -5/ DATA ARJ01(13)/-0.95522 82830 7083 E -6/ DATA ARJ01(14)/ 0.83883 55845 986 E -7/ DATA ARJ01(15)/-0.63318 44888 58 E -8/ DATA ARJ01(16)/ 0.41560 50422 1 E -9/ DATA ARJ01(17)/-0.23955 29307 E -10/ DATA ARJ01(18)/ 0.12228 6885 E -11/ DATA ARJ01(19)/-0.55697 11 E -13/ DATA ARJ01(20)/ 0.22782 0 E -14/ DATA ARJ01(21)/-0.8417 E -16/ DATA ARJ01(22)/ 0.282 E -17/ DATA ARJ01(23)/-0.9 E -19/ DATA ARJ0A1(0)/ 1.24030 13303 75189 70827 E 0/ DATA ARJ0A1(1)/ -0.47812 53536 32280 693 E -2/ DATA ARJ0A1(2)/ 0.66131 48891 70667 8 E -4/ DATA ARJ0A1(3)/ -0.18604 27404 86349 E -5/ DATA ARJ0A1(4)/ 0.83627 35565 080 E -7/ DATA ARJ0A1(5)/ -0.52585 70367 31 E -8/ DATA ARJ0A1(6)/ 0.42606 36325 1 E -9/ DATA ARJ0A1(7)/ -0.42117 61024 E -10/ DATA ARJ0A1(8)/ 0.48894 6426 E -11/ DATA ARJ0A1(9)/ -0.64834 929 E -12/ DATA ARJ0A1(10)/ 0.96172 34 E -13/ DATA ARJ0A1(11)/-0.15703 67 E -13/ DATA ARJ0A1(12)/ 0.27871 2 E -14/ DATA ARJ0A1(13)/-0.53222 E -15/ DATA ARJ0A1(14)/ 0.10844 E -15/ DATA ARJ0A1(15)/-0.2342 E -16/ DATA ARJ0A1(16)/ 0.533 E -17/ DATA ARJ0A1(17)/-0.127 E -17/ DATA ARJ0A1(18)/ 0.32 E -18/ DATA ARJ0A1(19)/-0.8 E -19/ DATA ARJ0A1(20)/ 0.2 E -19/ DATA ARJ0A1(21)/-0.1 E -19/ DATA ARJ0A2(0)/ 1.99616 09630 13416 75339 E 0/ DATA ARJ0A2(1)/ -0.19037 98192 46668 161 E -2/ DATA ARJ0A2(2)/ 0.15397 10927 04422 6 E -4/ DATA ARJ0A2(3)/ -0.31145 08832 8103 E -6/ DATA ARJ0A2(4)/ 0.11108 50971 321 E -7/ DATA ARJ0A2(5)/ -0.58666 78712 3 E -9/ DATA ARJ0A2(6)/ 0.41399 26949 E -10/ DATA ARJ0A2(7)/ -0.36539 8763 E -11/ DATA ARJ0A2(8)/ 0.38557 568 E -12/ DATA ARJ0A2(9)/ -0.47098 00 E -13/ DATA ARJ0A2(10)/ 0.65022 0 E -14/ DATA ARJ0A2(11)/-0.99624 E -15/ DATA ARJ0A2(12)/ 0.16700 E -15/ DATA ARJ0A2(13)/-0.3028 E -16/ DATA ARJ0A2(14)/ 0.589 E -17/ DATA ARJ0A2(15)/-0.122 E -17/ DATA ARJ0A2(16)/ 0.27 E -18/ DATA ARJ0A2(17)/-0.6 E -19/ DATA ARJ0A2(18)/ 0.1 E -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3/16,6,5/ DATA XLOW,XHIGH/8.457E-4,8388608.0E0/ C C Start computation C X = XVALUE IND = 1 IF ( X .LT. ZERO ) THEN X = -X IND = -1 ENDIF C C Error test C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) J0INT = ONE IF ( IND .EQ. -1 ) J0INT = -J0INT RETURN ENDIF C C Code for 0 <= |x| <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN J0INT = X ELSE T = X * X / ONE28 - ONE J0INT = X * CHEVAL(NTERM1,ARJ01,T) ENDIF ELSE C C Code for |x| > 16 C T = FIVE12 / ( X * X ) - ONE PIB41 = PIB411 / PIB412 XMPI4 = ( X - PIB41 ) - PIB42 TEMP = COS(XMPI4) * CHEVAL(NTERM2,ARJ0A1,T) / X TEMP = TEMP - SIN(XMPI4) * CHEVAL(NTERM3,ARJ0A2,T) J0INT = ONE - RT2BPI * TEMP / SQRT(X) ENDIF IF ( IND .EQ. -1 ) J0INT = -J0INT RETURN END REAL FUNCTION K0INT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the modified Bessel function C defined by C C K0INT(x) = {integral 0 to x} K0(t) dt C C The code uses Chebyshev expansions, whose coefficients are C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, the function is undefined. An error message is C printed and the function returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array AK0IN1. The C recommended value is such that C ABS(AK0IN1(NTERM1)) < EPS/100, C C NTERM2 - The no. of terms to be used in the array AK0IN2. The C recommended value is such that C ABS(AK0IN2(NTERM2)) < EPS/100, C C NTERM3 - The no. of terms to be used in the array AK0INA. The C recommended value is such that C ABS(AK0INA(NTERM3)) < EPS/100, C C XLOW - The value below which K0INT = x * ( const - ln(x) ) to C machine precision. The recommended value is C sqrt (18*EPSNEG). C C XHIGH - The value above which K0INT = pi/2 to machine precision. C The recommended value is C - log (2*EPSNEG) C C For values of EPS and EPSNEG refer to the file MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 14 June, 1995 C INTEGER NTERM1,NTERM2,NTERM3 REAL AK0IN1(0:15),AK0IN2(0:15),AK0INA(0:27), 1 CHEVAL,CONST1,CONST2,EIGHTN,FVAL,HALF, 2 ONEHUN,PIBY2,RT2BPI,SIX,T,TEMP,TWELVE,X, 3 XHIGH,XLOW,XVALUE,ZERO CHARACTER FNNAME*8,ERRMSG*14 DATA FNNAME/'K0INT '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,SIX/ 0.0 E 0 , 0.5 E 0 , 6.0 E 0 / DATA TWELVE,EIGHTN,ONEHUN/ 12.0 E 0 , 18.0 E 0 , 100.0 E 0 / DATA CONST1/1.11593 15156 58412 44881 E 0/ DATA CONST2/-0.11593 15156 58412 44881 E 0/ DATA PIBY2/1.57079 63267 94896 61923 E 0/ DATA RT2BPI/0.79788 45608 02865 35588 E 0/ DATA AK0IN1/16.79702 71446 47109 59477 E 0, 1 9.79134 68767 68894 07070 E 0, 2 2.80501 31604 43379 39300 E 0, 3 0.45615 62053 18885 02068 E 0, 4 0.47162 24457 07476 0784 E -1, 5 0.33526 51482 69698 289 E -2, 6 0.17335 18119 38747 27 E -3, 7 0.67995 18893 64702 E -5, 8 0.20900 26835 9924 E -6, 9 0.51660 38469 76 E -8, X 0.10485 70833 1 E -9, 1 0.17782 9320 E -11, 2 0.25568 44 E -13, 3 0.31557 E -15, 4 0.338 E -17, 5 0.3 E -19/ DATA AK0IN2/10.76266 55822 78091 74077 E 0, 1 5.62333 47984 99975 11550 E 0, 2 1.43543 66487 92908 67158 E 0, 3 0.21250 41014 37438 96043 E 0, 4 0.20365 37393 10000 9554 E -1, 5 0.13602 35840 95623 632 E -2, 6 0.66753 88699 20909 3 E -4, 7 0.25043 00357 07337 E -5, 8 0.74064 23741 728 E -7, 9 0.17697 47043 14 E -8, X 0.34857 75254 E -10, 1 0.57544 785 E -12, 2 0.80748 1 E -14, 3 0.9747 E -16, 4 0.102 E -17, 5 0.1 E -19/ DATA AK0INA(0)/ 1.91172 06544 50604 53895 E 0/ DATA AK0INA(1)/ -0.41830 64565 76958 1085 E -1/ DATA AK0INA(2)/ 0.21335 25080 68147 486 E -2/ DATA AK0INA(3)/ -0.15859 49728 45041 81 E -3/ DATA AK0INA(4)/ 0.14976 24699 85835 1 E -4/ DATA AK0INA(5)/ -0.16795 59553 22241 E -5/ DATA AK0INA(6)/ 0.21495 47247 8804 E -6/ DATA AK0INA(7)/ -0.30583 56654 790 E -7/ DATA AK0INA(8)/ 0.47494 64133 43 E -8/ DATA AK0INA(9)/ -0.79424 66043 2 E -9/ DATA AK0INA(10)/ 0.14156 55532 5 E -9/ DATA AK0INA(11)/-0.26678 25359 E -10/ DATA AK0INA(12)/ 0.52814 9717 E -11/ DATA AK0INA(13)/-0.10926 3199 E -11/ DATA AK0INA(14)/ 0.23518 838 E -12/ DATA AK0INA(15)/-0.52479 91 E -13/ DATA AK0INA(16)/ 0.12101 91 E -13/ DATA AK0INA(17)/-0.28763 2 E -14/ DATA AK0INA(18)/ 0.70297 E -15/ DATA AK0INA(19)/-0.17631 E -15/ DATA AK0INA(20)/ 0.4530 E -16/ DATA AK0INA(21)/-0.1190 E -16/ DATA AK0INA(22)/ 0.319 E -17/ DATA AK0INA(23)/-0.87 E -18/ DATA AK0INA(24)/ 0.24 E -18/ DATA AK0INA(25)/-0.7 E -19/ DATA AK0INA(26)/ 0.2 E -19/ DATA AK0INA(27)/-0.1 E -19/ C C Machine-dependent values (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3/10,9,10/ DATA XLOW,XHIGH/1.0358E-3,15.9424E0/ C C Start computation C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) K0INT = ZERO RETURN ENDIF C C Code for 0 <= XVALUE <= 6 C IF ( X .LE. SIX ) THEN IF ( X .LT. XLOW ) THEN FVAL = X IF ( X .GT. ZERO ) THEN FVAL = FVAL * ( CONST1 - LOG(X) ) ENDIF K0INT = FVAL ELSE T = ( ( X * X ) / EIGHTN - HALF ) - HALF FVAL = ( CONST2 + LOG(X) ) * CHEVAL(NTERM2,AK0IN2,T) K0INT = X * ( CHEVAL(NTERM1,AK0IN1,T) - FVAL ) ENDIF C C Code for x > 6 C ELSE FVAL = PIBY2 IF ( X .LT. XHIGH ) THEN T = ( TWELVE / X - HALF ) - HALF TEMP = EXP(-X) * CHEVAL(NTERM3,AK0INA,T) FVAL = FVAL - TEMP / ( SQRT(X) * RT2BPI) ENDIF K0INT = FVAL ENDIF RETURN END REAL FUNCTION LOBACH(XVALUE) C C DESCRIPTION: C C This function calculates the Lobachewsky function L(x), defined as C C LOBACH(x) = {integral 0 to x} ( -ln ( | cos t | ) dt C C The code uses Chebyshev expansions whose coefficients are given C to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If |x| too large, it is impossible to accurately reduce the C argument to the range [0,pi]. An error message is printed C and the program returns the value 0.0 C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms to be used of the array ARLOB1. C The recommended value is such that C ABS(ARLOB1(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The no. of terms to be used of the array ARLOB2. C The recommended value is such that C ABS(ARLOB2(NTERM2)) < EPS/100 C C XLOW1 - REAL - The value below which L(x) = 0.0 to machine-precision. C The recommended value is C cube-root ( 6*XMIN ) C C XLOW2 - REAL - The value below which L(x) = x**3/6 to C machine-precision. The recommended value is C sqrt ( 10*EPS ) C C XLOW3 - REAL - The value below which C L(pi/2) - L(pi/2-x) = x ( 1 - log(x) ) C to machine-precision. The recommended value is C sqrt ( 18*EPS ) C C XHIGH - REAL - The value of |x| above which it is impossible C to accurately reduce the argument. The C recommended value is 1 / EPS. C C For values of EPS, and XMIN, refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C INT , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C High St., C Paisley, C SCOTLAND C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: C 14 JUNE, 1995 C INTEGER INDPI2,INDSGN,NPI,NTERM1,NTERM2 REAL ARLOB1(0:15),ARLOB2(0:10), 1 CHEVAL,FVAL,FVAL1,HALF,LBPB21,LBPB22,LOBPIA,LOBPIB, 2 LOBPI1,LOBPI2,ONE,ONEHUN,PI,PIBY2,PIBY21,PIBY22,PIBY4,PI1, 3 PI11,PI12,PI2,SIX,T,TCON,TEN,TWO,X,XCUB,XHIGH,XLOW1, 4 XLOW2,XLOW3,XR,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'LOBACH'/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,HALF/ 0.0 E 0 , 0.5 E 0 / DATA ONE,TWO,SIX/ 1.0 E 0 , 2.0 E 0 , 6.0 E 0 / DATA TEN,ONEHUN/ 10.0 E 0 , 100.0 E 0 / DATA LOBPIA,LOBPIB/ 1115.0 E 0 , 512.0 E 0 / DATA LOBPI2/-1.48284 69639 78694 99311 E -4/ DATA LBPB22/-7.41423 48198 93474 96556 E -5/ DATA PI11,PI12/ 201.0 E 0 , 64.0 E 0 / DATA PI2/9.67653 58979 32384 62643 E -4/ DATA PIBY22/4.83826 79489 66192 31322 E -4/ DATA TCON/3.24227 78765 54808 68620 E 0/ DATA ARLOB1/0.34464 88495 34813 00507 E 0, 1 0.58419 83571 90277 669 E -2, 2 0.19175 02969 46003 30 E -3, 3 0.78725 16064 56769 E -5, 4 0.36507 47741 5804 E -6, 5 0.18302 87272 680 E -7, 6 0.96890 33300 5 E -9, 7 0.53390 55444 E -10, 8 0.30340 8025 E -11, 9 0.17667 875 E -12, X 0.10493 93 E -13, 1 0.63359 E -15, 2 0.3878 E -16, 3 0.240 E -17, 4 0.15 E -18, 5 0.1 E -19/ DATA ARLOB2/2.03459 41803 61328 51087 E 0, 1 0.17351 85882 02740 7681 E -1, 2 0.55162 80426 09052 1 E -4, 3 0.39781 64627 6598 E -6, 4 0.36901 80289 18 E -8, 5 0.38804 09214 E -10, 6 0.44069 698 E -12, 7 0.52767 4 E -14, 8 0.6568 E -16, 9 0.84 E -18, X 0.1 E -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2/7,5/ DATA XLOW1,XLOW2,XLOW3/4.13693E-13,1.09087E-3,1.46355E-3/ DATA XHIGH/8388608.0E0/ C C Start computation C X = ABS ( XVALUE ) INDSGN = 1 IF ( XVALUE .LT. ZERO ) THEN INDSGN = -1 ENDIF C C Error test C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) LOBACH = ZERO RETURN ENDIF C C Reduce argument to [0,pi] C PI1 = PI11/PI12 PI = PI1 + PI2 PIBY2 = PI/TWO PIBY21 = PI1/TWO PIBY4 = PIBY2/TWO NPI = INT ( X / PI ) XR = ( X - NPI * PI1 ) - NPI * PI2 C C Reduce argument to [0,pi/2] C INDPI2 = 0 IF ( XR .GT. PIBY2 ) THEN INDPI2 = 1 XR = ( PI1 - XR ) + PI2 ENDIF C C Code for argument in [0,pi/4] C IF ( XR .LE. PIBY4 ) THEN IF ( XR .LT. XLOW1 ) THEN FVAL = ZERO ELSE XCUB = XR * XR * XR IF ( XR .LT. XLOW2 ) THEN FVAL = XCUB / SIX ELSE T = ( TCON * XR * XR - HALF ) - HALF FVAL = XCUB * CHEVAL(NTERM1,ARLOB1,T) ENDIF ENDIF ELSE C C Code for argument in [pi/4,pi/2] C XR = ( PIBY21 - XR ) + PIBY22 IF ( XR .EQ. ZERO ) THEN FVAL1 = ZERO ELSE IF ( XR .LT. XLOW3 ) THEN FVAL1 = XR * ( ONE - LOG( XR ) ) ELSE T = ( TCON * XR * XR - HALF ) - HALF FVAL1 = XR * ( CHEVAL(NTERM2,ARLOB2,T) - LOG( XR ) ) ENDIF ENDIF LBPB21 = LOBPIA / ( LOBPIB + LOBPIB ) FVAL = ( LBPB21 - FVAL1 ) + LBPB22 ENDIF LOBPI1 = LOBPIA / LOBPIB C C Compute value for argument in [pi/2,pi] C IF ( INDPI2 .EQ. 1 ) THEN FVAL = ( LOBPI1 - FVAL ) + LOBPI2 ENDIF LOBACH = FVAL C C Scale up for arguments > pi C IF ( NPI .GT. 0 ) THEN LOBACH = ( FVAL + NPI * LOBPI2 ) + NPI * LOBPI1 ENDIF IF ( INDSGN .EQ. -1 ) THEN LOBACH = - LOBACH ENDIF RETURN END REAL FUNCTION STROM(XVALUE) C C DESCRIPTION: C C This program calculates Stromgren's integral, defined as C C STROM(X) = integral 0 to X { t**7 exp(2t)/[exp(t)-1]**3 } dt C C The code uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ASTROM to be used. C The recommended value is such that C ASTROM(NTERMS) < EPS/100 C C XLOW0 - REAL - The value below which STROM = 0.0 to machine C precision. The recommended value is C 5th root of (130*XMIN) C C XLOW1 - REAL - The value below which STROM = 3*(X**5)/(4*(pi**4)) C to machine precision. The recommended value is C 2*EPSNEG C C EPSLN - REAL - The value of ln(EPS). Used to determine the no. C of exponential terms for large X. C C EPNGLN - REAL - The value of ln(EPSNEG). Used to prevent C overflow for large X. C C XHIGH - REAL - The value above which C STROM = 196.52 - 15*(x**7)*exp(-x)/(4pi**4) C to machine precision. The recommended value is C 7 / EPS C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 14 June, 1995 C C INTEGER K1,K2,NTERMS,NUMEXP REAL ASTROM(0:26),CHEVAL,EPNGLN,EPSLN,FOUR, 1 F15BP4,HALF,ONE,ONEHUN,ONE30,ONE5LN,PI4B3,RK, 2 SEVEN,SUMEXP,SUM2,T,TWO,VALINF,X,XHIGH, 3 XK,XK1,XLOW0,XLOW1,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'STROM '/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA TWO,FOUR,SEVEN/ 2.0 E 0 , 4.0 E 0 , 7.0 E 0 / DATA ONEHUN,ONE30,ONE5LN/ 100.0 E 0 , 130.0 E 0 , 0.4055 E 0 / DATA F15BP4/0.38497 43345 50662 56959 E -1 / DATA PI4B3/1.29878 78804 53365 82982 E 2 / DATA VALINF/196.51956 92086 89882 61257 E 0/ DATA ASTROM(0)/ 0.56556 12087 25391 55290 E 0/ DATA ASTROM(1)/ 0.45557 31969 10178 5525 E -1/ DATA ASTROM(2)/ -0.40395 35875 93686 9170 E -1/ DATA ASTROM(3)/ -0.13339 05720 21486 815 E -2/ DATA ASTROM(4)/ 0.18586 25062 50538 030 E -2/ DATA ASTROM(5)/ -0.46855 55868 05365 9 E -4/ DATA ASTROM(6)/ -0.63434 75643 42294 9 E -4/ DATA ASTROM(7)/ 0.57254 87081 43200 E -5/ DATA ASTROM(8)/ 0.15935 28122 16822 E -5/ DATA ASTROM(9)/ -0.28884 32843 1036 E -6/ DATA ASTROM(10)/-0.24466 33604 801 E -7/ DATA ASTROM(11)/ 0.10072 50382 374 E -7/ DATA ASTROM(12)/-0.12482 98610 4 E -9/ DATA ASTROM(13)/-0.26300 62528 3 E -9/ DATA ASTROM(14)/ 0.24904 07578 E -10/ DATA ASTROM(15)/ 0.48545 4902 E -11/ DATA ASTROM(16)/-0.10537 8913 E -11/ DATA ASTROM(17)/-0.36044 17 E -13/ DATA ASTROM(18)/ 0.29920 78 E -13/ DATA ASTROM(19)/-0.16397 1 E -14/ DATA ASTROM(20)/-0.61061 E -15/ DATA ASTROM(21)/ 0.9335 E -16/ DATA ASTROM(22)/ 0.709 E -17/ DATA ASTROM(23)/-0.291 E -17/ DATA ASTROM(24)/ 0.8 E -19/ DATA ASTROM(25)/ 0.6 E -19/ DATA ASTROM(26)/-0.1 E -19/ C C Machine-dependent constants C DATA NTERMS/13/ DATA XLOW0,XLOW1/6.874E-8,1.192E-7/ DATA EPSLN,EPNGLN,XHIGH/-15.94E0,-16.64E0,5.89E7/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) STROM = ZERO RETURN ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW0 ) THEN STROM = ZERO ELSE IF ( X .LT. XLOW1 ) THEN STROM = (X**5) / PI4B3 ELSE T = ( ( X / TWO ) - HALF ) - HALF STROM = (X**5) * CHEVAL(NTERMS,ASTROM,T) * F15BP4 ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH ) THEN SUMEXP = ONE ELSE NUMEXP = INT( EPSLN / (ONE5LN - X ) ) + 1 IF ( NUMEXP .GT. 1 ) THEN T = EXP( -X ) ELSE T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , 7 SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUM2 = SUM2 * ( RK + ONE ) / TWO SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = SEVEN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. EPNGLN ) THEN STROM = VALINF ELSE STROM = VALINF - EXP(T) * F15BP4 ENDIF ENDIF RETURN END REAL FUNCTION STRVH0(XVALUE) C C C DESCRIPTION: C C This function calculates the value of the Struve function C of order 0, denoted H0(x), for the argument XVALUE, defined C C STRVHO(x) = (2/pi) integral{0 to pi/2} sin(x cos(t)) dt C C H0 also satisfies the second-order equation C C x*D(Df) + Df + x*f = 2x/pi C C The code uses Chebyshev expansions whose coefficients are C given to 20D. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C As the asymptotic expansion of H0 involves the Bessel function C of the second kind Y0, there is a problem for large x, since C we cannot accurately calculate the value of Y0. An error message C is printed and STRVH0 returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array ARRH0. The C recommended value is such that C ABS(ARRH0(NTERM1)) < EPS/100. C C NTERM2 - The no. of terms to be used in the array ARRH0A. The C recommended value is such that C ABS(ARRH0A(NTERM2)) < EPS/100. C C NTERM3 - The no. of terms to be used in the array AY0ASP. The C recommended value is such that C ABS(AY0ASP(NTERM3)) < EPS/100. C C NTERM4 - The no. of terms to be used in the array AY0ASQ. The C recommended value is such that C ABS(AY0ASQ(NTERM4)) < EPS/100. C C XLOW - The value for which H0(x) = 2*x/pi to machine precision, if C abs(x) < XLOW. The recommended value is C XLOW = 3 * SQRT(EPSNEG) C C XHIGH - The value above which we are unable to calculate Y0 with C any reasonable accuracy. An error message is printed and C STRVH0 returns the value 0.0. The recommended value is C XHIGH = 1/EPS. C C For values of EPS and EPSNEG refer to the file MACHCON.TXT. C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C ABS, COS, SIN, SQRT. C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C ALLAN J. MACLEOD C DEPT. OF MATHEMATICS AND STATISTICS C UNIVERSITY OF PAISLEY C HIGH ST. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 15 JUNE, 1995 C C INTEGER INDSGN,NTERM1,NTERM2,NTERM3,NTERM4 REAL ARRH0(0:19),ARRH0A(0:20),AY0ASP(0:12), 1 AY0ASQ(0:13),CHEVAL,EIGHT,ELEVEN,HALF,H0AS, 2 ONEHUN,ONE,PIBY4,RT2BPI,SIXTP5,T,THR2P5,TWENTY, 3 TWOBPI,TWO62,X,XHIGH,XLOW,XMP4,XSQ,XVALUE, 4 Y0P,Y0Q,Y0VAL,ZERO CHARACTER FNNAME*6,ERRMSG*26 DATA FNNAME/'STRVH0'/ DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/ DATA ZERO,HALF,ONE/0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA EIGHT,ELEVEN/8.0 E 0 , 11.0 E 0/ DATA TWENTY,ONEHUN/20.0 E 0 , 100.0 E 0/ DATA SIXTP5,TWO62,THR2P5/60.5 E 0 , 262.0 E 0 , 302.5 E 0/ DATA PIBY4/0.78539 81633 97448 30962 E 0/ DATA RT2BPI/0.79788 45608 02865 35588 E 0/ DATA TWOBPI/0.63661 97723 67581 34308 E 0/ DATA ARRH0(0)/ 0.28696 48739 90132 25740 E 0/ DATA ARRH0(1)/ -0.25405 33268 16183 52305 E 0/ DATA ARRH0(2)/ 0.20774 02673 93238 94439 E 0/ DATA ARRH0(3)/ -0.20364 02956 03865 85140 E 0/ DATA ARRH0(4)/ 0.12888 46908 68661 86016 E 0/ DATA ARRH0(5)/ -0.48256 32815 62226 1202 E -1/ DATA ARRH0(6)/ 0.11686 29347 56900 1242 E -1/ DATA ARRH0(7)/ -0.19811 81356 42418 416 E -2/ DATA ARRH0(8)/ 0.24899 13851 24212 86 E -3/ DATA ARRH0(9)/ -0.24188 27913 78595 0 E -4/ DATA ARRH0(10)/ 0.18743 75479 93431 E -5/ DATA ARRH0(11)/-0.11873 34607 4362 E -6/ DATA ARRH0(12)/ 0.62698 49433 46 E -8/ DATA ARRH0(13)/-0.28045 54679 3 E -9/ DATA ARRH0(14)/ 0.10769 41205 E -10/ DATA ARRH0(15)/-0.35904 793 E -12/ DATA ARRH0(16)/ 0.10494 47 E -13/ DATA ARRH0(17)/-0.27119 E -15/ DATA ARRH0(18)/ 0.624 E -17/ DATA ARRH0(19)/-0.13 E -18/ DATA ARRH0A(0)/ 1.99291 88575 19923 05515 E 0/ DATA ARRH0A(1)/ -0.38423 26687 01456 887 E -2/ DATA ARRH0A(2)/ -0.32871 99371 23530 50 E -3/ DATA ARRH0A(3)/ -0.29411 81203 70340 9 E -4/ DATA ARRH0A(4)/ -0.26731 53519 87066 E -5/ DATA ARRH0A(5)/ -0.24681 03107 5013 E -6/ DATA ARRH0A(6)/ -0.22950 14861 143 E -7/ DATA ARRH0A(7)/ -0.21568 22318 33 E -8/ DATA ARRH0A(8)/ -0.20303 50648 3 E -9/ DATA ARRH0A(9)/ -0.19345 75509 E -10/ DATA ARRH0A(10)/-0.18277 3144 E -11/ DATA ARRH0A(11)/-0.17768 424 E -12/ DATA ARRH0A(12)/-0.16432 96 E -13/ DATA ARRH0A(13)/-0.17156 9 E -14/ DATA ARRH0A(14)/-0.13368 E -15/ DATA ARRH0A(15)/-0.2077 E -16/ DATA ARRH0A(16)/ 0.2 E -19/ DATA ARRH0A(17)/-0.55 E -18/ DATA ARRH0A(18)/ 0.10 E -18/ DATA ARRH0A(19)/-0.4 E -19/ DATA ARRH0A(20)/ 0.1 E -19/ DATA AY0ASP/1.99944 63940 23982 71568 E 0, 1 -0.28650 77864 70319 58 E -3, 2 -0.10050 72797 43762 0 E -4, 3 -0.35835 94100 2463 E -6, 4 -0.12879 65120 531 E -7, 5 -0.46609 48663 6 E -9, 6 -0.16937 69454 E -10, 7 -0.61852 269 E -12, 8 -0.22618 41 E -13, 9 -0.83268 E -15, X -0.3042 E -16, 1 -0.115 E -17, 2 -0.4 E -19/ DATA AY0ASQ/1.99542 68138 68286 04092 E 0, 1 -0.23601 31928 67514 472 E -2, 2 -0.76015 38908 50296 6 E -4, 3 -0.25610 88714 56343 E -5, 4 -0.87502 92185 106 E -7, 5 -0.30430 42121 59 E -8, 6 -0.10621 42831 4 E -9, 7 -0.37737 1479 E -11, 8 -0.13213 687 E -12, 9 -0.48862 1 E -14, X -0.15809 E -15, 1 -0.762 E -17, 2 -0.3 E -19, 3 -0.3 E -19/ C C MACHINE-DEPENDENT CONSTANTS (Suitable for IEEE-arithmetic machines) C DATA NTERM1,NTERM2,NTERM3,NTERM4/13,8,5,6/ DATA XLOW,XHIGH/7.324 E -4 , 8388608.0 E 0/ C C Start computation C X = XVALUE INDSGN = 1 IF ( X .LT. ZERO ) THEN X = -X INDSGN = -1 ENDIF C C Error test C IF ( ABS(XVALUE) .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERRMSG) STRVH0 = ZERO RETURN ENDIF C C Code for abs(x) <= 11 C IF ( X .LE. ELEVEN ) THEN IF ( X .LT. XLOW ) THEN STRVH0 = TWOBPI * X ELSE T = ( ( X * X ) / SIXTP5 - HALF ) - HALF STRVH0 = TWOBPI * X * CHEVAL ( NTERM1 , ARRH0 , T ) ENDIF ELSE C C Code for abs(x) > 11 C XSQ = X * X T = ( TWO62 - XSQ ) / ( TWENTY + XSQ ) Y0P = CHEVAL ( NTERM3 , AY0ASP , T ) Y0Q = CHEVAL ( NTERM4 , AY0ASQ , T ) / ( EIGHT * X ) XMP4 = X - PIBY4 Y0VAL = Y0P * SIN ( XMP4 ) - Y0Q * COS ( XMP4 ) Y0VAL = Y0VAL * RT2BPI / SQRT ( X ) T = ( THR2P5 - XSQ ) / ( SIXTP5 + XSQ ) H0AS = TWOBPI * CHEVAL ( NTERM2 , ARRH0A , T ) / X STRVH0 = Y0VAL + H0AS ENDIF IF ( INDSGN .EQ. -1 ) STRVH0 = -STRVH0 RETURN END REAL FUNCTION STRVH1(XVALUE) C C C DESCRIPTION: C This function calculates the value of the Struve function C of order 1, denoted H1(x), for the argument XVALUE, defined as C C 2 C STRVH1(x) = (2x/pi) integral{0 to pi/2} sin( x cos(t))*sin t dt C C H1 also satisfies the second-order differential equation C C 2 2 2 2 C x * D f + x * Df + (x - 1)f = 2x / pi C C The code uses Chebyshev expansions with the coefficients C given to 20D. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C As the asymptotic expansion of H1 involves the Bessel function C of the second kind Y1, there is a problem for large x, since C we cannot accurately calculate the value of Y1. An error message C is printed and STRVH1 returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used in the array ARRH1. The C recommended value is such that C ABS(ARRH1(NTERM1)) < EPS/100. C C NTERM2 - The no. of terms to be used in the array ARRH1A. The C recommended value is such that C ABS(ARRH1A(NTERM2)) < EPS/100. C C NTERM3 - The no. of terms to be used in the array AY1ASP. The C recommended value is such that C ABS(AY1ASP(NTERM3)) < EPS/100. C C NTERM4 - The no. of terms to be used in the array AY1ASQ. The C recommended value is such that C ABS(AY1ASQ(NTERM4)) < EPS/100. C C XLOW1 - The value of x, below which H1(x) set to zero, if C abs(x) 9 C XSQ = X * X T = ( ONE82 - XSQ ) / ( TWENTY + XSQ ) Y1P = CHEVAL ( NTERM3 , AY1ASP , T ) Y1Q = CHEVAL ( NTERM4 , AY1ASQ , T ) / ( EIGHT * X) XM3P4 = X - THPBY4 Y1VAL = Y1P * SIN ( XM3P4 ) + Y1Q * COS ( XM3P4 ) Y1VAL = Y1VAL * RT2BPI / SQRT ( X ) T = ( TW02P5 - XSQ ) / ( FORTP5 + XSQ ) H1AS = TWOBPI * CHEVAL ( NTERM2 , ARRH1A , T ) STRVH1 = Y1VAL + H1AS ENDIF RETURN END REAL FUNCTION STRVL0(XVALUE) C C DESCRIPTION: C C This function calculates the modified Struve function of C order 0, denoted L0(x), defined as the solution of the C second-order equation C C x*D(Df) + Df - x*f = 2x/pi C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If the value of |XVALUE| is too large, the result C would cause an floating-pt overflow. An error message C is printed and the function returns the value of C sign(XVALUE)*XMAX where XMAX is the largest possible C floating-pt argument. C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The no. of terms for the array ARL0. C The recommended value is such that C ABS(ARL0(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The no. of terms for the array ARL0AS. C The recommended value is such that C ABS(ARL0AS(NTERM2)) < EPS/100 C C NTERM3 - INTEGER - The no. of terms for the array AI0ML0. C The recommended value is such that C ABS(AI0ML0(NTERM3)) < EPS/100 C C XLOW - REAL - The value of x below which L0(x) = 2*x/pi C to machine precision. The recommended value is C 3*SQRT(EPS) C C XHIGH1 - REAL - The value beyond which the Chebyshev series C in the asymptotic expansion of I0 - L0 gives C 1.0 to machine precision. The recommended value C is SQRT( 30/EPSNEG ) C C XHIGH2 - REAL - The value beyond which the Chebyshev series C in the asymptotic expansion of I0 gives 1.0 C to machine precision. The recommended value C is 28 / EPSNEG C C XMAX - REAL - The value of XMAX, where XMAX is the C largest possible floating-pt argument. C This is used to prevent overflow. C C For values of EPS, EPSNEG and XMAX the user should refer C to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C DR. ALLAN J. MACLEOD C DEPT. OF MATHEMATICS AND STATISTICS C UNIVERSITY OF PAISLEY C HIGH ST. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 21 NOVEMBER, 1995 C C INTEGER INDSGN,NTERM1,NTERM2,NTERM3 REAL ARL0(0:27),ARL0AS(0:15),AI0ML0(0:23), 1 ATEHUN,CHEVAL,CH1,CH2,FOUR,LNR2PI,ONE,ONEHUN, 2 SIXTEN,T,TEST,TWENT4,TWENT8,TWO,TWOBPI,TWO88, 3 X,XHIGH1,XHIGH2,XLOW,XMAX,XVALUE,XSQ,ZERO CHARACTER FNNAME*6,ERRMSG*24 DATA FNNAME/'STRVL0'/ DATA ERRMSG/'ARGUMENT CAUSES OVERFLOW'/ DATA ZERO,ONE,TWO/0.0 E 0 , 1.0 E 0 , 2.0 E 0/ DATA FOUR,SIXTEN/4.0 E 0 , 16.0 E 0/ DATA TWENT4,TWENT8,ONEHUN/24.0 E 0 , 28.0 E 0 , 100.0 E 0/ DATA TWO88,ATEHUN/288.0 E 0 , 800.0 E 0/ DATA LNR2PI/0.91893 85332 04672 74178 E 0/ DATA TWOBPI/0.63661 97723 67581 34308 E 0/ DATA ARL0(0)/ 0.42127 45834 99799 24863 E 0/ DATA ARL0(1)/ -0.33859 53639 12206 12188 E 0/ DATA ARL0(2)/ 0.21898 99481 27107 16064 E 0/ DATA ARL0(3)/ -0.12349 48282 07131 85712 E 0/ DATA ARL0(4)/ 0.62142 09793 86695 8440 E -1/ DATA ARL0(5)/ -0.28178 06028 10954 7545 E -1/ DATA ARL0(6)/ 0.11574 19676 63809 1209 E -1/ DATA ARL0(7)/ -0.43165 85743 06921 179 E -2/ DATA ARL0(8)/ 0.14614 23499 07298 329 E -2/ DATA ARL0(9)/ -0.44794 21180 54614 78 E -3/ DATA ARL0(10)/ 0.12364 74610 59437 61 E -3/ DATA ARL0(11)/-0.30490 28334 79704 4 E -4/ DATA ARL0(12)/ 0.66394 14015 21146 E -5/ DATA ARL0(13)/-0.12553 83577 03889 E -5/ DATA ARL0(14)/ 0.20073 44645 1228 E -6/ DATA ARL0(15)/-0.25882 60170 637 E -7/ DATA ARL0(16)/ 0.24114 37427 58 E -8/ DATA ARL0(17)/-0.10159 67435 2 E -9/ DATA ARL0(18)/-0.12024 30736 E -10/ DATA ARL0(19)/ 0.26290 6137 E -11/ DATA ARL0(20)/-0.15313 190 E -12/ DATA ARL0(21)/-0.15747 60 E -13/ DATA ARL0(22)/ 0.31563 5 E -14/ DATA ARL0(23)/-0.4096 E -16/ DATA ARL0(24)/-0.3620 E -16/ DATA ARL0(25)/ 0.239 E -17/ DATA ARL0(26)/ 0.36 E -18/ DATA ARL0(27)/-0.4 E -19/ DATA ARL0AS(0)/ 2.00861 30823 56058 88600 E 0/ DATA ARL0AS(1)/ 0.40373 79665 00438 470 E -2/ DATA ARL0AS(2)/ -0.25199 48028 65802 67 E -3/ DATA ARL0AS(3)/ 0.16057 36682 81117 6 E -4/ DATA ARL0AS(4)/ -0.10369 21824 73444 E -5/ DATA ARL0AS(5)/ 0.67655 78876 305 E -7/ DATA ARL0AS(6)/ -0.44499 99067 56 E -8/ DATA ARL0AS(7)/ 0.29468 88922 8 E -9/ DATA ARL0AS(8)/ -0.19621 80522 E -10/ DATA ARL0AS(9)/ 0.13133 0306 E -11/ DATA ARL0AS(10)/-0.88191 90 E -13/ DATA ARL0AS(11)/ 0.59537 6 E -14/ DATA ARL0AS(12)/-0.40389 E -15/ DATA ARL0AS(13)/ 0.2651 E -16/ DATA ARL0AS(14)/-0.208 E -17/ DATA ARL0AS(15)/ 0.11 E -18/ DATA AI0ML0(0)/ 2.00326 51024 11606 43125 E 0/ DATA AI0ML0(1)/ 0.19520 68515 76492 081 E -2/ DATA AI0ML0(2)/ 0.38239 52356 99083 28 E -3/ DATA AI0ML0(3)/ 0.75342 80817 05443 6 E -4/ DATA AI0ML0(4)/ 0.14959 57655 89707 8 E -4/ DATA AI0ML0(5)/ 0.29994 05312 10557 E -5/ DATA AI0ML0(6)/ 0.60769 60482 2459 E -6/ DATA AI0ML0(7)/ 0.12399 49554 4506 E -6/ DATA AI0ML0(8)/ 0.25232 62552 649 E -7/ DATA AI0ML0(9)/ 0.50463 48573 32 E -8/ DATA AI0ML0(10)/0.97913 23623 0 E -9/ DATA AI0ML0(11)/0.18389 11524 1 E -9/ DATA AI0ML0(12)/0.33763 09278 E -10/ DATA AI0ML0(13)/0.61117 9703 E -11/ DATA AI0ML0(14)/0.10847 2972 E -11/ DATA AI0ML0(15)/0.18861 271 E -12/ DATA AI0ML0(16)/0.32803 45 E -13/ DATA AI0ML0(17)/0.56564 7 E -14/ DATA AI0ML0(18)/0.93300 E -15/ DATA AI0ML0(19)/0.15881 E -15/ DATA AI0ML0(20)/0.2791 E -16/ DATA AI0ML0(21)/0.389 E -17/ DATA AI0ML0(22)/0.70 E -18/ DATA AI0ML0(23)/0.16 E -18/ C C MACHINE-DEPENDENT VALUES (Suitable for IEEE-arithmetic machines) C DATA NTERM1,NTERM2,NTERM3/17,7,11/ DATA XLOW,XMAX/1.0348E-3,3.4E38/ DATA XHIGH1,XHIGH2/22434.72E0,4.69763E8/ C C Start computation C X = XVALUE INDSGN = 1 IF ( X .LT. ZERO ) THEN X = -X INDSGN = -1 ENDIF C C Code for |xvalue| <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN STRVL0 = TWOBPI * X ELSE T = ( FOUR * X - TWENT4 ) / ( X + TWENT4 ) STRVL0 = TWOBPI * X * CHEVAL(NTERM1,ARL0,T) * EXP(X) ENDIF ELSE C C Code for |xvalue| > 16 C IF ( X .GT. XHIGH2 ) THEN CH1 = ONE ELSE T = ( X - TWENT8 ) / ( FOUR - X ) CH1 = CHEVAL(NTERM2,ARL0AS,T) ENDIF IF ( X .GT. XHIGH1 ) THEN CH2 = ONE ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) CH2 = CHEVAL(NTERM3,AI0ML0,T) ENDIF TEST = LOG(CH1) - LNR2PI - LOG(X)/TWO + X IF ( TEST .GT. LOG(XMAX) ) THEN CALL ERRPRN(FNNAME,ERRMSG) STRVL0 = XMAX ELSE STRVL0 = EXP(TEST) - TWOBPI * CH2 / X ENDIF ENDIF IF ( INDSGN .EQ. -1 ) STRVL0 = -STRVL0 RETURN END REAL FUNCTION STRVL1(XVALUE) C C DESCRIPTION: C C This function calculates the modified Struve function of C order 1, denoted L1(x), defined as the solution of C C x*x*D(Df) + x*Df - (x*x+1)f = 2*x*x/pi C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If the value of |XVALUE| is too large, the result C would cause an floating-pt overflow. An error message C is printed and the function returns the value of C sign(XVALUE)*XMAX where XMAX is the largest possible C floating-pt argument. C C C MACHINE-DEPENDENT PARAMETERS: C C NTERM1 - INTEGER - The no. of terms for the array ARL1. C The recommended value is such that C ABS(ARL1(NTERM1)) < EPS/100 C C NTERM2 - INTEGER - The no. of terms for the array ARL1AS. C The recommended value is such that C ABS(ARL1AS(NTERM2)) < EPS/100 C C NTERM3 - INTEGER - The no. of terms for the array AI1ML1. C The recommended value is such that C ABS(AI1ML1(NTERM3)) < EPS/100 C C XLOW1 - REAL - The value of x below which L1(x) = 2*x*x/(3*pi) C to machine precision. The recommended value is C SQRT(15*EPS) C C XLOW2 - REAL - The value of x below which L1(x) set to 0.0. C This is used to prevent underflow. The C recommended value is C SQRT(5*XMIN) C C XHIGH1 - REAL - The value of |x| above which the Chebyshev C series in the asymptotic expansion of I1 C equals 1.0 to machine precision. The C recommended value is SQRT( 30 / EPSNEG ). C C XHIGH2 - REAL - The value of |x| above which the Chebyshev C series in the asymptotic expansion of I1 - L1 C equals 1.0 to machine precision. The recommended C value is 30 / EPSNEG. C C XMAX - REAL - The value of XMAX, where XMAX is the C largest possible floating-pt argument. C This is used to prevent overflow. C C For values of EPS, EPSNEG, XMIN, and XMAX the user should refer C to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C DR. ALLAN J. MACLEOD C DEPT. OF MATHEMATICS AND STATISTICS C UNIVERSITY OF PAISLEY C HIGH ST. C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: C 21 NOVEMBER, 1995 C C INTEGER NTERM1,NTERM2,NTERM3 REAL ARL1(0:26),ARL1AS(0:16),AI1ML1(0:25), 1 ATEHUN,CHEVAL,CH1,CH2,FOUR,LNR2PI, 2 ONE,ONEHUN,PI3BY2,SIXTEN,T,TEST,THIRTY,TWENT4, 3 TWO,TWOBPI,TWO88,X,XHIGH1,XHIGH2,XLOW1,XLOW2, 4 XMAX,XVALUE,XSQ,ZERO CHARACTER FNNAME*6,ERRMSG*24 DATA FNNAME/'STRVL1'/ DATA ERRMSG/'ARGUMENT CAUSES OVERFLOW'/ DATA ZERO,ONE,TWO/0.0 E 0 , 1.0 E 0 , 2.0 E 0/ DATA FOUR,SIXTEN/4.0 E 0 , 16.0 E 0/ DATA TWENT4,THIRTY/24.0 E 0 , 30.0 E 0/ DATA ONEHUN/100.0 E 0/ DATA TWO88,ATEHUN/288.0 E 0 , 800.0 E 0/ DATA LNR2PI/0.91893 85332 04672 74178 E 0/ DATA PI3BY2/4.71238 89803 84689 85769 E 0/ DATA TWOBPI/0.63661 97723 67581 34308 E 0/ DATA ARL1(0)/ 0.38996 02735 12295 38208 E 0/ DATA ARL1(1)/ -0.33658 09610 19757 49366 E 0/ DATA ARL1(2)/ 0.23012 46791 25016 45616 E 0/ DATA ARL1(3)/ -0.13121 59400 79608 32327 E 0/ DATA ARL1(4)/ 0.64259 22289 91284 6518 E -1/ DATA ARL1(5)/ -0.27500 32950 61663 5833 E -1/ DATA ARL1(6)/ 0.10402 34148 63720 8871 E -1/ DATA ARL1(7)/ -0.35053 22949 36388 080 E -2/ DATA ARL1(8)/ 0.10574 84984 21439 717 E -2/ DATA ARL1(9)/ -0.28609 42640 36665 58 E -3/ DATA ARL1(10)/ 0.69257 08785 94220 8 E -4/ DATA ARL1(11)/-0.14896 93951 12271 7 E -4/ DATA ARL1(12)/ 0.28103 55825 97128 E -5/ DATA ARL1(13)/-0.45503 87929 7776 E -6/ DATA ARL1(14)/ 0.60901 71561 770 E -7/ DATA ARL1(15)/-0.62354 37248 08 E -8/ DATA ARL1(16)/ 0.38430 01206 7 E -9/ DATA ARL1(17)/ 0.79054 3916 E -11/ DATA ARL1(18)/-0.48982 4083 E -11/ DATA ARL1(19)/ 0.46356 884 E -12/ DATA ARL1(20)/ 0.68420 5 E -14/ DATA ARL1(21)/-0.56974 8 E -14/ DATA ARL1(22)/ 0.35324 E -15/ DATA ARL1(23)/ 0.4244 E -16/ DATA ARL1(24)/-0.644 E -17/ DATA ARL1(25)/-0.21 E -18/ DATA ARL1(26)/ 0.9 E -19/ DATA ARL1AS(0)/ 1.97540 37844 16523 56868 E 0/ DATA ARL1AS(1)/ -0.11951 30555 08829 4181 E -1/ DATA ARL1AS(2)/ 0.33639 48526 91960 46 E -3/ DATA ARL1AS(3)/ -0.10091 15655 48154 9 E -4/ DATA ARL1AS(4)/ 0.30638 95132 1998 E -6/ DATA ARL1AS(5)/ -0.95370 43703 96 E -8/ DATA ARL1AS(6)/ 0.29524 73555 8 E -9/ DATA ARL1AS(7)/ -0.95107 8318 E -11/ DATA ARL1AS(8)/ 0.28203 667 E -12/ DATA ARL1AS(9)/ -0.11341 75 E -13/ DATA ARL1AS(10)/ 0.147 E -17/ DATA ARL1AS(11)/-0.6232 E -16/ DATA ARL1AS(12)/-0.751 E -17/ DATA ARL1AS(13)/-0.17 E -18/ DATA ARL1AS(14)/ 0.51 E -18/ DATA ARL1AS(15)/ 0.23 E -18/ DATA ARL1AS(16)/ 0.5 E -19/ DATA AI1ML1(0)/ 1.99679 36189 67891 36501 E 0/ DATA AI1ML1(1)/ -0.19066 32614 09686 132 E -2/ DATA AI1ML1(2)/ -0.36094 62241 01744 81 E -3/ DATA AI1ML1(3)/ -0.68418 47304 59982 0 E -4/ DATA AI1ML1(4)/ -0.12990 08228 50942 6 E -4/ DATA AI1ML1(5)/ -0.24715 21887 05765 E -5/ DATA AI1ML1(6)/ -0.47147 83969 1972 E -6/ DATA AI1ML1(7)/ -0.90208 19982 592 E -7/ DATA AI1ML1(8)/ -0.17304 58637 504 E -7/ DATA AI1ML1(9)/ -0.33232 36701 59 E -8/ DATA AI1ML1(10)/-0.63736 42173 5 E -9/ DATA AI1ML1(11)/-0.12180 23975 6 E -9/ DATA AI1ML1(12)/-0.23173 46832 E -10/ DATA AI1ML1(13)/-0.43906 8833 E -11/ DATA AI1ML1(14)/-0.82847 110 E -12/ DATA AI1ML1(15)/-0.15562 249 E -12/ DATA AI1ML1(16)/-0.29131 12 E -13/ DATA AI1ML1(17)/-0.54396 5 E -14/ DATA AI1ML1(18)/-0.10117 7 E -14/ DATA AI1ML1(19)/-0.18767 E -15/ DATA AI1ML1(20)/-0.3484 E -16/ DATA AI1ML1(21)/-0.643 E -17/ DATA AI1ML1(22)/-0.118 E -17/ DATA AI1ML1(23)/-0.22 E -18/ DATA AI1ML1(24)/-0.4 E -19/ DATA AI1ML1(25)/-0.1 E -19/ C C MACHINE-DEPENDENT VALUES (Suitable for IEEE-arithmetic machines) C DATA NTERM1,NTERM2,NTERM3/16,6,11/ DATA XLOW1,XLOW2,XMAX/1.336E-3,2.43E-19,3.4E38/ DATA XHIGH1,XHIGH2/22434.72E0,5.033165E8/ C C START CALCULATION C X = ABS ( XVALUE ) C C CODE FOR |XVALUE| <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LE. XLOW2 ) THEN STRVL1 = ZERO ELSE XSQ = X * X IF ( X .LT. XLOW1 ) THEN STRVL1 = XSQ / PI3BY2 ELSE T = ( FOUR * X - TWENT4 ) / ( X + TWENT4 ) STRVL1 = XSQ * CHEVAL(NTERM1,ARL1,T) * EXP(X) / PI3BY2 ENDIF ENDIF ELSE C C CODE FOR |XVALUE| > 16 C IF ( X .GT. XHIGH2 ) THEN CH1 = ONE ELSE T = ( X - THIRTY ) / ( TWO - X ) CH1 = CHEVAL(NTERM2,ARL1AS,T) ENDIF IF ( X .GT. XHIGH1 ) THEN CH2 = ONE ELSE XSQ = X * X T = ( ATEHUN - XSQ ) / ( TWO88 + XSQ ) CH2 = CHEVAL(NTERM3,AI1ML1,T) ENDIF TEST = LOG(CH1) - LNR2PI - LOG(X)/TWO + X IF ( TEST .GT. LOG(XMAX) ) THEN CALL ERRPRN(FNNAME,ERRMSG) STRVL1 = XMAX ELSE STRVL1 = EXP(TEST) - TWOBPI * CH2 ENDIF ENDIF RETURN END REAL FUNCTION SYNCH1(XVALUE) C C DESCRIPTION: C C This function calculates the synchrotron radiation function C defined as C C SYNCH1(x) = x * Integral{x to inf} K(5/3)(t) dt, C C where K(5/3) is a modified Bessel function of order 5/3. C C The code uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C The function is undefined if x < 0.0. If XVALUE < 0.0, C an error message is printed and the function returns C the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms needed from the array C ASYNC1. The recommended value is such that C ABS(ASYNC1(NTERM1)) < EPS/100. C C NTERM2 - INTEGER - The no. of terms needed from the array C ASYNC2. The recommended value is such that C ABS(ASYNC2(NTERM2)) < EPS/100. C C NTERM3 - INTEGER - The no. of terms needed from the array C ASYNCA. The recommended value is such that C ABS(ASYNCA(NTERM3)) < EPS/100. C C XLOW - REAL - The value below which C SYNCH1(x) = 2.14952.. * (x**(1/3)) C to machine precision. The recommended value C is sqrt (8*EPSNEG) C C XHIGH1 - REAL - The value above which C SYNCH1(x) = 0.0 C to machine precision. The recommended value C is -8*LN(XMIN)/7 C C XHIGH2 - REAL - The value of LN(XMIN). This is used C to prevent underflow in calculations C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C ( e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST UPDATE: C 16 June, 1995 C INTEGER NTERM1,NTERM2,NTERM3 REAL ASYNC1(0:13),ASYNC2(0:11),ASYNCA(0:24), 1 CHEB1,CHEB2,CHEVAL,CONLOW,EIGHT,FOUR,HALF, 2 LNRTP2,ONE,ONEHUN,PIBRT3,T,THREE,TWELVE,X,XHIGH1, 3 XHIGH2,XLOW,XPOWTH,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'SYNCH1'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA THREE,FOUR/ 3.0 E 0 , 4.0 E 0 / DATA EIGHT,TWELVE/ 8.0 E 0 , 12.0 E 0 / DATA ONEHUN/ 100.0 E 0 / DATA CONLOW/2.14952 82415 34478 63671 E 0/ DATA PIBRT3/1.81379 93642 34217 85059 E 0/ DATA LNRTP2/0.22579 13526 44727 43236 E 0/ DATA ASYNC1/30.36468 29825 01076 27340 E 0, 1 17.07939 52774 08394 57449 E 0, 2 4.56013 21335 45072 88887 E 0, 3 0.54928 12467 30419 97963 E 0, 4 0.37297 60750 69301 1724 E -1, 5 0.16136 24302 01041 242 E -2, 6 0.48191 67721 20370 7 E -4, 7 0.10512 42528 89384 E -5, 8 0.17463 85046 697 E -7, 9 0.22815 48654 4 E -9, X 0.24044 3082 E -11, 1 0.20865 88 E -13, 2 0.15167 E -15, 3 0.94 E -18/ DATA ASYNC2/0.44907 21623 53266 08443 E 0, 1 0.89835 36779 94187 2179 E -1, 2 0.81044 57377 21512 894 E -2, 3 0.42617 16991 08916 19 E -3, 4 0.14760 96312 70746 0 E -4, 5 0.36286 33615 3998 E -6, 6 0.66634 80749 84 E -8, 7 0.94907 71655 E -10, 8 0.10791 2491 E -11, 9 0.10022 01 E -13, X 0.7745 E -16, 1 0.51 E -18/ DATA ASYNCA(0)/ 2.13293 05161 35500 09848 E 0/ DATA ASYNCA(1)/ 0.74135 28649 54200 2401 E -1/ DATA ASYNCA(2)/ 0.86968 09990 99641 978 E -2/ DATA ASYNCA(3)/ 0.11703 82624 87756 921 E -2/ DATA ASYNCA(4)/ 0.16451 05798 61919 15 E -3/ DATA ASYNCA(5)/ 0.24020 10214 20640 3 E -4/ DATA ASYNCA(6)/ 0.35827 75638 93885 E -5/ DATA ASYNCA(7)/ 0.54477 47626 9837 E -6/ DATA ASYNCA(8)/ 0.83880 28561 957 E -7/ DATA ASYNCA(9)/ 0.13069 88268 416 E -7/ DATA ASYNCA(10)/0.20530 99071 44 E -8/ DATA ASYNCA(11)/0.32518 75368 8 E -9/ DATA ASYNCA(12)/0.51791 40412 E -10/ DATA ASYNCA(13)/0.83002 9881 E -11/ DATA ASYNCA(14)/0.13352 7277 E -11/ DATA ASYNCA(15)/0.21591 498 E -12/ DATA ASYNCA(16)/0.34996 73 E -13/ DATA ASYNCA(17)/0.56994 2 E -14/ DATA ASYNCA(18)/0.92906 E -15/ DATA ASYNCA(19)/0.15222 E -15/ DATA ASYNCA(20)/0.2491 E -16/ DATA ASYNCA(21)/0.411 E -17/ DATA ASYNCA(22)/0.67 E -18/ DATA ASYNCA(23)/0.11 E -18/ DATA ASYNCA(24)/0.2 E -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3/9,7,11/ DATA XLOW,XHIGH1,XHIGH2/6.905E-4,99.809E0,-87.3327E0/ C C Start calculation C X = XVALUE IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) SYNCH1 = ZERO RETURN ENDIF C C Code for 0 <= x <= 4 C IF ( X .LE. FOUR ) THEN XPOWTH = X ** ( ONE / THREE ) IF ( X .LT. XLOW ) THEN SYNCH1 = CONLOW * XPOWTH ELSE T = ( X * X / EIGHT - HALF ) - HALF CHEB1 = CHEVAL(NTERM1,ASYNC1,T) CHEB2 = CHEVAL(NTERM2,ASYNC2,T) T = XPOWTH * CHEB1 - ( XPOWTH**11 ) * CHEB2 SYNCH1 = T - PIBRT3 * X ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN SYNCH1 = ZERO ELSE T = ( TWELVE - X ) / ( X + FOUR ) CHEB1 = CHEVAL(NTERM3,ASYNCA,T) T = LNRTP2 - X + LOG( SQRT(X) * CHEB1 ) IF ( T .LT. XHIGH2 ) THEN SYNCH1 = ZERO ELSE SYNCH1 = EXP(T) ENDIF ENDIF ENDIF RETURN END REAL FUNCTION SYNCH2(XVALUE) C C DESCRIPTION: C C This function calculates the synchrotron radiation function C defined as C C SYNCH2(x) = x * K(2/3)(x) C C where K(2/3) is a modified Bessel function of order 2/3. C C The code uses Chebyshev expansions, the coefficients of which C are given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C The function is undefined if x < 0.0. If XVALUE < 0.0, C an error message is printed and the function returns C the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - INTEGER - The no. of terms needed from the array C ASYNC1. The recommended value is such that C ABS(ASYN21(NTERM1)) < EPS/100. C C NTERM2 - INTEGER - The no. of terms needed from the array C ASYNC2. The recommended value is such that C ABS(ASYN22(NTERM2)) < EPS/100. C C NTERM3 - INTEGER - The no. of terms needed from the array C ASYNCA. The recommended value is such that C ABS(ASYN2A(NTERM3)) < EPS/100. C C XLOW - REAL - The value below which C SYNCH2(x) = 1.074764... * (x**(1/3)) C to machine precision. The recommended value C is sqrt (8*EPSNEG) C C XHIGH1 - REAL - The value above which C SYNCH2(x) = 0.0 C to machine precision. The recommended value C is -8*LN(XMIN)/7 C C XHIGH2 - REAL - The value of LN(XMIN). This is used C to prevent underflow in calculations C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP , LOG , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST UPDATE: C 16 June, 1995 C INTEGER NTERM1,NTERM2,NTERM3 REAL ASYN21(0:14),ASYN22(0:13),ASYN2A(0:18), 1 CHEB1,CHEB2,CHEVAL,CONLOW,EIGHT,FOUR,HALF, 2 LNRTP2,ONE,ONEHUN,T,TEN,THREE,TWO,X,XHIGH1, 3 XHIGH2,XLOW,XPOWTH,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'SYNCH2'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA TWO,THREE,FOUR/ 2.0 E 0 , 3.0 E 0 , 4.0 E 0 / DATA EIGHT,TEN,ONEHUN/ 8.0 E 0 , 10.0 E 0 , 100.0 E 0/ DATA CONLOW/1.07476 41207 67239 31836 E 0/ DATA LNRTP2/0.22579 13526 44727 43236 E 0/ DATA ASYN21/38.61783 99238 43085 48014 E 0, 1 23.03771 55949 63734 59697 E 0, 2 5.38024 99868 33570 59676 E 0, 3 0.61567 93806 99571 07760 E 0, 4 0.40668 80046 68895 5843 E -1, 5 0.17296 27455 26484 141 E -2, 6 0.51061 25883 65769 9 E -4, 7 0.11045 95950 22012 E -5, 8 0.18235 53020 649 E -7, 9 0.23707 69803 4 E -9, X 0.24887 2963 E -11, 1 0.21528 68 E -13, 2 0.15607 E -15, 3 0.96 E -18, 4 0.1 E -19/ DATA ASYN22/7.90631 48270 66080 42875 E 0, 1 3.13534 63612 85342 56841 E 0, 2 0.48548 79477 45371 45380 E 0, 3 0.39481 66758 27237 2337 E -1, 4 0.19661 62233 48088 022 E -2, 5 0.65907 89322 93042 0 E -4, 6 0.15857 56134 98559 E -5, 7 0.28686 53011 233 E -7, 8 0.40412 02359 5 E -9, 9 0.45568 4443 E -11, X 0.42045 90 E -13, 1 0.32326 E -15, 2 0.210 E -17, 3 0.1 E -19/ DATA ASYN2A/2.02033 70941 70713 60032 E 0, 1 0.10956 23712 18074 0443 E -1, 2 0.85423 84730 11467 55 E -3, 3 0.72343 02421 32822 2 E -4, 4 0.63124 42796 26992 E -5, 5 0.56481 93141 1744 E -6, 6 0.51283 24801 375 E -7, 7 0.47196 53291 45 E -8, 8 0.43807 44214 3 E -9, 9 0.41026 81493 E -10, X 0.38623 0721 E -11, 1 0.36613 228 E -12, 2 0.34802 32 E -13, 3 0.33301 0 E -14, 4 0.31856 E -15, 5 0.3074 E -16, 6 0.295 E -17, 7 0.29 E -18, 8 0.3 E -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3/9,8,8/ DATA XLOW,XHIGH1,XHIGH2/6.905E-4,99.809E0,-87.3327E0/ C C Start calculation C X = XVALUE IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) SYNCH2 = ZERO RETURN ENDIF C C Code for 0 <= x <= 4 C IF ( X .LE. FOUR ) THEN XPOWTH = X ** ( ONE / THREE ) IF ( X .LT. XLOW ) THEN SYNCH2 = CONLOW * XPOWTH ELSE T = ( X * X / EIGHT - HALF ) - HALF CHEB1 = CHEVAL(NTERM1,ASYN21,T) CHEB2 = CHEVAL(NTERM2,ASYN22,T) SYNCH2 = XPOWTH * CHEB1 - ( XPOWTH**5 ) * CHEB2 ENDIF ELSE IF ( X .GT. XHIGH1 ) THEN SYNCH2 = ZERO ELSE T = ( TEN - X ) / ( X + TWO ) CHEB1 = CHEVAL(NTERM3,ASYN2A,T) T = LNRTP2 - X + LOG( SQRT(X) * CHEB1 ) IF ( T .LT. XHIGH2 ) THEN SYNCH2 = ZERO ELSE SYNCH2 = EXP(T) ENDIF ENDIF ENDIF RETURN END REAL FUNCTION TRAN02(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 2, defined as C C TRAN02(X) = integral 0 to X { t**2 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW1 - REAL - The value below which TRAN02 = x to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large x contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN02 = VALINF - x**2 exp(-x) C The recommended value is 2/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN02'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 2 , 2.0 E 0 / DATA VALINF/0.32898 68133 69645 28729 E 1/ DATA ATRAN/1.67176 04464 34538 50301 E 0, 1 -0.14773 53599 46794 48986 E 0, 2 0.14821 38199 46936 3384 E -1, 3 -0.14195 33032 63056 126 E -2, 4 0.13065 41324 41570 83 E -3, 5 -0.11715 57958 67579 0 E -4, 6 0.10333 49844 57557 E -5, 7 -0.90191 13042 227 E -7, 8 0.78177 16983 31 E -8, 9 -0.67445 65684 0 E -9, X 0.57994 63945 E -10, 1 -0.49747 6185 E -11, 2 0.42596 097 E -12, 3 -0.36421 89 E -13, 4 0.31108 6 E -14, 5 -0.26547 E -15, 6 0.2264 E -16, 7 -0.193 E -17, 8 0.16 E -18, 9 -0.1 E -19/ C C Machine-dependent constants C DATA NTERMS/9/ DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ DATA XHIGH2/1.681E7/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN02 = ZERO RETURN ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW1 ) THEN TRAN02 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN02 = ( X ** ( NUMJN - 1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP(-X) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. XHIGH3 ) THEN TRAN02 = VALINF ELSE TRAN02 = VALINF - EXP(T) ENDIF ENDIF RETURN END REAL FUNCTION TRAN03(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 3, defined as C C TRAN03(X) = integral 0 to X { t**3 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - REAL - The value below which TRAN03 = 0.0 to machine C precision. The recommended value is C square root of (2*XMIN) C C XLOW1 - REAL - The value below which TRAN03 = X**2/2 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN03 = VALINF - X**3 exp(-X) C The recommended value is 3/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN03'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 3 , 3.0 E 0 / DATA VALINF/0.72123 41418 95756 57124 E 1/ DATA ATRAN/0.76201 25432 43872 00657 E 0, 1 -0.10567 43877 05058 53250 E 0, 2 0.11977 80848 19657 8097 E -1, 3 -0.12144 01520 36983 073 E -2, 4 0.11550 99769 39285 47 E -3, 5 -0.10581 59921 24422 9 E -4, 6 0.94746 63385 3018 E -6, 7 -0.83622 12128 581 E -7, 8 0.73109 09927 75 E -8, 9 -0.63505 94778 8 E -9, X 0.54911 82819 E -10, 1 -0.47321 3954 E -11, 2 0.40676 948 E -12, 3 -0.34897 06 E -13, 4 0.29892 3 E -14, 5 -0.25574 E -15, 6 0.2186 E -16, 7 -0.187 E -17, 8 0.16 E -18, 9 -0.1 E -19/ C C Machine-dependent constants C DATA NTERMS/9/ DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ DATA XLOW2,XHIGH2/1.54E-19,2.521E7/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN03 = ZERO RETURN ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN03 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN03 = ( X**(NUMJN-1) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X*X ) / EIGHT ) - HALF ) - HALF TRAN03 = ( X**(NUMJN-1) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT(XHIGH1/X) + 1 T = EXP(-X) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. XHIGH3 ) THEN TRAN03 = VALINF ELSE TRAN03 = VALINF - EXP(T) ENDIF ENDIF RETURN END REAL FUNCTION TRAN04(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 4, defined as C C TRAN04(X) = integral 0 to X { t**4 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - REAL - The value below which TRAN04 = 0.0 to machine C precision. The recommended value is C cube root of (3*XMIN) C C XLOW1 - REAL - The value below which TRAN04 = X**3/3 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN04 = VALINF - X**4 exp(-X) C The recommended value is 4/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN04'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 4 , 4.0 E 0 / DATA VALINF/0.25975 75760 90673 16596 E 2/ DATA ATRAN/0.48075 70994 61511 05786 E 0, 1 -0.81753 78810 32108 3956 E -1, 2 0.10027 00665 97516 2973 E -1, 3 -0.10599 33935 98201 507 E -2, 4 0.10345 06245 03040 53 E -3, 5 -0.96442 70548 58991 E -5, 6 0.87455 44408 5147 E -6, 7 -0.77932 12079 811 E -7, 8 0.68649 88614 10 E -8, 9 -0.59995 71076 4 E -9, X 0.52136 62413 E -10, 1 -0.45118 3819 E -11, 2 0.38921 592 E -12, 3 -0.33493 60 E -13, 4 0.28766 7 E -14, 5 -0.24668 E -15, 6 0.2113 E -16, 7 -0.181 E -17, 8 0.15 E -18, 9 -0.1 E -19/ C C Machine-dependent constants C DATA NTERMS/9/ DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ DATA XLOW2,XHIGH2/3.2835E-13,3.36E7/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN04 = ZERO RETURN ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN04 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN04 = ( X ** ( NUMJN-1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN04 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP ( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE/ ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN04 = VALINF ELSE TRAN04 = VALINF - EXP( T ) ENDIF ENDIF RETURN END REAL FUNCTION TRAN05(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order n, defined as C C TRAN05(X) = integral 0 to X { t**5 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - REAL - The value below which TRAN05 = 0.0 to machine C precision. The recommended value is C 4th root of (4*XMIN) C C XLOW1 - REAL - The value below which TRAN05 = X**4/4 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN05 = VALINF - X**5 exp(-X) C The recommended value is 5/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN05'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 5 , 5.0 E 0 / DATA VALINF/0.12443 13306 17204 39116 E 3/ DATA ATRAN/0.34777 77771 33910 78928 E 0, 1 -0.66456 98897 60504 2801 E -1, 2 0.86110 72656 88330 882 E -2, 3 -0.93966 82223 75553 84 E -3, 4 0.93632 48060 81513 4 E -4, 5 -0.88571 31934 08328 E -5, 6 0.81191 49891 4503 E -6, 7 -0.72957 65423 277 E -7, 8 0.64697 14550 45 E -8, 9 -0.56849 02825 5 E -9, X 0.49625 59787 E -10, 1 -0.43109 3996 E -11, 2 0.37310 094 E -12, 3 -0.32197 69 E -13, 4 0.27722 0 E -14, 5 -0.23824 E -15, 6 0.2044 E -16, 7 -0.175 E -17, 8 0.15 E -18, 9 -0.1 E -19/ C C Machine-dependent constants C DATA NTERMS/9/ DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ DATA XLOW2,XHIGH2/4.6611E-10,4.202E7/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN05 = ZERO RETURN ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN05 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN05 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN05 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP ( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG ( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN05 = VALINF ELSE TRAN05 = VALINF - EXP( T ) ENDIF ENDIF RETURN END REAL FUNCTION TRAN06(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 6, defined as C C TRAN06(X) = integral 0 to X { t**6 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - REAL - The value below which TRAN06 = 0.0 to machine C precision. The recommended value is C 5th root of (5*XMIN) C C XLOW1 - REAL - The value below which TRAN06 = X**5/5 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN06 = VALINF - X**6 exp(-X) C The recommended value is 6/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN06'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 6 , 6.0 E 0 / DATA VALINF/0.73248 70046 28803 38059 E 3/ DATA ATRAN/0.27127 33539 78400 08227 E 0, 1 -0.55886 10553 19145 3393 E -1, 2 0.75391 95132 90083 056 E -2, 3 -0.84351 13857 92112 19 E -3, 4 0.85490 98079 67670 2 E -4, 5 -0.81871 54932 93098 E -5, 6 0.75754 24042 7986 E -6, 7 -0.68573 06541 831 E -7, 8 0.61170 03760 31 E -8, 9 -0.54012 70702 4 E -9, X 0.47343 06435 E -10, 1 -0.41270 1055 E -11, 2 0.35825 603 E -12, 3 -0.30997 52 E -13, 4 0.26750 1 E -14, 5 -0.23036 E -15, 6 0.1980 E -16, 7 -0.170 E -17, 8 0.15 E -18, 9 -0.1 E -19/ C C Machine-dependent constants C DATA NTERMS/9/ DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ DATA XLOW2,XHIGH2/3.5824E-8,5.042E7/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN06 = ZERO RETURN ENDIF C C Code for x < = 4 .0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN06 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN06 = ( X ** ( NUMJN-1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN06 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4 .0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP( - X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN06 = VALINF ELSE TRAN06 = VALINF - EXP( T ) ENDIF ENDIF RETURN END REAL FUNCTION TRAN07(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 7, defined as C C TRAN07(X) = integral 0 to X { t**7 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - REAL - The value below which TRAN07 = 0.0 to machine C precision. The recommended value is C 6th root of (6*XMIN) C C XLOW1 - REAL - The value below which TRAN07 = X**6/6 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN07 = VALINF - X**7 exp(-X) C The recommended value is 7/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN07'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0/ DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 7 , 7.0 E 0/ DATA VALINF/0.50820 80358 00489 10473 E 4/ DATA ATRAN/0.22189 25073 40104 04423 E 0, 1 -0.48167 51061 17799 3694 E -1, 2 0.67009 24481 03153 629 E -2, 3 -0.76495 18344 30825 57 E -3, 4 0.78634 85592 34869 0 E -4, 5 -0.76102 51808 87504 E -5, 6 0.70991 69629 9917 E -6, 7 -0.64680 25624 903 E -7, 8 0.58003 92339 60 E -8, 9 -0.51443 37014 9 E -9, X 0.45259 44183 E -10, 1 -0.39580 0363 E -11, 2 0.34453 785 E -12, 3 -0.29882 92 E -13, 4 0.25843 4 E -14, 5 -0.22297 E -15, 6 0.1920 E -16, 7 -0.165 E -17, 8 0.14 E -18, 9 -0.1 E -19/ C C Machine-dependent constants C DATA NTERMS/9/ DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ DATA XLOW2,XHIGH2/6.432E-7,5.882E7/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN07 = ZERO RETURN ENDIF C C Code for x <= 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN07 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN07 = ( X**(NUMJN-1) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X*X ) / EIGHT ) - HALF ) - HALF TRAN07 = ( X**(NUMJN-1) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1/X ) + 1 T = EXP( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG(X) - X + LOG(SUMEXP) IF ( T .LT. XHIGH3 ) THEN TRAN07 = VALINF ELSE TRAN07 = VALINF - EXP(T) ENDIF ENDIF RETURN END REAL FUNCTION TRAN08(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 8, defined as C C TRAN08(X) = integral 0 to X { t**8 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - REAL - The value below which TRAN08 = 0.0 to machine C precision. The recommended value is C 7th root of (7*XMIN) C C XLOW1 - REAL - The value below which TRAN08 = X**7/7 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN08 = VALINF - X**8 exp(-X) C The recommended value is 8/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN08'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 8 , 8.0 E 0 / DATA VALINF/0.40484 39900 19011 15764 E 5/ DATA ATRAN/0.18750 69577 40437 19233 E 0, 1 -0.42295 27646 09367 3337 E -1, 2 0.60281 48569 29065 592 E -2, 3 -0.69961 05481 18147 76 E -3, 4 0.72784 82421 29878 9 E -4, 5 -0.71084 62500 50067 E -5, 6 0.66786 70689 0115 E -6, 7 -0.61201 57501 844 E -7, 8 0.55146 52644 74 E -8, 9 -0.49105 30705 2 E -9, X 0.43350 00869 E -10, 1 -0.38021 8700 E -11, 2 0.33182 369 E -12, 3 -0.28845 12 E -13, 4 0.24995 8 E -14, 5 -0.21605 E -15, 6 0.1863 E -16, 7 -0.160 E -17, 8 0.14 E -18, 9 -0.1 E -19/ C C Machine-dependent constants C DATA NTERMS/9/ DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ DATA XLOW2,XHIGH2/5.04E-6,6.723E7/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN08 = ZERO RETURN ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN08 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN08 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN08 = ( X ** ( NUMJN - 1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP ( - X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T .LT. XHIGH3 ) THEN TRAN08 = VALINF ELSE TRAN08 = VALINF - EXP( T ) ENDIF ENDIF RETURN END REAL FUNCTION TRAN09(XVALUE) C C DESCRIPTION: C C This program calculates the transport integral of order 9, defined as C C TRAN09(X) = integral 0 to X { t**9 exp(t)/[exp(t)-1]**2 } dt C C The program uses a Chebyshev series, the coefficients of which are C given to an accuracy of 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If XVALUE < 0.0, an error message is printed, and the program C returns the value 0.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERMS - INTEGER - The number of terms of the array ATRAN to be used. C The recommended value is such that C ATRAN(NTERMS) < EPS/100 C C XLOW2 - REAL - The value below which TRAN09 = 0.0 to machine C precision. The recommended value is C 8th root of (8*XMIN) C C XLOW1 - REAL - The value below which TRAN09 = X**8/8 to C machine precision. The recommended value is C sqrt(8*EPSNEG) C C XHIGH1 - REAL - The value above which the exponential series for C large X contains only one term. The recommended value C is - ln(EPS). C C XHIGH2 - REAL - The value above which C TRAN09 = VALINF - X**9 exp(-X) C The recommended value is 9/EPS C C XHIGH3 - REAL - The value of ln(EPSNEG). Used to prevent overflow C for large x. C C For values of EPS, EPSNEG, and XMIN refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C EXP, INT, LOG, SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY , C HIGH ST., C PAISLEY, C SCOTLAND. C PA1 2BE. C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: 19 JUNE, 1995 C INTEGER K1,K2,NTERMS,NUMEXP,NUMJN REAL ATRAN(0:19),CHEVAL,EIGHT,FOUR,HALF,ONE,ONEHUN,RK, & RNUMJN,SUMEXP,SUM2,T,VALINF,X,XHIGH1,XHIGH2, & XHIGH3,XK,XK1,XLOW1,XLOW2,XVALUE,ZERO CHARACTER FNNAME*6,ERRMSG*14 DATA FNNAME/'TRAN09'/ DATA ERRMSG/'ARGUMENT < 0.0'/ DATA ZERO,HALF,ONE/ 0.0 E 0 , 0.5 E 0 , 1.0 E 0 / DATA FOUR,EIGHT,ONEHUN/ 4.0 E 0 , 8.0 E 0 , 100.0 E 0 / DATA NUMJN,RNUMJN/ 9 , 9.0 E 0 / DATA VALINF/0.36360 88055 88728 71397 E 6/ DATA ATRAN/0.16224 04999 19498 46835 E 0, 1 -0.37683 51452 19593 7773 E -1, 2 0.54766 97159 17719 770 E -2, 3 -0.64443 94500 94495 21 E -3, 4 0.67736 45285 28098 3 E -4, 5 -0.66681 34975 82042 E -5, 6 0.63047 56001 9047 E -6, 7 -0.58074 78663 611 E -7, 8 0.52555 13051 23 E -8, 9 -0.46968 86176 1 E -9, X 0.41593 95065 E -10, 1 -0.36580 8491 E -11, 2 0.32000 794 E -12, 3 -0.27876 51 E -13, 4 0.24201 7 E -14, 5 -0.20953 E -15, 6 0.1810 E -16, 7 -0.156 E -17, 8 0.13 E -18, 9 -0.1 E -19/ C C Machine-dependent constants (for IEEE machines) C DATA NTERMS/9/ DATA XLOW1,XHIGH1,XHIGH3/6.91E-4,15.95E0,-16.64E0/ DATA XLOW2,XHIGH2/2.3544E-5,7.563E7/ C C Start execution C X = XVALUE C C Error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERRMSG) TRAN09 = ZERO RETURN ENDIF C C Code for x < = 4.0 C IF ( X .LE. FOUR ) THEN IF ( X .LT. XLOW2 ) THEN TRAN09 = ZERO ELSE IF ( X .LT. XLOW1 ) THEN TRAN09 = ( X ** ( NUMJN - 1 ) ) / ( RNUMJN - ONE ) ELSE T = ( ( ( X * X ) / EIGHT ) - HALF ) - HALF TRAN09 = ( X ** ( NUMJN-1 ) ) * CHEVAL(NTERMS,ATRAN,T) ENDIF ENDIF ELSE C C Code for x > 4.0 C IF ( X .GT. XHIGH2 ) THEN SUMEXP = ONE ELSE IF ( X .LE. XHIGH1 ) THEN NUMEXP = INT ( XHIGH1 / X ) + 1 T = EXP( -X ) ELSE NUMEXP = 1 T = ONE ENDIF RK = ZERO DO 100 K1 = 1 , NUMEXP RK = RK + ONE 100 CONTINUE SUMEXP = ZERO DO 300 K1 = 1 , NUMEXP SUM2 = ONE XK = ONE / ( RK * X ) XK1 = ONE DO 200 K2 = 1 , NUMJN SUM2 = SUM2 * XK1 * XK + ONE XK1 = XK1 + ONE 200 CONTINUE SUMEXP = SUMEXP * T + SUM2 RK = RK - ONE 300 CONTINUE ENDIF T = RNUMJN * LOG( X ) - X + LOG( SUMEXP ) IF ( T.LT.XHIGH3 ) THEN TRAN09 = VALINF ELSE TRAN09 = VALINF - EXP( T ) ENDIF ENDIF RETURN END REAL FUNCTION Y0INT(XVALUE) C C DESCRIPTION: C C This function calculates the integral of the Bessel C function Y0, defined as C C Y0INT(x) = {integral 0 to x} Y0(t) dt C C The code uses Chebyshev expansions whose coefficients are C given to 20 decimal places. C C This subroutine is set up to work on IEEE machines. C For other machines, you should retrieve the code C from the general MISCFUN archive. C C C ERROR RETURNS: C C If x < 0.0, the function is undefined. An error message C is printed and the function returns the value 0.0. C C If the value of x is too large, it is impossible to C accurately compute the trigonometric functions used. An C error message is printed, and the function returns the C value 1.0. C C C MACHINE-DEPENDENT CONSTANTS: C C NTERM1 - The no. of terms to be used from the array C ARJ01. The recommended value is such that C ABS(ARJ01(NTERM1)) < EPS/100 C C NTERM2 - The no. of terms to be used from the array C ARY01. The recommended value is such that C ABS(ARY01(NTERM2)) < EPS/100 C C NTERM3 - The no. of terms to be used from the array C ARY0A1. The recommended value is such that C ABS(ARY0A1(NTERM3)) < EPS/100 C C NTERM4 - The no. of terms to be used from the array C ARY0A2. The recommended value is such that C ABS(ARY0A2(NTERM4)) < EPS/100 C C XLOW - The value of x below which C Y0INT(x) = x*(ln(x) - 0.11593)*2/pi C to machine-precision. The recommended value is C sqrt(9*EPSNEG) C C XHIGH - The value of x above which it is impossible C to calculate (x-pi/4) accurately. The recommended C value is 1/EPSNEG C C For values of EPS and EPSNEG, refer to the file MACHCON.TXT C C The machine-arithmetic constants are given in DATA C statements. C C C INTRINSIC FUNCTIONS USED: C C COS , LOG , SIN , SQRT C C C OTHER MISCFUN SUBROUTINES USED: C C CHEVAL , ERRPRN C C C AUTHOR: C Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley, C Paisley, C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk) C C C LATEST REVISION: C 19 June, 1995 C INTEGER NTERM1,NTERM2,NTERM3,NTERM4 REAL ARJ01(0:23),ARY01(0:24),ARY0A1(0:21), 1 ARY0A2(0:18),CHEVAL,FIVE12,GAL2M1,GAMLN2, 2 NINE,ONE,ONEHUN,ONE28,PIB41,PIB411,PIB412, 3 PIB42,RT2BPI,SIXTEN,T,TEMP,TWOBPI,X,XHIGH, 4 XLOW,XMPI4,XVALUE,ZERO CHARACTER FNNAME*6,ERMSG1*14,ERMSG2*18 DATA FNNAME/'Y0INT '/ DATA ERMSG1/'ARGUMENT < 0.0'/ DATA ERMSG2/'ARGUMENT TOO LARGE'/ DATA ZERO,ONE/ 0.0 E 0 , 1.0 E 0 / DATA NINE,SIXTEN/ 9.0 E 0 , 16.0 E 0 / DATA ONEHUN,ONE28,FIVE12/ 100.0 E 0 , 128.0 E 0 , 512.0 E 0 / DATA RT2BPI/0.79788 45608 02865 35588 E 0/ DATA PIB411,PIB412/ 201.0 E 0 , 256.0 E 0/ DATA PIB42/0.24191 33974 48309 61566 E -3/ DATA TWOBPI/0.63661 97723 67581 34308 E 0/ DATA GAL2M1/-1.11593 15156 58412 44881 E 0/ DATA GAMLN2/-0.11593 15156 58412 44881 E 0/ DATA ARJ01(0)/ 0.38179 27932 16901 73518 E 0/ DATA ARJ01(1)/ -0.21275 63635 05053 21870 E 0/ DATA ARJ01(2)/ 0.16754 21340 72157 94187 E 0/ DATA ARJ01(3)/ -0.12853 20977 21963 98954 E 0/ DATA ARJ01(4)/ 0.10114 40545 57788 47013 E 0/ DATA ARJ01(5)/ -0.91007 95343 20156 8859 E -1/ DATA ARJ01(6)/ 0.64013 45264 65687 3103 E -1/ DATA ARJ01(7)/ -0.30669 63029 92675 4312 E -1/ DATA ARJ01(8)/ 0.10308 36525 32506 4201 E -1/ DATA ARJ01(9)/ -0.25567 06503 99956 918 E -2/ DATA ARJ01(10)/ 0.48832 75580 57983 04 E -3/ DATA ARJ01(11)/-0.74249 35126 03607 7 E -4/ DATA ARJ01(12)/ 0.92226 05637 30861 E -5/ DATA ARJ01(13)/-0.95522 82830 7083 E -6/ DATA ARJ01(14)/ 0.83883 55845 986 E -7/ DATA ARJ01(15)/-0.63318 44888 58 E -8/ DATA ARJ01(16)/ 0.41560 50422 1 E -9/ DATA ARJ01(17)/-0.23955 29307 E -10/ DATA ARJ01(18)/ 0.12228 6885 E -11/ DATA ARJ01(19)/-0.55697 11 E -13/ DATA ARJ01(20)/ 0.22782 0 E -14/ DATA ARJ01(21)/-0.8417 E -16/ DATA ARJ01(22)/ 0.282 E -17/ DATA ARJ01(23)/-0.9 E -19/ DATA ARY01(0)/ 0.54492 69630 27243 65490 E 0/ DATA ARY01(1)/ -0.14957 32358 86847 82157 E 0/ DATA ARY01(2)/ 0.11085 63448 62548 42337 E 0/ DATA ARY01(3)/ -0.94953 30018 68377 7109 E -1/ DATA ARY01(4)/ 0.68208 17786 99145 6963 E -1/ DATA ARY01(5)/ -0.10324 65338 33682 00408 E 0/ DATA ARY01(6)/ 0.10625 70328 75344 25491 E 0/ DATA ARY01(7)/ -0.62583 67679 96168 1990 E -1/ DATA ARY01(8)/ 0.23856 45760 33829 3285 E -1/ DATA ARY01(9)/ -0.64486 49130 15404 481 E -2/ DATA ARY01(10)/ 0.13128 70828 91002 331 E -2/ DATA ARY01(11)/-0.20988 08817 49896 40 E -3/ DATA ARY01(12)/ 0.27160 42484 13834 7 E -4/ DATA ARY01(13)/-0.29119 91140 14694 E -5/ DATA ARY01(14)/ 0.26344 33309 3795 E -6/ DATA ARY01(15)/-0.20411 72069 780 E -7/ DATA ARY01(16)/ 0.13712 47813 17 E -8/ DATA ARY01(17)/-0.80706 80792 E -10/ DATA ARY01(18)/ 0.41988 3057 E -11/ DATA ARY01(19)/-0.19459 104 E -12/ DATA ARY01(20)/ 0.80878 2 E -14/ DATA ARY01(21)/-0.30329 E -15/ DATA ARY01(22)/ 0.1032 E -16/ DATA ARY01(23)/-0.32 E -18/ DATA ARY01(24)/ 0.1 E -19/ DATA ARY0A1(0)/ 1.24030 13303 75189 70827 E 0/ DATA ARY0A1(1)/ -0.47812 53536 32280 693 E -2/ DATA ARY0A1(2)/ 0.66131 48891 70667 8 E -4/ DATA ARY0A1(3)/ -0.18604 27404 86349 E -5/ DATA ARY0A1(4)/ 0.83627 35565 080 E -7/ DATA ARY0A1(5)/ -0.52585 70367 31 E -8/ DATA ARY0A1(6)/ 0.42606 36325 1 E -9/ DATA ARY0A1(7)/ -0.42117 61024 E -10/ DATA ARY0A1(8)/ 0.48894 6426 E -11/ DATA ARY0A1(9)/ -0.64834 929 E -12/ DATA ARY0A1(10)/ 0.96172 34 E -13/ DATA ARY0A1(11)/-0.15703 67 E -13/ DATA ARY0A1(12)/ 0.27871 2 E -14/ DATA ARY0A1(13)/-0.53222 E -15/ DATA ARY0A1(14)/ 0.10844 E -15/ DATA ARY0A1(15)/-0.2342 E -16/ DATA ARY0A1(16)/ 0.533 E -17/ DATA ARY0A1(17)/-0.127 E -17/ DATA ARY0A1(18)/ 0.32 E -18/ DATA ARY0A1(19)/-0.8 E -19/ DATA ARY0A1(20)/ 0.2 E -19/ DATA ARY0A1(21)/-0.1 E -19/ DATA ARY0A2(0)/ 1.99616 09630 13416 75339 E 0/ DATA ARY0A2(1)/ -0.19037 98192 46668 161 E -2/ DATA ARY0A2(2)/ 0.15397 10927 04422 6 E -4/ DATA ARY0A2(3)/ -0.31145 08832 8103 E -6/ DATA ARY0A2(4)/ 0.11108 50971 321 E -7/ DATA ARY0A2(5)/ -0.58666 78712 3 E -9/ DATA ARY0A2(6)/ 0.41399 26949 E -10/ DATA ARY0A2(7)/ -0.36539 8763 E -11/ DATA ARY0A2(8)/ 0.38557 568 E -12/ DATA ARY0A2(9)/ -0.47098 00 E -13/ DATA ARY0A2(10)/ 0.65022 0 E -14/ DATA ARY0A2(11)/-0.99624 E -15/ DATA ARY0A2(12)/ 0.16700 E -15/ DATA ARY0A2(13)/-0.3028 E -16/ DATA ARY0A2(14)/ 0.589 E -17/ DATA ARY0A2(15)/-0.122 E -17/ DATA ARY0A2(16)/ 0.27 E -18/ DATA ARY0A2(17)/-0.6 E -19/ DATA ARY0A2(18)/ 0.1 E -19/ C C Machine-dependent constants (suitable for IEEE machines) C DATA NTERM1,NTERM2,NTERM3,NTERM4/16,16,6,5/ DATA XLOW,XHIGH/7.3242E-4,8388608.0E0/ C C Start computation C X = XVALUE C C First error test C IF ( X .LT. ZERO ) THEN CALL ERRPRN(FNNAME,ERMSG1) Y0INT = ZERO RETURN ENDIF C C Second error test C IF ( X .GT. XHIGH ) THEN CALL ERRPRN(FNNAME,ERMSG2) Y0INT = ZERO RETURN ENDIF C C Code for 0 <= x <= 16 C IF ( X .LE. SIXTEN ) THEN IF ( X .LT. XLOW ) THEN IF ( X .EQ. ZERO ) THEN Y0INT = ZERO ELSE Y0INT = ( LOG(X) + GAL2M1 ) * TWOBPI * X ENDIF ELSE T = X * X / ONE28 - ONE TEMP = ( LOG(X) + GAMLN2 ) * CHEVAL(NTERM1,ARJ01,T) TEMP = TEMP - CHEVAL(NTERM2,ARY01,T) Y0INT = TWOBPI * X * TEMP ENDIF ELSE C C Code for x > 16 C T = FIVE12 / ( X * X ) - ONE PIB41 = PIB411 / PIB412 XMPI4 = ( X - PIB41 ) - PIB42 TEMP = SIN(XMPI4) * CHEVAL(NTERM3,ARY0A1,T) / X TEMP = TEMP + COS(XMPI4) * CHEVAL(NTERM4,ARY0A2,T) Y0INT = - RT2BPI * TEMP / SQRT(X) ENDIF RETURN END REAL FUNCTION CHEVAL(N,A,T) C C This function evaluates a Chebyshev series, using the C Clenshaw method with Reinsch modification, as analysed C in the paper by Oliver. C C INPUT PARAMETERS C C N - INTEGER - The no. of terms in the sequence C C A - REAL ARRAY, dimension 0 to N - The coefficients of C the Chebyshev series C C T - REAL - The value at which the series is to be C evaluated C C C REFERENCES C C "An error analysis of the modified Clenshaw method for C evaluating Chebyshev and Fourier series" J. Oliver, C J.I.M.A., vol. 20, 1977, pp379-391 C C C MACHINE-DEPENDENT CONSTANTS: NONE C C C INTRINSIC FUNCTIONS USED; C C ABS C C C AUTHOR: Dr. Allan J. MacLeod, C Dept. of Mathematics and Statistics, C University of Paisley , C High St., C PAISLEY, C SCOTLAND C C C LATEST MODIFICATION: 21 December , 1992 C C INTEGER I,N REAL A(0:N),D1,D2,HALF,T,TEST,TT,TWO,U0,U1,U2,ZERO DATA ZERO,HALF/ 0.0 E 0 , 0.5 E 0 / DATA TEST,TWO/ 0.6 E 0 , 2.0 E 0 / U1 = ZERO C C If ABS ( T ) < 0.6 use the standard Clenshaw method C IF ( ABS( T ) .LT. TEST ) THEN U0 = ZERO TT = T + T DO 100 I = N , 0 , -1 U2 = U1 U1 = U0 U0 = TT * U1 + A( I ) - U2 100 CONTINUE CHEVAL = ( U0 - U2 ) / TWO ELSE C C If ABS ( T ) > = 0.6 use the Reinsch modification C D1 = ZERO C C T > = 0.6 code C IF ( T .GT. ZERO ) THEN TT = ( T - HALF ) - HALF TT = TT + TT DO 200 I = N , 0 , -1 D2 = D1 U2 = U1 D1 = TT * U2 + A( I ) + D2 U1 = D1 + U2 200 CONTINUE CHEVAL = ( D1 + D2 ) / TWO ELSE C C T < = -0.6 code C TT = ( T + HALF ) + HALF TT = TT + TT DO 300 I = N , 0 , -1 D2 = D1 U2 = U1 D1 = TT * U2 + A( I ) - D2 U1 = D1 - U2 300 CONTINUE CHEVAL = ( D1 - D2 ) / TWO ENDIF ENDIF RETURN END SUBROUTINE ERRPRN(FNNAME,ERRMSG) C C DESCRIPTION: C This subroutine prints out an error message if C an error has occurred in one of the MISCFUN C functions. C C C INPUT PARAMETERS: C C FNNAME - CHARACTER - The name of the function with the error. C C ERRMSG - CHARACTER - The message to be printed out. C C C MACHINE-DEPENDENT PARAMETER: C C OUTSTR - INTEGER - The numerical value of the output C stream to be used for printing the C error message. The subroutine has the C default value OUTSTR = 6. C C C AUTHOR: C DR. ALLAN J. MACLEOD, C DEPT. OF MATHEMATICS AND STATISTICS, C UNIVERSITY OF PAISLEY, C HIGH ST., C PAISLEY C SCOTLAND C PA1 2BE C C (e-mail: macl_ms0@paisley.ac.uk ) C C C LATEST REVISION: C 2 JUNE, 1995 C INTEGER OUTSTR CHARACTER FNNAME*6,ERRMSG*(*) DATA OUTSTR/6/ WRITE(OUTSTR,1000)FNNAME WRITE(OUTSTR,2000)ERRMSG 1000 FORMAT(/5X,'ERROR IN MISCFUN FUNCTION ',A6) 2000 FORMAT(/5X,A50) RETURN END SHAR_EOF fi # end of overwriting check cd .. cd .. # End of shell archive exit 0