C ALGORITHM 762, COLLECTED ALGORITHMS FROM ACM. C THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE, C VOL. 22, NO. 3, September, 1996, P. 372--382. 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:42:48 1996 export PATH; PATH=/bin:$PATH if test ! -d 'Doc' then mkdir 'Doc' fi cd 'Doc' if test -f 'readme' then echo shar: will not over-write existing file "'readme'" else cat << \SHAR_EOF > 'readme' Readme File For Disk Accompanying LLDRLF Paper This disk is in DOS format (1.44MB) and contains 5 files. CONTENTS readme.dsk: this file. src.f contains the complete source code for LLDRLF including the double precision version of BRATIO. driver1.f contains the source code for a test program that makes the calculations of LLDFLF on a set of A, B, and W values. RES1 contains the output from driver1.f run on an IBM RS6000/550. The output was obtained using all defaults, i.e., the user specifies neither W nor A nor B. driver2.f contains the main program, tstlld, that runs all test cases described in the paper. This program replaces program, tstsht, in driver1.f. The results of the full test run consumes about 7 MB of disk. PORTABILITY The only machine dependent code in src.f is in BRATIO which was previously published by TOMS. The test programs also use widely distributed machine specific routines listed below. src.f and driver1.f have been run on both an IBM RS6000 and a Solbourne machine. The code has been examined for portability by FTNCHEK V. 2.7. INSTALLATION (1) Machine dependent constants. Routines: INTEGER FUNCTION ipmpar in LLDRLF.F INTEGER FUNCTION i1mach in TSTLLD.F DOUBLE PRECISION FUNCTION d1mach in TSTLLD.F REAL FUNCTION r1mach in TSTLLD.F all return machine dependent constants. Appropriate values for various machines appear in these routines as comments. The values in the distributed version are IEEE which is appropriate for MSDOS machines, Apple Macintosh, and most UNIX workstations. For any other machine uncomment the appropriate values. Routine spmpar in LLDRLF has been modified to return double precision machine dependent constants. The user need take no action even though the comments specify single precision. (2) Compile and link the code in src.f and driver1.f into an executable object. ---------------------------------------------------------------------- DOCUMENTATION FOR TEST PROGRAM FOR LLDRLF This is an annotated run of the test program. tstlld Do you want to output to a file? (y/n) $? n <<<<<<<<<<<<<<<<<<<< BEGIN ANNOTATION >>>>>>>>>>>>>>>>>>>> If 'y' is selected, program will prompt for a file name and write all results to the selected file. <<<<<<<<<<<<<<<<<<<< END ANNOTATION >>>>>>>>>>>>>>>>>>>> Do you want to specify A and B? (y/n) $? n <<<<<<<<<<<<<<<<<<<< BEGIN ANNOTATION >>>>>>>>>>>>>>>>>>>> If not, A and B will take on all combinations of the following powers of 10: -3 1 5 10 <<<<<<<<<<<<<<<<<<<< END ANNOTATION >>>>>>>>>>>>>>>>>>>> Do you want to specify W? (y/n) $? y <<<<<<<<<<<<<<<<<<<< BEGIN ANNOTATION >>>>>>>>>>>>>>>>>>>> W is the argument of the log-F distribution and is specified in units of the standard deviation of that distribution. If a particular value is not specified, W will range over the values: -1000 -500 -100 -50 -10 -5 -1 0 and back from 1 to 1000 using the same absolute values. If none of A, B, or W is specified all combinations are taken as per the sample output. <<<<<<<<<<<<<<<<<<<< END ANNOTATION >>>>>>>>>>>>>>>>>>>> Enter W (in standard deviations). $? 1 <<<<<<<<<<<<<<<<<<<< BEGIN ANNOTATION >>>>>>>>>>>>>>>>>>>> W has been specified but not A and B which range over the values given above. As each answer is printed to the screen, the display pauses pending a CR. (When answers are written to a file, there is no pause.) <<<<<<<<<<<<<<<<<<<< END ANNOTATION >>>>>>>>>>>>>>>>>>>> ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E-03 B: 1.0000E-03 Standard Deviation: 1414.2147 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -5.2146643110562865E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.2960587976738849E-01 First Derivative 1.3837963645320079E-04 Second Derivative -1.5752856023812081E-07 log(1 - F(exp(W)|DFN,DFD)) -2.1073602618451908E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 Press Return / Enter to continue: $? ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E-03 B: 1.0000E+01 Standard Deviation: 1000.0009 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -9.9113563342173002E+03 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -9.9171128469472860E+03 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 <<<<<<<<<<<<<<<<<<<< BEGIN ANNOTATION >>>>>>>>>>>>>>>>>>>> Numerous lines of output deleted. <<<<<<<<<<<<<<<<<<<< END ANNOTATION >>>>>>>>>>>>>>>>>>>> ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E+10 B: 1.0000E+10 Standard Deviation: 1.4142E-05 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -1.4189385332380060E+00 First Derivative -7.0710678119243981E+04 Second Derivative -4.9999999997500000E+09 log(F(exp(W)|DFN,DFD)) -1.7275377902009820E-01 First Derivative 2.0336388971268665E+04 Second Derivative -1.8515685710458596E+09 log(1 - F(exp(W)|DFN,DFD)) -1.8410216450030916E+00 First Derivative -1.0784334959763364E+05 Second Derivative -4.0045116717191434E+09 Press Return / Enter to continue: $? Do you want to continue? (y/n) $? y <<<<<<<<<<<<<<<<<<<< BEGIN ANNOTATION >>>>>>>>>>>>>>>>>>>> A 'y' starts over and a 'n' exits the program. Here is an example in which A and B are specified but not W. <<<<<<<<<<<<<<<<<<<< END ANNOTATION >>>>>>>>>>>>>>>>>>>> Do you want to specify A and B? (y/n) $? y Enter A. $? 10 Enter B. $? 10 Do you want to specify W? (y/n) $? n ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E+01 B: 1.0000E+01 Standard Deviation: .4586 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -4.5732724904619372E+03 First Derivative 1.0000000000000000E+01 Second Derivative -1.3326648884764100-198 log(F(exp(W)|DFN,DFD)) -4.5747703565987140E+03 First Derivative 1.0000000000000000E+01 Second Derivative -1.2115135349785545-198 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 Press Return / Enter to continue: $? <<<<<<<<<<<<<<<<<<<< BEGIN ANNOTATION >>>>>>>>>>>>>>>>>>>> Numerous lines of output deleted. <<<<<<<<<<<<<<<<<<<< END ANNOTATION >>>>>>>>>>>>>>>>>>>> ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -4.5732724904619372E+03 First Derivative -1.0000000000000000E+01 Second Derivative -1.3326648884764100-198 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.5747703565987140E+03 First Derivative -1.0000000000000000E+01 Second Derivative -1.2115135349785545-198 Press Return / Enter to continue: $? Do you want to continue? (y/n) $? n 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 'RES1' then echo shar: will not over-write existing file "'RES1'" else cat << \SHAR_EOF > 'RES1' ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E-03 B: 1.0000E-03 Standard Deviation: 1414.2147 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -1.4180151734062165E+03 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.4149078693570054E+03 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -7.1090781149672682E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -7.0780050744751588E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.0378048673939815-308 First Derivative -4.0378048673946317-311 Second Derivative -4.0378048675137015-314 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -1.4522192196913522E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.4211461791992417E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.9072412871649328E-62 First Derivative -1.9072412871650163E-65 Second Derivative -1.9072412871650164E-68 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -7.4511185778186288E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -7.1403881728975179E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -9.7653582112375835E-32 First Derivative -9.7653582112374535E-35 Second Derivative -9.7653582112374541E-38 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -1.7942596825427099E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.4835292776216004E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -3.6067354476419122E-07 First Derivative -3.6067360980690292E-10 Second Derivative -3.6067373989235578E-13 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -1.0871523206332204E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -7.7642191571211079E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.2475127782525977E-04 First Derivative -4.2484149742244388E-07 Second Derivative -4.2502198772037607E-10 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -5.2146643110562865E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -2.1073602618451908E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.2960587976738849E-01 First Derivative -1.3837963645320079E-04 Second Derivative -1.5752856023812081E-07 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -3.8018358815984272E+00 First Derivative 0.0000000000000000E+00 Second Derivative -5.0000000000000001E-04 log(F(exp(W)|DFN,DFD)) -6.9314718055994617E-01 First Derivative 9.9861630636065312E-04 Second Derivative -9.9723452732939391E-07 log(1 - F(exp(W)|DFN,DFD)) -6.9314718055994617E-01 First Derivative -9.9861630636065312E-04 Second Derivative -9.9723452732939391E-07 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -5.2146643110562865E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.2960587976738849E-01 First Derivative 1.3837963645320079E-04 Second Derivative -1.5752856023812081E-07 log(1 - F(exp(W)|DFN,DFD)) -2.1073602618451908E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -1.0871523206332204E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.2475127782525977E-04 First Derivative 4.2484149742244388E-07 Second Derivative -4.2502198772037607E-10 log(1 - F(exp(W)|DFN,DFD)) -7.7642191571211079E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -1.7942596825427099E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -3.6067354476419122E-07 First Derivative 3.6067360980690292E-10 Second Derivative -3.6067373989235578E-13 log(1 - F(exp(W)|DFN,DFD)) -1.4835292776216004E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -7.4511185778186288E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -9.7653582112375835E-32 First Derivative 9.7653582112374535E-35 Second Derivative -9.7653582112374541E-38 log(1 - F(exp(W)|DFN,DFD)) -7.1403881728975179E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -1.4522192196913525E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.9072412871649328E-62 First Derivative 1.9072412871650163E-65 Second Derivative -1.9072412871650164E-68 log(1 - F(exp(W)|DFN,DFD)) -1.4211461791992417E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -7.1090781149672694E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.0378048673939815-308 First Derivative 4.0378048673946317-311 Second Derivative -4.0378048675137015-314 log(1 - F(exp(W)|DFN,DFD)) -7.0780050744751588E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -1.4180151734062165E+03 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.4149078693570054E+03 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E-03 B: 1.0000E+01 Standard Deviation: 1000.0009 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -1.0034610836329783E+03 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.0000072559909873E+03 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -5.0346064670828622E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -5.0000681906629529E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -7.0761587172322012-218 First Derivative -7.0761587172320258-221 Second Derivative -7.0761587172320259-224 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -1.0346029716853261E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.0000646952654169E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -3.6960865296096725E-44 First Derivative -3.6960865296096341E-47 Second Derivative -3.6960865296096340E-50 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -5.3460253476063400E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -5.0006425834072495E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.9163957566537132E-22 First Derivative -1.9163957566537068E-25 Second Derivative -1.9163957566537069E-28 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -1.3460218522088041E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.0006390880097140E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.5111726944248065E-05 First Derivative -4.5112744493503093E-08 Second Derivative -4.5114779653218836E-11 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -8.4602141528411217E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -5.0063865108502199E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -6.7175645464968865E-03 First Derivative -6.7401779906134537E-06 Second Derivative -6.7856079899586034E-09 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -4.4602106574435858E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.0063830154526840E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.5497904858362348E-01 First Derivative -5.7614036031509910E-04 Second Derivative -9.0807807509911135E-07 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -3.4612098335925352E+00 First Derivative 0.0000000000000000E+00 Second Derivative -9.9990000999900029E-04 log(F(exp(W)|DFN,DFD)) -6.3831404298559874E-03 First Derivative 9.9900144771369339E-04 Second Derivative -9.9800389253405634E-07 log(1 - F(exp(W)|DFN,DFD)) -5.0572849448748887E+00 First Derivative -1.5600729255014759E-01 Second Derivative -2.4338275328827333E-02 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -9.9113563342173002E+03 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -9.9171128469472860E+03 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -4.9911391288192652E+04 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.9917147800922641E+04 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -9.9911434980661856E+04 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -9.9917191493391845E+04 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -4.9991178452041541E+05 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.9991754103314539E+05 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -9.9991222144510737E+05 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -9.9991797795783740E+05 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -4.9999157168426430E+06 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.9999214733553734E+06 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -9.9999200860895626E+06 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -9.9999258426022939E+06 First Derivative -1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E-03 B: 1.0000E+05 Standard Deviation: 1000.0008 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -1.0034610302724275E+03 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.0000071526379365E+03 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -5.0346061963679711E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -5.0000674200230605E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -7.0767040552641240-218 First Derivative -7.0767040552642536-221 Second Derivative -7.0767040552642541-224 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -1.0346029112829287E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.0000641349380179E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -3.6962936372672060E-44 First Derivative -3.6962936372671684E-47 Second Derivative -3.6962936372671683E-50 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -5.3460250064729813E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -5.0006372430238748E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.9164981022668934E-22 First Derivative -1.9164981022669011E-25 Second Derivative -1.9164981022669011E-28 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -1.3460217213879384E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.0006339579388316E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.5114041319384290E-05 First Derivative -4.5115058973049800E-08 Second Derivative -4.5117094341595948E-11 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -8.4602131075230798E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -5.0063354730320118E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -6.7179085593137913E-03 First Derivative -6.7405243221975442E-06 Second Derivative -6.7859589903356805E-09 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -4.4602098224380367E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.0063321879469682E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.5500833353410364E-01 First Derivative -5.7618651818336310E-04 Second Derivative -9.0817742191963022E-07 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -3.4612090011717758E+00 First Derivative 0.0000000000000000E+00 Second Derivative -9.9999999000000028E-04 log(F(exp(W)|DFN,DFD)) -6.3323654273927804E-03 First Derivative 9.9900149758231152E-04 Second Derivative -9.9800399217169855E-07 log(1 - F(exp(W)|DFN,DFD)) -5.0652459393456111E+00 First Derivative -1.5726221519592892E-01 Second Derivative -2.4731404328330656E-02 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -9.8158017494519144E+07 First Derivative -1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -9.8158032461322263E+07 First Derivative -1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -4.9815834600302345E+08 First Derivative -1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.9815836096982658E+08 First Derivative -1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -9.9815875663865364E+08 First Derivative -1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -9.9815877160545695E+08 First Derivative -1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -4.9981620417236967E+09 First Derivative -1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.9981620566905003E+09 First Derivative -1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -9.9981661480800018E+09 First Derivative -1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -9.9981661630468044E+09 First Derivative -1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -4.9998198998930428E+10 First Derivative -1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.9998199013897240E+10 First Derivative -1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -9.9998240062493454E+10 First Derivative -1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -9.9998240077460266E+10 First Derivative -1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E-03 B: 1.0000E+10 Standard Deviation: 1000.0008 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -1.0034610302674325E+03 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.0000071526279417E+03 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -5.0346061963430219E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -5.0000674199481119E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -7.0767041083030419-218 First Derivative -7.0767041083031931-221 Second Derivative -7.0767041083031929-224 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -1.0346029112779784E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.0000641348830682E+02 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -3.6962936575782213E-44 First Derivative -3.6962936575781952E-47 Second Derivative -3.6962936575781953E-50 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -5.3460250064484811E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -5.0006372424993785E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.9164981123188562E-22 First Derivative -1.9164981123188426E-25 Second Derivative -1.9164981123188427E-28 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -1.3460217213834374E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.0006339574343357E+01 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.5114041546987878E-05 First Derivative -4.5115059200663786E-08 Second Derivative -4.5117094569230463E-11 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -8.4602131075030709E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -5.0063354680120522E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -6.7179085931509501E-03 First Derivative -6.7405243562627843E-06 Second Derivative -6.7859590248601561E-09 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -4.4602098224380278E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.0063321829470095E+00 First Derivative 1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.5500833641501243E-01 First Derivative -5.7618652272421300E-04 Second Derivative -9.0817743169323307E-07 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -3.4612090011717673E+00 First Derivative 0.0000000000000000E+00 Second Derivative -9.9999999999990006E-04 log(F(exp(W)|DFN,DFD)) -6.3323604324269350E-03 First Derivative 9.9900149758729907E-04 Second Derivative -9.9800399218166664E-07 log(1 - F(exp(W)|DFN,DFD)) -5.0652467256504430E+00 First Derivative -1.5726233963832240E-01 Second Derivative -2.4731443468519066E-02 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -9.7006721505768125E+12 First Derivative -1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -9.7006721506032910E+12 First Derivative -1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -4.9700705001227242E+13 First Derivative -1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.9700705001253727E+13 First Derivative -1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -9.9700746064540281E+13 First Derivative -1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -9.9700746064566766E+13 First Derivative -1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -4.9970107457104456E+14 First Derivative -1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.9970107457107106E+14 First Derivative -1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -9.9970148520417475E+14 First Derivative -1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -9.9970148520420138E+14 First Derivative -1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -4.9997047702692180E+15 First Derivative -1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.9997047702692440E+15 First Derivative -1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -9.9997088766005220E+15 First Derivative -1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -9.9997088766005500E+15 First Derivative -1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E+01 B: 1.0000E-03 Standard Deviation: 1000.0009 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -9.9999200860895626E+06 First Derivative 1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -9.9999258426022939E+06 First Derivative 1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -4.9999157168426430E+06 First Derivative 1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.9999214733553734E+06 First Derivative 1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -9.9991222144510737E+05 First Derivative 1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -9.9991797795783740E+05 First Derivative 1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -4.9991178452041541E+05 First Derivative 1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.9991754103314539E+05 First Derivative 1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -9.9911434980661856E+04 First Derivative 1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -9.9917191493391845E+04 First Derivative 1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -4.9911391288192652E+04 First Derivative 1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.9917147800922641E+04 First Derivative 1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -9.9113563342173002E+03 First Derivative 1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -9.9171128469472860E+03 First Derivative 1.0000000000000000E+01 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -3.4612098335925352E+00 First Derivative 0.0000000000000000E+00 Second Derivative -9.9990000999900029E-04 log(F(exp(W)|DFN,DFD)) -5.0572849448748887E+00 First Derivative 1.5600729255014759E-01 Second Derivative -2.4338275328827333E-02 log(1 - F(exp(W)|DFN,DFD)) -6.3831404298559874E-03 First Derivative -9.9900144771369339E-04 Second Derivative -9.9800389253405634E-07 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -4.4602106574435858E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.5497904858362348E-01 First Derivative 5.7614036031509910E-04 Second Derivative -9.0807807509911135E-07 log(1 - F(exp(W)|DFN,DFD)) -1.0063830154526840E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -8.4602141528411217E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -6.7175645464968865E-03 First Derivative 6.7401779906134537E-06 Second Derivative -6.7856079899586034E-09 log(1 - F(exp(W)|DFN,DFD)) -5.0063865108502199E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -1.3460218522088041E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.5111726944248065E-05 First Derivative 4.5112744493503093E-08 Second Derivative -4.5114779653218836E-11 log(1 - F(exp(W)|DFN,DFD)) -1.0006390880097140E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -5.3460253476063400E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.9163957566537132E-22 First Derivative 1.9163957566537068E-25 Second Derivative -1.9163957566537069E-28 log(1 - F(exp(W)|DFN,DFD)) -5.0006425834072495E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -1.0346029716853261E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -3.6960865296096725E-44 First Derivative 3.6960865296096341E-47 Second Derivative -3.6960865296096340E-50 log(1 - F(exp(W)|DFN,DFD)) -1.0000646952654169E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -5.0346064670828622E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -7.0761587172322012-218 First Derivative 7.0761587172320258-221 Second Derivative -7.0761587172320259-224 log(1 - F(exp(W)|DFN,DFD)) -5.0000681906629529E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -1.0034610836329783E+03 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.0000072559909873E+03 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E+01 B: 1.0000E+01 Standard Deviation: .4586 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -4.5732724904619372E+03 First Derivative 1.0000000000000000E+01 Second Derivative -1.3326648884764100-198 log(F(exp(W)|DFN,DFD)) -4.5747703565987140E+03 First Derivative 1.0000000000000000E+01 Second Derivative -1.2115135349785545-198 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -2.2801704900955588E+03 First Derivative 1.0000000000000000E+01 Second Derivative -5.1626831947668643E-99 log(F(exp(W)|DFN,DFD)) -2.2816683562323360E+03 First Derivative 1.0000000000000000E+01 Second Derivative -4.6933483588789677E-99 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -4.4568888980245617E+02 First Derivative 1.0000000000000000E+01 Second Derivative -2.4176815242413466E-19 log(F(exp(W)|DFN,DFD)) -4.4718675593923319E+02 First Derivative 1.0000000000000000E+01 Second Derivative -2.1978922947648608E-19 log(1 - F(exp(W)|DFN,DFD)) -6.1554458533835186-195 First Derivative -6.1554458533836707-194 Second Derivative -6.1554458533836709-193 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -2.1637868976801730E+02 First Derivative 9.9999999978010532E+00 Second Derivative -2.1989458943676061E-09 log(F(exp(W)|DFN,DFD)) -2.1787655590459437E+02 First Derivative 9.9999999980009591E+00 Second Derivative -1.9990417221224015E-09 log(1 - F(exp(W)|DFN,DFD)) -2.3845917360639720E-95 First Derivative -2.3845917355872393E-94 Second Derivative -2.3845917350628802E-93 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -3.3133327516172983E+01 First Derivative 9.7982269274243485E+00 Second Derivative -1.9973745393481981E-01 log(F(exp(W)|DFN,DFD)) -3.4612693366213811E+01 First Derivative 9.8166979311151739E+00 Second Derivative -1.8132426371733928E-01 log(1 - F(exp(W)|DFN,DFD)) -9.2874880344296150E-16 First Derivative -9.1172464572842077E-15 Second Derivative -8.9332849741726448E-14 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -1.1923029829550387E+01 First Derivative 8.1660827215883121E+00 Second Derivative -1.6657546492088404E+00 log(F(exp(W)|DFN,DFD)) -1.3239944666718156E+01 First Derivative 8.3447599701337953E+00 Second Derivative -1.4910187512359825E+00 log(1 - F(exp(W)|DFN,DFD)) -1.7781380550104785E-06 First Derivative -1.4838148454957241E-05 Second Derivative -1.2116976788903822E-04 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -1.4527203072996946E+00 First Derivative 2.2537369141154859E+00 Second Derivative -4.7460334960976596E+00 log(F(exp(W)|DFN,DFD)) -1.8539261932118762E+00 First Derivative 3.3398464808979456E+00 Second Derivative -3.6274392144879899E+00 log(1 - F(exp(W)|DFN,DFD)) -1.7033887649026339E-01 First Derivative -6.2023150554825557E-01 Second Derivative -1.7825257598261832E+00 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -9.3143334037940162E-01 First Derivative 0.0000000000000000E+00 Second Derivative -5.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -6.9314718055994506E-01 First Derivative 1.7619705200195308E+00 Second Derivative -3.1045401134178956E+00 log(1 - F(exp(W)|DFN,DFD)) -6.9314718055994506E-01 First Derivative -1.7619705200195308E+00 Second Derivative -3.1045401134178956E+00 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -1.4527203072996957E+00 First Derivative -2.2537369141154859E+00 Second Derivative -4.7460334960976596E+00 log(F(exp(W)|DFN,DFD)) -1.7033887649026339E-01 First Derivative 6.2023150554825557E-01 Second Derivative -1.7825257598261832E+00 log(1 - F(exp(W)|DFN,DFD)) -1.8539261932118762E+00 First Derivative -3.3398464808979456E+00 Second Derivative -3.6274392144879899E+00 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -1.1923029829550387E+01 First Derivative -8.1660827215883121E+00 Second Derivative -1.6657546492088404E+00 log(F(exp(W)|DFN,DFD)) -1.7781380550104785E-06 First Derivative 1.4838148454957241E-05 Second Derivative -1.2116976788903822E-04 log(1 - F(exp(W)|DFN,DFD)) -1.3239944666718156E+01 First Derivative -8.3447599701337953E+00 Second Derivative -1.4910187512359825E+00 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -3.3133327516172983E+01 First Derivative -9.7982269274243485E+00 Second Derivative -1.9973745393481981E-01 log(F(exp(W)|DFN,DFD)) -9.2874880344296150E-16 First Derivative 9.1172464572842077E-15 Second Derivative -8.9332849741726448E-14 log(1 - F(exp(W)|DFN,DFD)) -3.4612693366213811E+01 First Derivative -9.8166979311151739E+00 Second Derivative -1.8132426371733928E-01 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -2.1637868976801730E+02 First Derivative -9.9999999978010532E+00 Second Derivative -2.1989458943676061E-09 log(F(exp(W)|DFN,DFD)) -2.3845917360639720E-95 First Derivative 2.3845917355872393E-94 Second Derivative -2.3845917350628802E-93 log(1 - F(exp(W)|DFN,DFD)) -2.1787655590459437E+02 First Derivative -9.9999999980009591E+00 Second Derivative -1.9990417221224015E-09 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -4.4568888980245623E+02 First Derivative -1.0000000000000000E+01 Second Derivative -2.4176815242413466E-19 log(F(exp(W)|DFN,DFD)) -6.1554458533835186-195 First Derivative 6.1554458533836707-194 Second Derivative -6.1554458533836709-193 log(1 - F(exp(W)|DFN,DFD)) -4.4718675593923319E+02 First Derivative -1.0000000000000000E+01 Second Derivative -2.1978922947648608E-19 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -2.2801704900955588E+03 First Derivative -1.0000000000000000E+01 Second Derivative -5.1626831947668643E-99 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -2.2816683562323360E+03 First Derivative -1.0000000000000000E+01 Second Derivative -4.6933483588789677E-99 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -4.5732724904619372E+03 First Derivative -1.0000000000000000E+01 Second Derivative -1.3326648884764100-198 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.5747703565987140E+03 First Derivative -1.0000000000000000E+01 Second Derivative -1.2115135349785545-198 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E+01 B: 1.0000E+05 Standard Deviation: .3243 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -3.2340168963174692E+03 First Derivative 1.0000000000000000E+01 Second Derivative -1.4270157659510940-140 log(F(exp(W)|DFN,DFD)) -3.2351682388614663E+03 First Derivative 1.0000000000000000E+01 Second Derivative -1.2972870599555157-140 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -1.6124718327154280E+03 First Derivative 1.0000000000000000E+01 Second Derivative -3.7777750959098786E-70 log(F(exp(W)|DFN,DFD)) -1.6136231752594254E+03 First Derivative 1.0000000000000000E+01 Second Derivative -3.4343409962817415E-70 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -3.1523578183379544E+02 First Derivative 9.9999999999999183E+00 Second Derivative -8.2315564663431681E-14 log(F(exp(W)|DFN,DFD)) -3.1638712437779259E+02 First Derivative 9.9999999999999254E+00 Second Derivative -7.4832331512210704E-14 log(1 - F(exp(W)|DFN,DFD)) -3.9338494700177524-138 First Derivative -3.9338494700175802-137 Second Derivative -3.9338494700175482-136 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -1.5308127638091591E+02 First Derivative 9.9999990926753828E+00 Second Derivative -9.0732461785686469E-07 log(F(exp(W)|DFN,DFD)) -1.5423261884242905E+02 First Derivative 9.9999991751594450E+00 Second Derivative -8.2484055034993721E-07 log(1 - F(exp(W)|DFN,DFD)) -1.0414171066198608E-67 First Derivative -1.0414170207195625E-66 Second Derivative -1.0414169262292326E-65 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -2.3748139270980541E+01 First Derivative 9.6095318767000109E+00 Second Derivative -3.9046659879888429E-01 log(F(exp(W)|DFN,DFD)) -2.4863450951713027E+01 First Derivative 9.6461052199383310E+00 Second Derivative -3.5279031712173942E-01 log(1 - F(exp(W)|DFN,DFD)) -1.5919904222499156E-11 First Derivative -1.5356507122279138E-10 Second Derivative -1.4756884470867034E-09 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -9.1183295103432851E+00 First Derivative 8.0239097620323641E+00 Second Derivative -1.9760511925458917E+00 log(F(exp(W)|DFN,DFD)) -1.0075376905439015E+01 First Derivative 8.2341483841502754E+00 Second Derivative -1.7311360105981799E+00 log(1 - F(exp(W)|DFN,DFD)) -4.2104503425869197E-05 First Derivative -3.4670202765671172E-04 Second Derivative -2.7820259865270849E-03 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -1.4005887037965181E+00 First Derivative 2.7695319215990928E+00 Second Derivative -7.2299453339890203E+00 log(F(exp(W)|DFN,DFD)) -1.6419233349386095E+00 First Derivative 4.0252103893037932E+00 Second Derivative -5.0543700138300274E+00 log(1 - F(exp(W)|DFN,DFD)) -2.1518444948319163E-01 First Derivative -9.6641521752302728E-01 Second Derivative -3.6104761671092351E+00 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -9.2726909672136060E-01 First Derivative 0.0000000000000000E+00 Second Derivative -9.9990000999900008E+00 log(F(exp(W)|DFN,DFD)) -6.1237114728617059E-01 First Derivative 2.3079151846721486E+00 Second Derivative -5.3264724996402775E+00 log(1 - F(exp(W)|DFN,DFD)) -7.8102590896640534E-01 First Derivative -2.7319055277985882E+00 Second Derivative -7.4633078128164829E+00 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -1.5148518930989192E+00 First Derivative -3.8302165399253658E+00 Second Derivative -1.3828303982285718E+01 log(F(exp(W)|DFN,DFD)) -1.2519439211184191E-01 First Derivative 7.8787569266741941E-01 Second Derivative -3.6384826165560700E+00 log(1 - F(exp(W)|DFN,DFD)) -2.1398318259335576E+00 First Derivative -5.9074985334784822E+00 Second Derivative -1.2271540330536293E+01 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -2.5312613017095277E+01 First Derivative -4.0588495523498224E+01 Second Derivative -5.0562906123644908E+01 log(F(exp(W)|DFN,DFD)) -7.6868665965674064E-13 First Derivative 3.2125517364939259E-11 Second Derivative -1.3039264177579336E-09 log(1 - F(exp(W)|DFN,DFD)) -2.7894092973127275E+01 First Derivative -4.1792734349351086E+01 Second Derivative -5.0328433342043120E+01 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -2.1432146276584987E+02 First Derivative -2.4549867278454519E+02 Second Derivative -2.5484594233964296E+02 log(F(exp(W)|DFN,DFD)) -1.0702270945404195E-95 First Derivative 2.6384547705073414E-93 Second Derivative -6.4773714436160403E-91 log(1 - F(exp(W)|DFN,DFD)) -2.1867771297059113E+02 First Derivative -2.4653223451051937E+02 Second Derivative -2.5480628180901002E+02 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -7.0050054109869769E+05 First Derivative -9.9909349779165539E+04 Second Derivative -9.0568054425716824E+01 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -7.0051090187470929E+05 First Derivative -9.9909350685658777E+04 Second Derivative -9.0567148754081458E+01 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -2.3219549133800888E+06 First Derivative -9.9999999991768447E+04 Second Derivative -8.2315564649881323E-06 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -2.3219652750630053E+06 First Derivative -9.9999999991768520E+04 Second Derivative -8.2314741502466496E-06 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -1.5294315422188187E+07 First Derivative -1.0000000000000000E+05 Second Derivative -3.7777750959098785E-62 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.5294325783871103E+07 First Derivative -1.0000000000000000E+05 Second Derivative -3.7777373185366563E-62 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -3.1509766058208592E+07 First Derivative -1.0000000000000000E+05 Second Derivative -1.4270157659510939-132 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -3.1509776419891510E+07 First Derivative -1.0000000000000000E+05 Second Derivative -1.4270014959361613-132 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E+01 B: 1.0000E+10 Standard Deviation: .3243 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -3.2338632194564575E+03 First Derivative 1.0000000000000000E+01 Second Derivative -1.4490426205564323-140 log(F(exp(W)|DFN,DFD)) -3.2350145120034545E+03 First Derivative 1.0000000000000000E+01 Second Derivative -1.3173114732331584-140 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -1.6123952442740476E+03 First Derivative 1.0000000000000000E+01 Second Derivative -3.8066292464665831E-70 log(F(exp(W)|DFN,DFD)) -1.6135465368210446E+03 First Derivative 1.0000000000000000E+01 Second Derivative -3.4605720422423500E-70 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -3.1522086412812013E+02 First Derivative 9.9999999999999183E+00 Second Derivative -8.2434330733016166E-14 log(F(exp(W)|DFN,DFD)) -3.1637215667511703E+02 First Derivative 9.9999999999999254E+00 Second Derivative -7.4940300666378275E-14 log(1 - F(exp(W)|DFN,DFD)) -3.9931730203593735-138 First Derivative -3.9931730203588794-137 Second Derivative -3.9931730203588465-136 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -1.5307406751781255E+02 First Derivative 9.9999990920664636E+00 Second Derivative -9.0793353730022820E-07 log(F(exp(W)|DFN,DFD)) -1.5422535998227011E+02 First Derivative 9.9999991746058807E+00 Second Derivative -8.2539411346380062E-07 log(1 - F(exp(W)|DFN,DFD)) -1.0490041109517726E-67 First Derivative -1.0490040243675348E-66 Second Derivative -1.0490039291249415E-65 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -2.3747119400412856E+01 First Derivative 9.6095091948809959E+00 Second Derivative -3.9049080510375694E-01 log(F(exp(W)|DFN,DFD)) -2.4862378971838140E+01 First Derivative 9.6460848444242462E+00 Second Derivative -3.5281181873414874E-01 log(1 - F(exp(W)|DFN,DFD)) -1.5936979189811749E-11 First Derivative -1.5372945342996671E-10 Second Derivative -1.4772645962829276E-09 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -9.1180328635573833E+00 First Derivative 8.0239159800999964E+00 Second Derivative -1.9760840195095131E+00 log(F(exp(W)|DFN,DFD)) -1.0075031317601789E+01 First Derivative 8.2341570789943273E+00 Second Derivative -1.7311582327563009E+00 log(1 - F(exp(W)|DFN,DFD)) -4.2119057051216678E-05 First Derivative -3.4682223564033401E-04 Second Derivative -2.7829927644716168E-03 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -1.4005843552880475E+00 First Derivative 2.7696206893287232E+00 Second Derivative -7.2303793054434404E+00 log(F(exp(W)|DFN,DFD)) -1.6418968895922712E+00 First Derivative 4.0253226948936076E+00 Second Derivative -5.0546057810237484E+00 log(1 - F(exp(W)|DFN,DFD)) -2.1519079886663856E-01 First Derivative -9.6647387577047328E-01 Second Derivative -3.6108377945764212E+00 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -9.2726909663803569E-01 First Derivative 0.0000000000000000E+00 Second Derivative -9.9999999899999992E+00 log(F(exp(W)|DFN,DFD)) -6.1235960796915279E-01 First Derivative 2.3080039436420869E+00 Second Derivative -5.3268822038674255E+00 log(1 - F(exp(W)|DFN,DFD)) -7.8103956835967658E-01 First Derivative -2.7320794368144954E+00 Second Derivative -7.4642580490646102E+00 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -1.5148661965659456E+00 First Derivative -3.8305330457285178E+00 Second Derivative -1.3830533026600154E+01 log(F(exp(W)|DFN,DFD)) -1.2518751065392122E-01 First Derivative 7.8789839332816525E-01 Second Derivative -3.6388547105290465E+00 log(1 - F(exp(W)|DFN,DFD)) -2.1398834246713379E+00 First Derivative -5.9080142349489773E+00 Second Derivative -1.2273788438753204E+01 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -2.5317725012270721E+01 First Derivative -4.0605135544412803E+01 Second Derivative -5.0605135288324824E+01 log(F(exp(W)|DFN,DFD)) -7.6449137411377048E-13 First Derivative 3.1963308950373786E-11 Second Derivative -1.2978744923788922E-09 log(1 - F(exp(W)|DFN,DFD)) -2.7899565652648416E+01 First Derivative -4.1809901370587419E+01 Second Derivative -5.0371140367014924E+01 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -2.1458588299156159E+02 First Derivative -2.4608797012451956E+02 Second Derivative -2.5608796356641471E+02 log(F(exp(W)|DFN,DFD)) -8.1963413011124028E-96 First Derivative 2.0255134072766565E-93 Second Derivative -4.9845448285671165E-91 log(1 - F(exp(W)|DFN,DFD)) -2.1894448105551851E+02 First Derivative -2.4712409267319424E+02 Second Derivative -2.5605084473960977E+02 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -1.0953792327969025E+08 First Derivative -1.0894033931224398E+08 Second Derivative -1.0775354934260343E+08 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.0953794063470867E+08 First Derivative -1.0894034030135010E+08 Second Derivative -1.0775354933182806E+08 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -1.1706101888470341E+11 First Derivative -9.9999175663488045E+09 Second Derivative -8.2432971666045938E+04 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.1706101890657796E+11 First Derivative -9.9999175663488121E+09 Second Derivative -8.2432971657802525E+04 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -1.4142353165966401E+12 First Derivative -1.0000000000000000E+10 Second Derivative -3.8066292464665828E-52 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.4142353166185146E+12 First Derivative -1.0000000000000000E+10 Second Derivative -3.8066292460859173E-52 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -3.0357032917790503E+12 First Derivative -1.0000000000000000E+10 Second Derivative -1.4490426205564323-122 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -3.0357032918009243E+12 First Derivative -1.0000000000000000E+10 Second Derivative -1.4490426204114855-122 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E+05 B: 1.0000E-03 Standard Deviation: 1000.0008 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -9.9998240062493454E+10 First Derivative 1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -9.9998240077460266E+10 First Derivative 1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -4.9998198998930428E+10 First Derivative 1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.9998199013897240E+10 First Derivative 1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -9.9981661480800018E+09 First Derivative 1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -9.9981661630468044E+09 First Derivative 1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -4.9981620417236967E+09 First Derivative 1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.9981620566905003E+09 First Derivative 1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -9.9815875663865364E+08 First Derivative 1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -9.9815877160545695E+08 First Derivative 1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -4.9815834600302345E+08 First Derivative 1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.9815836096982658E+08 First Derivative 1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -9.8158017494519144E+07 First Derivative 1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -9.8158032461322263E+07 First Derivative 1.0000000000000000E+05 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -3.4612090011717758E+00 First Derivative 0.0000000000000000E+00 Second Derivative -9.9999999000000028E-04 log(F(exp(W)|DFN,DFD)) -5.0652459393456111E+00 First Derivative 1.5726221519592892E-01 Second Derivative -2.4731404328330656E-02 log(1 - F(exp(W)|DFN,DFD)) -6.3323654273927804E-03 First Derivative -9.9900149758231152E-04 Second Derivative -9.9800399217169855E-07 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -4.4602098224380367E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.5500833353410364E-01 First Derivative 5.7618651818336310E-04 Second Derivative -9.0817742191963022E-07 log(1 - F(exp(W)|DFN,DFD)) -1.0063321879469682E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -8.4602131075230798E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -6.7179085593137913E-03 First Derivative 6.7405243221975442E-06 Second Derivative -6.7859589903356805E-09 log(1 - F(exp(W)|DFN,DFD)) -5.0063354730320118E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -1.3460217213879384E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.5114041319384290E-05 First Derivative 4.5115058973049800E-08 Second Derivative -4.5117094341595948E-11 log(1 - F(exp(W)|DFN,DFD)) -1.0006339579388316E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -5.3460250064729813E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.9164981022668934E-22 First Derivative 1.9164981022669011E-25 Second Derivative -1.9164981022669011E-28 log(1 - F(exp(W)|DFN,DFD)) -5.0006372430238748E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -1.0346029112829287E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -3.6962936372672060E-44 First Derivative 3.6962936372671684E-47 Second Derivative -3.6962936372671683E-50 log(1 - F(exp(W)|DFN,DFD)) -1.0000641349380179E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -5.0346061963679711E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -7.0767040552641240-218 First Derivative 7.0767040552642536-221 Second Derivative -7.0767040552642541-224 log(1 - F(exp(W)|DFN,DFD)) -5.0000674200230605E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -1.0034610302724275E+03 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.0000071526379365E+03 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E+05 B: 1.0000E+01 Standard Deviation: .3243 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -3.1509766058208592E+07 First Derivative 1.0000000000000000E+05 Second Derivative -1.4270157659510939-132 log(F(exp(W)|DFN,DFD)) -3.1509776419891510E+07 First Derivative 1.0000000000000000E+05 Second Derivative -1.4270014959361613-132 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -1.5294315422188187E+07 First Derivative 1.0000000000000000E+05 Second Derivative -3.7777750959098785E-62 log(F(exp(W)|DFN,DFD)) -1.5294325783871103E+07 First Derivative 1.0000000000000000E+05 Second Derivative -3.7777373185366563E-62 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -2.3219549133800888E+06 First Derivative 9.9999999991768447E+04 Second Derivative -8.2315564649881323E-06 log(F(exp(W)|DFN,DFD)) -2.3219652750630053E+06 First Derivative 9.9999999991768520E+04 Second Derivative -8.2314741502466496E-06 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -7.0050054109869769E+05 First Derivative 9.9909349779165539E+04 Second Derivative -9.0568054425716824E+01 log(F(exp(W)|DFN,DFD)) -7.0051090187470929E+05 First Derivative 9.9909350685658777E+04 Second Derivative -9.0567148754081458E+01 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -2.1432146276584987E+02 First Derivative 2.4549867278454519E+02 Second Derivative -2.5484594233964296E+02 log(F(exp(W)|DFN,DFD)) -2.1867771297059113E+02 First Derivative 2.4653223451051937E+02 Second Derivative -2.5480628180901002E+02 log(1 - F(exp(W)|DFN,DFD)) -1.0702270945404195E-95 First Derivative -2.6384547705073414E-93 Second Derivative -6.4773714436160403E-91 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -2.5312613017095277E+01 First Derivative 4.0588495523498224E+01 Second Derivative -5.0562906123644908E+01 log(F(exp(W)|DFN,DFD)) -2.7894092973127275E+01 First Derivative 4.1792734349351086E+01 Second Derivative -5.0328433342043120E+01 log(1 - F(exp(W)|DFN,DFD)) -7.6868665965674064E-13 First Derivative -3.2125517364939259E-11 Second Derivative -1.3039264177579336E-09 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -1.5148518930989192E+00 First Derivative 3.8302165399253658E+00 Second Derivative -1.3828303982285718E+01 log(F(exp(W)|DFN,DFD)) -2.1398318259335576E+00 First Derivative 5.9074985334784822E+00 Second Derivative -1.2271540330536293E+01 log(1 - F(exp(W)|DFN,DFD)) -1.2519439211184191E-01 First Derivative -7.8787569266741941E-01 Second Derivative -3.6384826165560700E+00 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -9.2726909672136060E-01 First Derivative 0.0000000000000000E+00 Second Derivative -9.9990000999900008E+00 log(F(exp(W)|DFN,DFD)) -7.8102590896640534E-01 First Derivative 2.7319055277985882E+00 Second Derivative -7.4633078128164829E+00 log(1 - F(exp(W)|DFN,DFD)) -6.1237114728617059E-01 First Derivative -2.3079151846721486E+00 Second Derivative -5.3264724996402775E+00 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -1.4005887037965181E+00 First Derivative -2.7695319215990928E+00 Second Derivative -7.2299453339890203E+00 log(F(exp(W)|DFN,DFD)) -2.1518444948319163E-01 First Derivative 9.6641521752302728E-01 Second Derivative -3.6104761671092351E+00 log(1 - F(exp(W)|DFN,DFD)) -1.6419233349386095E+00 First Derivative -4.0252103893037932E+00 Second Derivative -5.0543700138300274E+00 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -9.1183295103432851E+00 First Derivative -8.0239097620323641E+00 Second Derivative -1.9760511925458917E+00 log(F(exp(W)|DFN,DFD)) -4.2104503425869197E-05 First Derivative 3.4670202765671172E-04 Second Derivative -2.7820259865270849E-03 log(1 - F(exp(W)|DFN,DFD)) -1.0075376905439015E+01 First Derivative -8.2341483841502754E+00 Second Derivative -1.7311360105981799E+00 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -2.3748139270980541E+01 First Derivative -9.6095318767000109E+00 Second Derivative -3.9046659879888429E-01 log(F(exp(W)|DFN,DFD)) -1.5919904222499156E-11 First Derivative 1.5356507122279138E-10 Second Derivative -1.4756884470867034E-09 log(1 - F(exp(W)|DFN,DFD)) -2.4863450951713027E+01 First Derivative -9.6461052199383310E+00 Second Derivative -3.5279031712173942E-01 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -1.5308127638091591E+02 First Derivative -9.9999990926753828E+00 Second Derivative -9.0732461785686469E-07 log(F(exp(W)|DFN,DFD)) -1.0414171066198608E-67 First Derivative 1.0414170207195625E-66 Second Derivative -1.0414169262292326E-65 log(1 - F(exp(W)|DFN,DFD)) -1.5423261884242905E+02 First Derivative -9.9999991751594450E+00 Second Derivative -8.2484055034993721E-07 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -3.1523578183379544E+02 First Derivative -9.9999999999999183E+00 Second Derivative -8.2315564663431681E-14 log(F(exp(W)|DFN,DFD)) -3.9338494700177524-138 First Derivative 3.9338494700175802-137 Second Derivative -3.9338494700175482-136 log(1 - F(exp(W)|DFN,DFD)) -3.1638712437779259E+02 First Derivative -9.9999999999999254E+00 Second Derivative -7.4832331512210704E-14 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -1.6124718327154280E+03 First Derivative -1.0000000000000000E+01 Second Derivative -3.7777750959098786E-70 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.6136231752594254E+03 First Derivative -1.0000000000000000E+01 Second Derivative -3.4343409962817415E-70 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -3.2340168963174692E+03 First Derivative -1.0000000000000000E+01 Second Derivative -1.4270157659510940-140 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -3.2351682388614663E+03 First Derivative -1.0000000000000000E+01 Second Derivative -1.2972870599555157-140 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E+05 B: 1.0000E+05 Standard Deviation: .0045 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -3.1085779958729801E+05 First Derivative 9.7741248526967363E+04 Second Derivative -2.2332416819479945E+03 log(F(exp(W)|DFN,DFD)) -3.1086387977733428E+05 First Derivative 9.7741271375236029E+04 Second Derivative -2.2332188277270216E+03 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -1.0528740618542809E+05 First Derivative 8.0688496281819156E+04 Second Derivative -1.7446832838894294E+04 log(F(exp(W)|DFN,DFD)) -1.0529329465026056E+05 First Derivative 8.0688712503036222E+04 Second Derivative -1.7446611622348908E+04 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -4.9598241221303224E+03 First Derivative 2.1995360685783169E+04 Second Derivative -4.7581020541511520E+04 log(F(exp(W)|DFN,DFD)) -4.9644129181445123E+03 First Derivative 2.1997523468708863E+04 Second Derivative -4.7575868165598935E+04 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -1.2483296449739591E+03 First Derivative 1.1134014493583265E+04 Second Derivative -4.9380168606283391E+04 log(F(exp(W)|DFN,DFD)) -1.2522379138378881E+03 First Derivative 1.1138445996217275E+04 Second Derivative -4.9360052771119845E+04 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -5.0915023631183971E+01 First Derivative 2.2357009614114813E+03 Second Derivative -4.9975008206055718E+04 log(F(exp(W)|DFN,DFD)) -5.3227204371255667E+01 First Derivative 2.2576277713098380E+03 Second Derivative -4.9502574962744766E+04 log(1 - F(exp(W)|DFN,DFD)) -7.6510114945053022E-24 First Derivative -1.7273136028605835E-20 Second Derivative -3.8617566825745362E-17 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -1.3418741872822510E+01 First Derivative 1.1179902010709197E+03 Second Derivative -4.9993750489551545E+04 log(F(exp(W)|DFN,DFD)) -1.5064760686560318E+01 First Derivative 1.1596899407830274E+03 Second Derivative -4.8358768677410560E+04 log(1 - F(exp(W)|DFN,DFD)) -2.8671976029061557E-07 First Derivative -3.3250606950067295E-04 Second Derivative -3.7173863805864482E-01 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -1.4189418665427280E+00 First Derivative 2.2360698408809193E+02 Second Derivative -4.9999749999583335E+04 log(F(exp(W)|DFN,DFD)) -1.8410229159575540E+00 First Derivative 3.4102991190055400E+02 Second Derivative -4.0044730726985566E+04 log(1 - F(exp(W)|DFN,DFD)) -1.7275353935659699E-01 First Derivative -6.4309078757632136E+01 Second Derivative -1.8515616761133035E+04 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -9.1893978320467273E-01 First Derivative 0.0000000000000000E+00 Second Derivative -5.0000000000000000E+04 log(F(exp(W)|DFN,DFD)) -6.9314718055994540E-01 First Derivative 1.7841218859990198E+02 Second Derivative -3.1830909041006995E+04 log(1 - F(exp(W)|DFN,DFD)) -6.9314718055994540E-01 First Derivative -1.7841218859990198E+02 Second Derivative -3.1830909041006995E+04 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -1.4189418665427280E+00 First Derivative -2.2360698408809193E+02 Second Derivative -4.9999749999583335E+04 log(F(exp(W)|DFN,DFD)) -1.7275353935659699E-01 First Derivative 6.4309078757632136E+01 Second Derivative -1.8515616761133035E+04 log(1 - F(exp(W)|DFN,DFD)) -1.8410229159575540E+00 First Derivative -3.4102991190055400E+02 Second Derivative -4.0044730726985566E+04 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -1.3418741872822510E+01 First Derivative -1.1179902010709197E+03 Second Derivative -4.9993750489551545E+04 log(F(exp(W)|DFN,DFD)) -2.8671976029061557E-07 First Derivative 3.3250606950067295E-04 Second Derivative -3.7173863805864482E-01 log(1 - F(exp(W)|DFN,DFD)) -1.5064760686560318E+01 First Derivative -1.1596899407830274E+03 Second Derivative -4.8358768677410560E+04 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -5.0915023631183971E+01 First Derivative -2.2357009614114813E+03 Second Derivative -4.9975008206055718E+04 log(F(exp(W)|DFN,DFD)) -7.6510114945053022E-24 First Derivative 1.7273136028605835E-20 Second Derivative -3.8617566825745362E-17 log(1 - F(exp(W)|DFN,DFD)) -5.3227204371255667E+01 First Derivative -2.2576277713098380E+03 Second Derivative -4.9502574962744766E+04 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -1.2483296449739814E+03 First Derivative -1.1134014493583265E+04 Second Derivative -4.9380168606283391E+04 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.2522379138378881E+03 First Derivative -1.1138445996217275E+04 Second Derivative -4.9360052771119845E+04 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -4.9598241221303115E+03 First Derivative -2.1995360685783169E+04 Second Derivative -4.7581020541511520E+04 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.9644129181445123E+03 First Derivative -2.1997523468708863E+04 Second Derivative -4.7575868165598935E+04 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -1.0528740618542813E+05 First Derivative -8.0688496281819156E+04 Second Derivative -1.7446832838894294E+04 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.0529329465026056E+05 First Derivative -8.0688712503036222E+04 Second Derivative -1.7446611622348908E+04 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -3.1085779958729801E+05 First Derivative -9.7741248526967363E+04 Second Derivative -2.2332416819479945E+03 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -3.1086387977733428E+05 First Derivative -9.7741271375236029E+04 Second Derivative -2.2332188277270216E+03 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E+05 B: 1.0000E+10 Standard Deviation: .0032 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -2.2046341966344247E+05 First Derivative 9.5767137892262574E+04 Second Derivative -4.2328603160431867E+03 log(F(exp(W)|DFN,DFD)) -2.2046913288104831E+05 First Derivative 9.5767182091267590E+04 Second Derivative -4.2328141635661241E+03 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -7.8689494506437011E+04 First Derivative 7.9426014458269841E+04 Second Derivative -2.0573943213265327E+04 log(F(exp(W)|DFN,DFD)) -7.8695020633197331E+04 First Derivative 7.9426273486122867E+04 Second Derivative -2.0573617093176519E+04 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -4.5130645011025808E+03 First Derivative 2.7110633853432344E+04 Second Derivative -7.2888834865910743E+04 log(F(exp(W)|DFN,DFD)) -4.5175158238351632E+03 First Derivative 2.7113321791283754E+04 Second Derivative -7.2878923921511145E+04 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -1.1875687411565648E+03 First Derivative 1.4624721531156318E+04 Second Derivative -8.5374549582315201E+04 log(F(exp(W)|DFN,DFD)) -1.1914031507963202E+03 First Derivative 1.4630554169351879E+04 Second Derivative -8.5334729070417117E+04 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -5.0396287329936797E+01 First Derivative 3.1127933857698658E+03 Second Derivative -9.6886267910536611E+04 log(F(exp(W)|DFN,DFD)) -5.2692863127444760E+01 First Derivative 3.1433158660562058E+03 Second Derivative -9.5941796555228328E+04 log(1 - F(exp(W)|DFN,DFD)) -1.3055103164428164E-23 First Derivative -4.1036312909836235E-20 Second Derivative -1.2773756340212080E-16 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -1.3353381160642240E+01 First Derivative 1.5687006828354986E+03 Second Derivative -9.8430330454784591E+04 log(F(exp(W)|DFN,DFD)) -1.4991528563040161E+01 First Derivative 1.6271822792622322E+03 Second Derivative -9.5160217368683618E+04 log(1 - F(exp(W)|DFN,DFD)) -3.0850480795234006E-07 First Derivative -5.0199363400026868E-04 Second Derivative -7.8747800843290350E-01 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -1.4184152405841721E+00 First Derivative 3.1572750955392547E+02 Second Derivative -9.9683278804964721E+04 log(F(exp(W)|DFN,DFD)) -1.8386150368647001E+00 First Derivative 4.8138026466126428E+02 Second Derivative -7.9741967095404776E+04 log(1 - F(exp(W)|DFN,DFD)) -1.7320825112686775E-01 First Derivative -9.1035609490184896E+01 Second Derivative -3.7029928460309216E+04 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -9.1893936653800623E-01 First Derivative 0.0000000000000000E+00 Second Derivative -9.9999000009999887E+04 log(F(exp(W)|DFN,DFD)) -6.9230650242381142E-01 First Derivative 2.5209975652245311E+02 Second Derivative -6.3554287238680139E+04 log(1 - F(exp(W)|DFN,DFD)) -6.9398856603049008E-01 First Derivative -2.5252416118590619E+02 Second Derivative -6.3768451982645536E+04 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -1.4194693257587854E+00 First Derivative -3.1672749538722582E+02 Second Derivative -1.0031572116086904E+05 log(F(exp(W)|DFN,DFD)) -1.7229879471002413E-01 First Derivative 9.0857032663535662E+01 Second Derivative -3.7031920778259802E+04 log(1 - F(exp(W)|DFN,DFD)) -1.8434378808821992E+00 First Derivative -4.8319789374214463E+02 Second Derivative -8.0438145855512237E+04 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -1.3485143388439630E+01 First Derivative -1.5937008286123375E+03 Second Derivative -1.0159266871092873E+05 log(F(exp(W)|DFN,DFD)) -2.6616767203435844E-07 First Derivative 4.4002219472741533E-04 Second Derivative -7.0126392996443299E-01 log(1 - F(exp(W)|DFN,DFD)) -1.5139139513839305E+01 First Derivative -1.6531764838503259E+03 Second Derivative -9.8323754601243796E+04 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -5.1450424677515542E+01 First Derivative -3.2128002183875051E+03 Second Derivative -1.0321173494082740E+05 log(F(exp(W)|DFN,DFD)) -4.4079669225040087E-24 First Derivative 1.4300864755778362E-20 Second Derivative -4.5945821410494898E-17 log(1 - F(exp(W)|DFN,DFD)) -5.3778628664003783E+01 First Derivative -3.2443221573938777E+03 Second Derivative -1.0226732516210958E+05 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -1.3194941035568984E+03 First Derivative -1.7129896079340295E+04 Second Derivative -1.1712852415180403E+05 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.3234866251404667E+03 First Derivative -1.7136728696331309E+04 Second Derivative -1.1708870366079902E+05 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -5.5724315774511851E+03 First Derivative -3.7194085298251928E+04 Second Derivative -1.3719220309536988E+05 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -5.5771991238973296E+03 First Derivative -3.7197773215035355E+04 Second Derivative -1.3718229214529716E+05 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -2.2793295533349103E+05 First Derivative -3.8603579344762996E+05 Second Derivative -4.8601217060460715E+05 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -2.2794006256439307E+05 First Derivative -3.8603705242482258E+05 Second Derivative -4.8601184443797549E+05 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -1.9460052020214386E+06 First Derivative -2.2619559378658822E+06 Second Derivative -2.3613980598594197E+06 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.9460140773046236E+06 First Derivative -2.2619569818282677E+06 Second Derivative -2.3613980134712262E+06 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E+10 B: 1.0000E-03 Standard Deviation: 1000.0008 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -9.9997088766005220E+15 First Derivative 1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -9.9997088766005500E+15 First Derivative 1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -4.9997047702692180E+15 First Derivative 1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.9997047702692440E+15 First Derivative 1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -9.9970148520417475E+14 First Derivative 1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -9.9970148520420138E+14 First Derivative 1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -4.9970107457104456E+14 First Derivative 1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.9970107457107106E+14 First Derivative 1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -9.9700746064540281E+13 First Derivative 1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -9.9700746064566766E+13 First Derivative 1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -4.9700705001227242E+13 First Derivative 1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.9700705001253727E+13 First Derivative 1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -9.7006721505768125E+12 First Derivative 1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -9.7006721506032910E+12 First Derivative 1.0000000000000000E+10 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -3.4612090011717673E+00 First Derivative 0.0000000000000000E+00 Second Derivative -9.9999999999990006E-04 log(F(exp(W)|DFN,DFD)) -5.0652467256504430E+00 First Derivative 1.5726233963832240E-01 Second Derivative -2.4731443468519066E-02 log(1 - F(exp(W)|DFN,DFD)) -6.3323604324269350E-03 First Derivative -9.9900149758729907E-04 Second Derivative -9.9800399218166664E-07 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -4.4602098224380278E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.5500833641501243E-01 First Derivative 5.7618652272421300E-04 Second Derivative -9.0817743169323307E-07 log(1 - F(exp(W)|DFN,DFD)) -1.0063321829470095E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -8.4602131075030709E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -6.7179085931509501E-03 First Derivative 6.7405243562627843E-06 Second Derivative -6.7859590248601561E-09 log(1 - F(exp(W)|DFN,DFD)) -5.0063354680120522E+00 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -1.3460217213834374E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -4.5114041546987878E-05 First Derivative 4.5115059200663786E-08 Second Derivative -4.5117094569230463E-11 log(1 - F(exp(W)|DFN,DFD)) -1.0006339574343357E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -5.3460250064484811E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -1.9164981123188562E-22 First Derivative 1.9164981123188426E-25 Second Derivative -1.9164981123188427E-28 log(1 - F(exp(W)|DFN,DFD)) -5.0006372424993785E+01 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -1.0346029112779784E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -3.6962936575782213E-44 First Derivative 3.6962936575781952E-47 Second Derivative -3.6962936575781953E-50 log(1 - F(exp(W)|DFN,DFD)) -1.0000641348830682E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -5.0346061963430219E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) -7.0767041083030419-218 First Derivative 7.0767041083031931-221 Second Derivative -7.0767041083031929-224 log(1 - F(exp(W)|DFN,DFD)) -5.0000674199481119E+02 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -1.0034610302674325E+03 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.0000071526279417E+03 First Derivative -1.0000000000000000E-03 Second Derivative 0.0000000000000000E+00 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E+10 B: 1.0000E+01 Standard Deviation: .3243 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -3.0357032917790503E+12 First Derivative 1.0000000000000000E+10 Second Derivative -1.4490426205564323-122 log(F(exp(W)|DFN,DFD)) -3.0357032918009243E+12 First Derivative 1.0000000000000000E+10 Second Derivative -1.4490426204114855-122 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -1.4142353165966401E+12 First Derivative 1.0000000000000000E+10 Second Derivative -3.8066292464665828E-52 log(F(exp(W)|DFN,DFD)) -1.4142353166185146E+12 First Derivative 1.0000000000000000E+10 Second Derivative -3.8066292460859173E-52 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -1.1706101888470341E+11 First Derivative 9.9999175663488045E+09 Second Derivative -8.2432971666045938E+04 log(F(exp(W)|DFN,DFD)) -1.1706101890657796E+11 First Derivative 9.9999175663488121E+09 Second Derivative -8.2432971657802525E+04 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -1.0953792327969025E+08 First Derivative 1.0894033931224398E+08 Second Derivative -1.0775354934260343E+08 log(F(exp(W)|DFN,DFD)) -1.0953794063470867E+08 First Derivative 1.0894034030135010E+08 Second Derivative -1.0775354933182806E+08 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -2.1458588299156159E+02 First Derivative 2.4608797012451956E+02 Second Derivative -2.5608796356641471E+02 log(F(exp(W)|DFN,DFD)) -2.1894448105551851E+02 First Derivative 2.4712409267319424E+02 Second Derivative -2.5605084473960977E+02 log(1 - F(exp(W)|DFN,DFD)) -8.1963413011124028E-96 First Derivative -2.0255134072766565E-93 Second Derivative -4.9845448285671165E-91 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -2.5317725012270721E+01 First Derivative 4.0605135544412803E+01 Second Derivative -5.0605135288324824E+01 log(F(exp(W)|DFN,DFD)) -2.7899565652648416E+01 First Derivative 4.1809901370587419E+01 Second Derivative -5.0371140367014924E+01 log(1 - F(exp(W)|DFN,DFD)) -7.6449137411377048E-13 First Derivative -3.1963308950373786E-11 Second Derivative -1.2978744923788922E-09 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -1.5148661965659456E+00 First Derivative 3.8305330457285178E+00 Second Derivative -1.3830533026600154E+01 log(F(exp(W)|DFN,DFD)) -2.1398834246713379E+00 First Derivative 5.9080142349489773E+00 Second Derivative -1.2273788438753204E+01 log(1 - F(exp(W)|DFN,DFD)) -1.2518751065392122E-01 First Derivative -7.8789839332816525E-01 Second Derivative -3.6388547105290465E+00 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -9.2726909663803569E-01 First Derivative 0.0000000000000000E+00 Second Derivative -9.9999999899999992E+00 log(F(exp(W)|DFN,DFD)) -7.8103956835967658E-01 First Derivative 2.7320794368144954E+00 Second Derivative -7.4642580490646102E+00 log(1 - F(exp(W)|DFN,DFD)) -6.1235960796915279E-01 First Derivative -2.3080039436420869E+00 Second Derivative -5.3268822038674255E+00 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -1.4005843552880475E+00 First Derivative -2.7696206893287232E+00 Second Derivative -7.2303793054434404E+00 log(F(exp(W)|DFN,DFD)) -2.1519079886663856E-01 First Derivative 9.6647387577047328E-01 Second Derivative -3.6108377945764212E+00 log(1 - F(exp(W)|DFN,DFD)) -1.6418968895922712E+00 First Derivative -4.0253226948936076E+00 Second Derivative -5.0546057810237484E+00 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -9.1180328635573833E+00 First Derivative -8.0239159800999964E+00 Second Derivative -1.9760840195095131E+00 log(F(exp(W)|DFN,DFD)) -4.2119057051216678E-05 First Derivative 3.4682223564033401E-04 Second Derivative -2.7829927644716168E-03 log(1 - F(exp(W)|DFN,DFD)) -1.0075031317601789E+01 First Derivative -8.2341570789943273E+00 Second Derivative -1.7311582327563009E+00 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -2.3747119400412856E+01 First Derivative -9.6095091948809959E+00 Second Derivative -3.9049080510375694E-01 log(F(exp(W)|DFN,DFD)) -1.5936979189811749E-11 First Derivative 1.5372945342996671E-10 Second Derivative -1.4772645962829276E-09 log(1 - F(exp(W)|DFN,DFD)) -2.4862378971838140E+01 First Derivative -9.6460848444242462E+00 Second Derivative -3.5281181873414874E-01 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -1.5307406751781255E+02 First Derivative -9.9999990920664636E+00 Second Derivative -9.0793353730022820E-07 log(F(exp(W)|DFN,DFD)) -1.0490041109517726E-67 First Derivative 1.0490040243675348E-66 Second Derivative -1.0490039291249415E-65 log(1 - F(exp(W)|DFN,DFD)) -1.5422535998227011E+02 First Derivative -9.9999991746058807E+00 Second Derivative -8.2539411346380062E-07 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -3.1522086412812013E+02 First Derivative -9.9999999999999183E+00 Second Derivative -8.2434330733016166E-14 log(F(exp(W)|DFN,DFD)) -3.9931730203593735-138 First Derivative 3.9931730203588794-137 Second Derivative -3.9931730203588465-136 log(1 - F(exp(W)|DFN,DFD)) -3.1637215667511703E+02 First Derivative -9.9999999999999254E+00 Second Derivative -7.4940300666378275E-14 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -1.6123952442740476E+03 First Derivative -1.0000000000000000E+01 Second Derivative -3.8066292464665831E-70 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.6135465368210446E+03 First Derivative -1.0000000000000000E+01 Second Derivative -3.4605720422423500E-70 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -3.2338632194564575E+03 First Derivative -1.0000000000000000E+01 Second Derivative -1.4490426205564323-140 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -3.2350145120034545E+03 First Derivative -1.0000000000000000E+01 Second Derivative -1.3173114732331584-140 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E+10 B: 1.0000E+05 Standard Deviation: .0032 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -1.9460052020214386E+06 First Derivative 2.2619559378658822E+06 Second Derivative -2.3613980598594197E+06 log(F(exp(W)|DFN,DFD)) -1.9460140773046236E+06 First Derivative 2.2619569818282677E+06 Second Derivative -2.3613980134712262E+06 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -2.2793295533349103E+05 First Derivative 3.8603579344762996E+05 Second Derivative -4.8601217060460715E+05 log(F(exp(W)|DFN,DFD)) -2.2794006256439307E+05 First Derivative 3.8603705242482258E+05 Second Derivative -4.8601184443797549E+05 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -5.5724315774511851E+03 First Derivative 3.7194085298251928E+04 Second Derivative -1.3719220309536988E+05 log(F(exp(W)|DFN,DFD)) -5.5771991238973296E+03 First Derivative 3.7197773215035355E+04 Second Derivative -1.3718229214529716E+05 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -1.3194941035568984E+03 First Derivative 1.7129896079340295E+04 Second Derivative -1.1712852415180403E+05 log(F(exp(W)|DFN,DFD)) -1.3234866251404667E+03 First Derivative 1.7136728696331309E+04 Second Derivative -1.1708870366079902E+05 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -5.1450424677515542E+01 First Derivative 3.2128002183875051E+03 Second Derivative -1.0321173494082740E+05 log(F(exp(W)|DFN,DFD)) -5.3778628664003783E+01 First Derivative 3.2443221573938777E+03 Second Derivative -1.0226732516210958E+05 log(1 - F(exp(W)|DFN,DFD)) -4.4079669225040087E-24 First Derivative -1.4300864755778362E-20 Second Derivative -4.5945821410494898E-17 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -1.3485143388439630E+01 First Derivative 1.5937008286123375E+03 Second Derivative -1.0159266871092873E+05 log(F(exp(W)|DFN,DFD)) -1.5139139513839305E+01 First Derivative 1.6531764838503259E+03 Second Derivative -9.8323754601243796E+04 log(1 - F(exp(W)|DFN,DFD)) -2.6616767203435844E-07 First Derivative -4.4002219472741533E-04 Second Derivative -7.0126392996443299E-01 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -1.4194693257587854E+00 First Derivative 3.1672749538722582E+02 Second Derivative -1.0031572116086904E+05 log(F(exp(W)|DFN,DFD)) -1.8434378808821992E+00 First Derivative 4.8319789374214463E+02 Second Derivative -8.0438145855512237E+04 log(1 - F(exp(W)|DFN,DFD)) -1.7229879471002413E-01 First Derivative -9.0857032663535662E+01 Second Derivative -3.7031920778259802E+04 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -9.1893936653800623E-01 First Derivative 0.0000000000000000E+00 Second Derivative -9.9999000009999887E+04 log(F(exp(W)|DFN,DFD)) -6.9398856603049008E-01 First Derivative 2.5252416118590619E+02 Second Derivative -6.3768451982645536E+04 log(1 - F(exp(W)|DFN,DFD)) -6.9230650242381142E-01 First Derivative -2.5209975652245311E+02 Second Derivative -6.3554287238680139E+04 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -1.4184152405841721E+00 First Derivative -3.1572750955392547E+02 Second Derivative -9.9683278804964721E+04 log(F(exp(W)|DFN,DFD)) -1.7320825112686775E-01 First Derivative 9.1035609490184896E+01 Second Derivative -3.7029928460309216E+04 log(1 - F(exp(W)|DFN,DFD)) -1.8386150368647001E+00 First Derivative -4.8138026466126428E+02 Second Derivative -7.9741967095404776E+04 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -1.3353381160642240E+01 First Derivative -1.5687006828354986E+03 Second Derivative -9.8430330454784591E+04 log(F(exp(W)|DFN,DFD)) -3.0850480795234006E-07 First Derivative 5.0199363400026868E-04 Second Derivative -7.8747800843290350E-01 log(1 - F(exp(W)|DFN,DFD)) -1.4991528563040161E+01 First Derivative -1.6271822792622322E+03 Second Derivative -9.5160217368683618E+04 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -5.0396287329936797E+01 First Derivative -3.1127933857698658E+03 Second Derivative -9.6886267910536611E+04 log(F(exp(W)|DFN,DFD)) -1.3055103164428164E-23 First Derivative 4.1036312909836235E-20 Second Derivative -1.2773756340212080E-16 log(1 - F(exp(W)|DFN,DFD)) -5.2692863127444760E+01 First Derivative -3.1433158660562058E+03 Second Derivative -9.5941796555228328E+04 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -1.1875687411565648E+03 First Derivative -1.4624721531156318E+04 Second Derivative -8.5374549582315201E+04 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.1914031507963202E+03 First Derivative -1.4630554169351879E+04 Second Derivative -8.5334729070417117E+04 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -4.5130645011025808E+03 First Derivative -2.7110633853432344E+04 Second Derivative -7.2888834865910743E+04 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -4.5175158238351632E+03 First Derivative -2.7113321791283754E+04 Second Derivative -7.2878923921511145E+04 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -7.8689494506437011E+04 First Derivative -7.9426014458269841E+04 Second Derivative -2.0573943213265327E+04 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -7.8695020633197331E+04 First Derivative -7.9426273486122867E+04 Second Derivative -2.0573617093176519E+04 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -2.2046341966344247E+05 First Derivative -9.5767137892262574E+04 Second Derivative -4.2328603160431867E+03 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -2.2046913288104831E+05 First Derivative -9.5767182091267590E+04 Second Derivative -4.2328141635661241E+03 ++++++++++++++++++++++++++++++++++++++++++++++++++ ------------------ Values Used ------------------- A: 1.0000E+10 B: 1.0000E+10 Standard Deviation: 1.4142E-05 ************************************************** W (in standard deviations) -1000.0000 log(f(exp(W)|DFN,DFD)) -4.9999675235242065E+05 First Derivative 7.0709499632690191E+07 Second Derivative -4.9997500083330851E+09 log(F(exp(W)|DFN,DFD)) -5.0000366009204020E+05 First Derivative 7.0709570340870425E+07 Second Derivative -4.9997450114458570E+09 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -500.0000 log(f(exp(W)|DFN,DFD)) -1.2500065852898454E+05 First Derivative 3.5355191747035064E+07 Second Derivative -4.9999375005208263E+09 log(F(exp(W)|DFN,DFD)) -1.2500687313690911E+05 First Derivative 3.5355333166079834E+07 Second Derivative -4.9999175016408424E+09 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -100.0000 log(f(exp(W)|DFN,DFD)) -5.0009185221166053E+03 First Derivative 7.0710666335311849E+06 Second Derivative -4.9999975000008335E+09 log(F(exp(W)|DFN,DFD)) -5.0055237921100079E+03 First Derivative 7.0717735987254763E+06 Second Derivative -4.9994977996198835E+09 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -50.0000 log(f(exp(W)|DFN,DFD)) -1.2509189125540508E+03 First Derivative 3.5355337587072202E+06 Second Derivative -4.9999993750000525E+09 log(F(exp(W)|DFN,DFD)) -1.2548313351178781E+03 First Derivative 3.5369468430350865E+06 Second Derivative -4.9980041589040461E+09 log(1 - F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 ************************************************** W (in standard deviations) -10.0000 log(f(exp(W)|DFN,DFD)) -5.0918938494050487E+01 First Derivative 7.0710678002571373E+05 Second Derivative -4.9999999750000000E+09 log(F(exp(W)|DFN,DFD)) -5.3231285109700735E+01 First Derivative 7.1404301909486158E+05 Second Derivative -4.9527730857075882E+09 log(1 - F(exp(W)|DFN,DFD)) -7.6198533363481961E-24 First Derivative -5.4409030804869337E-18 Second Derivative -3.8472994576751020E-12 ************************************************** W (in standard deviations) -5.0000 log(f(exp(W)|DFN,DFD)) -1.3418938531238000E+01 First Derivative 3.5355339045479859E+05 Second Derivative -4.9999999937499990E+09 log(F(exp(W)|DFN,DFD)) -1.5064998391728729E+01 First Derivative 3.6674121243206639E+05 Second Derivative -4.8365178205047102E+09 log(1 - F(exp(W)|DFN,DFD)) -2.8665161363493803E-07 First Derivative -1.0512697540066272E-01 Second Derivative -3.7168009632843467E+04 ************************************************** W (in standard deviations) -1.0000 log(f(exp(W)|DFN,DFD)) -1.4189385332380060E+00 First Derivative 7.0710678119243981E+04 Second Derivative -4.9999999997500000E+09 log(F(exp(W)|DFN,DFD)) -1.8410216450030916E+00 First Derivative 1.0784334959763364E+05 Second Derivative -4.0045116717191434E+09 log(1 - F(exp(W)|DFN,DFD)) -1.7275377902009820E-01 First Derivative -2.0336388971268665E+04 Second Derivative -1.8515685710458596E+09 ************************************************** W (in standard deviations) .0000 log(f(exp(W)|DFN,DFD)) -9.1893853321717278E-01 First Derivative 0.0000000000000000E+00 Second Derivative -5.0000000000000000E+09 log(F(exp(W)|DFN,DFD)) -6.9314718055994529E-01 First Derivative 5.6418958354070390E+04 Second Derivative -3.1830988617583289E+09 log(1 - F(exp(W)|DFN,DFD)) -6.9314718055994529E-01 First Derivative -5.6418958354070390E+04 Second Derivative -3.1830988617583289E+09 ************************************************** W (in standard deviations) 1.0000 log(f(exp(W)|DFN,DFD)) -1.4189385332380060E+00 First Derivative -7.0710678119243981E+04 Second Derivative -4.9999999997500000E+09 log(F(exp(W)|DFN,DFD)) -1.7275377902009820E-01 First Derivative 2.0336388971268665E+04 Second Derivative -1.8515685710458596E+09 log(1 - F(exp(W)|DFN,DFD)) -1.8410216450030916E+00 First Derivative -1.0784334959763364E+05 Second Derivative -4.0045116717191434E+09 ************************************************** W (in standard deviations) 5.0000 log(f(exp(W)|DFN,DFD)) -1.3418938531238000E+01 First Derivative -3.5355339045479859E+05 Second Derivative -4.9999999937499990E+09 log(F(exp(W)|DFN,DFD)) -2.8665161363493803E-07 First Derivative 1.0512697540066272E-01 Second Derivative -3.7168009632843467E+04 log(1 - F(exp(W)|DFN,DFD)) -1.5064998391728729E+01 First Derivative -3.6674121243206639E+05 Second Derivative -4.8365178205047102E+09 ************************************************** W (in standard deviations) 10.0000 log(f(exp(W)|DFN,DFD)) -5.0918938494050487E+01 First Derivative -7.0710678002571373E+05 Second Derivative -4.9999999750000000E+09 log(F(exp(W)|DFN,DFD)) -7.6198533363481961E-24 First Derivative 5.4409030804869337E-18 Second Derivative -3.8472994576751020E-12 log(1 - F(exp(W)|DFN,DFD)) -5.3231285109700735E+01 First Derivative -7.1404301909486158E+05 Second Derivative -4.9527730857075882E+09 ************************************************** W (in standard deviations) 50.0000 log(f(exp(W)|DFN,DFD)) -1.2509189125540508E+03 First Derivative -3.5355337587072202E+06 Second Derivative -4.9999993750000525E+09 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.2548313351178781E+03 First Derivative -3.5369468430350865E+06 Second Derivative -4.9980041589040461E+09 ************************************************** W (in standard deviations) 100.0000 log(f(exp(W)|DFN,DFD)) -5.0009185221166053E+03 First Derivative -7.0710666335311849E+06 Second Derivative -4.9999975000008335E+09 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -5.0055237921100079E+03 First Derivative -7.0717735987254763E+06 Second Derivative -4.9994977996198835E+09 ************************************************** W (in standard deviations) 500.0000 log(f(exp(W)|DFN,DFD)) -1.2500065852898454E+05 First Derivative -3.5355191747035064E+07 Second Derivative -4.9999375005208263E+09 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -1.2500687313690911E+05 First Derivative -3.5355333166079834E+07 Second Derivative -4.9999175016408424E+09 ************************************************** W (in standard deviations) 1000.0000 log(f(exp(W)|DFN,DFD)) -4.9999675235242065E+05 First Derivative -7.0709499632690191E+07 Second Derivative -4.9997500083330851E+09 log(F(exp(W)|DFN,DFD)) 0.0000000000000000E+00 First Derivative 0.0000000000000000E+00 Second Derivative 0.0000000000000000E+00 log(1 - F(exp(W)|DFN,DFD)) -5.0000366009204020E+05 First Derivative -7.0709570340870425E+07 Second Derivative -4.9997450114458570E+09 SHAR_EOF fi # end of overwriting check if test -f 'driver2.f' then echo shar: will not over-write existing file "'driver2.f'" else cat << \SHAR_EOF > 'driver2.f' PROGRAM tstlld C C PACKAGE WHICH PRINTS THE RESULTS OF CALL TO LLDRLF TO SCREEN C C .. Parameters .. INTEGER bigar PARAMETER (bigar=100) DOUBLE PRECISION two PARAMETER (two=2.0D0) REAL ablow PARAMETER (ablow=1.0E-3) REAL abhigh PARAMETER (abhigh=1.0E10) REAL wlow PARAMETER (wlow=-1000.0E0) REAL whigh PARAMETER (whigh=1000.0E0) C .. C .. Local Scalars .. DOUBLE PRECISION dfd,dfn,a,b,w,worig,tau,dum,l,dldw,d2ldw2 INTEGER i,iw,nw,nab,iab,ia,ib,inun,outun,stdout LOGICAL qfile,qscrn,qw,qab C .. C .. Local Arrays .. DOUBLE PRECISION warray(bigar) DOUBLE PRECISION aarray(bigar),barray(bigar) CHARACTER cases(3)*26 C .. C .. External Functions .. LOGICAL qyngt INTEGER obfugt REAL rlgt EXTERNAL qyngt,obfugt,rlgt C .. C .. External Subroutines .. EXTERNAL lldrlf C .. C .. Intrinsic Functions .. INTRINSIC dble,sqrt,abs,max,log10 C .. C .. Data statements .. DATA (cases(i),i=1,3)/'log(f(exp(W)|DFN,DFD)) ', + 'log(F(exp(W)|DFN,DFD)) ','log(1 - F(exp(W)|DFN,DFD))'/ C .. C .. Executable Statements .. C C Setup for run C C See if user wants to output to the screen or a file C CALL gtstio(inun,stdout) qfile = (qyngt('('' Do you want to output to a file? (y/n)'')')) qscrn = .NOT. qfile IF (qfile) THEN outun = obfugt('('' Enter name of output file.'')',.TRUE.) ELSE outun = stdout END IF C C Ask if user wants to specify A and B or run all possibilities C 10 qab = (qyngt('('' Do you want to specify A and B? (y/n)'')')) C C Ask for A and B C IF (qab) THEN nab = 1 aarray(1) = dble(rlgt('('' Enter A.'')',ablow,abhigh)) barray(1) = dble(rlgt('('' Enter B.'')',ablow,abhigh)) ELSE C C Otherwise define all A and B possibilities C nab = 0 DO 20 iab = -3,10,1 nab = nab + 1 aarray(nab) = 10.0D0**dble(iab) barray(nab) = aarray(nab) 20 CONTINUE END IF C C Ask if user wants to specify W or run all possibilities C qw = (qyngt('('' Do you want to specify W? (y/n)'')')) C C Ask for W C IF (qw) THEN nw = 1 warray(1) = dble(rlgt( + '('' Enter W (in standard deviations).'')',wlow, + whigh)) ELSE C C Otherwise define all W possibilities C nw = 0 DO 30 iw = -1000,-100,100 nw = nw + 1 warray(nw) = dble(iw) 30 CONTINUE DO 40 iw = -90,-10,10 nw = nw + 1 warray(nw) = dble(iw) 40 CONTINUE DO 50 iw = -9,9,1 nw = nw + 1 warray(nw) = dble(iw) 50 CONTINUE DO 60 iw = 10,100,10 nw = nw + 1 warray(nw) = dble(iw) 60 CONTINUE DO 70 iw = 200,1000,100 nw = nw + 1 warray(nw) = dble(iw) 70 CONTINUE END IF C C loop through all possible combinations of A and B C DO 100 ia = 1,nab DO 90 ib = 1,nab C C Caculate tau, the standard deviation of the distribution, C and define dfn and dfd C a = aarray(ia) b = barray(ib) dfn = two*a dfd = two*b CALL mvlogf(dfn,dfd,dum,tau) tau = sqrt(tau) C C output information on a, b and tau C WRITE (outun,9000) WRITE (outun,9010) WRITE (outun,9020) 'A: ',a WRITE (outun,9020) 'B: ',b IF ((tau.GE.0.0001) .AND. (tau.LE.99999.0)) THEN WRITE (outun,9030) 'Standard Deviation: ',tau ELSE WRITE (outun,9040) 'Standard Deviation: ',tau END IF C C loop through all w C DO 80 iw = 1,nw worig = warray(iw) w = worig*tau C C call lldrlf C WRITE (outun,9050) WRITE (outun,9060) 'W (in standard deviations)',worig C C case = 1 C CALL lldrlf(w,dfn,dfd,1,l,dldw,d2ldw2) WRITE (outun,9070) cases(1),l WRITE (outun,9070) ' First Derivative',dldw WRITE (outun,9070) ' Second Derivative',d2ldw2 C C case = 2 C CALL lldrlf(w,dfn,dfd,2,l,dldw,d2ldw2) WRITE (outun,9070) cases(2),l WRITE (outun,9070) ' First Derivative',dldw WRITE (outun,9070) ' Second Derivative',d2ldw2 C C case = 3 C CALL lldrlf(w,dfn,dfd,3,l,dldw,d2ldw2) WRITE (outun,9070) cases(3),l WRITE (outun,9070) ' First Derivative',dldw WRITE (outun,9070) ' Second Derivative',d2ldw2 IF (qscrn) CALL pause 80 CONTINUE 90 CONTINUE 100 CONTINUE C C Ask if they wish to continue C IF (qyngt('('' Do you want to continue? (y/n)'')')) GO TO 10 C C close file and quit C IF (qfile) CLOSE (outun) C C Format Statments C 9000 FORMAT (1X,'++++++++++++++++++++++++++++++++++++++++++++++++++') 9010 FORMAT (1X,'------------------ Values Used -------------------') 9020 FORMAT (1X,1A,1P,1E10.4) 9030 FORMAT (1X,1A,1F10.4) 9040 FORMAT (1X,1A,1P,1E10.4) 9050 FORMAT (1X,'**************************************************') 9060 FORMAT (1X,1A30,1F12.4) 9070 FORMAT (1X,1A30,1P,1E25.16) END SHAR_EOF fi # end of overwriting check if test -f 'driver1.f' then echo shar: will not over-write existing file "'driver1.f'" else cat << \SHAR_EOF > 'driver1.f' PROGRAM tstsht C C PACKAGE WHICH PRINTS THE RESULTS OF CALL TO LLDRLF TO SCREEN C MODIFIED TO DEFAULT TO SMALL SUBSET OF TEST CASES C C .. Parameters .. INTEGER bigar PARAMETER (bigar=100) DOUBLE PRECISION two PARAMETER (two=2.0D0) REAL ablow PARAMETER (ablow=1.0E-3) REAL abhigh PARAMETER (abhigh=1.0E10) REAL wlow PARAMETER (wlow=-1000.0E0) REAL whigh PARAMETER (whigh=1000.0E0) C .. C .. Local Scalars .. DOUBLE PRECISION a,b,d2ldw2,dfd,dfn,dldw,dum,l,tau,w,worig INTEGER i,ia,ib,inun,iw,nab,nw,outun,stdout LOGICAL qab,qfile,qscrn,qw C .. C .. Local Arrays .. DOUBLE PRECISION aarray(bigar),barray(bigar),warray(bigar) CHARACTER cases(3)*26 C .. C .. External Functions .. REAL rlgt INTEGER obfugt LOGICAL qyngt EXTERNAL rlgt,obfugt,qyngt C .. C .. External Subroutines .. EXTERNAL gtstio,lldrlf,mvlogf,pause C .. C .. Intrinsic Functions .. INTRINSIC dble,sqrt C .. C .. Data statements .. DATA (cases(i),i=1,3)/'log(f(exp(W)|DFN,DFD)) ', + 'log(F(exp(W)|DFN,DFD)) ','log(1 - F(exp(W)|DFN,DFD))'/ DATA (warray(i),i=1,15)/-1000.0D0,-500.0D0,-100.0D0,-50.0D0, + -10.0D0,-5.0D0,-1.0D0,0.0D0,1.0D0,5.0D0,10.0D0,50.0D0, + 100.0D0,500.0D0,1000.0D0/ DATA (aarray(i),i=1,4)/-3.0D0,1.0D0,5.0D0,10.0D0/ C .. C .. Executable Statements .. C C Setup for run C nab = 4 DO 10 i = 1,nab aarray(i) = 10.0D0 ** aarray(i) barray(i) = aarray(i) 10 CONTINUE C See if user wants to output to the screen or a file C CALL gtstio(inun,stdout) qfile = (qyngt('('' Do you want to output to a file? (y/n)'')')) qscrn = .NOT. qfile IF (qfile) THEN outun = obfugt('('' Enter name of output file.'')',.TRUE.) ELSE outun = stdout END IF C C Ask if user wants to specify A and B or run all possibilities C 20 qab = (qyngt('('' Do you want to specify A and B? (y/n)'')')) C C Ask for A and B C IF (qab) THEN nab = 1 aarray(1) = dble(rlgt('('' Enter A.'')',ablow,abhigh)) barray(1) = dble(rlgt('('' Enter B.'')',ablow,abhigh)) ELSE C C Otherwise define all A and B possibilities C nab = 4 END IF C C Ask if user wants to specify W or run all possibilities C qw = (qyngt('('' Do you want to specify W? (y/n)'')')) C C Ask for W C IF (qw) THEN nw = 1 warray(1) = dble(rlgt( + '('' Enter W (in standard deviations).'')',wlow, + whigh)) ELSE C C Otherwise define all W possibilities C nw = 15 END IF C C loop through all possible combinations of A and B C DO 60 ia = 1,nab DO 50 ib = 1,nab C C Caculate tau, the standard deviation of the distribution, C and define dfn and dfd C a = aarray(ia) b = barray(ib) dfn = two*a dfd = two*b CALL mvlogf(dfn,dfd,dum,tau) tau = sqrt(tau) C C output information on a, b and tau C WRITE (outun,9000) WRITE (outun,9010) WRITE (outun,9020) 'A: ',a WRITE (outun,9020) 'B: ',b IF ((tau.GE.0.0001) .AND. (tau.LE.99999.0)) THEN WRITE (outun,9030) 'Standard Deviation: ',tau ELSE WRITE (outun,9040) 'Standard Deviation: ',tau END IF C C loop through all w C DO 40 iw = 1,nw worig = warray(iw) w = worig*tau C C call lldrlf C WRITE (outun,9050) WRITE (outun,9060) 'W (in standard deviations)',worig C C case = 1 C CALL lldrlf(w,dfn,dfd,1,l,dldw,d2ldw2) WRITE (outun,9070) cases(1),l WRITE (outun,9070) ' First Derivative',dldw WRITE (outun,9070) ' Second Derivative',d2ldw2 C C case = 2 C CALL lldrlf(w,dfn,dfd,2,l,dldw,d2ldw2) WRITE (outun,9070) cases(2),l WRITE (outun,9070) ' First Derivative',dldw WRITE (outun,9070) ' Second Derivative',d2ldw2 C C case = 3 C CALL lldrlf(w,dfn,dfd,3,l,dldw,d2ldw2) WRITE (outun,9070) cases(3),l WRITE (outun,9070) ' First Derivative',dldw WRITE (outun,9070) ' Second Derivative',d2ldw2 IF (qscrn) CALL pause 40 CONTINUE 50 CONTINUE 60 CONTINUE C C Ask if they wish to continue C IF (qyngt('('' Do you want to continue? (y/n)'')')) GO TO 20 C C close file and quit C IF (qfile) CLOSE (outun) C C Format Statments C 9000 FORMAT (1X,'++++++++++++++++++++++++++++++++++++++++++++++++++') 9010 FORMAT (1X,'------------------ Values Used -------------------') 9020 FORMAT (1X,1A,1P,1E10.4) 9030 FORMAT (1X,1A,1F10.4) 9040 FORMAT (1X,1A,1P,1E10.4) 9050 FORMAT (1X,'**************************************************') 9060 FORMAT (1X,1A30,1F12.4) 9070 FORMAT (1X,1A30,1P,1E25.16) 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 'others.f' then echo shar: will not over-write existing file "'others.f'" else cat << \SHAR_EOF > 'others.f' SUBROUTINE dpsifn(x,n,kode,m,ans) *include *dpsifndc C .. Scalar Arguments .. DOUBLE PRECISION x INTEGER kode,m,n C .. C .. Array Arguments .. DOUBLE PRECISION ans(m) C .. C .. Local Scalars .. DOUBLE PRECISION arg,den,elim,eps,fln,fn,fnp,fns,fx,r1m4,r1m5,rln, + rxsq,s,slope,t,t1,t2,ta,tk,tol,tols,tss,tst,tt, + wdtol,xdmln,xdmy,xinc,xln,xm,xmin,xq,yint INTEGER i,iflag,iset,j,k,mx,nmax,nn,np,nx C .. C .. Local Arrays .. DOUBLE PRECISION b(22),trm(22),trmr(100) C .. C .. External Functions .. DOUBLE PRECISION d1mach INTEGER i1mach EXTERNAL d1mach,i1mach C .. C .. Intrinsic Functions .. INTRINSIC abs,dble,dlog,dmax1,dmin1,exp,int,min0 C .. C .. Data statements .. c----------------------------------------------------------------------- c bernoulli numbers c----------------------------------------------------------------------- DATA nmax/100/ DATA b(1),b(2),b(3),b(4),b(5),b(6),b(7),b(8),b(9),b(10),b(11), + b(12),b(13),b(14),b(15),b(16),b(17),b(18),b(19),b(20),b(21), + b(22)/1.00000000000000000d+00,-5.00000000000000000d-01, + 1.66666666666666667d-01,-3.33333333333333333d-02, + 2.38095238095238095d-02,-3.33333333333333333d-02, + 7.57575757575757576d-02,-2.53113553113553114d-01, + 1.16666666666666667d+00,-7.09215686274509804d+00, + 5.49711779448621554d+01,-5.29124242424242424d+02, + 6.19212318840579710d+03,-8.65802531135531136d+04, + 1.42551716666666667d+06,-2.72982310678160920d+07, + 6.01580873900642368d+08,-1.51163157670921569d+10, + 4.29614643061166667d+11,-1.37116552050883328d+13, + 4.88332318973593167d+14,-1.92965793419400681d+16/ C .. C .. Executable Statements .. c c iflag = 0 iset = 1 IF (x.LE.0.0d0) GO TO 300 10 CONTINUE iset = 2 IF (n.LT.0) GO TO 300 20 CONTINUE iset = 3 IF (kode.LT.1 .OR. kode.GT.2) GO TO 300 30 CONTINUE iset = 4 IF (m.LT.1) GO TO 300 40 CONTINUE IF (iflag.NE.0) GO TO 360 nn = n + m - 1 fn = dble(nn) fnp = fn + 1.0d0 nx = min0(-i1mach(12),i1mach(13)) r1m5 = d1mach(5) r1m4 = d1mach(4)*0.5d0 wdtol = dmax1(r1m4,0.5d-18) c----------------------------------------------------------------------- c elim = approximate exponential over and underflow limit c----------------------------------------------------------------------- elim = 2.302d0* (dble(nx)*r1m5-3.0d0) xln = dlog(x) t = fnp*xln c----------------------------------------------------------------------- c overflow and underflow test for small and large x c----------------------------------------------------------------------- IF (abs(t).GT.elim) GO TO 290 IF (x.LT.wdtol) GO TO 260 c----------------------------------------------------------------------- c compute xmin and the number of terms of the series, fln+1 c----------------------------------------------------------------------- rln = r1m5*dble(i1mach(11)) rln = dmin1(rln,18.06d0) fln = dmax1(rln,3.0d0) - 3.0d0 yint = 3.50d0 + 0.40d0*fln slope = 0.21d0 + fln* (0.0006038d0*fln+0.008677d0) xm = yint + slope*fn mx = int(xm) + 1 xmin = dble(mx) IF (n.EQ.0) GO TO 50 xm = -2.302d0*rln - dmin1(0.0d0,xln) fns = dble(n) arg = xm/fns arg = dmin1(0.0d0,arg) eps = exp(arg) xm = 1.0d0 - eps IF (abs(arg).LT.1.0d-3) xm = -arg fln = x*xm/eps xm = xmin - x IF (xm.GT.7.0d0 .AND. fln.LT.15.0d0) GO TO 200 50 CONTINUE xdmy = x xdmln = xln xinc = 0.0d0 IF (x.GE.xmin) GO TO 60 nx = int(x) xinc = xmin - dble(nx) xdmy = x + xinc xdmln = dlog(xdmy) 60 CONTINUE c----------------------------------------------------------------------- c generate w(n+m-1,x) by the asymptotic expansion c----------------------------------------------------------------------- t = fn*xdmln t1 = xdmln + xdmln t2 = t + xdmln tk = dmax1(abs(t),abs(t1),abs(t2)) IF (tk.GT.elim) GO TO 380 tss = exp(-t) tt = 0.5d0/xdmy t1 = tt tst = wdtol*tt IF (nn.NE.0) t1 = tt + 1.0d0/fn rxsq = 1.0d0/ (xdmy*xdmy) ta = 0.5d0*rxsq t = fnp*ta s = t*b(3) IF (abs(s).LT.tst) GO TO 80 tk = 2.0d0 DO 70 k = 4,22 t = t* ((tk+fn+1.0d0)/ (tk+1.0d0))* ((tk+fn)/ (tk+2.0d0))*rxsq trm(k) = t*b(k) IF (abs(trm(k)).LT.tst) GO TO 80 s = s + trm(k) tk = tk + 2.0d0 70 CONTINUE 80 CONTINUE s = (s+t1)*tss IF (xinc.EQ.0.0d0) GO TO 100 c----------------------------------------------------------------------- c backward recur from xdmy to x c----------------------------------------------------------------------- nx = int(xinc) np = nn + 1 IF (nx.GT.nmax) GO TO 390 IF (nn.EQ.0) GO TO 160 xm = xinc - 1.0d0 fx = x + xm c----------------------------------------------------------------------- c this loop should not be changed. fx is accurate when x is small c----------------------------------------------------------------------- DO 90 i = 1,nx trmr(i) = fx** (-np) s = s + trmr(i) xm = xm - 1.0d0 fx = x + xm 90 CONTINUE 100 CONTINUE ans(m) = s IF (fn.EQ.0.0d0) GO TO 180 c----------------------------------------------------------------------- c generate lower derivatives, j.lt.n+m-1 c----------------------------------------------------------------------- IF (m.EQ.1) RETURN DO 150 j = 2,m fnp = fn fn = fn - 1.0d0 tss = tss*xdmy t1 = tt IF (fn.NE.0.0d0) t1 = tt + 1.0d0/fn t = fnp*ta s = t*b(3) IF (abs(s).LT.tst) GO TO 120 tk = 3.0d0 + fnp DO 110 k = 4,22 trm(k) = trm(k)*fnp/tk IF (abs(trm(k)).LT.tst) GO TO 120 s = s + trm(k) tk = tk + 2.0d0 110 CONTINUE 120 CONTINUE s = (s+t1)*tss IF (xinc.EQ.0.0d0) GO TO 140 IF (fn.EQ.0.0d0) GO TO 160 xm = xinc - 1.0d0 fx = x + xm DO 130 i = 1,nx trmr(i) = trmr(i)*fx s = s + trmr(i) xm = xm - 1.0d0 fx = x + xm 130 CONTINUE 140 CONTINUE mx = m - j + 1 ans(mx) = s IF (fn.EQ.0.0d0) GO TO 180 150 CONTINUE RETURN c----------------------------------------------------------------------- c recursion for n = 0 c----------------------------------------------------------------------- 160 CONTINUE DO 170 i = 1,nx s = s + 1.0d0/ (x+dble(nx-i)) 170 CONTINUE 180 CONTINUE IF (kode.EQ.2) GO TO 190 ans(1) = s - xdmln RETURN 190 CONTINUE IF (xdmy.EQ.x) RETURN xq = xdmy/x ans(1) = s - dlog(xq) RETURN c----------------------------------------------------------------------- c compute by series (x+k)**(-(n+1)) , k=0,1,2,... c----------------------------------------------------------------------- 200 CONTINUE nn = int(fln) + 1 np = n + 1 t1 = (fns+1.0d0)*xln t = exp(-t1) s = t den = x DO 210 i = 1,nn den = den + 1.0d0 trm(i) = den** (-np) s = s + trm(i) 210 CONTINUE ans(1) = s IF (n.NE.0) GO TO 220 IF (kode.EQ.2) ans(1) = s + xln 220 CONTINUE IF (m.EQ.1) RETURN c----------------------------------------------------------------------- c generate higher derivatives, j.gt.n c----------------------------------------------------------------------- tol = wdtol/5.0d0 DO 250 j = 2,m t = t/x s = t tols = t*tol den = x DO 230 i = 1,nn den = den + 1.0d0 trm(i) = trm(i)/den s = s + trm(i) IF (trm(i).LT.tols) GO TO 240 230 CONTINUE 240 CONTINUE ans(j) = s 250 CONTINUE RETURN c----------------------------------------------------------------------- c small x.lt.unit round off c----------------------------------------------------------------------- 260 CONTINUE ans(1) = x** (-n-1) IF (m.EQ.1) GO TO 280 k = 1 DO 270 i = 2,m ans(k+1) = ans(k)/x k = k + 1 270 CONTINUE 280 CONTINUE IF (n.NE.0) RETURN IF (kode.EQ.2) ans(1) = ans(1) + xln RETURN 290 CONTINUE IF (t.GT.0.0d0) GO TO 380 GO TO 370 c----------------------------------------------------------------------- c error messages c----------------------------------------------------------------------- 300 IF (iflag.NE.0) GO TO 310 310 GO TO (320,330,340,350),iset 320 WRITE (*,*) ' PSIFN, X is not positive.' iflag = 1 GO TO 10 330 WRITE (*,*) ' PSIFN, N is not greater than or equal to zero.' iflag = 1 GO TO 20 340 WRITE (*,*) ' PSIFN, KODE is not 1 or 2.' iflag = 1 GO TO 30 350 WRITE (*,*) ' PSIFN, M is not greater than zero.' iflag = 1 GO TO 40 360 STOP ' PSIFN, end input errors for PSIFN.' 370 STOP ' PSIFN, overflow, X too small or N+M-1 too large.' 380 STOP ' PSIFN, underflow, X too large or N+M-1 too large.' 390 STOP ' PSIFN, increase the dimension of trmr(NMAX).' END SUBROUTINE gtcuio(inun,outun) C********************************************************************** C C SUBROUTINE GTCUIO(INUN,OUTUN) C C GeT CUrrent Input Output units C C C Function C C C Returns the FORTRAN unit numbers of the current input and C output units. These units are used for the standard reads and C writes but may be reassigned from the standard units. This is C convenient on input, for example, when the echo of input from C a previous interactive run is used, and on output when a report C should be directed to a file rather than a terminal. C C C Arguments C C C INUN <-- The FORTRAN unit number of the current input unit. C INUN is INTEGER C C OUTUN <-- The FORTRAN unit number of the current output unit. C OUTUN is INTEGER C C C Note C C C If GTCUIO is called before the current units are set by C a call to STCUIO, then the standard input and output unit C numbers should be returned. C C C---------------------------------------------------------------------- C C C ENTRY STCUIO(INUN,OUTUN) C C SeT CUrrent Input Output units C C C Function C C C Sets the FORTRAN unit numbers of the current input and C output units. It is the responsibility of the programmer C to assure that whatever action is necessary for opening these C units for reading and writing has been taken before the C units are used. C C C Arguments C C C INUN --> The FORTRAN unit number of the current input unit. C INUN is INTEGER C C OUTUN --> The FORTRAN unit number of the current output unit. C OUTUN is INTEGER C C********************************************************************** C C .. Scalar Arguments .. INTEGER inun,outun C .. C .. Local Scalars .. INTEGER in,out LOGICAL qset C .. C .. External Subroutines .. EXTERNAL gtstio C .. C .. Save statement .. SAVE in,out,qset C .. C .. Data statements .. DATA qset/.FALSE./ C .. C .. Executable Statements .. C IF (qset) GO TO 10 CALL gtstio(in,out) 10 inun = in C outun = out RETURN C ENTRY stcuio(inun,outun) in = inun out = outun qset = .TRUE. RETURN END SUBROUTINE gtecun(inun,allun) C********************************************************************** C C SUBROUTINE GTECUN(INUN,ALLUN) C C GeT ECho UNits C C C Function C C C Returns the FORTRAN unit numbers of the units to receive C the echo of current input and both current input and current C output. A negative value for either unit number indicates C that the corresponding echoing function is not desired. C C C Note C C C If GTECUN is called before the units are set with STECUN, C then a negative value is returned. C An EOF (end of file) from input is echoed as a line C consisting of a single blank character. C C C Arguments C C C INUN <-- The FORTRAN unit number of the unit to receive the C echo of everything read from current input. A C negative value indicates that this echo function is C not to be performed. C INUN is INTEGER C C ALLUN <-- The FORTRAN unit number of the unit to receive the C echo of everything read from current input or written C to current output. A negative value indicates that C this echo function is not to be performed. C ALLUN is INTEGER C C C---------------------------------------------------------------------- C C C ENTRY STECUN(INUN,ALLUN) C C Set ECho Units C C Function C C Sets the units for the echo of input and echo of input and C output functions. A negative unit number indicates that the C function is not to be performed. C C C Arguments C C C INUN --> The FORTRAN unit number of the unit to receive the C echo of everything read from current input. A C negative value indicates that this echo function is C not to be performed. C INUN is INTEGER C C ALLUN --> The FORTRAN unit number of the unit to receive the C echo of everything read from current input or written C to current output. A negative value indicates that C this echo function is not to be performed. C ALLUN is INTEGER C C********************************************************************** C C .. Scalar Arguments .. INTEGER allun,inun C .. C .. Local Scalars .. INTEGER all,in LOGICAL qset C .. C .. Save statement .. SAVE in,all,qset C .. C .. Data statements .. DATA qset/.FALSE./ C .. C .. Executable Statements .. C IF (.NOT. (qset)) GO TO 10 inun = in allun = all GO TO 20 10 inun = -1 allun = -1 20 RETURN C C ENTRY stecun(inun,allun) in = inun all = allun qset = .TRUE. RETURN END SUBROUTINE gtstio(inun,outun) C********************************************************************** C C SUBROUTINE GTSTIO(INUN,OUTUN) C C GeT STandard Input Output units C (Machine Dependent Routine) C C C Function C C C Returns the FORTRAN unit numbers corresponding to standard input C and output (i.e., the * unit). These units are usually connected C to a terminal for an interactive run. C C C Arguments C C C INUN <-- The unit number corresponding to FORTRAN standard input. C INUN is INTEGER C C OUTUN <-- The unit number corresponding to FORTRAN standard output C OUTUN is INTEGER C C C Note C C C On the first call, the routine should take whatever action C is necessary to associate the unit numbers returned with standard C input and output. The unit numbers should be kept as SAVE C variable so that they can be returned on successive calls. C The unit numbers returned by this routine will not change C within a single run of a program. C C********************************************************************** C********************************************************************** C C Code last modified 87/Feb/20 C C********************************************************************** C *** VARIABLES C C C ** ARGUMENTS C C INUN <-- UNIT NUMBER CORRESPONDING TO THE STANDARD INPUT UNIT INTEGER inun C C OUTUN <-- UNIT NUMBER CORRESPONDING TO THE STANDARD OUTPUT UNIT INTEGER outun C C C C *** BODY OF ROUTINE C C inun = 5 outun = 6 C RETURN C C END INTEGER FUNCTION igtfun() C********************************************************************** C C INTEGER FUNCTION IGTFUN() C C I GeT Free Unit Number C C C Function C C C Returns a FORTRAN unit number that is not in current use. C Returns an invalid unit number (generally less than zero) C if no unassigned unit numbers are available. C C********************************************************************** C *** OVERVIEW OF PROGRAM UNIT C C C ** USAGE C C * OPERATION C C This function is called with no arguments once for each new unit C number that is needed by any program unit during execution of C a program. C C C C *** VARIABLES C C C ** PARAMETERS AND CONSTANTS C C * PROCESSOR-DEPENDENT PARAMETERS C C UNUMMN -- minimum possible unit number for a file C C C UNUMMX -- maximum possible unit number for a file C C C * CONSTANTS C C ONE -- mnemonically-named integer constant C C C C ** OTHER SIGNIFICANT VARIABLES C C LASTUN -- last-returned unit number C C C C ** MISCELLANEOUS VARIABLES C The following variables are used for such purposes as indices and C temporary storage. Each one is intended to be significant only C within a well-defined block of code (although it may appear in C more than one block), and its meaning and use should be apparent C from its name and context. C C QEXIST -- C C QOPEN -- C C C C C *** DATA STATEMENTS C C LASTUN -- initiated to cause first invocation to start at C maximum value C C C C C C .. Parameters .. INTEGER unummn PARAMETER (unummn=0) INTEGER unummx PARAMETER (unummx=99) INTEGER one PARAMETER (one=1) C .. C .. Local Scalars .. INTEGER lastun LOGICAL qexist,qopen C .. C .. Save statement .. SAVE lastun C .. C .. Data statements .. DATA lastun/unummn/ C .. C .. Executable Statements .. C igtfun = lastun C 10 igtfun = igtfun - one IF (igtfun.LT.unummn) igtfun = unummx C IF (.NOT. (igtfun.EQ.lastun)) GO TO 20 C *** all available unit numbers are in use igtfun = unummn - one GO TO 30 20 INQUIRE (unit=igtfun,exist=qexist,opened=qopen) C IF (qexist .AND. .NOT.qopen) GO TO 30 C GO TO 10 30 lastun = igtfun C C RETURN C C END INTEGER FUNCTION lens(string) C C C .. Scalar Arguments .. CHARACTER string* (*) C .. C .. Local Scalars .. INTEGER i,lng C .. C .. Intrinsic Function .. INTRINSIC len C .. C .. Executable Statements .. C lens = len(string) IF (.NOT. (lens.GT.0)) GO TO 40 lng = lens DO 30,i = lng,1,-1 IF (.NOT. (string(i:i).EQ.' ')) GO TO 10 lens = lens - 1 GO TO 20 10 RETURN 20 CONTINUE 30 CONTINUE 40 RETURN END SUBROUTINE mvlogf(dfn,dfd,mean,var) IMPLICIT DOUBLE PRECISION (a-h,o-p,r-z),INTEGER (i-n),LOGICAL (q) C********************************************************************** C C SUBROUTINE MVLOGF( DFN, DFD, MEAN, VAR ) C Mean and Variance of the Log F Distribution C C C Arguments C C C DFN --> Numerator degrees of freedom of the log-F C DOUBLE PRECISION DFN C C DFD --> Denominator degrees of freedom of the log-F C DOUBLE PRECISION DFD C C MEAN <-- Mean of log-F distribution C DOUBLE PRECISION MEAN C C VAR <-- Variance of log-F distribution C DOUBLE PRECISION VAR C C********************************************************************** C .. Parameters .. DOUBLE PRECISION half PARAMETER (half=0.5D0) C .. C .. Scalar Arguments .. DOUBLE PRECISION dfd,dfn,mean,var C .. C .. Local Scalars .. DOUBLE PRECISION a,b C .. C .. Local Arrays .. DOUBLE PRECISION psia(2),psib(2) C .. C .. External Subroutines .. EXTERNAL dpsifn C .. C .. Executable Statements .. a = dfn*half b = dfd*half CALL dpsifn(a,0,2,2,psia) CALL dpsifn(b,0,2,2,psib) C At this point, PSIA(1) = -psi(A) + ln(A) C PSIA(2) = psi(1,A) C Similarly for B mean = psib(1) - psia(1) var = psia(2) + psib(2) RETURN END INTEGER FUNCTION obfugt(mssg,qfrmtd) C C Calls QGOBFU C C .. Scalar Arguments .. LOGICAL qfrmtd CHARACTER mssg* (*) C .. C .. Local Scalars .. LOGICAL qok C .. C .. External Functions .. LOGICAL qgobfu EXTERNAL qgobfu C .. C .. Executable Statements .. qok = qgobfu(mssg,qfrmtd,obfugt) IF (.NOT. (qok)) STOP ' QGOBFU CALLED FROM OBFUGT' RETURN END SUBROUTINE pause IMPLICIT INTEGER (a-p,r-z),LOGICAL (q) C********************************************************************** C C SUBROUTINE PAUSE C C C Function C C C The message C 'ENTER RETURN/ENTER TO CONTINUE' C is displayed at the terminal and the display is stopped until C the user hits the return/enter key. C C********************************************************************** C C .. Local Scalars .. CHARACTER dum*1 C .. C .. External Functions .. CHARACTER strgt*1 EXTERNAL strgt C .. C .. Executable Statements .. dum = strgt('('' Press Return / Enter to continue:'')',.TRUE.) RETURN END SUBROUTINE prompt C********************************************************************** C C SUBROUTINE PROMPT C C C Function C C C PROMPT issues a line feed and a '?' prompt for FORTRAN system C that do not have a built in prompt feature. C C********************************************************************** C********************************************************************** C C This version is specific to D.E.C. VAX running V.M.S. FORTRAN. C Code last modified 87/Feb/20 C C********************************************************************** IMPLICIT INTEGER (a-p,r-z),LOGICAL (q) C C C QECIN -- Flag as to whether input is echoed C QECALL -- Flag as to whether entire dialog is echoed C ECIN -- Unit to which input is echoed C ECALL -- Unit to which entire dialog is echoed C C C GTECUN -- returns unit numbers associated with echo input and C echo all files (negative numbers if none) C .. Local Scalars .. INTEGER ecall,ecin,inun,outun LOGICAL qecall,qecin C .. C .. External Subroutines .. EXTERNAL gtcuio,gtecun C .. C .. Executable Statements .. C CALL gtcuio(inun,outun) C C Initialize for echo processing C CALL gtecun(ecin,ecall) qecin = ecin .GE. 0 qecall = ecall .GE. 0 WRITE (outun,'(''$? '')') C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 10 WRITE (ecall,9000) 9000 FORMAT (' ? ') 10 RETURN C - === End Echo Code === END LOGICAL FUNCTION qgobfu(mssg,qfrmtd,unit) C********************************************************************** C C LOGICAL FUNCTION QGOBFU(FORMSG,QFRMTD,UNIT) C C Q Get Output B File Unit number C (Machine Dependent Routine) C C C Function C C C Conducts a dialog using current input and output to obtain C the name of the output file. If the file is currently open, the C unit number with which it is associated is returned. If the file C is not open, then it is opened and associated with a unit number C not in current use and this unit number is returned. C The function returns .TRUE. if an output file was obtained, C .FALSE. if some problem occurred. An EOF on current input C will cause a value of .FALSE. to be returned if current input C is not standard input (checked by equality of unit numbers). C Three consequtive errors will cause a value of .FALSE. to C be returned regardless of the current input file. C C The dialog is sketched below. Some details may differ from C machine to machine as the set of legal file names differs as does C the information that the user may need to specify such a name. C C The message specified by FORMSG is presented the user. C C ENTER FILE NAME C C The program then does an INQUIRE on the file. If it is open, C the unit number with which it is associated will be returned C (assuming that the user does no specify REDO on the verify). C If the file is not open, the program ascertains whether it exists C and in either case opens it. Should there be a problem with either C the INQUIRE or OPEN (which is probably indicative of an illegal C file specification), the following message is presented the user. C C PROBLEM OPENING FILE --- C --- R(ETRY) FILE SPECIFICATION OR Q(UIT) C C If the user specifies Q the routine returns .FALSE. C C If the user specifies R, the routine starts again from the C beginning of the dialog. C C If the file is opened successfully and did not previously exist, C the message below is presented. C C OUTPUT FILE CREATED -- C C If the file is opened successfully and did previously exist, the C user is presented with a choice C C OUTPUT FILE ALREADY EXISTS -- -- C -- O(VERWRITE) OR A(PPEND) TO END OF FILE C C If O is specified, the file is rewound. If A is specified, C the file is positioned immediately prior to the EOF. C C Finally, the user is given the opportunity to change his mind. C C P(ROCEED) OR R(EDO) FILE SPECIFICATION C C If P is specified, QGOBFU returns .TRUE. C If R is specified, the dialog begins over. C C C Arguments C C C QGOBFU <-- .TRUE. if all has gone well and a specified old file C has been successfully opened, otherwise .FALSE. C C FORMSG --> A FORTRAN format (first and last characters must be C left and right parentheses) which, when invoked, C will print a message to the user about the C output file that is to be specified. C If FORMSG is a character string consisting entirely C of blanks, then no message is printed to the user. C FORMSG is CHARACTER*(*) C C QFRMTD --> If .TRUE., the output file will be opened for FORMATTED C writing. C If .FALSE., the output file will be opened for C UNFORMATTED writing. C C UNIT <-- Defined only if QGOBFU is .TRUE. The unit number C associated with the output file. This unit C number will be the one with which the file C was associated if it was open at the call, otherwise C it will be associated with an unused unit number which C is returned. C UNIT is INTEGER C C C NOTE C C This routine is very similar to QGTOFU. The difference is that the C user may NOT enter * to specify the terminal to be the output file C C---------------------------------------------------------------------- C C C ENTRY QNOBFU(FILNAM) C C C Function C C C This entry inherits the characteristic of being a logical function C Returns .TRUE. if the previous invocation successfully opened an C output file; in this case, FILNAM is the (system dependent) name C of the file that was opened. C Returns .FALSE. if the previous invocation did not successfully C open an output file; in this case, FILNAM is indeterminate. C C C Arguments C C C FILNAM <-- The name of the file opened for output on the previous C invocation if it was successful; otherwise C indeterminate. C C C---------------------------------------------------------------------- C C C ===== IBM CMS Specific Information ===== C C ENTRY QOPOBF(OPTSTR) C C C Function C C C This entry point allows the specification of the format of the C output file. If the entry is not called before the call to the C main routine, the output data file will be opened as a file of C fixed-length 80 character records. C C OPTSTR is a string that contains options for a FILEDEF command. C The string should not begin with a left parenthesis. The options C specified are in effect for only the next invocation of QGOBFU. C OPTSTR is CHARACTER*60 C C The value returned by QOPOBF is always .TRUE. and should be C ignored. C C********************************************************************** C C *** Variables C C C C C ** Parameters and constants C C * Processor-dependent parameters C C FLNMLM -- limit of length of a file name C C * CONSTANTS C C ONE -- mnemonically-named integer constant C C QFALSE -- mnemonically-named logical constant C C QTRUE -- mnemonically-named logical constant C C ZERO -- mnemonically-named integer constant C C Z***** -- assorted character constants C C C * Parameters peculiar to this application C C ERRMX -- maximum number of read errors allowed before automatic C failure occurs C C C ** Arguments C C MSSG --> buffer to hold format specification for writing C prompt message to user. If value is blank, C no prompt message will be written. C C QFRMTD --> formatted-file flag. Value is .TRUE. if file to be C opened formatted, .FALSE. if to be opened unformatted C C UNIT <-- Fortran unit number assigned to file. Value is C significant only if result of function is .TRUE. C C C ** Other significant variables C C ECALL -- Unit to which entire dialog is echoed C C ECIN -- Unit to which input is echoed C C ERR -- variable to hold error code returned by I/O statement C C FILEID -- buffer to hold file id C C FILNAM -- dummy argument for entry point that returns name C of last file opened by main routine C C FRSTNB -- position in buffer fileid (q.v.) of first non-blank C character C C INNM -- Fortran unit number of current input unit C C LASTNB -- position in buffer fileid (q.v.) of last non-blank C character C C MSG --> buffer to hold format specification for messages C to be written to user by called routines. C C NEWNUM -- unassigned unit number C C OUTNM -- Fortran unit number of current output unit C C QECALL -- Flag as to whether entire dialog is echoed C C QECIN -- Flag as to whether input is echoed C C QEXIST -- does-file-exist flag C C QOPEN -- is-file-open flag C C QPASS1 -- does-new-unit-number-need-to-be-generated flag C C QPSTAT -- Value returned in previous invocation of QGOBFU C C QRETRY -- does-user-want-to-retry-file-specification flag C C STDIFU -- Fortran unit number of standard input unit C C STDOFU -- Fortran unit number of standard output unitT C C C ** Miscellaneous variables C The following variables are used for such purposes as indices and C temporary storage. Each one is intended to be significant only C within a well-defined block of code (although it may appear in C more than one block), and its meaning and use should be apparent C from its name and context. C C ANSWER -- C FILERR -- C I -- C C C C *** Functions and subroutines C C C ** Library subprograms C Detailed information on each of the following subprograms can be C found in the reference for its respective library. C C * COMPLIB C C GTCUIO -- returns unit numbers associated with current input C and output units C C GTECUN -- returns unit numbers associated with echo input and C echo all files (negative numbers if none) C C GTSTIO -- returns unit numbers associated with standard inputT C and output units C C IGTFUN -- returns a Fortran unit number that is not currently j C in use C .. Parameters .. INTEGER flnmlm PARAMETER (flnmlm=500) INTEGER one PARAMETER (one=1) LOGICAL qfalse PARAMETER (qfalse=.FALSE.) LOGICAL qtrue PARAMETER (qtrue=.TRUE.) INTEGER zero PARAMETER (zero=0) CHARACTER*(1) zblank PARAMETER (zblank=' ') INTEGER errmx PARAMETER (errmx=3) C .. C .. Scalar Arguments .. INTEGER unit LOGICAL qfrmtd CHARACTER mssg* (*),filnam* (*) C .. C .. Local Scalars .. INTEGER answer,ecall,ecin,err,filerr,frstnb,i,i99954,i99964, + i99967,i99970,i99987,i99992,i99995,i99999,innm,lastnb, + newnum,outnm,stdifu,stdofu LOGICAL qecall,qecin,qexist,qok,qopen,qpass1,qpstat,qretry CHARACTER msg*100,fileid* (flnmlm) C .. C .. External Functions .. INTEGER igtfun LOGICAL qgtchr,qgtstr EXTERNAL igtfun,qgtchr,qgtstr C .. C .. External Subroutines .. EXTERNAL gtcuio,gtecun,gtstio C .. C .. Entry Points .. LOGICAL qnobfu C .. C .. Save statement .. SAVE fileid,qpstat C .. C .. Data statements .. C C C********************************************************************** DATA fileid/' '/ DATA qpstat/qfalse/ C .. C .. Executable Statements .. C C C C *** Body of routine C C C GET-OUTPUT-FILE-UNIT-NUMBER ASSIGN 10 TO i99999 GO TO 160 C 10 RETURN C C C ENTRY qnobfu(filnam) C C Entry point to return name of last file opened by main routine C IF (.NOT. (qpstat)) GO TO 20 filnam = fileid GO TO 30 20 filnam = ' ' 30 qnobfu = qpstat RETURN C C STOP '*** EXECUTION FLOWING INTO FLECS PROCEDURES ***' C TO CHECK-OPEN-ERROR C C ERRMX --> C FILEID --> C FRSTNB --> C INNM --> C LASTNB --> C ONE --> C OUTNM --> C QTRUE --> C STDIFU --> C ZERO --> C ZQ --> C ZR --> C *scrt* -- ANSWER, ERR C QRETRY <-- C *more* -- other variables may be used in invoked procedures C C 40 WRITE (outnm,FMT='(T2,''Problem opening file '',A,'' --'')') + fileid(frstnb:lastnb) C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 50 WRITE (ecall,FMT='(T2,''PROBLEM OPENING FILE '',A,'' --'')') + fileid(frstnb:lastnb) 50 msg = '(T5,''-- R(etry file specification) or Q(uit)?'')' C - === End Echo Code === C C qok = qgtchr(msg,'RQ',qtrue,answer) C IF (qok) GO TO 70 C RETURN-FALSE ASSIGN 60 TO i99992 GO TO 470 C 60 CONTINUE 70 IF (.NOT. (answer.EQ.1)) GO TO 80 qretry = qtrue GO TO 100 C RETURN-FALSE 80 ASSIGN 90 TO i99992 GO TO 470 C 90 CONTINUE 100 GO TO i99995 C TO FIND-FILE-NAME C C FILEID --> C FLNMLM --> C ONE --> C ZBLANK --> C ZERO --> C *scrt* -- I C FRSTNB <-- C LASTNB <-- C C 110 frstnb = zero i = zero C 120 IF (i.GE.flnmlm) GO TO 140 C i = i + one C IF (.NOT. (fileid(i:i).NE.zblank)) GO TO 130 frstnb = i GO TO 140 130 GO TO 120 C 140 lastnb = frstnb C DO 150 i = (frstnb+one),flnmlm IF (fileid(i:i).NE.zblank) lastnb = i 150 CONTINUE GO TO i99987 C C TO GET-OUTPUT-FILE-UNIT-NUMBER C C ERRMX --> C MSSG --> C ONE --> C QFALSE --> C QTRUE --> C ZBLANK --> C ZERO --> C *scrt* -- ERR, FILERR, FILEID, FRSTNB, INNM, LASTNB, C *scrt* -- OUTNM, QPASS1, QRETRY, STDIFU, STDOFU C QGOBFU <-- C UNIT <-- C *more* -- other variables may be used in invoked procedures C C 160 CALL gtcuio(innm,outnm) C CALL gtstio(stdifu,stdofu) C C C Initialize for echo processing C CALL gtecun(ecin,ecall) qecin = ecin .GE. 0 qecall = ecall .GE. 0 C qpass1 = qtrue C filerr = zero C *** until get a file or fail or decide to bail out ... C 170 IF (.NOT. (filerr.GE.errmx)) GO TO 190 C RETURN-FALSE ASSIGN 180 TO i99992 GO TO 470 C *** too many failed attempts at files -- return as .FALSE. C C *** get a file name or fail ... C 180 CONTINUE 190 IF (.NOT. (mssg.NE.zblank)) GO TO 210 WRITE (outnm,FMT=mssg) C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 200 WRITE (ecall,FMT=mssg) C - === End Echo Code === 200 CONTINUE 210 msg = '('' Specify file name:'')' qok = qgtstr(msg,fileid,qfalse) C IF (qok) GO TO 230 C RETURN-FALSE ASSIGN 220 TO i99992 GO TO 470 C 220 CONTINUE C FIND-FILE-NAME 230 ASSIGN 240 TO i99987 GO TO 110 C C *** check specified file 240 INQUIRE (file=fileid(frstnb:lastnb),exist=qexist,opened=qopen, + number=unit,iostat=err) C C IF (.NOT. (err.NE.zero)) GO TO 280 C *** file does not exist C C OPEN-FILE ASSIGN 250 TO i99970 GO TO 420 250 IF (.NOT. (qretry)) GO TO 260 filerr = filerr + one GO TO 170 C VERIFY-FILE 260 ASSIGN 270 TO i99967 GO TO 490 C C 270 GO TO 370 280 IF (.NOT. (qopen)) GO TO 300 C VERIFY-FILE-EXISTING ASSIGN 290 TO i99964 GO TO 530 290 GO TO 370 C C *** FILE ALREADY OPEN C C OPEN-FILE 300 ASSIGN 310 TO i99970 GO TO 420 310 IF (.NOT. (qretry)) GO TO 320 filerr = filerr + one GO TO 170 320 IF (.NOT. (qexist)) GO TO 340 C VERIFY-FILE-EXISTING ASSIGN 330 TO i99964 GO TO 530 330 GO TO 360 C C VERIFY-FILE 340 ASSIGN 350 TO i99967 GO TO 490 C 350 CONTINUE C 360 CONTINUE 370 IF (.NOT. (qretry)) GO TO 380 C filerr = filerr + one GO TO 170 GO TO 400 C RETURN-TRUE 380 ASSIGN 390 TO i99954 GO TO 480 C *** attempt successful C 390 CONTINUE 400 GO TO 170 410 GO TO i99999 C C TO OPEN-FILE C C FILEID --> C FRSTNB --> C LASTNB --> C NEWNUM --> C QFALSE --> C QFRMTD --> C QPASS1 --> C UNIT --> C ZERO --> C *scrt* -- ERR C NEWNUM <-- C QPASS1 <-- C QRETRY <-- C UNIT <-- C *more* -- other variables may be used in invoked procedures C C 420 IF (.NOT. (qpass1)) GO TO 430 newnum = igtfun() qpass1 = qfalse 430 unit = newnum C IF (qfrmtd) THEN OPEN (unit=unit,file=fileid(frstnb:lastnb),form='FORMATTED', + iostat=err) ELSE OPEN (unit=unit,file=fileid(frstnb:lastnb),form='UNFORMATTED', + iostat=err) END IF C IF (.NOT. (err.EQ.zero)) GO TO 440 qretry = qfalse GO TO 460 C CHECK-OPEN-ERROR 440 ASSIGN 450 TO i99995 GO TO 40 C 450 CONTINUE 460 GO TO i99970 C TO RETURN-FALSE 470 qgobfu = qfalse qpstat = qfalse RETURN GO TO i99992 C TO RETURN-TRUE 480 qgobfu = qtrue qpstat = qtrue RETURN GO TO i99954 C TO VERIFY-FILE C C ERRMX --> C FILEID --> C FRSTNB --> C INNM --> C LASTNB --> C ONE --> C OUTNM --> C QFALSE --> C QTRUE --> C UNIT --> C ZERO --> C ZP --> C ZR --> C *scrt* -- ANSWER, ERR C QRETRY <-- C *more* -- other variables may be used in invoked procedures C C 490 WRITE (outnm,FMT='(T2,''Created file '',A,'' --'')') + fileid(frstnb:lastnb) C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 500 WRITE (ecall,FMT='(T2,''CREATED FILE '',A,'' --'')') + fileid(frstnb:lastnb) 500 msg = '(T5,''-- P(roceed) or R(etry file specification)?'')' C - === End Echo Code === C qok = qgtchr(msg,'PR',qtrue,answer) C IF (qok) GO TO 520 C RETURN-FALSE ASSIGN 510 TO i99992 GO TO 470 C 510 CONTINUE C 520 IF ((1).EQ. (answer)) THEN qretry = qfalse C ELSE IF ((2).EQ. (answer)) THEN qretry = qtrue CLOSE (unit) END IF C GO TO i99967 C C TO VERIFY-FILE-EXISTING C C ERRMX --> C FILEID --> C FRSTNB --> C INNM --> C LASTNB --> C ONE --> C OUTNM --> C QFALSE --> C QFRMTD --> C QTRUE --> C UNIT --> C ZA --> C ZERO --> C ZO --> C ZQ --> C ZR --> C *scrt* -- ANSWER, ERR C QRETRY <-- C *more* -- other variables may be used in invoked procedures C C 530 WRITE (outnm,FMT='(T2,''File '',A,'' already exists --'')') + fileid(frstnb:lastnb) C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 540 WRITE (ecall,FMT='(T2,''FILE '',A,'' ALREADY EXISTS --'')') + fileid(frstnb:lastnb) 540 qok = qgtchr( +'('' Enter choice of action''/t5,''A(ppend)''/t5,''O(verwrite)''/ +t5,''R(etry)''/t5,''Q(uit)'')','AORQ',qtrue,answer) C - === End Echo Code === C IF (qok) GO TO 560 C RETURN-FALSE ASSIGN 550 TO i99992 GO TO 470 C 550 CONTINUE C 560 IF ((1).NE. (answer)) GO TO 630 C *** append -- skip to end of file IF (qfrmtd) THEN GO TO 580 570 IF (.NOT. (err.EQ.zero)) GO TO 590 580 READ (unit,FMT='(A)',iostat=err) GO TO 570 590 CONTINUE ELSE GO TO 610 600 IF (.NOT. (err.EQ.zero)) GO TO 620 610 READ (unit,iostat=err) GO TO 600 620 CONTINUE END IF BACKSPACE unit qretry = qfalse GO TO 680 630 IF ((2).NE. (answer)) GO TO 640 C C *** overwrite REWIND unit qretry = qfalse GO TO 680 640 IF ((3).NE. (answer)) GO TO 650 C C *** retry CLOSE (unit) qretry = qtrue GO TO 680 650 IF ((4).NE. (answer)) GO TO 670 C RETURN-FALSE ASSIGN 660 TO i99992 GO TO 470 660 GO TO 680 C C *** quit C 670 CONTINUE 680 GO TO i99964 C C C END LOGICAL FUNCTION qgtchr(mssg,chrlst,qupcas,iwhich) C********************************************************************** C C LOGICAL FUNCTION QGTCHR(FORMSG,CHRLST,QUPCAS,IWHICH) C C Q GeT ChaRacter C C C Function C C C If FORMSG is non-blank, writes it to current output then C reads a line from current input and examines the first C non-blank character for being a member of CHRLST. If this C character is in CHRLST, returns .TRUE. and sets IWHICH to C the ordinal position of the character in CHRLST. C If there are three unsuccessful attempts to obtain a C character in CHRLST, QGTCHR will return .FALSE. QGTCHR will C also return .FALSE. if and EOF is enountered on current input C and current input is not standard input (as determined by C comparing unit numbers). C C C Note C C C Two error messages can be issued to current output as a result of C the use of this routine. C C A NULL LINE IS NOT ACCEPTABLE HERE - TRY AGAIN C is issued by QGTSTR, which is called by this routine. C C THE LEGAL FIRST NON-BLANK CHARACTER MUST BE ONE OF C THE FOLLOWING - TRY AGAIN C (followed by a list of legal characters) C is issued if the first non-blank character is not in CHRLST. C C FORMSG is rewritten after the above error messages. C C C Arguments C C C QGTCHR <-- .TRUE. if the first non-blank character obtained is a C member of CHRLST (even if it takes three attempts). C .FALSE. if an EOF is encountered on current input and C current input is not standard input or if three C attempts to obtain a character from CHRLST fail. C QGTCHR is LOGICAL C C FORMSG --> A FORTRAN format (first and last characters must be C left and right parentheses) which, when invoked, C will print a message to the user about the C character that is to be obtained. C If FORMSG is a character string consisting entirely of C blanks, then no message is printed to the user. C FORMSG is CHARACTER*(*) C C CHRLST --> A list of characters against which the first non-blank C character from current input is matched. C CHRLST is CHARACTER*(*) C C QUPCAS --> If .TRUE. the character obtained from current input is C translated to upper case if it is a lower case letter C before the match to CHRLST is done. C If .FALSE. no such translation is performed. C QUPCAS is LOGICAL C C IWHICH <-- Defined only if QGTCHR is .TRUE. The ordinal position C of the character obtained in CHRLST. C IWHICH is INTEGER C C********************************************************************** C C C QECIN -- Flag as to whether input is echoed C QECALL -- Flag as to whether entire dialog is echoed C ECIN -- Unit to which input is echoed C ECALL -- Unit to which entire dialog is echoed C C C GTECUN -- returns unit numbers associated with echo input and C echo all files (negative numbers if none) C C C C .. Scalar Arguments .. INTEGER iwhich LOGICAL qupcas CHARACTER mssg* (*),chrlst* (*) C .. C .. Local Scalars .. INTEGER ecall,ecin,i,i99996,icuin,icuot,itries,ivalue,lenstr LOGICAL qecall,qecin,qstr CHARACTER char*1,string*80 C .. C .. External Functions .. LOGICAL qgtstr CHARACTER trnchr*1 EXTERNAL qgtstr,trnchr C .. C .. External Subroutines .. EXTERNAL gtcuio,gtecun C .. C .. Intrinsic Functions .. INTRINSIC index,len C .. C .. Executable Statements .. C CALL gtcuio(icuin,icuot) C C Initialize for echo processing C CALL gtecun(ecin,ecall) qecin = ecin .GE. 0 qecall = ecall .GE. 0 itries = 0 qgtchr = .FALSE. C C loop until valid character read or processing terminated C 10 IF (qgtchr) GO TO 130 C C increment and test number of tries C itries = itries + 1 IF (.NOT. (itries.GT.3)) GO TO 30 C TERMINATE-PROCESSING ASSIGN 20 TO i99996 GO TO 140 C C get input string C 20 CONTINUE 30 qstr = qgtstr(mssg,string,.FALSE.) C IF (.NOT. (qstr)) RETURN C C find first non-blank character C lenstr = len(string) i = 1 char = ' ' 40 IF (.NOT. ((i.LE.lenstr).AND. (char.EQ.' '))) GO TO 60 IF (.NOT. (string(i:i).NE.' ')) GO TO 50 char = string(i:i) 50 i = i + 1 GO TO 40 60 IF (qupcas) char = trnchr(char) C C check char for membership in character list CHRLST C C iwhich = index(chrlst,char) IF (.NOT. (iwhich.NE.0)) GO TO 70 qgtchr = .TRUE. GO TO 120 70 WRITE (icuot,*) ' FIRST CHARACTER MUST BE ONE OF THE FOLLOWING:' C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 80 WRITE (ecall,*) ' FIRST CHARACTER MUST BE ONE OF THE FOLLOWING:' 80 DO 100,i = 1,len(chrlst) C - === End Echo Code === WRITE (icuot,*) ' ',chrlst C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 90 WRITE (ecall,*) ' ',chrlst 90 CONTINUE 100 CONTINUE C - === End Echo Code === WRITE (icuot,*) ' PLEASE TRY AGAIN' C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 110 WRITE (ecall,*) ' PLEASE TRY AGAIN' C - === End Echo Code === 110 CONTINUE 120 GO TO 10 C 130 RETURN C STOP '*** EXECUTION FLOWING INTO FLECS PROCEDURES ***' C TO TERMINATE-PROCESSING C C WHOOPS, LOOKS LIKE WE'VE BOMBED OUT! C 140 itries = itries - 1 qgtchr = .FALSE. ivalue = 0 WRITE (icuot,9000) itries C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 150 WRITE (ecall,9000) itries 150 CONTINUE 9000 FORMAT (' CHARACTER READ WAS UNSUCCESSFUL AFTER ',I2,' TRIES.') C - === End Echo Code === RETURN GO TO i99996 C END LOGICAL FUNCTION qgtrl(mssg,low,hi,value) C********************************************************************** C C LOGICAL FUNCTION QGTRL(FORMSG,RLOW,RHI,RVALUE) C C Q GeT ReaL C C C Function C C C If FORMSG is non-blank, prints it to current output, then C reads a real value between RLOW and RHI (inclusive) from C the current input unit and returns the value in RVALUE. QGTRL C returns .TRUE. if this was successfully accomplished, else C it returns .FALSE. C If there are three unsuccessful attempts to obtain the C number in the range specified, QGTRL returns .FALSE. C QGTRL will also return .FALSE. if an EOF is encountered on C current input and current input is not standard input C (as determined by comparing unit numbers). C C C Note C C C Three error messages can be issued to current output as a result C of the use of this routine. C C A NULL LINE IS NOT ACCEPTABLE HERE - TRY AGAIN C is issued by this routine if a blank line or EOF is C encountered. C C THE STRING ENTERED IS NOT A LEGAL REAL VALUE - TRY AGAIN C is issued for the obvious reason. C C NUMBER MUST BE BETWEEN AND - TRY AGAIN C is issued if a legal but out of range value is encountered. C C FORMSG is re-written to current output after either of the C previous error messages. C C C Arguments C C C QGTRL <-- .TRUE. if a legal real in the specified range C was obtained from current input, else .FALSE. C QGTRL is LOGICAL C C FORMSG --> A FORTRAN format (first and last characters must be C left and right parentheses) which, when invoked, C will print a message to the user about the C real number that is to be obtained. C If FORMSG is a character string consisting entirely C of blanks, then no message is printed to the user. C FORMSG is CHARACTER*(*) C C RLOW --> The lowest legal value for the number obtained. C RLOW is REAL C C RHI --> The highest legal value for the number obtained. C RHI is REAL C C RVALUE <-- Defined only if QGTRL is .TRUE. The value of the C real number obtained from current input. C RVALUE is REAL C C********************************************************************** C C C QECIN -- Flag as to whether input is echoed C QECALL -- Flag as to whether entire dialog is echoed C ECIN -- Unit to which input is echoed C ECALL -- Unit to which entire dialog is echoed C C C GTECUN -- returns unit numbers associated with echo input and C echo all files (negative numbers if none) C C C C .. Scalar Arguments .. REAL hi,low,value CHARACTER mssg* (*) C .. C .. Local Scalars .. INTEGER ecall,ecin,i99996,icuin,icuout,ios,istin,istout,itries LOGICAL qecall,qecin C .. C .. External Subroutines .. EXTERNAL gtcuio,gtecun,gtstio,prompt C .. C .. Executable Statements .. C C call routines to get current and standard I/O unit numbers C CALL gtcuio(icuin,icuout) CALL gtstio(istin,istout) C C Initialize for echo processing C CALL gtecun(ecin,ecall) qecin = ecin .GE. 0 qecall = ecall .GE. 0 itries = 0 qgtrl = .FALSE. C C loop until number read or processing terminated C 10 IF (qgtrl) GO TO 190 C C increment and test number of tries C itries = itries + 1 IF (.NOT. (itries.GT.3)) GO TO 30 C TERMINATE-PROCESSING ASSIGN 20 TO i99996 GO TO 200 C C print message if there is one and read input C 20 CONTINUE 30 IF (.NOT. (mssg.NE.' ')) GO TO 50 WRITE (icuout,mssg) C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 40 WRITE (ecall,mssg) C - === End Echo Code === 40 CONTINUE 50 CALL prompt READ (icuin,*,iostat=ios) value C C C if number read, verify against acceptable range C IF (.NOT. (ios.EQ.0)) GO TO 110 C + === Begin Echo Code === IF (.NOT. (qecin)) GO TO 60 WRITE (ecin,*) value 60 IF (.NOT. (qecall)) GO TO 70 WRITE (ecall,*) value 70 IF (.NOT. (value.LT.low.OR.value.GT.hi)) GO TO 90 C - === End Echo Code === C C if number was read correctly but was out of range... C WRITE (icuout,9000) low,hi C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 80 WRITE (icuout,9000) low,hi 80 CONTINUE 9000 FORMAT (' NUMBER MUST BE BETWEEN ',G9.3,' AND ',G9.3,' -', + ' TRY AGAIN') C - === End Echo Code === GO TO 100 90 qgtrl = .TRUE. C 100 GO TO 180 110 IF (.NOT. (ios.GT.0)) GO TO 130 C C if an error is encountered... (IOS > 0) C WRITE (icuout,*) + ' AN ERROR WAS ENCOUNTERED DURING READ - TRY AGAIN' C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 120 WRITE (ecall,*) + ' AN ERROR WAS ENCOUNTERED DURING READ - TRY AGAIN' 120 GO TO 180 C - === End Echo Code === 130 IF (.NOT. (icuin.NE.istin)) GO TO 160 C C if end-of-file is encountered... (IOS < 0) C C if end-of-file occurred on non-standard input, then give up C WRITE (icuout,*) ' END-OF-FILE ENCOUNTERED ON NON-STANDARD INPUT' C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 140 WRITE (ecall,*) ' END-OF-FILE ENCOUNTERED ON NON-STANDARD INPUT' C TERMINATE-PROCESSING 140 ASSIGN 150 TO i99996 GO TO 200 C - === End Echo Code === 150 GO TO 180 C C if end-of-file occurred on standard input, then rewind input C 160 WRITE (icuout,*) ' A NULL LINE IS NOT ACCEPTABLE HERE - TRY AGAIN' C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 170 WRITE (ecall,*) ' A NULL LINE IS NOT ACCEPTABLE HERE - TRY AGAIN' 170 REWIND (icuin) C - === End Echo Code === 180 GO TO 10 190 RETURN C C at this point, we know that IOS = 0 (no error on read) C STOP '*** EXECUTION FLOWING INTO FLECS PROCEDURES ***' C TO TERMINATE-PROCESSING C C WHOOPS, LOOKS LIKE WE'VE BOMBED OUT! C 200 itries = itries - 1 qgtrl = .FALSE. value = 0.0 WRITE (icuout,9010) itries C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 210 WRITE (ecall,9010) itries 210 CONTINUE 9010 FORMAT (' REAL NUMBER READ WAS UNSUCCESSFUL AFTER ',I2,' TRIES.') C - === End Echo Code === RETURN GO TO i99996 C END LOGICAL FUNCTION qgtstr(mssg,string,qnulok) C********************************************************************** C C LOGICAL FUNCTION QGTSTR(FORMSG,STRING,QNULOK) C C Q GeT STRing ignoring lines that begin with # C C C C Function C C C If FORMSG is non-blank, prints it to current output, then C reads a line from the current input file and places its C contents in STRING. Returns .TRUE. if the line was successfully C read. It returns .FALSE. if (1) an EOF is encountered and C current input is not standard input; (2) an error was encountered C in the read; or (3) QNULOK is .FALSE. indicating that a null line C is not a legal input, and three successive null lines are obtained C C If QNULOK is .FALSE. indicating that a null line is not a C legal input, the message C A NULL LINE IS NOT ACCEPTABLE HERE - TRY AGAIN C is written to current output and a new line is obtained. C C C Note C C C If an EOF is encountered on standard input, then standard C input is rewound. The EOF is treated as a null C line, as is a line consisting only of blank characters, as is C a line with '#' as the first non-blank character. C If QNULOK is .TRUE. then a null line will cause STRING to C be returned filled with all blanks. C C C Arguments C C C FORMSG --> A FORTRAN format (first and last characters must be C left and right parentheses) which, when invoked, C will print a message to the user about the C string that is to be obtained. C If FORMSG is a character string consisting entirely C of blanks, then no message is printed to the user. C FORMSG is CHARACTER*(*) C C QGTSTR <-- .TRUE. if QNULOK is .FALSE. and a non-null record was C read from current input or if QNULOK is .TRUE. and C a null or non-null record was read. The reasons for C returning .FALSE. are listed above. C QGTSTR is LOGICAL C C STRING <-- Defined only if QGTSTR is .TRUE. The character string C read from current input. C STRING is CHARACTER*(*) C C********************************************************************** C C C QECIN -- Flag as to whether input is echoed C QECALL -- Flag as to whether entire dialog is echoed C ECIN -- Unit to which input is echoed C ECALL -- Unit to which entire dialog is echoed C C C GTECUN -- returns unit numbers associated with echo input and C echo all files (negative numbers if none) C C C PROMPT -- writes prompt character as appropriate for system C C C C .. Scalar Arguments .. LOGICAL qnulok CHARACTER mssg* (*),string* (*) C .. C .. Local Scalars .. INTEGER ecall,ecin,i,i99996,icuin,icuout,ios,istin,istout,itries, + length LOGICAL qcomnt,qdone,qecall,qecin C .. C .. External Subroutines .. EXTERNAL gtcuio,gtecun,gtstio,prompt C .. C .. External Functions .. INTEGER lens EXTERNAL lens C .. C .. Executable Statements .. C C call routines to get current and standard I/O unit numbers C CALL gtcuio(icuin,icuout) CALL gtstio(istin,istout) C C Initialize for echo processing C CALL gtecun(ecin,ecall) qecin = ecin .GE. 0 qecall = ecall .GE. 0 itries = 0 qgtstr = .FALSE. C C loop until string read or processing terminated C 10 IF (qgtstr) GO TO 390 C C increment and test number of tries C itries = itries + 1 IF (.NOT. (itries.GT.3)) GO TO 30 C TERMINATE-PROCESSING ASSIGN 20 TO i99996 GO TO 400 20 RETURN 30 IF (.NOT. (mssg.NE.' ')) GO TO 50 C C print message if there is one C WRITE (icuout,FMT=mssg) C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 40 WRITE (ecall,FMT=mssg) C - === End Echo Code === 40 CONTINUE 50 IF (icuin.EQ.istin) CALL prompt C C Write prompt character C C C loop until we get a line without a '#' in the first column C GO TO 70 60 IF (qdone) GO TO 380 70 qdone = .TRUE. C C read input C READ (icuin,FMT='(A)',iostat=ios) string C C C if string read, set QGTSTR C IF (.NOT. (ios.EQ.0)) GO TO 260 C + === Begin Echo Code === IF (.NOT. (qecin)) GO TO 80 WRITE (ecin,FMT='(A)') string 80 IF (.NOT. (qecall)) GO TO 90 WRITE (ecall,FMT='(A)') string 90 IF (.NOT. (string(1:1).EQ.'#')) GO TO 100 qdone = .FALSE. GO TO 250 C - === End Echo Code === C C if STRING is not already blank, blank eveything following # C including the #, if it already is blank it isn't a comment line C 100 IF (.NOT. (string.NE.' ')) GO TO 170 length = lens(string) i = 1 GO TO 120 110 i = i + 1 120 IF (i.GT.length) GO TO 140 IF (.NOT. (string(i:i).EQ.'#')) GO TO 130 string(i:length) = ' ' GO TO 140 130 GO TO 110 140 IF (.NOT. (string.EQ.' ')) GO TO 150 qcomnt = .TRUE. GO TO 160 150 qcomnt = .FALSE. 160 GO TO 180 170 qcomnt = .FALSE. C C if string was read correctly but was blank or consisted of nothing C but a comment when not allowed. Both cases will make STRING = ' ' C 180 IF (.NOT. ((.NOT.qnulok).AND. (string.EQ.' '))) GO TO 230 IF (.NOT. (qcomnt)) GO TO 200 WRITE (icuout,FMT=9000) C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 190 WRITE (icuout,FMT=9000) 190 CONTINUE 9000 FORMAT (' COMMENT LINE NOT ALLOWED - TRY AGAIN') C - === End Echo Code === GO TO 220 C 200 WRITE (icuout,FMT=9010) C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 210 WRITE (icuout,FMT=9010) 210 CONTINUE 9010 FORMAT (' BLANK LINE NOT ALLOWED - TRY AGAIN') C - === End Echo Code === 220 GO TO 240 230 qgtstr = .TRUE. C 240 CONTINUE 250 GO TO 370 260 IF (.NOT. (ios.GT.0)) GO TO 290 C C if an error is encountered... C WRITE (icuout,FMT=*) ' AN ERROR WAS ENCOUNTERED DURING READ' C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 270 WRITE (ecall,FMT=*) ' AN ERROR WAS ENCOUNTERED DURING READ' C TERMINATE-PROCESSING 270 ASSIGN 280 TO i99996 GO TO 400 C - === End Echo Code === 280 RETURN GO TO 370 290 IF (.NOT. (icuin.NE.istin)) GO TO 320 C C if end-of-file is encountered... (IOS < 0) C C if end-of-file occurred on non-standard input, then give up C WRITE (icuout,FMT=*) + ' END-OF-FILE ENCOUNTERED ON NON-STANDARD INPUT' C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 300 WRITE (ecall,FMT=*) + ' END-OF-FILE ENCOUNTERED ON NON-STANDARD INPUT' C TERMINATE-PROCESSING 300 ASSIGN 310 TO i99996 GO TO 400 C - === End Echo Code === 310 RETURN GO TO 370 320 IF (.NOT. (qnulok)) GO TO 350 C C if end-of-file occurred on standard input, then rewind input C C if a null line is acceptable as input C IF (icuin.EQ.istin) REWIND (icuin) string = ' ' C + === Begin Echo Code === IF (.NOT. (qecin)) GO TO 330 WRITE (ecin,FMT='(A)') string 330 IF (.NOT. (qecall)) GO TO 340 WRITE (ecall,FMT='(A)') string 340 qgtstr = .TRUE. C - === End Echo Code === GO TO 370 C C if a null line is not acceptable C 350 WRITE (icuout,FMT=*) + ' A NULL LINE IS NOT ACCEPTABLE HERE - TRY AGAIN' C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 360 WRITE (ecall,FMT=*) + ' A NULL LINE IS NOT ACCEPTABLE HERE - TRY AGAIN' 360 REWIND (icuin) C - === End Echo Code === 370 GO TO 60 380 GO TO 10 390 RETURN C C at this point, we know that IOS = 0 (no error on read) C and we got a line C STOP '*** EXECUTION FLOWING INTO FLECS PROCEDURES ***' C TO TERMINATE-PROCESSING C C WHOOPS, LOOKS LIKE WE'VE BOMBED OUT! C 400 itries = itries - 1 qgtstr = .FALSE. WRITE (icuout,FMT=9020) itries C + === Begin Echo Code === IF (.NOT. (qecall)) GO TO 410 WRITE (ecall,FMT=9020) itries 410 CONTINUE 9020 FORMAT (' READ WAS UNSUCCESSFUL AFTER ',I2,' TRIES.') C - === End Echo Code === GO TO i99996 C END LOGICAL FUNCTION qgtyn(mssg,qyn) C********************************************************************** C C LOGICAL FUNCTION QGTYN(FORMSG,QYN) C C Q GeT Y-es or N-o C C C Function C C C If FORMSG is not blank, writes it to the current output unit, C then reads a line from the current input unit and examines the C first non-blank character for being 'Y', 'y', 'N', or 'n'. If C the first non-blank character is 'Y' or 'y', QYN is set to C .TRUE., if the first non-blank character is 'N' or 'n', QYN C is set to .FALSE. C If there are three unsuccessful attempts to obtain a C yes/no response, QGTYN returns .FALSE., otherwise, QGTYN C returns .TRUE. C C C Note C C C Two error messages can be issued to current output as a result of C the use of this routine. C C A NULL LINE IS NOT ACCEPTABLE HERE - TRY AGAIN C is issued by QGTSTR, which is called indirectly by this routine. C C THE LEGAL FIRST NON-BLANK CHARACTER MUST BE ONE OF C THE FOLLOWING: C (followed by a list of legal characters) C is issued by QGTCHR, which is called by this routine. C C FORMSG is rewritten after the above error messages. C C C Arguments C C C QGTYN <-- .TRUE. if the first non-blank character obtained is a C member of 'YyNn' (even if it takes three attempts). C .FALSE. if an EOF is encountered on current input and C current input is not standard input or if three C attempts to obtain a character from 'YyNn' fail. C QGTYN is LOGICAL C C FORMSG --> A FORTRAN format (first and last characters must be C left and right parentheses) which, when invoked, C will print a message to the user about the C yes or no answer that is to be specified. C If FORMSG is a character string consisting entirely C of blanks, then no message is printed to the user. C FORMSG is CHARACTER*(*) C C QYN <-- Defined only if QGTCHR is .TRUE. If the response is C 'Y' or 'y', this is .TRUE., otherwise .FALSE. C QYN is LOGICAL C C********************************************************************** C C C C .. Scalar Arguments .. LOGICAL qyn CHARACTER mssg* (*) C .. C .. Local Scalars .. INTEGER iwhich C .. C .. External Functions .. LOGICAL qgtchr EXTERNAL qgtchr C .. C .. Executable Statements .. C qgtyn = qgtchr(mssg,'YN',.TRUE.,iwhich) C IF (.NOT. (qgtyn)) GO TO 30 IF (.NOT. (iwhich.EQ.1)) GO TO 10 qyn = .TRUE. GO TO 20 10 qyn = .FALSE. 20 CONTINUE C 30 END LOGICAL FUNCTION qyngt(mssg) C C********************************************************************** C C LOGICAL FUNCTION QYNGT(FORMSG) C C Q Y-es or N-o GeT C C C Function C C C If FORMSG is not blank, writes it to the current output unit, C then reads a line from the current input unit and examines the C first non-blank character for being 'Y', 'y', 'N', or 'n'. If C the first non-blank character is 'Y' or 'y', QYNGT is set to C .TRUE., if the first non-blank character is 'N' or 'n', QYN C is set to .FALSE. C If there are three unsuccessful attempts to obtain a C yes/no response, QYNGT STOPs. C C C Note C C C Two error messages can be issued to current output as a result of C the use of this routine. C C A NULL LINE IS NOT ACCEPTABLE HERE - TRY AGAIN C is issued by QGTSTR, which is called indirectly by this routine. C C THE LEGAL FIRST NON-BLANK CHARACTER MUST BE ONE OF C THE FOLLOWING: C (followed by a list of legal characters) C is issued by QGTCHR, which is called by this routine. C C FORMSG is rewritten after the above error messages. C C C Arguments C C C QYNGT <-- .TRUE. if the first non-blank character obtained is a C member of 'Yy' (even if it takes three attempts). C .FALSE. if an the character is a member of 'Nn'. C QYNGT is LOGICAL C C FORMSG --> A FORTRAN format (first and last characters must be C left and right parentheses) which, when invoked, C will print a message to the user about the C yes or no answer that is to be specified. C If FORMSG is a character string consisting entirely C of blanks, then no message is printed to the user. C FORMSG is CHARACTER*(*) C C C C Note C C C This routine merely renames QGTYN. C C********************************************************************** C C .. Scalar Arguments .. CHARACTER mssg* (*) C .. C .. Local Scalars .. LOGICAL qok C .. C .. External Functions .. LOGICAL qgtyn EXTERNAL qgtyn C .. C .. Executable Statements .. qok = qgtyn(mssg,qyngt) IF (.NOT. (qok)) STOP ' QGTYN CALLED FROM QYNGT' RETURN END REAL FUNCTION rlgt(mssg,rlow,rhi) C C********************************************************************** C C REAL FUNCTION RLGT(FORMSG,RLOW,RHI) C C ReaL GeT C C C Function C C C If FORMSG is non-blank, prints it to current output, then C reads a real value between RLOW and RHI (inclusive) from C the current input unit and returns the value. C RLGT STOPs if any problem is encountered, as described. C If there are three unsuccessful attempts to obtain the C number in the range specified, RLGT STOPS. C RLGT will also STOP if an EOF is encountered on C current input and current input is not standard input C (as determined by comparing unit numbers). C C C Note C C C Three error messages can be issued to current output as a result C of the use of this routine. C C A NULL LINE IS NOT ACCEPTABLE HERE - TRY AGAIN C is issued by this routine if a blank line or EOF is C encountered. C C THE STRING ENTERED IS NOT A LEGAL REAL VALUE - TRY AGAIN C is issued for the obvious reason. C C NUMBER MUST BE BETWEEN AND - TRY AGAIN C is issued if a legal but out of range value is encountered. C C FORMSG is re-written to current output after either of the C previous error messages. C C C Arguments C C C RLGT <-- The value of the real number obtained from current C input. C RLGT is REAL C C FORMSG --> A FORTRAN format (first and last characters must be C left and right parentheses) which, when invoked, C will print a message to the user about the C real number that is to be obtained. C If FORMSG is a character string consisting entirely of C blanks, then no message is printed to the user. C FORMSG is CHARACTER*(*) C C RLOW --> The lowest legal value for the number obtained. C RLOW is REAL C C RHI --> The highest legal value for the number obtained. C RHI is REAL C C C C Note C C C This routine merely renames QGTRL. C C********************************************************************** C C .. Scalar Arguments .. REAL rhi,rlow CHARACTER mssg* (*) C .. C .. Local Scalars .. LOGICAL qok C .. C .. External Functions .. LOGICAL qgtrl EXTERNAL qgtrl C .. C .. Executable Statements .. qok = qgtrl(mssg,rlow,rhi,rlgt) IF (.NOT. (qok)) STOP ' QGTRL CALLED FROM RLGT' RETURN END CHARACTER*(*) FUNCTION strgt(mssg,qnulok) C C********************************************************************** C C CHARACTER*(*) FUNCTION STRGT(MSSG,QNULOK) C C STRing GeT C C C C Function C C C If MSSG is non-blank, prints it to current output, then C reads a line from the current input file and returns its C contents. C STRGT returns .FALSE. if (1) an EOF is encountered and C current input is not standard input; (2) an error was encountered C in the read; or (3) QNULOK is .FALSE. indicating that a null line C is not a legal input, and three successive null lines are obtained C C If QNULOK is .FALSE. indicating that a null line is not a C legal input, the message C A NULL LINE IS NOT ACCEPTABLE HERE - TRY AGAIN C is written to current output and a new line is obtained. C C C Note C C C If an EOF is encountered on standard input, then standard C input is rewound. The EOF is treated as a null C line as is a line consisting only of blank characters. C If QNULOK is .TRUE. then a null line will cause STRING to C be returned filled with all blanks. C C C Arguments C C C STRGT <-- The string read from current input. C STRGT is CHARACTER*(*) C C MSSG --> A FORTRAN format (first and last characters must be C left and right parentheses) which, when invoked, C will print a message to the user about the C string that is to be obtained. C If MSSG is a character string consisting entirely of C blanks, then no message is printed to the user. C MSSG is CHARACTER*(*) C C QNULOK --> .TRUE. if a null string is acceptable, else .FALSE. C QNULOK is LOGICAL C C C Note C C C This routine merely renames QGTSTR. C C********************************************************************** C C .. Scalar Arguments .. LOGICAL qnulok CHARACTER mssg* (*) C .. C .. Local Scalars .. LOGICAL qok C .. C .. External Functions .. LOGICAL qgtstr EXTERNAL qgtstr C .. C .. Executable Statements .. qok = qgtstr(mssg,strgt,qnulok) IF (.NOT. (qok)) STOP ' QGTSTR CALLED FROM STRGT' RETURN END CHARACTER*1 FUNCTION trnchr(chr) C C********************************************************************** C C CHARACTER*1 FUNCTION TRNCHR(CHR) C TRaNslate to upper case one CHaRacter C C C Function C C C If CHR is a lower case letter 'a..z' then returns the upper C case letter corresponding. C C If CHR is not a lower case letter, then returns CHR. C C C Arguments C C C TRNCHR <-- CHR or its upper case equivalent if CHR is in 'a..z' C TRNCHR is CHARACTER*1 C C CHR --> Character to be translated to upper case C CHR is CHARACTER*1 C C********************************************************************** C C .. Scalar Arguments .. CHARACTER chr*1 C .. C .. Local Scalars .. INTEGER ix LOGICAL qnotlc CHARACTER locase*26,upcase*26 C .. C .. Intrinsic Functions .. INTRINSIC index C .. C .. Data statements .. DATA locase/'abcdefghijklmnopqrstuvwxyz'/ DATA upcase/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ C .. C .. Executable Statements .. qnotlc = chr .LT. 'a' .OR. chr .GT. 'z' IF (.NOT. (qnotlc)) GO TO 10 trnchr = chr RETURN 10 ix = index(locase,chr) IF (.NOT. (ix.LE.0)) GO TO 20 trnchr = chr GO TO 30 20 trnchr = upcase(ix:ix) 30 RETURN END SHAR_EOF fi # end of overwriting check if test -f 'src.f' then echo shar: will not over-write existing file "'src.f'" else cat << \SHAR_EOF > 'src.f' SUBROUTINE lldrlf(ww,dfn,dfd,case,l,dldw,d2ldw2) C********************************************************************** C C SUBROUTINE LLDRLF(WW,DFN,DFD,CASE,L,DLDW,D2LDW2) C Log-Likelihood and DeRivatives for Log-F Models C C C Function C C C Let F(Z|DFN,DFD) be the cumulative F distribution with degrees C of freedom DFN and DFD. Let W have a Log-F distribtuion with C the same degrees of freedom. That is, exp(W) is distributed C as F. Let f(exp(W)|DFN,DFD) be the density corresponding to C F(exp(W)|DFN,DFD), f(exp(W)|DFN,DFD) = dF(exp(W)|DFN,DFD)/dw. C C This subroutine calculates one of the following three values C log(f(exp(W)|DFN,DFD)) C log(F(exp(W)|DFN,DFD)) C log(1 - F(exp(W)|DFN,DFD)) C and its first two derivatives with respect to W. C C C C Arguments C C C WW --> Argument at which log(f(exp(W)|DFN,DFD)), C log(F(exp(W)|DFN,DFD)) or log(1 - F(exp(W)|DFN,DFD)) c is to be calculated C DOUBLE PRECISION WW C C DFN --> Numerator degrees of freedom C DOUBLE PRECISION DFN C C DFD --> Denominator degrees of freedom C DOUBLE PRECISION DFD C C CASE --> Indicates which function of W is to be calculated C 1 : log(f(exp(W)|DFN,DFD)) C 2 : log(F(exp(W)|DFN,DFD)) C 3 : log(1 - F(exp(W)|DFN,DFD)) C INTEGER CASE C C L <-- log(f(exp(W)|DFN,DFD)), log(F(exp(W)|DFN,DFD)) or C log(1 - F(exp(W)|DFN,DFD)) depending on CASE. C DOUBLE PRECISION L C C DLDW <-- Derivative of L with respect to W C DOUBLE PRECISION DLDW C C D2LDW2 <-- Second derivative of L with respec to W (twice) C DOUBLE PRECISION D2LDW2 C C********************************************************************** C .. Parameters .. DOUBLE PRECISION center PARAMETER (center=0.1D0) DOUBLE PRECISION zero PARAMETER (zero=0.0D0) DOUBLE PRECISION tiny PARAMETER (tiny=1.0D-8) DOUBLE PRECISION thp PARAMETER (thp=0.03D0) DOUBLE PRECISION half PARAMETER (half=0.5D0) DOUBLE PRECISION pt7 PARAMETER (pt7=0.7D0) DOUBLE PRECISION one PARAMETER (one=1.0D0) DOUBLE PRECISION two PARAMETER (two=2.0D0) DOUBLE PRECISION fiften PARAMETER (fiften=1500.0D0) DOUBLE PRECISION forty PARAMETER (forty=40.0D0) DOUBLE PRECISION hundrd PARAMETER (hundrd=100.0D0) DOUBLE PRECISION maxx PARAMETER (maxx=0.74D0) C .. C .. Scalar Arguments .. DOUBLE PRECISION ww,dfn,dfd,l,dldw,d2ldw2 INTEGER case C .. C .. Local Scalars .. DOUBLE PRECISION a,aswp,alopk,b,bswp,w,expwpk,k,logk,opk,opkemw, + prd,remain,rat,wswp,xld,xd1,tau,lbda,logz,logy, + logx,z,lcum,x,y,lambda,thpab,eps3,eps,epsold, + eps5,temp LOGICAL qcentr,qswtch C .. C .. External Functions .. DOUBLE PRECISION cenlf,dbetrm,dexpm1,dln1pe,dln1px,spmpar,dexp1 EXTERNAL cenlf,dbetrm,dexpm1,dln1pe,dln1px,spmpar,dexp1 C C .. External Subroutines .. EXTERNAL ltlf,dlasym,dlfrac,dser,dextr C .. C .. Intrinsic Functions .. INTRINSIC abs,exp,log,max,min,sqrt C .. C .. Save statement .. SAVE eps,epsold,eps3,eps5 C .. C .. Data statements .. DATA eps/-1.0D0/,epsold/-2.0D0/ C .. C .. Executable Statements .. C C EPS, EPS3 and EPS5 are machine dependent and only need C to be calculated once per execution of a program calling llpder. C IF (eps.NE.epsold) THEN eps = spmpar(1) epsold = eps eps3 = hundrd*eps eps5 = fiften*eps END IF C C The following code calculates log(f(exp(W)|DFN,DFD)) or C log(1 - F(exp(W)|DFN,DFD)). To get log(F(exp(W)|DFN,DFD)) C We take advantage of the fact that C log(F(exp(W)|DFN,DFD)) = log(1 - F(exp(-W)|DFD,DFN)) C C d log(F(exp(W)|DFN,DFD)) = d log(1 - F(exp(-W)|DFD,DFN)) C ________________________ - ______________________________ C dw dw C and C d^2 log(F(exp(W)|DFN,DFD)) = d^2 log(1 - F(exp(-W)|DFD,DFN)) C ________________________ ______________________________ C dw^2 dw^2 C C w = ww C C Compute log(f(exp(W)|DFN,DFD)) and its first derivative C Note: These computations are needed to find the derivatives of C log(1 - F(exp(W)|DFN,DFD)) C C C Calculate some functions of a and b C a = half*dfn b = half*dfd IF (case.EQ.2) THEN temp = b b = a a = temp w = -w END IF aswp = max(a,b) bswp = min(a,b) qswtch = b .GT. a C C Compute quantities for calculation of f(w) and df(w)/dw C k = bswp/aswp logk = log(k) opk = one + k prd = bswp*opk alopk = dln1px(k) remain = dbetrm(a,b) tau = sqrt(one/ (one/a+one/b)) C C Reverse sign of W if B greater than A C IF (qswtch) THEN wswp = -w ELSE wswp = w END IF qcentr = abs(wswp) .LE. center C C Compute log(f(exp(W)|DFN,DFD)) C IF (qcentr) THEN xld = cenlf(wswp,k) ELSE xld = -k*wswp + opk* (alopk-dln1pe(logk-wswp)) END IF xld = aswp*xld - remain C C Compute first derivative of log(f(exp(W)|DFN,DFD)) C IF (wswp.GT.zero) THEN opkemw = one + k*exp(-wswp) ELSE expwpk = exp(wswp) + k END IF IF (wswp.GT.zero) THEN C XD1 = BSWP * (EXP(-WSWP) - ONE) / ( ONE + K*EXP(-WSWP) ) xd1 = bswp*dexpm1(-wswp)/opkemw ELSE C XD1 = BSWP * ( ONE - EXP(WSWP) ) / ( EXP(WSWP) + K ) xd1 = -bswp*dexpm1(wswp)/expwpk END IF IF (qswtch) xd1 = -xd1 C C Calculate log(f(exp(W)|DFN,DFD)) and its first and C its first and second derivatives if needed. C IF (case.EQ.1) THEN l = xld dldw = xd1 C C Compute the second derivative of log(f(exp(W)|DFN,DFD)) C IF (wswp.GT.zero) THEN d2ldw2 = -prd*exp(-wswp)/opkemw**2 ELSE d2ldw2 = -prd*exp(wswp)/expwpk**2 END IF ELSE C C Calculate log(1 - F(exp(W)|DFN,DFD)) and its first and C its first and second derivatives if needed. C C Calculate log(1 - F(exp(W)|DFN,DFD)) C CALL ltlf(w,two*a,two*b,lcum,l) C C Calculate first and second derivative C C Calculate values based on A, B and W C lbda = log(b/a) logz = lbda - w logx = -dln1pe(-logz) logy = -dln1pe(logz) x = exp(logx) y = exp(logy) C C Try Extreme Value Calculations C IF (a.EQ.one) THEN dldw = -b*y d2ldw2 = -b*x*y GO TO 10 END IF IF ((abs(a-one)*x.LT.0.1D0) .AND. (x.LT.maxx)) THEN CALL dextr(a,b,x,y,dldw,d2ldw2) dldw = -b*y + dldw d2ldw2 = -b*x*y + d2ldw2 GO TO 10 END IF C C Try asymptotic Calculation C thpab = thp*bswp IF (qswtch) THEN lambda = (a+b)*y - a ELSE lambda = b - (a+b)*x END IF IF ((a.GT.hundrd) .AND. (b.GT.hundrd) .AND. + (lambda.GT.tiny) .AND. (lambda.LE.thpab)) THEN CALL dlasym(b,a,x,y,lambda,eps3,dldw,d2ldw2) GO TO 10 END IF C C Try Continued Fraction Calculation C IF ((a.GT.forty) .AND. (b.GT.forty) .AND. + (lambda.GE.thpab) .AND. (a*x.GE.pt7)) THEN CALL dlfrac(b,a,x,y,lambda,eps5,dldw,d2ldw2) dldw = -lambda + dldw d2ldw2 = - (a+b)*x*y + d2ldw2 GO TO 10 END IF C C Try series Calculation C z = dexp1(logz) IF (z.LE.1.0D13) THEN rat = (a-two)*z/ (b+two) ELSE rat = one END IF IF (abs(rat).LE.0.1D0) THEN CALL dser(a,b,z,dldw,d2ldw2) IF (qswtch) THEN dldw = (a-one) - (a+b-one)*y + dldw ELSE dldw = (a+b-one)*x - b + dldw END IF d2ldw2 = - (b+a-one)*y*x + d2ldw2 GO TO 10 END IF C C Use direct differentiation method C dldw = -tau*exp(xld-l) d2ldw2 = dldw* (xd1-dldw) C C If CASE = 2 set L = LCUM and negative DLDW C 10 IF (case.EQ.2) THEN dldw = -dldw END IF END IF RETURN END DOUBLE PRECISION FUNCTION algdiv(a,b) C----------------------------------------------------------------------- C C COMPUTATION OF LN(GAMMA(B)/GAMMA(A+B)) WHEN B .GE. 8 C C -------- C C IN THIS ALGORITHM, DEL(X) IS THE FUNCTION DEFINED BY C LN(GAMMA(X)) = (X - 0.5)*LN(X) - X + 0.5*LN(2*PI) + DEL(X). C C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a,b C .. C .. Local Scalars .. DOUBLE PRECISION c,c0,c1,c2,c3,c4,c5,d,h,s11,s3,s5,s7,s9,t,u,v,w, + x,x2 C .. C .. External Functions .. DOUBLE PRECISION alnrel EXTERNAL alnrel C .. C .. Intrinsic Functions .. INTRINSIC dlog C .. C .. Data statements .. DATA c0/.833333333333333D-01/,c1/-.277777777760991D-02/, + c2/.793650666825390D-03/,c3/-.595202931351870D-03/, + c4/.837308034031215D-03/,c5/-.165322962780713D-02/ C .. C .. Executable Statements .. C------------------------ IF (a.LE.b) GO TO 10 h = b/a c = 1.0D0/ (1.0D0+h) x = h/ (1.0D0+h) d = a + (b-0.5D0) GO TO 20 10 h = a/b c = h/ (1.0D0+h) x = 1.0D0/ (1.0D0+h) d = b + (a-0.5D0) C C SET SN = (1 - X**N)/(1 - X) C 20 x2 = x*x s3 = 1.0D0 + (x+x2) s5 = 1.0D0 + (x+x2*s3) s7 = 1.0D0 + (x+x2*s5) s9 = 1.0D0 + (x+x2*s7) s11 = 1.0D0 + (x+x2*s9) C C SET W = DEL(B) - DEL(A + B) C t = (1.0D0/b)**2 w = ((((c5*s11*t+c4*s9)*t+c3*s7)*t+c2*s5)*t+c1*s3)*t + c0 w = w* (c/b) C C COMBINE THE RESULTS C u = d*alnrel(a/b) v = a* (dlog(b)-1.0D0) IF (u.LE.v) GO TO 30 algdiv = (w-v) - u RETURN 30 algdiv = (w-u) - v RETURN END DOUBLE PRECISION FUNCTION alnrel(a) C----------------------------------------------------------------------- C EVALUATION OF THE FUNCTION LN(1 + A) C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a C .. C .. Local Scalars .. DOUBLE PRECISION p1,p2,p3,q1,q2,q3,t,t2,w,x C .. C .. Intrinsic Functions .. INTRINSIC abs,dble,dlog C .. C .. Data statements .. DATA p1/-.129418923021993D+01/,p2/.405303492862024D+00/, + p3/-.178874546012214D-01/ DATA q1/-.162752256355323D+01/,q2/.747811014037616D+00/, + q3/-.845104217945565D-01/ C .. C .. Executable Statements .. C-------------------------- IF (abs(a).GT.0.375D0) GO TO 10 t = a/ (a+2.0D0) t2 = t*t w = (((p3*t2+p2)*t2+p1)*t2+1.0D0)/ (((q3*t2+q2)*t2+q1)*t2+1.0D0) alnrel = 2.0D0*t*w RETURN C 10 x = 1.D0 + dble(a) alnrel = dlog(x) RETURN END DOUBLE PRECISION FUNCTION apser(a,b,x,eps) C----------------------------------------------------------------------- C APSER YIELDS THE INCOMPLETE BETA RATIO I(SUB(1-X))(B,A) FOR C A .LE. MIN(EPS,EPS*B), B*X .LE. 1, AND X .LE. 0.5. USED WHEN C A IS VERY SMALL. USE ONLY IF ABOVE INEQUALITIES ARE SATISFIED. C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a,b,eps,x C .. C .. Local Scalars .. DOUBLE PRECISION aj,bx,c,g,j,s,t,tol C .. C .. External Functions .. DOUBLE PRECISION psi EXTERNAL psi C .. C .. Intrinsic Functions .. INTRINSIC abs,dlog C .. C .. Data statements .. C-------------------- DATA g/.577215664901533D0/ C .. C .. Executable Statements .. C-------------------- bx = b*x t = x - bx IF (b*eps.GT.2.D-2) GO TO 10 c = dlog(x) + psi(b) + g + t GO TO 20 10 c = dlog(bx) + g + t C 20 tol = 5.0D0*eps*abs(c) j = 1.0D0 s = 0.0D0 30 j = j + 1.0D0 t = t* (x-bx/j) aj = t/j s = s + aj IF (abs(aj).GT.tol) GO TO 30 C apser = -a* (c+s) RETURN END DOUBLE PRECISION FUNCTION basym(a,b,lambda,eps) C----------------------------------------------------------------------- C ASYMPTOTIC EXPANSION FOR IX(A,B) FOR LARGE A AND B. C LAMBDA = (A + B)*Y - B AND EPS IS THE TOLERANCE USED. C IT IS ASSUMED THAT LAMBDA IS NONNEGATIVE AND THAT C A AND B ARE GREATER THAN OR EQUAL TO 15. C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a,b,eps,lambda C .. C .. Local Scalars .. DOUBLE PRECISION bsum,dsum,e0,e1,f,h,h2,hn,j0,j1,r,r0,r1,s,sum,t, + t0,t1,u,w,w0,z,z0,z2,zn,znm1 INTEGER i,im1,imj,j,m,mm1,mmj,n,np1,num C .. C .. Local Arrays .. DOUBLE PRECISION a0(21),b0(21),c(21),d(21) C .. C .. External Functions .. DOUBLE PRECISION bcorr,erfc1,rlog1 EXTERNAL bcorr,erfc1,rlog1 C .. C .. Intrinsic Functions .. INTRINSIC abs,exp,sqrt C .. C .. Data statements .. C------------------------ C ****** NUM IS THE MAXIMUM VALUE THAT N CAN TAKE IN THE DO LOOP C ENDING AT STATEMENT 50. IT IS REQUIRED THAT NUM BE EVEN. C THE ARRAYS A0, B0, C, D HAVE DIMENSION NUM + 1. C C------------------------ C E0 = 2/SQRT(PI) C E1 = 2**(-3/2) C------------------------ DATA num/20/ DATA e0/1.12837916709551D0/,e1/.353553390593274D0/ C .. C .. Executable Statements .. C------------------------ basym = 0.0D0 IF (a.GE.b) GO TO 10 h = a/b r0 = 1.0D0/ (1.0D0+h) r1 = (b-a)/b w0 = 1.0D0/sqrt(a* (1.0D0+h)) GO TO 20 10 h = b/a r0 = 1.0D0/ (1.0D0+h) r1 = (b-a)/a w0 = 1.0D0/sqrt(b* (1.0D0+h)) C 20 f = a*rlog1(-lambda/a) + b*rlog1(lambda/b) t = exp(-f) IF (t.EQ.0.0D0) RETURN z0 = sqrt(f) z = 0.5D0* (z0/e1) z2 = f + f C a0(1) = (2.0D0/3.0D0)*r1 c(1) = -0.5D0*a0(1) d(1) = -c(1) j0 = (0.5D0/e0)*erfc1(1,z0) j1 = e1 sum = j0 + d(1)*w0*j1 C s = 1.0D0 h2 = h*h hn = 1.0D0 w = w0 znm1 = z zn = z2 DO 70 n = 2,num,2 hn = h2*hn a0(n) = 2.0D0*r0* (1.0D0+h*hn)/ (n+2.0D0) np1 = n + 1 s = s + hn a0(np1) = 2.0D0*r1*s/ (n+3.0D0) C DO 60 i = n,np1 r = -0.5D0* (i+1.0D0) b0(1) = r*a0(1) DO 40 m = 2,i bsum = 0.0D0 mm1 = m - 1 DO 30 j = 1,mm1 mmj = m - j bsum = bsum + (j*r-mmj)*a0(j)*b0(mmj) 30 CONTINUE b0(m) = r*a0(m) + bsum/m 40 CONTINUE c(i) = b0(i)/ (i+1.0D0) C dsum = 0.0D0 im1 = i - 1 DO 50 j = 1,im1 imj = i - j dsum = dsum + d(imj)*c(j) 50 CONTINUE d(i) = - (dsum+c(i)) 60 CONTINUE C j0 = e1*znm1 + (n-1.0D0)*j0 j1 = e1*zn + n*j1 znm1 = z2*znm1 zn = z2*zn w = w0*w t0 = d(n)*w*j0 w = w0*w t1 = d(np1)*w*j1 sum = sum + (t0+t1) IF ((abs(t0)+abs(t1)).LE.eps*sum) GO TO 80 70 CONTINUE C 80 u = exp(-bcorr(a,b)) basym = e0*t*u*sum RETURN END DOUBLE PRECISION FUNCTION bcorr(a0,b0) C----------------------------------------------------------------------- C C EVALUATION OF DEL(A0) + DEL(B0) - DEL(A0 + B0) WHERE C LN(GAMMA(A)) = (A - 0.5)*LN(A) - A + 0.5*LN(2*PI) + DEL(A). C IT IS ASSUMED THAT A0 .GE. 8 AND B0 .GE. 8. C C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a0,b0 C .. C .. Local Scalars .. DOUBLE PRECISION a,b,c,c0,c1,c2,c3,c4,c5,h,s11,s3,s5,s7,s9,t,w,x, + x2 C .. C .. Intrinsic Functions .. INTRINSIC dmax1,dmin1 C .. C .. Data statements .. DATA c0/.833333333333333D-01/,c1/-.277777777760991D-02/, + c2/.793650666825390D-03/,c3/-.595202931351870D-03/, + c4/.837308034031215D-03/,c5/-.165322962780713D-02/ C .. C .. Executable Statements .. C------------------------ a = dmin1(a0,b0) b = dmax1(a0,b0) C h = a/b c = h/ (1.0D0+h) x = 1.0D0/ (1.0D0+h) x2 = x*x C C SET SN = (1 - X**N)/(1 - X) C s3 = 1.0D0 + (x+x2) s5 = 1.0D0 + (x+x2*s3) s7 = 1.0D0 + (x+x2*s5) s9 = 1.0D0 + (x+x2*s7) s11 = 1.0D0 + (x+x2*s9) C C SET W = DEL(B) - DEL(A + B) C t = (1.0D0/b)**2 w = ((((c5*s11*t+c4*s9)*t+c3*s7)*t+c2*s5)*t+c1*s3)*t + c0 w = w* (c/b) C C COMPUTE DEL(A) + W C t = (1.0D0/a)**2 bcorr = (((((c5*t+c4)*t+c3)*t+c2)*t+c1)*t+c0)/a + w RETURN END DOUBLE PRECISION FUNCTION betaln(a0,b0) C----------------------------------------------------------------------- C EVALUATION OF THE LOGARITHM OF THE BETA FUNCTION C----------------------------------------------------------------------- C E = 0.5*LN(2*PI) C-------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a0,b0 C .. C .. Local Scalars .. DOUBLE PRECISION a,b,c,e,h,u,v,w,z INTEGER i,n C .. C .. External Functions .. DOUBLE PRECISION algdiv,alnrel,bcorr,gamln,gsumln EXTERNAL algdiv,alnrel,bcorr,gamln,gsumln C .. C .. Intrinsic Functions .. INTRINSIC dlog,dmax1,dmin1 C .. C .. Data statements .. DATA e/.918938533204673D0/ C .. C .. Executable Statements .. C-------------------------- a = dmin1(a0,b0) b = dmax1(a0,b0) IF (a.GE.8.0D0) GO TO 100 IF (a.GE.1.0D0) GO TO 20 C----------------------------------------------------------------------- C PROCEDURE WHEN A .LT. 1 C----------------------------------------------------------------------- IF (b.GE.8.0D0) GO TO 10 betaln = gamln(a) + (gamln(b)-gamln(a+b)) RETURN 10 betaln = gamln(a) + algdiv(a,b) RETURN C----------------------------------------------------------------------- C PROCEDURE WHEN 1 .LE. A .LT. 8 C----------------------------------------------------------------------- 20 IF (a.GT.2.0D0) GO TO 40 IF (b.GT.2.0D0) GO TO 30 betaln = gamln(a) + gamln(b) - gsumln(a,b) RETURN 30 w = 0.0D0 IF (b.LT.8.0D0) GO TO 60 betaln = gamln(a) + algdiv(a,b) RETURN C C REDUCTION OF A WHEN B .LE. 1000 C 40 IF (b.GT.1000.0D0) GO TO 80 n = a - 1.0D0 w = 1.0D0 DO 50 i = 1,n a = a - 1.0D0 h = a/b w = w* (h/ (1.0D0+h)) 50 CONTINUE w = dlog(w) IF (b.LT.8.0D0) GO TO 60 betaln = w + gamln(a) + algdiv(a,b) RETURN C C REDUCTION OF B WHEN B .LT. 8 C 60 n = b - 1.0D0 z = 1.0D0 DO 70 i = 1,n b = b - 1.0D0 z = z* (b/ (a+b)) 70 CONTINUE betaln = w + dlog(z) + (gamln(a)+ (gamln(b)-gsumln(a,b))) RETURN C C REDUCTION OF A WHEN B .GT. 1000 C 80 n = a - 1.0D0 w = 1.0D0 DO 90 i = 1,n a = a - 1.0D0 w = w* (a/ (1.0D0+a/b)) 90 CONTINUE betaln = (dlog(w)-n*dlog(b)) + (gamln(a)+algdiv(a,b)) RETURN C----------------------------------------------------------------------- C PROCEDURE WHEN A .GE. 8 C----------------------------------------------------------------------- 100 w = bcorr(a,b) h = a/b c = h/ (1.0D0+h) u = - (a-0.5D0)*dlog(c) v = b*alnrel(h) IF (u.LE.v) GO TO 110 betaln = (((-0.5D0*dlog(b)+e)+w)-v) - u RETURN 110 betaln = (((-0.5D0*dlog(b)+e)+w)-u) - v RETURN END DOUBLE PRECISION FUNCTION bfrac(a,b,x,y,lambda,eps) C----------------------------------------------------------------------- C CONTINUED FRACTION EXPANSION FOR IX(A,B) WHEN A,B .GT. 1. C IT IS ASSUMED THAT LAMBDA = (A + B)*Y - B. C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a,b,eps,lambda,x,y C .. C .. Local Scalars .. DOUBLE PRECISION alpha,an,anp1,beta,bn,bnp1,c,c0,c1,e,n,p,r,r0,s, + t,w,yp1 C .. C .. External Functions .. DOUBLE PRECISION brcomp EXTERNAL brcomp C .. C .. Intrinsic Functions .. INTRINSIC abs C .. C .. Executable Statements .. C-------------------- bfrac = brcomp(a,b,x,y) IF (bfrac.EQ.0.0D0) RETURN C c = 1.0D0 + lambda c0 = b/a c1 = 1.0D0 + 1.0D0/a yp1 = y + 1.0D0 C n = 0.0D0 p = 1.0D0 s = a + 1.0D0 an = 0.0D0 bn = 1.0D0 anp1 = 1.0D0 bnp1 = c/c1 r = c1/c C C CONTINUED FRACTION CALCULATION C 10 n = n + 1.0D0 t = n/a w = n* (b-n)*x e = a/s alpha = (p* (p+c0)*e*e)* (w*x) e = (1.0D0+t)/ (c1+t+t) beta = n + w/s + e* (c+n*yp1) p = 1.0D0 + t s = s + 2.0D0 C C UPDATE AN, BN, ANP1, AND BNP1 C t = alpha*an + beta*anp1 an = anp1 anp1 = t t = alpha*bn + beta*bnp1 bn = bnp1 bnp1 = t C r0 = r r = anp1/bnp1 IF (abs(r-r0).LE.eps*r) GO TO 20 C C RESCALE AN, BN, ANP1, AND BNP1 C an = an/bnp1 bn = bn/bnp1 anp1 = r bnp1 = 1.0D0 GO TO 10 C C TERMINATION C 20 bfrac = bfrac*r RETURN END SUBROUTINE bgrat(a,b,x,y,w,eps,ierr) C----------------------------------------------------------------------- C ASYMPTOTIC EXPANSION FOR IX(A,B) WHEN A IS LARGER THAN B. C THE RESULT OF THE EXPANSION IS ADDED TO W. IT IS ASSUMED C THAT A .GE. 15 AND B .LE. 1. EPS IS THE TOLERANCE USED. C IERR IS A VARIABLE THAT REPORTS THE STATUS OF THE RESULTS. C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a,b,eps,w,x,y INTEGER ierr C .. C .. Local Scalars .. DOUBLE PRECISION bm1,bp2n,cn,coef,dj,j,l,lnx,n2,nu,p,q,r,s,sum,t, + t2,u,v,z INTEGER i,n,nm1 C .. C .. Local Arrays .. DOUBLE PRECISION c(30),d(30) C .. C .. External Functions .. DOUBLE PRECISION algdiv,alnrel,gam1 EXTERNAL algdiv,alnrel,gam1 C .. C .. External Subroutines .. EXTERNAL grat1 C .. C .. Intrinsic Functions .. INTRINSIC abs,dlog,exp C .. C .. Executable Statements .. C bm1 = (b-0.5D0) - 0.5D0 nu = a + 0.5D0*bm1 IF (y.GT.0.375D0) GO TO 10 lnx = alnrel(-y) GO TO 20 10 lnx = dlog(x) 20 z = -nu*lnx IF (b*z.EQ.0.0D0) GO TO 70 C C COMPUTATION OF THE EXPANSION C SET R = EXP(-Z)*Z**B/GAMMA(B) C r = b* (1.0D0+gam1(b))*exp(b*dlog(z)) r = r*exp(a*lnx)*exp(0.5D0*bm1*lnx) u = algdiv(b,a) + b*dlog(nu) u = r*exp(-u) IF (u.EQ.0.0D0) GO TO 70 CALL grat1(b,z,r,p,q,eps) C v = 0.25D0* (1.0D0/nu)**2 t2 = 0.25D0*lnx*lnx l = w/u j = q/r sum = j t = 1.0D0 cn = 1.0D0 n2 = 0.0D0 DO 50 n = 1,30 bp2n = b + n2 j = (bp2n* (bp2n+1.0D0)*j+ (z+bp2n+1.0D0)*t)*v n2 = n2 + 2.0D0 t = t*t2 cn = cn/ (n2* (n2+1.0D0)) c(n) = cn s = 0.0D0 IF (n.EQ.1) GO TO 40 nm1 = n - 1 coef = b - n DO 30 i = 1,nm1 s = s + coef*c(i)*d(n-i) coef = coef + b 30 CONTINUE 40 d(n) = bm1*cn + s/n dj = d(n)*j sum = sum + dj IF (sum.LE.0.0D0) GO TO 70 IF (abs(dj).LE.eps* (sum+l)) GO TO 60 50 CONTINUE C C ADD THE RESULTS TO W C 60 ierr = 0 w = w + u*sum RETURN C C THE EXPANSION CANNOT BE COMPUTED C 70 ierr = 1 RETURN END DOUBLE PRECISION FUNCTION bpser(a,b,x,eps) C----------------------------------------------------------------------- C POWER SERIES EXPANSION FOR EVALUATING IX(A,B) WHEN B .LE. 1 C OR B*X .LE. 0.7. EPS IS THE TOLERANCE USED. C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a,b,eps,x C .. C .. Local Scalars .. DOUBLE PRECISION a0,apb,b0,c,n,sum,t,tol,u,w,z INTEGER i,m C .. C .. External Functions .. DOUBLE PRECISION algdiv,betaln,gam1,gamln1 EXTERNAL algdiv,betaln,gam1,gamln1 C .. C .. Intrinsic Functions .. INTRINSIC abs,dble,dlog,dmax1,dmin1,exp C .. C .. Executable Statements .. C bpser = 0.0D0 IF (x.EQ.0.0D0) RETURN C----------------------------------------------------------------------- C COMPUTE THE FACTOR X**A/(A*BETA(A,B)) C----------------------------------------------------------------------- a0 = dmin1(a,b) IF (a0.LT.1.0D0) GO TO 10 z = a*dlog(x) - betaln(a,b) bpser = exp(z)/a GO TO 100 10 b0 = dmax1(a,b) IF (b0.GE.8.0D0) GO TO 90 IF (b0.GT.1.0D0) GO TO 40 C C PROCEDURE FOR A0 .LT. 1 AND B0 .LE. 1 C bpser = x**a IF (bpser.EQ.0.0D0) RETURN C apb = a + b IF (apb.GT.1.0D0) GO TO 20 z = 1.0D0 + gam1(apb) GO TO 30 20 u = dble(a) + dble(b) - 1.D0 z = (1.0D0+gam1(u))/apb C 30 c = (1.0D0+gam1(a))* (1.0D0+gam1(b))/z bpser = bpser*c* (b/apb) GO TO 100 C C PROCEDURE FOR A0 .LT. 1 AND 1 .LT. B0 .LT. 8 C 40 u = gamln1(a0) m = b0 - 1.0D0 IF (m.LT.1) GO TO 60 c = 1.0D0 DO 50 i = 1,m b0 = b0 - 1.0D0 c = c* (b0/ (a0+b0)) 50 CONTINUE u = dlog(c) + u C 60 z = a*dlog(x) - u b0 = b0 - 1.0D0 apb = a0 + b0 IF (apb.GT.1.0D0) GO TO 70 t = 1.0D0 + gam1(apb) GO TO 80 70 u = dble(a0) + dble(b0) - 1.D0 t = (1.0D0+gam1(u))/apb 80 bpser = exp(z)* (a0/a)* (1.0D0+gam1(b0))/t GO TO 100 C C PROCEDURE FOR A0 .LT. 1 AND B0 .GE. 8 C 90 u = gamln1(a0) + algdiv(a0,b0) z = a*dlog(x) - u bpser = (a0/a)*exp(z) 100 IF (bpser.EQ.0.0D0 .OR. a.LE.0.1D0*eps) RETURN C----------------------------------------------------------------------- C COMPUTE THE SERIES C----------------------------------------------------------------------- sum = 0.0D0 n = 0.0D0 c = 1.0D0 tol = eps/a 110 n = n + 1.0D0 c = c* (0.5D0+ (0.5D0-b/n))*x w = c/ (a+n) sum = sum + w IF (abs(w).GT.tol) GO TO 110 bpser = bpser* (1.0D0+a*sum) RETURN END SUBROUTINE bratio(a,b,x,y,w,w1,ierr) C----------------------------------------------------------------------- C C EVALUATION OF THE INCOMPLETE BETA FUNCTION IX(A,B) C C -------------------- C C IT IS ASSUMED THAT A AND B ARE NONNEGATIVE, AND THAT X .LE. 1 C AND Y = 1 - X. BRATIO ASSIGNS W AND W1 THE VALUES C C W = IX(A,B) C W1 = 1 - IX(A,B) C C IERR IS A VARIABLE THAT REPORTS THE STATUS OF THE RESULTS. C IF NO INPUT ERRORS ARE DETECTED THEN IERR IS SET TO 0 AND C W AND W1 ARE COMPUTED. OTHERWISE, IF AN ERROR IS DETECTED, C THEN W AND W1 ARE ASSIGNED THE VALUE 0 AND IERR IS SET TO C ONE OF THE FOLLOWING VALUES ... C C IERR = 1 IF A OR B IS NEGATIVE C IERR = 2 IF A = B = 0 C IERR = 3 IF X .LT. 0 OR X .GT. 1 C IERR = 4 IF Y .LT. 0 OR Y .GT. 1 C IERR = 5 IF X + Y .NE. 1 C IERR = 6 IF X = A = 0 C IERR = 7 IF Y = B = 0 C C-------------------- C WRITTEN BY ALFRED H. MORRIS, JR. C NAVAL SURFACE WARFARE CENTER C DAHLGREN, VIRGINIA C REVISED ... NOV 1991 C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a,b,w,w1,x,y INTEGER ierr C .. C .. Local Scalars .. DOUBLE PRECISION a0,b0,eps,lambda,t,x0,y0,z INTEGER ierr1,ind,n C .. C .. External Functions .. DOUBLE PRECISION apser,basym,bfrac,bpser,bup,fpser,spmpar EXTERNAL apser,basym,bfrac,bpser,bup,fpser,spmpar C .. C .. External Subroutines .. EXTERNAL bgrat C .. C .. Intrinsic Functions .. INTRINSIC abs,dmax1,dmin1 C .. C .. Executable Statements .. C----------------------------------------------------------------------- C C ****** EPS IS A MACHINE DEPENDENT CONSTANT. EPS IS THE SMALLEST C FLOATING POINT NUMBER FOR WHICH 1.0 + EPS .GT. 1.0 C eps = spmpar(1) C C----------------------------------------------------------------------- w = 0.0D0 w1 = 0.0D0 IF (a.LT.0.0D0 .OR. b.LT.0.0D0) GO TO 270 IF (a.EQ.0.0D0 .AND. b.EQ.0.0D0) GO TO 280 IF (x.LT.0.0D0 .OR. x.GT.1.0D0) GO TO 290 IF (y.LT.0.0D0 .OR. y.GT.1.0D0) GO TO 300 z = ((x+y)-0.5D0) - 0.5D0 IF (abs(z).GT.3.0D0*eps) GO TO 310 C ierr = 0 IF (x.EQ.0.0D0) GO TO 210 IF (y.EQ.0.0D0) GO TO 230 IF (a.EQ.0.0D0) GO TO 240 IF (b.EQ.0.0D0) GO TO 220 C eps = dmax1(eps,1.D-15) IF (dmax1(a,b).LT.1.D-3*eps) GO TO 260 C ind = 0 a0 = a b0 = b x0 = x y0 = y IF (dmin1(a0,b0).GT.1.0D0) GO TO 40 C C PROCEDURE FOR A0 .LE. 1 OR B0 .LE. 1 C IF (x.LE.0.5D0) GO TO 10 ind = 1 a0 = b b0 = a x0 = y y0 = x C 10 IF (b0.LT.dmin1(eps,eps*a0)) GO TO 90 IF (a0.LT.dmin1(eps,eps*b0) .AND. b0*x0.LE.1.0D0) GO TO 100 IF (dmax1(a0,b0).GT.1.0D0) GO TO 20 IF (a0.GE.dmin1(0.2D0,b0)) GO TO 110 IF (x0**a0.LE.0.9D0) GO TO 110 IF (x0.GE.0.3D0) GO TO 120 n = 20 GO TO 140 C 20 IF (b0.LE.1.0D0) GO TO 110 IF (x0.GE.0.3D0) GO TO 120 IF (x0.GE.0.1D0) GO TO 30 IF ((x0*b0)**a0.LE.0.7D0) GO TO 110 30 IF (b0.GT.15.0D0) GO TO 150 n = 20 GO TO 140 C C PROCEDURE FOR A0 .GT. 1 AND B0 .GT. 1 C 40 IF (a.GT.b) GO TO 50 lambda = a - (a+b)*x GO TO 60 50 lambda = (a+b)*y - b 60 IF (lambda.GE.0.0D0) GO TO 70 ind = 1 a0 = b b0 = a x0 = y y0 = x lambda = abs(lambda) C 70 IF (b0.LT.40.0D0 .AND. b0*x0.LE.0.7D0) GO TO 110 IF (b0.LT.40.0D0) GO TO 160 IF (a0.GT.b0) GO TO 80 IF (a0.LE.100.0D0) GO TO 130 IF (lambda.GT.0.03D0*a0) GO TO 130 GO TO 200 80 IF (b0.LE.100.0D0) GO TO 130 IF (lambda.GT.0.03D0*b0) GO TO 130 GO TO 200 C C EVALUATION OF THE APPROPRIATE ALGORITHM C 90 w = fpser(a0,b0,x0,eps) w1 = 0.5D0 + (0.5D0-w) GO TO 250 C 100 w1 = apser(a0,b0,x0,eps) w = 0.5D0 + (0.5D0-w1) GO TO 250 C 110 w = bpser(a0,b0,x0,eps) w1 = 0.5D0 + (0.5D0-w) GO TO 250 C 120 w1 = bpser(b0,a0,y0,eps) w = 0.5D0 + (0.5D0-w1) GO TO 250 C 130 w = bfrac(a0,b0,x0,y0,lambda,15.0D0*eps) w1 = 0.5D0 + (0.5D0-w) GO TO 250 C 140 w1 = bup(b0,a0,y0,x0,n,eps) b0 = b0 + n 150 CALL bgrat(b0,a0,y0,x0,w1,15.0D0*eps,ierr1) w = 0.5D0 + (0.5D0-w1) GO TO 250 C 160 n = b0 b0 = b0 - n IF (b0.NE.0.0D0) GO TO 170 n = n - 1 b0 = 1.0D0 170 w = bup(b0,a0,y0,x0,n,eps) IF (x0.GT.0.7D0) GO TO 180 w = w + bpser(a0,b0,x0,eps) w1 = 0.5D0 + (0.5D0-w) GO TO 250 C 180 IF (a0.GT.15.0D0) GO TO 190 n = 20 w = w + bup(a0,b0,x0,y0,n,eps) a0 = a0 + n 190 CALL bgrat(a0,b0,x0,y0,w,15.0D0*eps,ierr1) w1 = 0.5D0 + (0.5D0-w) GO TO 250 C 200 w = basym(a0,b0,lambda,100.0D0*eps) w1 = 0.5D0 + (0.5D0-w) GO TO 250 C C TERMINATION OF THE PROCEDURE C 210 IF (a.EQ.0.0D0) GO TO 320 220 w = 0.0D0 w1 = 1.0D0 RETURN C 230 IF (b.EQ.0.0D0) GO TO 330 240 w = 1.0D0 w1 = 0.0D0 RETURN C 250 IF (ind.EQ.0) RETURN t = w w = w1 w1 = t RETURN C C PROCEDURE FOR A AND B .LT. 1.E-3*EPS C 260 w = b/ (a+b) w1 = a/ (a+b) RETURN C C ERROR RETURN C 270 ierr = 1 RETURN 280 ierr = 2 RETURN 290 ierr = 3 RETURN 300 ierr = 4 RETURN 310 ierr = 5 RETURN 320 ierr = 6 RETURN 330 ierr = 7 RETURN END DOUBLE PRECISION FUNCTION brcmp1(mu,a,b,x,y) C----------------------------------------------------------------------- C EVALUATION OF EXP(MU) * (X**A*Y**B/BETA(A,B)) C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a,b,x,y INTEGER mu C .. C .. Local Scalars .. DOUBLE PRECISION a0,apb,b0,c,const,e,h,lambda,lnx,lny,t,u,v,x0,y0, + z INTEGER i,n C .. C .. External Functions .. DOUBLE PRECISION algdiv,alnrel,bcorr,betaln,esum,gam1,gamln1,rlog1 EXTERNAL algdiv,alnrel,bcorr,betaln,esum,gam1,gamln1,rlog1 C .. C .. Intrinsic Functions .. INTRINSIC abs,dble,dlog,dmax1,dmin1,exp,sqrt C .. C .. Data statements .. C----------------- C CONST = 1/SQRT(2*PI) C----------------- DATA const/.398942280401433D0/ C .. C .. Executable Statements .. C a0 = dmin1(a,b) IF (a0.GE.8.0D0) GO TO 130 C IF (x.GT.0.375D0) GO TO 10 lnx = dlog(x) lny = alnrel(-x) GO TO 30 10 IF (y.GT.0.375D0) GO TO 20 lnx = alnrel(-y) lny = dlog(y) GO TO 30 20 lnx = dlog(x) lny = dlog(y) C 30 z = a*lnx + b*lny IF (a0.LT.1.0D0) GO TO 40 z = z - betaln(a,b) brcmp1 = esum(mu,z) RETURN C----------------------------------------------------------------------- C PROCEDURE FOR A .LT. 1 OR B .LT. 1 C----------------------------------------------------------------------- 40 b0 = dmax1(a,b) IF (b0.GE.8.0D0) GO TO 120 IF (b0.GT.1.0D0) GO TO 70 C C ALGORITHM FOR B0 .LE. 1 C brcmp1 = esum(mu,z) IF (brcmp1.EQ.0.0D0) RETURN C apb = a + b IF (apb.GT.1.0D0) GO TO 50 z = 1.0D0 + gam1(apb) GO TO 60 50 u = dble(a) + dble(b) - 1.D0 z = (1.0D0+gam1(u))/apb C 60 c = (1.0D0+gam1(a))* (1.0D0+gam1(b))/z brcmp1 = brcmp1* (a0*c)/ (1.0D0+a0/b0) RETURN C C ALGORITHM FOR 1 .LT. B0 .LT. 8 C 70 u = gamln1(a0) n = b0 - 1.0D0 IF (n.LT.1) GO TO 90 c = 1.0D0 DO 80 i = 1,n b0 = b0 - 1.0D0 c = c* (b0/ (a0+b0)) 80 CONTINUE u = dlog(c) + u C 90 z = z - u b0 = b0 - 1.0D0 apb = a0 + b0 IF (apb.GT.1.0D0) GO TO 100 t = 1.0D0 + gam1(apb) GO TO 110 100 u = dble(a0) + dble(b0) - 1.D0 t = (1.0D0+gam1(u))/apb 110 brcmp1 = a0*esum(mu,z)* (1.0D0+gam1(b0))/t RETURN C C ALGORITHM FOR B0 .GE. 8 C 120 u = gamln1(a0) + algdiv(a0,b0) brcmp1 = a0*esum(mu,z-u) RETURN C----------------------------------------------------------------------- C PROCEDURE FOR A .GE. 8 AND B .GE. 8 C----------------------------------------------------------------------- 130 IF (a.GT.b) GO TO 140 h = a/b x0 = h/ (1.0D0+h) y0 = 1.0D0/ (1.0D0+h) lambda = a - (a+b)*x GO TO 150 140 h = b/a x0 = 1.0D0/ (1.0D0+h) y0 = h/ (1.0D0+h) lambda = (a+b)*y - b C 150 e = -lambda/a IF (abs(e).GT.0.6D0) GO TO 160 u = rlog1(e) GO TO 170 160 u = e - dlog(x/x0) C 170 e = lambda/b IF (abs(e).GT.0.6D0) GO TO 180 v = rlog1(e) GO TO 190 180 v = e - dlog(y/y0) C 190 z = esum(mu,- (a*u+b*v)) brcmp1 = const*sqrt(b*x0)*z*exp(-bcorr(a,b)) RETURN END DOUBLE PRECISION FUNCTION brcomp(a,b,x,y) C----------------------------------------------------------------------- C EVALUATION OF X**A*Y**B/BETA(A,B) C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a,b,x,y C .. C .. Local Scalars .. DOUBLE PRECISION a0,apb,b0,c,const,e,h,lambda,lnx,lny,t,u,v,x0,y0, + z INTEGER i,n C .. C .. External Functions .. DOUBLE PRECISION algdiv,alnrel,bcorr,betaln,gam1,gamln1,rlog1 EXTERNAL algdiv,alnrel,bcorr,betaln,gam1,gamln1,rlog1 C .. C .. Intrinsic Functions .. INTRINSIC abs,dble,dlog,dmax1,dmin1,exp,sqrt C .. C .. Data statements .. C----------------- C CONST = 1/SQRT(2*PI) C----------------- DATA const/.398942280401433D0/ C .. C .. Executable Statements .. C brcomp = 0.0D0 IF (x.EQ.0.0D0 .OR. y.EQ.0.0D0) RETURN a0 = dmin1(a,b) IF (a0.GE.8.0D0) GO TO 130 C IF (x.GT.0.375D0) GO TO 10 lnx = dlog(x) lny = alnrel(-x) GO TO 30 10 IF (y.GT.0.375D0) GO TO 20 lnx = alnrel(-y) lny = dlog(y) GO TO 30 20 lnx = dlog(x) lny = dlog(y) C 30 z = a*lnx + b*lny IF (a0.LT.1.0D0) GO TO 40 z = z - betaln(a,b) brcomp = exp(z) RETURN C----------------------------------------------------------------------- C PROCEDURE FOR A .LT. 1 OR B .LT. 1 C----------------------------------------------------------------------- 40 b0 = dmax1(a,b) IF (b0.GE.8.0D0) GO TO 120 IF (b0.GT.1.0D0) GO TO 70 C C ALGORITHM FOR B0 .LE. 1 C brcomp = exp(z) IF (brcomp.EQ.0.0D0) RETURN C apb = a + b IF (apb.GT.1.0D0) GO TO 50 z = 1.0D0 + gam1(apb) GO TO 60 50 u = dble(a) + dble(b) - 1.D0 z = (1.0D0+gam1(u))/apb C 60 c = (1.0D0+gam1(a))* (1.0D0+gam1(b))/z brcomp = brcomp* (a0*c)/ (1.0D0+a0/b0) RETURN C C ALGORITHM FOR 1 .LT. B0 .LT. 8 C 70 u = gamln1(a0) n = b0 - 1.0D0 IF (n.LT.1) GO TO 90 c = 1.0D0 DO 80 i = 1,n b0 = b0 - 1.0D0 c = c* (b0/ (a0+b0)) 80 CONTINUE u = dlog(c) + u C 90 z = z - u b0 = b0 - 1.0D0 apb = a0 + b0 IF (apb.GT.1.0D0) GO TO 100 t = 1.0D0 + gam1(apb) GO TO 110 100 u = dble(a0) + dble(b0) - 1.D0 t = (1.0D0+gam1(u))/apb 110 brcomp = a0*exp(z)* (1.0D0+gam1(b0))/t RETURN C C ALGORITHM FOR B0 .GE. 8 C 120 u = gamln1(a0) + algdiv(a0,b0) brcomp = a0*exp(z-u) RETURN C----------------------------------------------------------------------- C PROCEDURE FOR A .GE. 8 AND B .GE. 8 C----------------------------------------------------------------------- 130 IF (a.GT.b) GO TO 140 h = a/b x0 = h/ (1.0D0+h) y0 = 1.0D0/ (1.0D0+h) lambda = a - (a+b)*x GO TO 150 140 h = b/a x0 = 1.0D0/ (1.0D0+h) y0 = h/ (1.0D0+h) lambda = (a+b)*y - b C 150 e = -lambda/a IF (abs(e).GT.0.6D0) GO TO 160 u = rlog1(e) GO TO 170 160 u = e - dlog(x/x0) C 170 e = lambda/b IF (abs(e).GT.0.6D0) GO TO 180 v = rlog1(e) GO TO 190 180 v = e - dlog(y/y0) C 190 z = exp(- (a*u+b*v)) brcomp = const*sqrt(b*x0)*z*exp(-bcorr(a,b)) RETURN END DOUBLE PRECISION FUNCTION bup(a,b,x,y,n,eps) C----------------------------------------------------------------------- C EVALUATION OF IX(A,B) - IX(A+N,B) WHERE N IS A POSITIVE INTEGER. C EPS IS THE TOLERANCE USED. C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a,b,eps,x,y INTEGER n C .. C .. Local Scalars .. DOUBLE PRECISION ap1,apb,d,l,r,t,w INTEGER i,k,kp1,mu,nm1 C .. C .. External Functions .. DOUBLE PRECISION brcmp1,exparg EXTERNAL brcmp1,exparg C .. C .. Intrinsic Functions .. INTRINSIC abs,exp C .. C .. Executable Statements .. C C OBTAIN THE SCALING FACTOR EXP(-MU) AND C EXP(MU)*(X**A*Y**B/BETA(A,B))/A C apb = a + b ap1 = a + 1.0D0 mu = 0 d = 1.0D0 IF (n.EQ.1 .OR. a.LT.1.0D0) GO TO 10 IF (apb.LT.1.1D0*ap1) GO TO 10 mu = abs(exparg(1)) k = exparg(0) IF (k.LT.mu) mu = k t = mu d = exp(-t) C 10 bup = brcmp1(mu,a,b,x,y)/a IF (n.EQ.1 .OR. bup.EQ.0.0D0) RETURN nm1 = n - 1 w = d C C LET K BE THE INDEX OF THE MAXIMUM TERM C k = 0 IF (b.LE.1.0D0) GO TO 50 IF (y.GT.1.D-4) GO TO 20 k = nm1 GO TO 30 20 r = (b-1.0D0)*x/y - a IF (r.LT.1.0D0) GO TO 50 k = nm1 t = nm1 IF (r.LT.t) k = r C C ADD THE INCREASING TERMS OF THE SERIES C 30 DO 40 i = 1,k l = i - 1 d = ((apb+l)/ (ap1+l))*x*d w = w + d 40 CONTINUE IF (k.EQ.nm1) GO TO 70 C C ADD THE REMAINING TERMS OF THE SERIES C 50 kp1 = k + 1 DO 60 i = kp1,nm1 l = i - 1 d = ((apb+l)/ (ap1+l))*x*d w = w + d IF (d.LE.eps*w) GO TO 70 60 CONTINUE C C TERMINATE THE PROCEDURE C 70 bup = bup*w RETURN END DOUBLE PRECISION FUNCTION cenlf(w,k) C********************************************************************** C C DOUBLE PRECISION FUNCTION CENLF(W) C CENtral part of the Log F density C C Returns Ninth Degree Taylor's series expansion of C W - (1+K) * LOG( 1 + (EXP(W)-1) / (1+K) ) C C Is called only for K < 1 and W <= 0.1 C C C********************************************************************** IMPLICIT DOUBLE PRECISION (a-h,o-p,r-z),INTEGER (i-n),LOGICAL (q) C C .. Scalar Arguments .. DOUBLE PRECISION k,w C .. C .. Local Scalars .. DOUBLE PRECISION denom,numer INTEGER i,icoef,idnum C .. C .. Local Arrays .. DOUBLE PRECISION coef(9),mult(3:9),numcof(7,3:9) C .. C .. External Functions .. DOUBLE PRECISION devlpl EXTERNAL devlpl C .. C .. Save statement .. DOUBLE PRECISION kold SAVE coef,kold C .. C .. Data statements .. DATA kold/-1.0D0/ DATA mult/0.5D0,0.16666666666666666667D0, + 0.41666666666666666667D-1,0.83333333333333333333D-2, + 0.13888888888888888889D-2,0.19841269841269841270D-3, + 0.24801587301587301587D-4/ DATA (numcof(i,3),i=1,7)/1.0D0,6*0.0D0/ DATA (numcof(i,4),i=1,7)/-1.0D0,1.0D0,5*0.0D0/ DATA (numcof(i,5),i=1,7)/1.0D0,-4.0D0,1.0D0,4*0.0D0/ DATA (numcof(i,6),i=1,7)/-1.0D0,11.0D0,-11.0D0,1.0D0,3*0.0D0/ DATA (numcof(i,7),i=1,7)/1.0D0,-26.0D0,66.0D0,-26.0D0,1.0D0, + 2*0.0D0/ DATA (numcof(i,8),i=1,7)/-1.0D0,57.0D0,-302.0D0,302.0D0,-57.0D0, + 1.0D0,0.0D0/ DATA (numcof(i,9),i=1,7)/1.0D0,-120.0D0,1191.0D0,-2416.0D0, + 1191.0D0,-120.0D0,1.0D0/ C .. C .. Executable Statements .. C C C If K changes, set up coefficients for new K C IF (kold.NE.k) THEN kold = k DO 10,i = 1,2 coef(i) = 0.0D0 10 CONTINUE denom = 1.0D0 DO 20,icoef = 3,9 idnum = icoef - 2 numer = -mult(icoef)*k*devlpl(numcof(1,icoef),idnum,k) denom = denom* (1.0D0+k) coef(icoef) = numer/denom 20 CONTINUE END IF C C Calculate CENLF C cenlf = devlpl(coef,9,w) RETURN END DOUBLE PRECISION FUNCTION dbetrm(a,b) C********************************************************************** C C DOUBLE PRECISION FUNCTION DBETRM( A, B ) C Double Precision Sterling Remainder for Complete C Beta Function C C C Function C C C Log(Beta(A,B)) = Lgamma(A) + Lgamma(B) - Lgamma(A+B) C where Lgamma is the log of the (complete) gamma function C C Let ZZ be approximation obtained if each log gamma is approximated C by Sterling's formula, i.e., C Sterling(Z) = LOG( SQRT( 2*PI ) ) + ( Z-0.5 ) * LOG( Z ) - Z C C Returns Log(Beta(A,B)) - ZZ C C C Arguments C C C A --> One argument of the Beta C DOUBLE PRECISION A C C B --> The other argument of the Beta C DOUBLE PRECISION B C C********************************************************************** C .. Parameters .. DOUBLE PRECISION hln2pi PARAMETER (hln2pi=0.91893853320467274178D0) C .. C .. Scalar Arguments .. DOUBLE PRECISION a,b C .. C .. External Functions .. DOUBLE PRECISION dstrem EXTERNAL dstrem C .. C .. Intrinsic Functions .. INTRINSIC max,min C .. C .. Executable Statements .. C Try to sum from smallest to largest dbetrm = -dstrem(a+b) dbetrm = dbetrm + dstrem(max(a,b)) dbetrm = dbetrm + dstrem(min(a,b)) dbetrm = dbetrm + hln2pi RETURN END DOUBLE PRECISION FUNCTION devlpl(a,n,x) C C********************************************************************** C C DOUBLE PRECISION FUNCTION DEVLPL(A,N,X) C Double precision EVALuate a PoLynomial at X C C C Function C C C returns C A(1) + A(2)*X + ... + A(N)*X**(N-1) C C C Arguments C C C A --> Array of coefficients of the polynomial. C A is DOUBLE PRECISION(N) C C N --> Length of A, also degree of polynomial - 1. C N is INTEGER C C X --> Point at which the polynomial is to be evaluated. C X is DOUBLE PRECISION C C********************************************************************** C C .. Scalar Arguments .. DOUBLE PRECISION x INTEGER n C .. C .. Array Arguments .. DOUBLE PRECISION a(n) C .. C .. Local Scalars .. DOUBLE PRECISION term INTEGER i C .. C .. Executable Statements .. term = a(n) DO 10,i = n - 1,1,-1 term = a(i) + term*x 10 CONTINUE devlpl = term RETURN END DOUBLE PRECISION FUNCTION dexp1(x) C********************************************************************** C C DOUBLE PRECISION FUNCTION dexp1(x) C Evaluation of the function EXP(X) with no overflow C C C Arguments C C C X --> Argument at which exp(x) desired C DOUBLE PRECISION X C C C Method C C C If Exp(x) > largest double precision value for machine then dexp1 C returns the largest double precision value for the machine; C otherwise it returns exp(x) C C********************************************************************** C .. Scalar Arguments .. DOUBLE PRECISION x C .. C .. Local Scalars .. DOUBLE PRECISION max,logmax C .. C .. External Functions .. DOUBLE PRECISION spmpar EXTERNAL spmpar C .. C .. Intrinsic Functions .. INTRINSIC exp,dlog C .. C .. Save statements .. SAVE max,logmax C .. C .. Data statements .. DATA max/0.0d0/,logmax/0.0d0/ C .. C .. Executable Statements .. IF (.NOT. (max.EQ.0.0d0)) GO TO 10 max = spmpar(3) logmax = dlog(max) 10 IF (.NOT. (x.GT.logmax)) GO TO 20 dexp1 = max GO TO 30 C 20 dexp1 = exp(x) C 30 RETURN END DOUBLE PRECISION FUNCTION dexpm1(x) C********************************************************************** C C DOUBLE PRECISION FUNCTION dexpm1(x) C Evaluation of the function EXP(X) - 1 C C C Arguments C C C X --> Argument at which exp(x)-1 desired C DOUBLE PRECISION X C C C Method C C C Renaming of function rexp from code of: C C DiDinato, A. R. and Morris, A. H. Algorithm 708: Significant C Digit Computation of the Incomplete Beta Function Ratios. ACM C Trans. Math. Softw. 18 (1993), 360-373. C C********************************************************************** C .. Scalar Arguments .. DOUBLE PRECISION x C .. C .. Local Scalars .. DOUBLE PRECISION p1,p2,q1,q2,q3,q4,w C .. C .. Intrinsic Functions .. INTRINSIC abs,exp C .. C .. Data statements .. DATA p1/.914041914819518D-09/,p2/.238082361044469D-01/, + q1/-.499999999085958D+00/,q2/.107141568980644D+00/, + q3/-.119041179760821D-01/,q4/.595130811860248D-03/ C .. C .. Executable Statements .. C IF (abs(x).GT.0.15D0) GO TO 10 dexpm1 = x* (((p2*x+p1)*x+1.0D0)/ + ((((q4*x+q3)*x+q2)*x+q1)*x+1.0D0)) RETURN C 10 w = exp(x) IF (x.GT.0.0D0) GO TO 20 dexpm1 = (w-0.5D0) - 0.5D0 RETURN 20 dexpm1 = w* (0.5D0+ (0.5D0-1.0D0/w)) RETURN END SUBROUTINE dextr(a,b,x,y,d1,d2) C-------------------------------------------------------------------- C C Calculates first and second derivatives of the log of C 1 + A*[(1-A)(2-A)...(j-B)*X^j]/[j!(A+j)] j=1,2,... C This is the summation part of the extreme value formula C G(A,B)*[(X^B)/B]*SUM C which can be used to calculate IX(A,B). C C-------------------------------------------------------------------- C .. Parameters .. DOUBLE PRECISION zero PARAMETER (zero=0.0D0) DOUBLE PRECISION one PARAMETER (one=1.0D0) DOUBLE PRECISION two PARAMETER (two=2.0D0) DOUBLE PRECISION tiny PARAMETER (tiny=1.0D-13) C .. C .. Scalar Arguments .. DOUBLE PRECISION a,b,x,y,d1,d2 C .. C .. Local Scalars .. DOUBLE PRECISION xd1,xd2,xnma,xnpb,term,termd1,termd2,termo, + trmd1o,trmd2o,sum,sumt,sumd1,sumd1t,sumd2,sumd2t, + temp,xn,rat,rat1,rat2 LOGICAL qdone C .. C .. Intrinsic Functions .. INTRINSIC abs C .. C .. Executable Statements .. C C initialize variables C C qdone = .FALSE. xnma = one - a xnpb = one + b xd1 = -x*y xd2 = xd1* (two*x-one) term = xnma*x termd1 = xnma*xd1 termd2 = xnma*xd2 sum = zero sumd1 = zero sumd2 = zero xn = one C C Compute sum C GO TO 20 10 IF (qdone .OR. (xn.GT.100D0)) GO TO 90 20 sumt = term/xnpb sum = sum + sumt sumd1t = termd1/xnpb sumd1 = sumd1 + sumd1t sumd2t = termd2/xnpb sumd2 = sumd2 + sumd2t IF (.NOT. (sum.NE.zero)) GO TO 30 rat = abs(sumt/sum) GO TO 40 30 rat = one 40 IF (.NOT. (sumd1.NE.zero)) GO TO 50 rat1 = abs(sumd1t/sumd1) GO TO 60 50 rat1 = one 60 IF (.NOT. (sumd2.NE.zero)) GO TO 70 rat2 = abs(sumd2t/sumd2) GO TO 80 70 rat2 = one 80 qdone = (((rat.LE.tiny).OR. (sumt.EQ.zero)) .AND. + ((rat1.LE.tiny).OR. (sumd1t.EQ.zero)) .AND. + ((rat2.LE.tiny).OR. (sumd2t.EQ.zero))) IF (.NOT.qdone) THEN xn = xn + one xnma = one + xnma xnpb = one + xnpb termo = term trmd1o = termd1 trmd2o = termd2 temp = xnma/xn term = temp*termo*x termd1 = temp* (termo*xd1+trmd1o*x) termd2 = temp* (termo*xd2+two*trmd1o*xd1+trmd2o*x) END IF GO TO 10 90 temp = b/ (one+b*sum) d1 = sumd1*temp d2 = sumd2*temp - (d1*d1) RETURN END SUBROUTINE dlasym(a,b,x,y,lambda,eps,d1,d2) C----------------------------------------------------------------------- C C CALCULATES D1 AND D2 THE FIRST AND SECOND DERIATIVES C OF LOG(IX(A,B)) USING ASYMPTOTIC EXPANSION FOR LARGE A AND B. C LAMBDA = (A + B)*Y - B AND EPS IS THE TOLERANCE USED. C IT IS ASSUMED THAT LAMBDA IS NONNEGATIVE AND THAT C A AND B ARE GREATER THAN OR EQUAL TO 15. C C Derivatives were taken from LASYM which is a modification of C BASYM from: C DiDinato, A. R. and Morris, A. H. Algorithm 708: Significant C Digit Computation of the Incomplete Beta Function Ratios. ACM C Trans. Math. Softw. 18 (1993), 360-373. C C----------------------------------------------------------------------- C C .. Scalar Arguments .. DOUBLE PRECISION a,b,x,y,eps,lambda,d1,d2 C .. C .. Local Scalars .. DOUBLE PRECISION bsum,dsum,e0,e1,e2,f,h,h2,hn,j0,j1,r,r0,r1,s,sum, + t0,t1,w,w0,z,z0,z2,zn,znm1,lambd1,lambd2,fd1,fd2, + j0d1,j0d2,znd1,znd2,znm1d1,znm1d2,j1d1,j1d2,t0d1, + t0d2,t1d1,t1d2,sumd1,sumd2,lambb,lamba,z12,z32, + zno,znd1o,znd2o,zn1o,zn1d1o,zn1d2o,temp INTEGER i,im1,imj,j,m,mm1,mmj,n,np1,num C .. C .. Local Arrays .. DOUBLE PRECISION a0(21),b0(21),c(21),d(21) C .. C .. External Functions .. DOUBLE PRECISION bcorr,erfc1,rlog1 EXTERNAL bcorr,erfc1,rlog1 C .. C .. Intrinsic Functions .. INTRINSIC abs,sqrt,log C .. C .. Data statements .. C------------------------ C ****** NUM IS THE MAXIMUM VALUE THAT N CAN TAKE IN THE DO LOOP C ENDING AT STATEMENT 50. IT IS REQUIRED THAT NUM BE EVEN. C THE ARRAYS A0, B0, C, D HAVE DIMENSION NUM + 1. C C------------------------ C E0 = 2/SQRT(PI) C E1 = 2**(-3/2) C E2 = 1/SQRT(PI) C------------------------ DATA num/20/ DATA e0/1.12837916709551D0/,e1/.353553390593274D0/, + e2/0.5641895835477563D0/ C .. C .. Executable Statements .. C------------------------ IF (a.GE.b) GO TO 10 h = a/b r0 = 1.0D0/ (1.0D0+h) r1 = (b-a)/b w0 = 1.0D0/sqrt(a* (1.0D0+h)) GO TO 20 10 h = b/a r0 = 1.0D0/ (1.0D0+h) r1 = (b-a)/a w0 = 1.0D0/sqrt(b* (1.0D0+h)) C 20 lambd1 = (a+b)*x*y lambd2 = lambd1* (2.0d0*x-1.0d0) lambb = 1.0d0/ (1.0d0+ (lambda/b)) lamba = 1.0d0/ (0.5d0+ (0.5d0-lambda/a)) temp = lamba - lambb f = a*rlog1(-lambda/a) + b*rlog1(lambda/b) fd1 = lambd1*temp fd2 = lambd2*temp + (lambd1**2.0d0)* + (((lamba**2.0d0)/a)+ ((lambb**2.0d0)/b)) z0 = sqrt(f) z = 0.5D0* (z0/e1) z2 = f + f z12 = 1.0d0/z0 z32 = z12/f C a0(1) = (2.0D0/3.0D0)*r1 c(1) = -0.5D0*a0(1) d(1) = -c(1) j0 = erfc1(1,z0) temp = (j0- (e2*z12)) j0d1 = fd1*temp j0d2 = fd1* (j0d1+ (e2*0.5d0*fd1*z32)) + fd2*temp j0 = (0.5d0/e0)*j0 j0d1 = (0.5d0/e0)*j0d1 j0d2 = (0.5d0/e0)*j0d2 j1 = e1 j1d1 = 0.0d0 j1d2 = 0.0d0 sum = j0 + d(1)*w0*j1 sumd1 = j0d1 sumd2 = j0d2 C s = 1.0D0 h2 = h*h hn = 1.0D0 w = w0 znm1 = z znm1d1 = fd1*0.25d0*z12/e1 znm1d2 = (0.25d0/e1)* (z12*fd2-0.5d0*z32*fd1*fd1) zn = z2 znd1 = 2.0d0*fd1 znd2 = 2.0d0*fd2 DO 70 n = 2,num,2 hn = h2*hn a0(n) = 2.0D0*r0* (1.0D0+h*hn)/ (n+2.0D0) np1 = n + 1 s = s + hn a0(np1) = 2.0D0*r1*s/ (n+3.0D0) C DO 60 i = n,np1 r = -0.5D0* (i+1.0D0) b0(1) = r*a0(1) DO 40 m = 2,i bsum = 0.0D0 mm1 = m - 1 DO 30 j = 1,mm1 mmj = m - j bsum = bsum + (j*r-mmj)*a0(j)*b0(mmj) 30 CONTINUE b0(m) = r*a0(m) + bsum/m 40 CONTINUE c(i) = b0(i)/ (i+1.0D0) C dsum = 0.0D0 im1 = i - 1 DO 50 j = 1,im1 imj = i - j dsum = dsum + d(imj)*c(j) 50 CONTINUE d(i) = - (dsum+c(i)) 60 CONTINUE C j0 = e1*znm1 + (n-1.0D0)*j0 j0d1 = e1*znm1d1 + (n-1.0d0)*j0d1 j0d2 = e1*znm1d2 + (n-1.0d0)*j0d2 j1 = e1*zn + n*j1 j1d1 = e1*znd1 + n*j1d1 j1d2 = e1*znd2 + n*j1d2 zn1o = znm1 zn1d1o = znm1d1 zn1d2o = znm1d2 znm1 = z2*zn1o znm1d1 = 2.0d0*f*zn1d1o + 2.0d0*zn1o*fd1 znm1d2 = 2.0d0*f*zn1d2o + 4.0d0*fd1*zn1d1o + 2.0d0*zn1o*fd2 zno = zn znd1o = znd1 znd2o = znd2 zn = z2*zno znd1 = 2.0d0*fd1*zno + 2.0d0*f*znd1o znd2 = 2.0d0*fd2*zno + 4.0d0*fd1*znd1o + 2.0d0*f*znd2o w = w0*w t0 = d(n)*w*j0 t0d1 = d(n)*w*j0d1 t0d2 = d(n)*w*j0d2 w = w0*w t1 = d(np1)*w*j1 t1d1 = d(np1)*w*j1d1 t1d2 = d(np1)*w*j1d2 sum = sum + (t0+t1) sumd1 = sumd1 + (t0d1+t1d1) sumd2 = sumd2 + (t0d2+t1d2) IF ((abs(t0+t1).LE.eps) .AND. (abs(t0d1+t1d1).LE.eps) .AND. + (abs(t0d2+t1d2).LE.eps)) GO TO 80 70 CONTINUE GO TO 90 C 80 d1 = -fd1 + (sumd1/sum) d2 = -fd2 + (sumd2/sum) - ((sumd1/sum)**2.0d0) RETURN 90 END SUBROUTINE dlfrac(a,b,x,y,lambda,eps,d1,d2) C----------------------------------------------------------------------- C C CALCULATES THE FIRST AND SECOND DERIATIVES OF LOG(IX(A,B)). C CONTINUED FRACTION EXPANSION FOR IX(A,B) WHEN A,B .GT. 1. C IT IS ASSUMED THAT LAMBDA = (A + B)*Y - B. C C Derivatives of code in LBFRAC were taken. LBFRAC is a C modification of BFRAC from: C DiDinato, A. R. and Morris, A. H. Algorithm 708: Significant C Digit Computation of the Incomplete Beta Function Ratios. ACM C Trans. Math. Softw. 18 (1993), 360-373. C C----------------------------------------------------------------------- C .. Parameters .. DOUBLE PRECISION otnten PARAMETER (otnten=1.0D-10) DOUBLE PRECISION otten PARAMETER (otten=1.0D10) C .. Scalar Arguments .. DOUBLE PRECISION a,b,eps,lambda,x,y,d1,d2 C .. C .. Local Scalars .. DOUBLE PRECISION alpha,an,anp1,beta,bn,bnp1,c,c0,c1,e,n,p,r,r0,s, + t,w,yp1,xd1,xd2,and1,and2,bnd1,bnd2,anp1d1, + anp1d2,bnp1d1,bnp1d2,rd1,rd2,anp1o,an1d1o,an1d2o, + bnp1o,bn1d1o,bn1d2o,temp,betad1,betad2,alpad1, + alpad2,rd10,rd20 C .. C .. Intrinsic Functions .. INTRINSIC abs C .. C .. Executable Statements .. C-------------------- C c = 1.0D0 + lambda c0 = b/a c1 = 1.0D0 + 1.0D0/a yp1 = y + 1.0D0 C xd1 = -x*y xd2 = xd1* (2.0d0*x-1.0d0) C n = 0.0D0 p = 1.0D0 s = a + 1.0D0 an = 0.0D0 and1 = 0.0d0 and2 = 0.0d0 bn = 1.0D0 bnd1 = 0.0d0 bnd2 = 0.0d0 anp1 = 1.0D0 anp1d1 = 0.0d0 anp1d2 = 0.0d0 bnp1 = c/c1 bnp1d1 = - (a+b)*xd1/c1 bnp1d2 = - (a+b)*xd2/c1 r = c1/c rd1 = (-r*bnp1d1+anp1d1)/bnp1 rd2 = (-r*bnp1d2-bnp1d1*rd1+anp1d2)/bnp1 - + bnp1d1* (-r*bnp1d1+anp1d1)/ (bnp1*bnp1) r0 = r rd10 = rd1 rd20 = rd2 C C CONTINUED FRACTION CALCULATION C 10 n = n + 1.0D0 t = n/a w = n* (b-n)*x e = a/s alpha = (p* (p+c0)*e*e)* (w*x) temp = 2.0d0* (p* (p+c0)*e*e)* (n* (b-n)) alpad1 = temp*x*xd1 alpad2 = temp* (x*xd2+xd1*xd1) e = (1.0D0+t)/ (c1+t+t) beta = n + w/s + e* (c+n*yp1) temp = n* (b-n)/s - e* (n+a+b) betad1 = temp*xd1 betad2 = temp*xd2 p = 1.0D0 + t s = s + 2.0D0 C C UPDATE AN, BN, ANP1, AND BNP1 C anp1o = anp1 an1d1o = anp1d1 an1d2o = anp1d2 anp1 = alpha*an + beta*anp1o anp1d1 = alpha*and1 + alpad1*an + beta*an1d1o + betad1*anp1o anp1d2 = alpha*and2 + 2.0d0*alpad1*and1 + alpad2*an + + beta*an1d2o + 2.0d0*betad1*an1d1o + betad2*anp1o an = anp1o and1 = an1d1o and2 = an1d2o C bnp1o = bnp1 bn1d1o = bnp1d1 bn1d2o = bnp1d2 bnp1 = alpha*bn + beta*bnp1o bnp1d1 = alpha*bnd1 + alpad1*bn + beta*bn1d1o + betad1*bnp1o bnp1d2 = alpha*bnd2 + 2.0d0*alpad1*bnd1 + alpad2*bn + + beta*bn1d2o + 2.0d0*betad1*bn1d1o + betad2*bnp1o bn = bnp1o bnd1 = bn1d1o bnd2 = bn1d2o C r = anp1/bnp1 rd1 = (-r*bnp1d1+anp1d1)/bnp1 rd2 = (-r*bnp1d2-bnp1d1*rd1+anp1d2)/bnp1 - + bnp1d1* (-r*bnp1d1+anp1d1)/ (bnp1*bnp1) IF ((abs(r-r0).LE.eps*abs(r)) .AND. + (abs(rd1-rd10).LE.eps*abs(rd1)) .AND. + (abs(rd2-rd20).LE.eps*abs(rd2))) GO TO 70 C C RESCALE AN, BN, ANP1, AND BNP1 and DERIVATIVES C r0 = r rd10 = rd1 rd20 = rd2 C 20 IF (.NOT. (abs(anp1).GT.otten)) GO TO 30 anp1 = anp1*otnten anp1d1 = anp1d1*otnten anp1d2 = anp1d2*otnten an = an*otnten and1 = and1*otnten and2 = and2*otnten r0 = r0*otnten rd10 = rd10*otnten rd20 = rd20*otnten GO TO 20 30 IF (.NOT. (abs(anp1).LT.otnten)) GO TO 40 anp1 = anp1*otten anp1d1 = anp1d1*otten anp1d2 = anp1d2*otten an = an*otten and1 = and1*otten and2 = and2*otten r0 = r0*otten rd10 = rd10*otten rd20 = rd20*otten GO TO 30 40 IF (.NOT. (abs(bnp1).GT.otten)) GO TO 50 bnp1 = bnp1*otnten bnp1d1 = bnp1d1*otnten bnp1d2 = bnp1d2*otnten bn = bn*otnten bnd1 = bnd1*otnten bnd2 = bnd2*otnten r0 = r0*otten rd10 = rd10*otten rd20 = rd20*otten GO TO 40 50 IF (.NOT. (abs(bnp1).LT.otnten)) GO TO 60 bnp1 = bnp1*otten bnp1d1 = bnp1d1*otten bnp1d2 = bnp1d2*otten bn = bn*otten bnd1 = bnd1*otten bnd2 = bnd2*otten r0 = r0*otnten rd10 = rd10*otnten rd20 = rd20*otnten GO TO 50 60 GO TO 10 C C TERMINATION C 70 CONTINUE d1 = rd1/r d2 = - (d1*d1) + rd2/r RETURN END DOUBLE PRECISION FUNCTION dln1pe(x) IMPLICIT DOUBLE PRECISION (a-h,o-p,r-z),INTEGER (i-n),LOGICAL (q) C********************************************************************** C C DOUBLE PRECISION FUNCTION DLN1PE( X ) C Double Precision LN(1 + exp(x)) C C C Arguments C C C X --> Argument C DOUBLE PRECISION X C C********************************************************************** C LBREAK is log(0.375) C .. Parameters .. DOUBLE PRECISION lbreak PARAMETER (lbreak=-.98082925301172623686D0) DOUBLE PRECISION one PARAMETER (one=1.0D0) C .. C .. Scalar Arguments .. DOUBLE PRECISION x C .. C .. External Functions .. DOUBLE PRECISION dln1px EXTERNAL dln1px C .. C .. Intrinsic Functions .. INTRINSIC exp,log C .. C .. Executable Statements .. IF (x.LE.lbreak) THEN dln1pe = dln1px(exp(x)) ELSE IF (-x.LE.lbreak) THEN dln1pe = x + dln1px(exp(-x)) ELSE dln1pe = log(one+exp(x)) END IF RETURN END DOUBLE PRECISION FUNCTION dln1px(a) C********************************************************************** C C DOUBLE PRECISION FUNCTION DLN1PX(X) C Double precision LN(1+X) C C C Function C C C Returns ln(1+x) C Note that the obvious code of C LOG(1.0+X) C won't work for small X because 1.0+X loses accuracy C C C Arguments C C C X --> Value for which ln(1-x) is desired. C X is DOUBLE PRECISION C C C Method C C C Renames ALNREL from: C DiDinato, A. R. and Morris, A. H. Algorithm 708: Significant C Digit Computation of the Incomplete Beta Function Ratios. ACM C Trans. Math. Softw. 18 (1993), 360-373. C C********************************************************************** C----------------------------------------------------------------------- C EVALUATION OF THE FUNCTION LN(1 + A) C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a C .. C .. Local Scalars .. DOUBLE PRECISION p1,p2,p3,q1,q2,q3,t,t2,w,x C .. C .. Intrinsic Functions .. INTRINSIC abs,dble,dlog C .. C .. Data statements .. DATA p1/-.129418923021993D+01/,p2/.405303492862024D+00/, + p3/-.178874546012214D-01/ DATA q1/-.162752256355323D+01/,q2/.747811014037616D+00/, + q3/-.845104217945565D-01/ C .. C .. Executable Statements .. C-------------------------- IF (abs(a).GT.0.375D0) GO TO 10 t = a/ (a+2.0D0) t2 = t*t w = (((p3*t2+p2)*t2+p1)*t2+1.0D0)/ (((q3*t2+q2)*t2+q1)*t2+1.0D0) dln1px = 2.0D0*t*w RETURN C 10 x = 1.D0 + dble(a) dln1px = dlog(x) RETURN END DOUBLE PRECISION FUNCTION dlngam(a) C********************************************************************** C C DOUBLE PRECISION FUNCTION DLNGAM(X) C Double precision LN of the GAMma function C C C Function C C C Returns the natural logarithm of GAMMA(X). C C C Arguments C C C X --> value at which scaled log gamma is to be returned C X is DOUBLE PRECISION C C C Method C C C Renames GAMLN from: C DiDinato, A. R. and Morris, A. H. Algorithm 708: Significant C Digit Computation of the Incomplete Beta Function Ratios. ACM C Trans. Math. Softw. 18 (1993), 360-373. C C********************************************************************** C----------------------------------------------------------------------- C EVALUATION OF LN(GAMMA(A)) FOR POSITIVE A C----------------------------------------------------------------------- C WRITTEN BY ALFRED H. MORRIS C NAVAL SURFACE WARFARE CENTER C DAHLGREN, VIRGINIA C-------------------------- C D = 0.5*(LN(2*PI) - 1) C-------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a C .. C .. Local Scalars .. DOUBLE PRECISION c0,c1,c2,c3,c4,c5,d,t,w INTEGER i,n C .. C .. External Functions .. DOUBLE PRECISION gamln1 EXTERNAL gamln1 C .. C .. Intrinsic Functions .. INTRINSIC dlog C .. C .. Data statements .. C-------------------------- DATA d/.418938533204673D0/ DATA c0/.833333333333333D-01/,c1/-.277777777760991D-02/, + c2/.793650666825390D-03/,c3/-.595202931351870D-03/, + c4/.837308034031215D-03/,c5/-.165322962780713D-02/ C .. C .. Executable Statements .. C----------------------------------------------------------------------- IF (a.GT.0.8D0) GO TO 10 dlngam = gamln1(a) - dlog(a) RETURN 10 IF (a.GT.2.25D0) GO TO 20 t = (a-0.5D0) - 0.5D0 dlngam = gamln1(t) RETURN C 20 IF (a.GE.10.0D0) GO TO 40 n = a - 1.25D0 t = a w = 1.0D0 DO 30 i = 1,n t = t - 1.0D0 w = t*w 30 CONTINUE dlngam = gamln1(t-1.0D0) + dlog(w) RETURN C 40 t = (1.0D0/a)**2 w = (((((c5*t+c4)*t+c3)*t+c2)*t+c1)*t+c0)/a dlngam = (d+w) + (a-0.5D0)* (dlog(a)-1.0D0) END SUBROUTINE dser(a,b,z,d1,d2) C------------------------------------------------------------------- C C Calculates first and second derivatives of log of C 1 + [Beta(A+1,n+1)/Beta(B-n-1,n+1)]*(x/(1-x))^(n+1)] n=0,1,... C This summation is part of Abramowitz and Stegun series 26.5.5 C [(x^b)*((1-x)^(a-1))/(b*Beta(a,b))]*SUM C which can be used to calculate IX(A,B). C C------------------------------------------------------------------- C .. Parameters .. DOUBLE PRECISION zero PARAMETER (zero=0.0D0) DOUBLE PRECISION one PARAMETER (one=1.0D0) DOUBLE PRECISION tiny PARAMETER (tiny=1.0D-13) C .. C .. Scalar Arguments .. DOUBLE PRECISION a,b,z,d1,d2 C .. C .. Local Scalars .. DOUBLE PRECISION zd1,zd2,am2,bp2,term,termd1,termd2,termo,trmd1o, + trmd2o,sum,sumd1,sumd2,sump1,xn,ratio,ratd1, + ratd2,temp LOGICAL qdone C .. C .. Intrinsic Functions .. INTRINSIC abs C .. C .. External Functions .. DOUBLE PRECISION dln1px EXTERNAL dln1px C .. C .. Executable Statements .. C C initialize variables C C qdone = .FALSE. zd1 = -z zd2 = z am2 = a - one - one bp2 = b + one + one temp = (a-one)/ (b+one) term = temp*z termd1 = temp*zd1 termd2 = temp*zd2 sum = zero sumd1 = zero sumd2 = zero xn = zero C C Compute sum C GO TO 20 10 IF (qdone .OR. (xn.GT.100D0)) GO TO 30 20 sum = sum + term sumd1 = sumd1 + termd1 sumd2 = sumd2 + termd2 qdone = ((abs(term/sum).LE.tiny) .AND. + (abs(termd1/sumd1).LE.tiny) .AND. + (abs(termd2/sumd2).LE.tiny)) IF (.NOT.qdone) THEN temp = (am2-xn)/ (bp2+xn) ratio = temp*z ratd1 = temp*zd1 ratd2 = temp*zd2 termo = term trmd1o = termd1 trmd2o = termd2 term = termo*ratio termd1 = trmd1o*ratio + termo*ratd1 termd2 = trmd2o*ratio + 2.0D0*trmd1o*ratd1 + termo*ratd2 xn = xn + one END IF GO TO 10 30 sump1 = sum + one d1 = sumd1/sump1 d2 = - (d1*d1) + sumd2/sump1 RETURN END DOUBLE PRECISION FUNCTION dstrem(z) IMPLICIT DOUBLE PRECISION (a-h,o-p,r-z),INTEGER (i-n),LOGICAL (q) C********************************************************************** C C DOUBLE PRECISION FUNCTION DSTREM( Z ) C Double precision Sterling Remainder C C C Function C C C Returns Log(Gamma(Z)) - Sterling(Z) where Sterling(Z) is C Sterling's Approximation to Log(Gamma(Z)) C C Sterling(Z) = LOG( SQRT( 2*PI ) ) + ( Z-0.5 ) * LOG( Z ) - Z C C C Arguments C C C Z --> Value at which Sterling remainder calculated C Must be positive. C DOUBLE PRECISION Z C C C Method C C C C If Z >= 6 uses 9 terms of series in Bernoulli numbers C (Values calculated using Maple) C Otherwise computes difference explicitly C C********************************************************************** C .. Parameters .. DOUBLE PRECISION hln2pi PARAMETER (hln2pi=0.91893853320467274178D0) INTEGER ncoef PARAMETER (ncoef=10) C .. C .. Scalar Arguments .. DOUBLE PRECISION z C .. C .. Local Scalars .. DOUBLE PRECISION sterl C .. C .. Local Arrays .. DOUBLE PRECISION coef(ncoef) C .. C .. External Functions .. DOUBLE PRECISION devlpl,dlngam EXTERNAL devlpl,dlngam C .. C .. Intrinsic Functions .. INTRINSIC log C .. C .. Data statements .. DATA coef/0.0D0,0.0833333333333333333333333333333D0, + -0.00277777777777777777777777777778D0, + 0.000793650793650793650793650793651D0, + -0.000595238095238095238095238095238D0, + 0.000841750841750841750841750841751D0, + -0.00191752691752691752691752691753D0, + 0.00641025641025641025641025641026D0, + -0.0295506535947712418300653594771D0, + 0.179644372368830573164938490016D0/ C .. C .. Executable Statements .. C For information, here are the next 11 coefficients of the C remainder term in Sterling's formula C -1.39243221690590111642743221691 C 13.4028640441683919944789510007 C -156.848284626002017306365132452 C 2193.10333333333333333333333333 C -36108.7712537249893571732652192 C 691472.268851313067108395250776 C -0.152382215394074161922833649589D8 C 0.382900751391414141414141414141D9 C -0.108822660357843910890151491655D11 C 0.347320283765002252252252252252D12 C -0.123696021422692744542517103493D14 C IF (z.LE.0.0D0) STOP 'Zero or negative argument in DSTREM' IF (.NOT. (z.GT.6.0D0)) GO TO 10 dstrem = devlpl(coef,10,1.0D0/z**2)*z GO TO 20 10 sterl = hln2pi + (z-0.5D0)*log(z) - z dstrem = dlngam(z) - sterl 20 RETURN END DOUBLE PRECISION FUNCTION erf(x) C----------------------------------------------------------------------- C EVALUATION OF THE REAL ERROR FUNCTION C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION x C .. C .. Local Scalars .. DOUBLE PRECISION ax,bot,c,t,top,x2 C .. C .. Local Arrays .. DOUBLE PRECISION a(5),b(3),p(8),q(8),r(5),s(4) C .. C .. Intrinsic Functions .. INTRINSIC abs,exp,sign C .. C .. Data statements .. C------------------------- C------------------------- C------------------------- C------------------------- DATA c/.564189583547756D0/ DATA a(1)/.771058495001320D-04/,a(2)/-.133733772997339D-02/, + a(3)/.323076579225834D-01/,a(4)/.479137145607681D-01/, + a(5)/.128379167095513D+00/ DATA b(1)/.301048631703895D-02/,b(2)/.538971687740286D-01/, + b(3)/.375795757275549D+00/ DATA p(1)/-1.36864857382717D-07/,p(2)/5.64195517478974D-01/, + p(3)/7.21175825088309D+00/,p(4)/4.31622272220567D+01/, + p(5)/1.52989285046940D+02/,p(6)/3.39320816734344D+02/, + p(7)/4.51918953711873D+02/,p(8)/3.00459261020162D+02/ DATA q(1)/1.00000000000000D+00/,q(2)/1.27827273196294D+01/, + q(3)/7.70001529352295D+01/,q(4)/2.77585444743988D+02/, + q(5)/6.38980264465631D+02/,q(6)/9.31354094850610D+02/, + q(7)/7.90950925327898D+02/,q(8)/3.00459260956983D+02/ DATA r(1)/2.10144126479064D+00/,r(2)/2.62370141675169D+01/, + r(3)/2.13688200555087D+01/,r(4)/4.65807828718470D+00/, + r(5)/2.82094791773523D-01/ DATA s(1)/9.41537750555460D+01/,s(2)/1.87114811799590D+02/, + s(3)/9.90191814623914D+01/,s(4)/1.80124575948747D+01/ C .. C .. Executable Statements .. C------------------------- ax = abs(x) IF (ax.GT.0.5D0) GO TO 10 t = x*x top = ((((a(1)*t+a(2))*t+a(3))*t+a(4))*t+a(5)) + 1.0D0 bot = ((b(1)*t+b(2))*t+b(3))*t + 1.0D0 erf = x* (top/bot) RETURN C 10 IF (ax.GT.4.0D0) GO TO 20 top = ((((((p(1)*ax+p(2))*ax+p(3))*ax+p(4))*ax+p(5))*ax+p(6))*ax+ + p(7))*ax + p(8) bot = ((((((q(1)*ax+q(2))*ax+q(3))*ax+q(4))*ax+q(5))*ax+q(6))*ax+ + q(7))*ax + q(8) erf = 0.5D0 + (0.5D0-exp(-x*x)*top/bot) IF (x.LT.0.0D0) erf = -erf RETURN C 20 IF (ax.GE.5.8D0) GO TO 30 x2 = x*x t = 1.0D0/x2 top = (((r(1)*t+r(2))*t+r(3))*t+r(4))*t + r(5) bot = (((s(1)*t+s(2))*t+s(3))*t+s(4))*t + 1.0D0 erf = (c-top/ (x2*bot))/ax erf = 0.5D0 + (0.5D0-exp(-x2)*erf) IF (x.LT.0.0D0) erf = -erf RETURN C 30 erf = sign(1.0D0,x) RETURN END DOUBLE PRECISION FUNCTION erfc1(ind,x) C----------------------------------------------------------------------- C EVALUATION OF THE COMPLEMENTARY ERROR FUNCTION C C ERFC1(IND,X) = ERFC(X) IF IND = 0 C ERFC1(IND,X) = EXP(X*X)*ERFC(X) OTHERWISE C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION x INTEGER ind C .. C .. Local Scalars .. DOUBLE PRECISION ax,bot,c,e,t,top,w C .. C .. Local Arrays .. DOUBLE PRECISION a(5),b(3),p(8),q(8),r(5),s(4) C .. C .. External Functions .. DOUBLE PRECISION exparg EXTERNAL exparg C .. C .. Intrinsic Functions .. INTRINSIC abs,dble,exp C .. C .. Data statements .. C------------------------- C------------------------- C------------------------- C------------------------- DATA c/.564189583547756D0/ DATA a(1)/.771058495001320D-04/,a(2)/-.133733772997339D-02/, + a(3)/.323076579225834D-01/,a(4)/.479137145607681D-01/, + a(5)/.128379167095513D+00/ DATA b(1)/.301048631703895D-02/,b(2)/.538971687740286D-01/, + b(3)/.375795757275549D+00/ DATA p(1)/-1.36864857382717D-07/,p(2)/5.64195517478974D-01/, + p(3)/7.21175825088309D+00/,p(4)/4.31622272220567D+01/, + p(5)/1.52989285046940D+02/,p(6)/3.39320816734344D+02/, + p(7)/4.51918953711873D+02/,p(8)/3.00459261020162D+02/ DATA q(1)/1.00000000000000D+00/,q(2)/1.27827273196294D+01/, + q(3)/7.70001529352295D+01/,q(4)/2.77585444743988D+02/, + q(5)/6.38980264465631D+02/,q(6)/9.31354094850610D+02/, + q(7)/7.90950925327898D+02/,q(8)/3.00459260956983D+02/ DATA r(1)/2.10144126479064D+00/,r(2)/2.62370141675169D+01/, + r(3)/2.13688200555087D+01/,r(4)/4.65807828718470D+00/, + r(5)/2.82094791773523D-01/ DATA s(1)/9.41537750555460D+01/,s(2)/1.87114811799590D+02/, + s(3)/9.90191814623914D+01/,s(4)/1.80124575948747D+01/ C .. C .. Executable Statements .. C------------------------- C C ABS(X) .LE. 0.5 C ax = abs(x) IF (ax.GT.0.5D0) GO TO 10 t = x*x top = ((((a(1)*t+a(2))*t+a(3))*t+a(4))*t+a(5)) + 1.0D0 bot = ((b(1)*t+b(2))*t+b(3))*t + 1.0D0 erfc1 = 0.5D0 + (0.5D0-x* (top/bot)) IF (ind.NE.0) erfc1 = exp(t)*erfc1 RETURN C C 0.5 .LT. ABS(X) .LE. 4 C 10 IF (ax.GT.4.0D0) GO TO 20 top = ((((((p(1)*ax+p(2))*ax+p(3))*ax+p(4))*ax+p(5))*ax+p(6))*ax+ + p(7))*ax + p(8) bot = ((((((q(1)*ax+q(2))*ax+q(3))*ax+q(4))*ax+q(5))*ax+q(6))*ax+ + q(7))*ax + q(8) erfc1 = top/bot GO TO 40 C C ABS(X) .GT. 4 C 20 IF (x.LE.-5.6D0) GO TO 60 IF (ind.NE.0) GO TO 30 IF (x.GT.100.0D0) GO TO 70 IF (x*x.GT.-exparg(1)) GO TO 70 C 30 t = (1.0D0/x)**2 top = (((r(1)*t+r(2))*t+r(3))*t+r(4))*t + r(5) bot = (((s(1)*t+s(2))*t+s(3))*t+s(4))*t + 1.0D0 erfc1 = (c-t*top/bot)/ax C C FINAL ASSEMBLY C 40 IF (ind.EQ.0) GO TO 50 IF (x.LT.0.0D0) erfc1 = 2.0D0*exp(x*x) - erfc1 RETURN 50 w = dble(x)*dble(x) t = w e = w - dble(t) erfc1 = ((0.5D0+ (0.5D0-e))*exp(-t))*erfc1 IF (x.LT.0.0D0) erfc1 = 2.0D0 - erfc1 RETURN C C LIMIT VALUE FOR LARGE NEGATIVE X C 60 erfc1 = 2.0D0 IF (ind.NE.0) erfc1 = 2.0D0*exp(x*x) RETURN C C LIMIT VALUE FOR LARGE POSITIVE X C WHEN IND = 0 C 70 erfc1 = 0.0D0 RETURN END DOUBLE PRECISION FUNCTION esum(mu,x) C----------------------------------------------------------------------- C EVALUATION OF EXP(MU + X) C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION x INTEGER mu C .. C .. Local Scalars .. DOUBLE PRECISION w C .. C .. Intrinsic Functions .. INTRINSIC exp C .. C .. Executable Statements .. IF (x.GT.0.0D0) GO TO 10 C IF (mu.LT.0) GO TO 20 w = mu + x IF (w.GT.0.0D0) GO TO 20 esum = exp(w) RETURN C 10 IF (mu.GT.0) GO TO 20 w = mu + x IF (w.LT.0.0D0) GO TO 20 esum = exp(w) RETURN C 20 w = mu esum = exp(w)*exp(x) RETURN END DOUBLE PRECISION FUNCTION exparg(l) C-------------------------------------------------------------------- C IF L = 0 THEN EXPARG(L) = THE LARGEST POSITIVE W FOR WHICH C EXP(W) CAN BE COMPUTED. C C IF L IS NONZERO THEN EXPARG(L) = THE LARGEST NEGATIVE W FOR C WHICH THE COMPUTED VALUE OF EXP(W) IS NONZERO. C C NOTE... ONLY AN APPROXIMATE VALUE FOR EXPARG(L) IS NEEDED. C-------------------------------------------------------------------- C .. Scalar Arguments .. INTEGER l C .. C .. Local Scalars .. DOUBLE PRECISION lnb INTEGER b,m C .. C .. External Functions .. INTEGER ipmpar EXTERNAL ipmpar C .. C .. Intrinsic Functions .. INTRINSIC dble,dlog C .. C .. Executable Statements .. C b = ipmpar(4) IF (b.NE.2) GO TO 10 lnb = .69314718055995D0 GO TO 40 10 IF (b.NE.8) GO TO 20 lnb = 2.0794415416798D0 GO TO 40 20 IF (b.NE.16) GO TO 30 lnb = 2.7725887222398D0 GO TO 40 30 lnb = dlog(dble(b)) C 40 IF (l.EQ.0) GO TO 50 m = ipmpar(9) - 1 exparg = 0.99999D0* (m*lnb) RETURN 50 m = ipmpar(10) exparg = 0.99999D0* (m*lnb) RETURN END DOUBLE PRECISION FUNCTION fpser(a,b,x,eps) C----------------------------------------------------------------------- C C EVALUATION OF I (A,B) C X C C FOR B .LT. MIN(EPS,EPS*A) AND X .LE. 0.5. C C----------------------------------------------------------------------- C C SET FPSER = X**A C C .. Scalar Arguments .. DOUBLE PRECISION a,b,eps,x C .. C .. Local Scalars .. DOUBLE PRECISION an,c,s,t,tol C .. C .. External Functions .. DOUBLE PRECISION exparg EXTERNAL exparg C .. C .. Intrinsic Functions .. INTRINSIC abs,dlog,exp C .. C .. Executable Statements .. fpser = 1.0D0 IF (a.LE.1.D-3*eps) GO TO 10 fpser = 0.0D0 t = a*dlog(x) IF (t.LT.exparg(1)) RETURN fpser = exp(t) C C NOTE THAT 1/B(A,B) = B C 10 fpser = (b/a)*fpser tol = eps/a an = a + 1.0D0 t = x s = t/an 20 an = an + 1.0D0 t = x*t c = t/an s = s + c IF (abs(c).GT.tol) GO TO 20 C fpser = fpser* (1.0D0+a*s) RETURN END DOUBLE PRECISION FUNCTION gam1(a) C ------------------------------------------------------------------ C COMPUTATION OF 1/GAMMA(A+1) - 1 FOR -0.5 .LE. A .LE. 1.5 C ------------------------------------------------------------------ C .. Scalar Arguments .. DOUBLE PRECISION a C .. C .. Local Scalars .. DOUBLE PRECISION bot,d,s1,s2,t,top,w C .. C .. Local Arrays .. DOUBLE PRECISION p(7),q(5),r(9) C .. C .. Data statements .. C ------------------- C ------------------- C ------------------- C ------------------- DATA p(1)/.577215664901533D+00/,p(2)/-.409078193005776D+00/, + p(3)/-.230975380857675D+00/,p(4)/.597275330452234D-01/, + p(5)/.766968181649490D-02/,p(6)/-.514889771323592D-02/, + p(7)/.589597428611429D-03/ DATA q(1)/.100000000000000D+01/,q(2)/.427569613095214D+00/, + q(3)/.158451672430138D+00/,q(4)/.261132021441447D-01/, + q(5)/.423244297896961D-02/ DATA r(1)/-.422784335098468D+00/,r(2)/-.771330383816272D+00/, + r(3)/-.244757765222226D+00/,r(4)/.118378989872749D+00/, + r(5)/.930357293360349D-03/,r(6)/-.118290993445146D-01/, + r(7)/.223047661158249D-02/,r(8)/.266505979058923D-03/, + r(9)/-.132674909766242D-03/ DATA s1/.273076135303957D+00/,s2/.559398236957378D-01/ C .. C .. Executable Statements .. C ------------------- t = a d = a - 0.5D0 IF (d.GT.0.0D0) t = d - 0.5D0 IF (t) 40,10,20 C 10 gam1 = 0.0D0 RETURN C 20 top = (((((p(7)*t+p(6))*t+p(5))*t+p(4))*t+p(3))*t+p(2))*t + p(1) bot = (((q(5)*t+q(4))*t+q(3))*t+q(2))*t + 1.0D0 w = top/bot IF (d.GT.0.0D0) GO TO 30 gam1 = a*w RETURN 30 gam1 = (t/a)* ((w-0.5D0)-0.5D0) RETURN C 40 top = (((((((r(9)*t+r(8))*t+r(7))*t+r(6))*t+r(5))*t+r(4))*t+r(3))* + t+r(2))*t + r(1) bot = (s2*t+s1)*t + 1.0D0 w = top/bot IF (d.GT.0.0D0) GO TO 50 gam1 = a* ((w+0.5D0)+0.5D0) RETURN 50 gam1 = t*w/a RETURN END DOUBLE PRECISION FUNCTION gamln(a) C----------------------------------------------------------------------- C EVALUATION OF LN(GAMMA(A)) FOR POSITIVE A C----------------------------------------------------------------------- C WRITTEN BY ALFRED H. MORRIS C NAVAL SURFACE WARFARE CENTER C DAHLGREN, VIRGINIA C-------------------------- C D = 0.5*(LN(2*PI) - 1) C-------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a C .. C .. Local Scalars .. DOUBLE PRECISION c0,c1,c2,c3,c4,c5,d,t,w INTEGER i,n C .. C .. External Functions .. DOUBLE PRECISION gamln1 EXTERNAL gamln1 C .. C .. Intrinsic Functions .. INTRINSIC dlog C .. C .. Data statements .. C-------------------------- DATA d/.418938533204673D0/ DATA c0/.833333333333333D-01/,c1/-.277777777760991D-02/, + c2/.793650666825390D-03/,c3/-.595202931351870D-03/, + c4/.837308034031215D-03/,c5/-.165322962780713D-02/ C .. C .. Executable Statements .. C----------------------------------------------------------------------- IF (a.GT.0.8D0) GO TO 10 gamln = gamln1(a) - dlog(a) RETURN 10 IF (a.GT.2.25D0) GO TO 20 t = (a-0.5D0) - 0.5D0 gamln = gamln1(t) RETURN C 20 IF (a.GE.10.0D0) GO TO 40 n = a - 1.25D0 t = a w = 1.0D0 DO 30 i = 1,n t = t - 1.0D0 w = t*w 30 CONTINUE gamln = gamln1(t-1.0D0) + dlog(w) RETURN C 40 t = (1.0D0/a)**2 w = (((((c5*t+c4)*t+c3)*t+c2)*t+c1)*t+c0)/a gamln = (d+w) + (a-0.5D0)* (dlog(a)-1.0D0) END DOUBLE PRECISION FUNCTION gamln1(a) C----------------------------------------------------------------------- C EVALUATION OF LN(GAMMA(1 + A)) FOR -0.2 .LE. A .LE. 1.25 C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a C .. C .. Local Scalars .. DOUBLE PRECISION p0,p1,p2,p3,p4,p5,p6,q1,q2,q3,q4,q5,q6,r0,r1,r2, + r3,r4,r5,s1,s2,s3,s4,s5,w,x C .. C .. Data statements .. C---------------------- DATA p0/.577215664901533D+00/,p1/.844203922187225D+00/, + p2/-.168860593646662D+00/,p3/-.780427615533591D+00/, + p4/-.402055799310489D+00/,p5/-.673562214325671D-01/, + p6/-.271935708322958D-02/ DATA q1/.288743195473681D+01/,q2/.312755088914843D+01/, + q3/.156875193295039D+01/,q4/.361951990101499D+00/, + q5/.325038868253937D-01/,q6/.667465618796164D-03/ DATA r0/.422784335098467D+00/,r1/.848044614534529D+00/, + r2/.565221050691933D+00/,r3/.156513060486551D+00/, + r4/.170502484022650D-01/,r5/.497958207639485D-03/ DATA s1/.124313399877507D+01/,s2/.548042109832463D+00/, + s3/.101552187439830D+00/,s4/.713309612391000D-02/, + s5/.116165475989616D-03/ C .. C .. Executable Statements .. C---------------------- IF (a.GE.0.6D0) GO TO 10 w = ((((((p6*a+p5)*a+p4)*a+p3)*a+p2)*a+p1)*a+p0)/ + ((((((q6*a+q5)*a+q4)*a+q3)*a+q2)*a+q1)*a+1.0D0) gamln1 = -a*w RETURN C 10 x = (a-0.5D0) - 0.5D0 w = (((((r5*x+r4)*x+r3)*x+r2)*x+r1)*x+r0)/ + (((((s5*x+s4)*x+s3)*x+s2)*x+s1)*x+1.0D0) gamln1 = x*w RETURN END SUBROUTINE grat1(a,x,r,p,q,eps) C .. Scalar Arguments .. DOUBLE PRECISION a,eps,p,q,r,x C .. C .. Local Scalars .. DOUBLE PRECISION a2n,a2nm1,am0,an,an0,b2n,b2nm1,c,cma,g,h,j,l,sum, + t,tol,w,z C .. C .. External Functions .. DOUBLE PRECISION erf,erfc1,gam1,rexp EXTERNAL erf,erfc1,gam1,rexp C .. C .. Intrinsic Functions .. INTRINSIC abs,dlog,exp,sqrt C .. C .. Executable Statements .. C----------------------------------------------------------------------- C EVALUATION OF THE INCOMPLETE GAMMA RATIO FUNCTIONS C P(A,X) AND Q(A,X) C C IT IS ASSUMED THAT A .LE. 1. EPS IS THE TOLERANCE TO BE USED. C THE INPUT ARGUMENT R HAS THE VALUE E**(-X)*X**A/GAMMA(A). C----------------------------------------------------------------------- IF (a*x.EQ.0.0D0) GO TO 120 IF (a.EQ.0.5D0) GO TO 100 IF (x.LT.1.1D0) GO TO 10 GO TO 60 C C TAYLOR SERIES FOR P(A,X)/X**A C 10 an = 3.0D0 c = x sum = x/ (a+3.0D0) tol = 0.1D0*eps/ (a+1.0D0) 20 an = an + 1.0D0 c = -c* (x/an) t = c/ (a+an) sum = sum + t IF (abs(t).GT.tol) GO TO 20 j = a*x* ((sum/6.0D0-0.5D0/ (a+2.0D0))*x+1.0D0/ (a+1.0D0)) C z = a*dlog(x) h = gam1(a) g = 1.0D0 + h IF (x.LT.0.25D0) GO TO 30 IF (a.LT.x/2.59D0) GO TO 50 GO TO 40 30 IF (z.GT.-.13394D0) GO TO 50 C 40 w = exp(z) p = w*g* (0.5D0+ (0.5D0-j)) q = 0.5D0 + (0.5D0-p) RETURN C 50 l = rexp(z) w = 0.5D0 + (0.5D0+l) q = (w*j-l)*g - h IF (q.LT.0.0D0) GO TO 90 p = 0.5D0 + (0.5D0-q) RETURN C C CONTINUED FRACTION EXPANSION C 60 a2nm1 = 1.0D0 a2n = 1.0D0 b2nm1 = x b2n = x + (1.0D0-a) c = 1.0D0 70 a2nm1 = x*a2n + c*a2nm1 b2nm1 = x*b2n + c*b2nm1 am0 = a2nm1/b2nm1 c = c + 1.0D0 cma = c - a a2n = a2nm1 + cma*a2n b2n = b2nm1 + cma*b2n an0 = a2n/b2n IF (abs(an0-am0).GE.eps*an0) GO TO 70 q = r*an0 p = 0.5D0 + (0.5D0-q) RETURN C C SPECIAL CASES C 80 p = 0.0D0 q = 1.0D0 RETURN C 90 p = 1.0D0 q = 0.0D0 RETURN C 100 IF (x.GE.0.25D0) GO TO 110 p = erf(sqrt(x)) q = 0.5D0 + (0.5D0-p) RETURN 110 q = erfc1(0,sqrt(x)) p = 0.5D0 + (0.5D0-q) RETURN C 120 IF (x.LE.a) GO TO 80 GO TO 90 END DOUBLE PRECISION FUNCTION gsumln(a,b) C----------------------------------------------------------------------- C EVALUATION OF THE FUNCTION LN(GAMMA(A + B)) C FOR 1 .LE. A .LE. 2 AND 1 .LE. B .LE. 2 C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION a,b C .. C .. Local Scalars .. DOUBLE PRECISION x C .. C .. External Functions .. DOUBLE PRECISION alnrel,gamln1 EXTERNAL alnrel,gamln1 C .. C .. Intrinsic Functions .. INTRINSIC dble,dlog C .. C .. Executable Statements .. x = dble(a) + dble(b) - 2.D0 IF (x.GT.0.25D0) GO TO 10 gsumln = gamln1(1.0D0+x) RETURN 10 IF (x.GT.1.25D0) GO TO 20 gsumln = gamln1(x) + alnrel(x) RETURN 20 gsumln = gamln1(x-1.0D0) + dlog(x* (1.0D0+x)) RETURN END INTEGER FUNCTION ipmpar(i) C----------------------------------------------------------------------- C C IPMPAR PROVIDES THE INTEGER MACHINE CONSTANTS FOR THE COMPUTER C THAT IS USED. IT IS ASSUMED THAT THE ARGUMENT I IS AN INTEGER C HAVING ONE OF THE VALUES 1-10. IPMPAR(I) HAS THE VALUE ... C C INTEGERS. C C ASSUME INTEGERS ARE REPRESENTED IN THE N-DIGIT, BASE-A FORM C C SIGN ( X(N-1)*A**(N-1) + ... + X(1)*A + X(0) ) C C WHERE 0 .LE. X(I) .LT. A FOR I=0,...,N-1. C C IPMPAR(1) = A, THE BASE. C C IPMPAR(2) = N, THE NUMBER OF BASE-A DIGITS. C C IPMPAR(3) = A**N - 1, THE LARGEST MAGNITUDE. C C FLOATING-POINT NUMBERS. C C IT IS ASSUMED THAT THE SINGLE AND DOUBLE PRECISION FLOATING C POINT ARITHMETICS HAVE THE SAME BASE, SAY B, AND THAT THE C NONZERO NUMBERS ARE REPRESENTED IN THE FORM C C SIGN (B**E) * (X(1)/B + ... + X(M)/B**M) C C WHERE X(I) = 0,1,...,B-1 FOR I=1,...,M, C X(1) .GE. 1, AND EMIN .LE. E .LE. EMAX. C C IPMPAR(4) = B, THE BASE. C C SINGLE-PRECISION C C IPMPAR(5) = M, THE NUMBER OF BASE-B DIGITS. C C IPMPAR(6) = EMIN, THE SMALLEST EXPONENT E. C C IPMPAR(7) = EMAX, THE LARGEST EXPONENT E. C C DOUBLE-PRECISION C C IPMPAR(8) = M, THE NUMBER OF BASE-B DIGITS. C C IPMPAR(9) = EMIN, THE SMALLEST EXPONENT E. C C IPMPAR(10) = EMAX, THE LARGEST EXPONENT E. C C----------------------------------------------------------------------- C C TO DEFINE THIS FUNCTION FOR THE COMPUTER BEING USED, ACTIVATE C THE DATA STATMENTS FOR THE COMPUTER BY REMOVING THE C FROM C COLUMN 1. (ALL THE OTHER DATA STATEMENTS SHOULD HAVE C IN C COLUMN 1.) C C----------------------------------------------------------------------- C C IPMPAR IS AN ADAPTATION OF THE FUNCTION I1MACH, WRITTEN BY C P.A. FOX, A.D. HALL, AND N.L. SCHRYER (BELL LABORATORIES). C IPMPAR WAS FORMED BY A.H. MORRIS (NSWC). THE CONSTANTS ARE C FROM BELL LABORATORIES, NSWC, AND OTHER SOURCES. C C----------------------------------------------------------------------- C .. Scalar Arguments .. INTEGER i C .. C .. Local Arrays .. INTEGER imach(10) C .. C .. Data statements .. C C MACHINE CONSTANTS FOR AMDAHL MACHINES. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 31 / C DATA IMACH( 3) / 2147483647 / C DATA IMACH( 4) / 16 / C DATA IMACH( 5) / 6 / C DATA IMACH( 6) / -64 / C DATA IMACH( 7) / 63 / C DATA IMACH( 8) / 14 / C DATA IMACH( 9) / -64 / C DATA IMACH(10) / 63 / C C MACHINE CONSTANTS FOR THE AT&T 3B SERIES, AT&T C PC 7300, AND AT&T 6300. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 31 / C DATA IMACH( 3) / 2147483647 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 24 / C DATA IMACH( 6) / -125 / C DATA IMACH( 7) / 128 / C DATA IMACH( 8) / 53 / C DATA IMACH( 9) / -1021 / C DATA IMACH(10) / 1024 / C C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 33 / C DATA IMACH( 3) / 8589934591 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 24 / C DATA IMACH( 6) / -256 / C DATA IMACH( 7) / 255 / C DATA IMACH( 8) / 60 / C DATA IMACH( 9) / -256 / C DATA IMACH(10) / 255 / C C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 39 / C DATA IMACH( 3) / 549755813887 / C DATA IMACH( 4) / 8 / C DATA IMACH( 5) / 13 / C DATA IMACH( 6) / -50 / C DATA IMACH( 7) / 76 / C DATA IMACH( 8) / 26 / C DATA IMACH( 9) / -50 / C DATA IMACH(10) / 76 / C C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 39 / C DATA IMACH( 3) / 549755813887 / C DATA IMACH( 4) / 8 / C DATA IMACH( 5) / 13 / C DATA IMACH( 6) / -50 / C DATA IMACH( 7) / 76 / C DATA IMACH( 8) / 26 / C DATA IMACH( 9) / -32754 / C DATA IMACH(10) / 32780 / C C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES C 60 BIT ARITHMETIC, AND THE CDC CYBER 995 64 BIT C ARITHMETIC (NOS OPERATING SYSTEM). C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 48 / C DATA IMACH( 3) / 281474976710655 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 48 / C DATA IMACH( 6) / -974 / C DATA IMACH( 7) / 1070 / C DATA IMACH( 8) / 95 / C DATA IMACH( 9) / -926 / C DATA IMACH(10) / 1070 / C C MACHINE CONSTANTS FOR THE CDC CYBER 995 64 BIT C ARITHMETIC (NOS/VE OPERATING SYSTEM). C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 63 / C DATA IMACH( 3) / 9223372036854775807 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 48 / C DATA IMACH( 6) / -4096 / C DATA IMACH( 7) / 4095 / C DATA IMACH( 8) / 96 / C DATA IMACH( 9) / -4096 / C DATA IMACH(10) / 4095 / C C MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 63 / C DATA IMACH( 3) / 9223372036854775807 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 47 / C DATA IMACH( 6) / -8189 / C DATA IMACH( 7) / 8190 / C DATA IMACH( 8) / 94 / C DATA IMACH( 9) / -8099 / C DATA IMACH(10) / 8190 / C C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 15 / C DATA IMACH( 3) / 32767 / C DATA IMACH( 4) / 16 / C DATA IMACH( 5) / 6 / C DATA IMACH( 6) / -64 / C DATA IMACH( 7) / 63 / C DATA IMACH( 8) / 14 / C DATA IMACH( 9) / -64 / C DATA IMACH(10) / 63 / C C MACHINE CONSTANTS FOR THE HARRIS 220. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 23 / C DATA IMACH( 3) / 8388607 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 23 / C DATA IMACH( 6) / -127 / C DATA IMACH( 7) / 127 / C DATA IMACH( 8) / 38 / C DATA IMACH( 9) / -127 / C DATA IMACH(10) / 127 / C C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 C AND DPS 8/70 SERIES. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 35 / C DATA IMACH( 3) / 34359738367 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 27 / C DATA IMACH( 6) / -127 / C DATA IMACH( 7) / 127 / C DATA IMACH( 8) / 63 / C DATA IMACH( 9) / -127 / C DATA IMACH(10) / 127 / C C MACHINE CONSTANTS FOR THE HP 2100 C 3 WORD DOUBLE PRECISION OPTION WITH FTN4 C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 15 / C DATA IMACH( 3) / 32767 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 23 / C DATA IMACH( 6) / -128 / C DATA IMACH( 7) / 127 / C DATA IMACH( 8) / 39 / C DATA IMACH( 9) / -128 / C DATA IMACH(10) / 127 / C C MACHINE CONSTANTS FOR THE HP 2100 C 4 WORD DOUBLE PRECISION OPTION WITH FTN4 C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 15 / C DATA IMACH( 3) / 32767 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 23 / C DATA IMACH( 6) / -128 / C DATA IMACH( 7) / 127 / C DATA IMACH( 8) / 55 / C DATA IMACH( 9) / -128 / C DATA IMACH(10) / 127 / C C MACHINE CONSTANTS FOR THE HP 9000. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 31 / C DATA IMACH( 3) / 2147483647 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 24 / C DATA IMACH( 6) / -126 / C DATA IMACH( 7) / 128 / C DATA IMACH( 8) / 53 / C DATA IMACH( 9) / -1021 / C DATA IMACH(10) / 1024 / C C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, C THE ICL 2900, THE ITEL AS/6, THE XEROX SIGMA C 5/7/9 AND THE SEL SYSTEMS 85/86. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 31 / C DATA IMACH( 3) / 2147483647 / C DATA IMACH( 4) / 16 / C DATA IMACH( 5) / 6 / C DATA IMACH( 6) / -64 / C DATA IMACH( 7) / 63 / C DATA IMACH( 8) / 14 / C DATA IMACH( 9) / -64 / C DATA IMACH(10) / 63 / C C MACHINE CONSTANTS FOR THE IBM PC. C C DATA imach(1)/2/ C DATA imach(2)/31/ C DATA imach(3)/2147483647/ C DATA imach(4)/2/ C DATA imach(5)/24/ C DATA imach(6)/-125/ C DATA imach(7)/128/ C DATA imach(8)/53/ C DATA imach(9)/-1021/ C DATA imach(10)/1024/ C C MACHINE CONSTANTS FOR THE MACINTOSH II - ABSOFT C MACFORTRAN II. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 31 / C DATA IMACH( 3) / 2147483647 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 24 / C DATA IMACH( 6) / -125 / C DATA IMACH( 7) / 128 / C DATA IMACH( 8) / 53 / C DATA IMACH( 9) / -1021 / C DATA IMACH(10) / 1024 / C C MACHINE CONSTANTS FOR THE MICROVAX - VMS FORTRAN. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 31 / C DATA IMACH( 3) / 2147483647 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 24 / C DATA IMACH( 6) / -127 / C DATA IMACH( 7) / 127 / C DATA IMACH( 8) / 56 / C DATA IMACH( 9) / -127 / C DATA IMACH(10) / 127 / C C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 35 / C DATA IMACH( 3) / 34359738367 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 27 / C DATA IMACH( 6) / -128 / C DATA IMACH( 7) / 127 / C DATA IMACH( 8) / 54 / C DATA IMACH( 9) / -101 / C DATA IMACH(10) / 127 / C C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 35 / C DATA IMACH( 3) / 34359738367 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 27 / C DATA IMACH( 6) / -128 / C DATA IMACH( 7) / 127 / C DATA IMACH( 8) / 62 / C DATA IMACH( 9) / -128 / C DATA IMACH(10) / 127 / C C MACHINE CONSTANTS FOR THE PDP-11 FORTRAN SUPPORTING C 32-BIT INTEGER ARITHMETIC. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 31 / C DATA IMACH( 3) / 2147483647 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 24 / C DATA IMACH( 6) / -127 / C DATA IMACH( 7) / 127 / C DATA IMACH( 8) / 56 / C DATA IMACH( 9) / -127 / C DATA IMACH(10) / 127 / C C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 31 / C DATA IMACH( 3) / 2147483647 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 24 / C DATA IMACH( 6) / -125 / C DATA IMACH( 7) / 128 / C DATA IMACH( 8) / 53 / C DATA IMACH( 9) / -1021 / C DATA IMACH(10) / 1024 / C C MACHINE CONSTANTS FOR THE SILICON GRAPHICS IRIS-4D C SERIES (MIPS R3000 PROCESSOR). C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 31 / C DATA IMACH( 3) / 2147483647 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 24 / C DATA IMACH( 6) / -125 / C DATA IMACH( 7) / 128 / C DATA IMACH( 8) / 53 / C DATA IMACH( 9) / -1021 / C DATA IMACH(10) / 1024 / C C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T C 3B SERIES, MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T C PC 7300), AND 8087 BASED MICROS (E.G. IBM PC AND AT&T 6300). C DATA IMACH( 1) / 2 / DATA IMACH( 2) / 31 / DATA IMACH( 3) / 2147483647 / DATA IMACH( 4) / 2 / DATA IMACH( 5) / 24 / DATA IMACH( 6) / -125 / DATA IMACH( 7) / 128 / DATA IMACH( 8) / 53 / DATA IMACH( 9) / -1021 / DATA IMACH(10) / 1024 / C C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 35 / C DATA IMACH( 3) / 34359738367 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 27 / C DATA IMACH( 6) / -128 / C DATA IMACH( 7) / 127 / C DATA IMACH( 8) / 60 / C DATA IMACH( 9) /-1024 / C DATA IMACH(10) / 1023 / C C MACHINE CONSTANTS FOR THE VAX 11/780. C C DATA IMACH( 1) / 2 / C DATA IMACH( 2) / 31 / C DATA IMACH( 3) / 2147483647 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 24 / C DATA IMACH( 6) / -127 / C DATA IMACH( 7) / 127 / C DATA IMACH( 8) / 56 / C DATA IMACH( 9) / -127 / C DATA IMACH(10) / 127 / C ipmpar = imach(i) RETURN END DOUBLE PRECISION FUNCTION lasym(a,b,lambda,eps) C----------------------------------------------------------------------- C C ASYMPTOTIC EXPANSION FOR LOG(IX(A,B)) FOR LARGE A AND B. C LAMBDA = (A + B)*Y - B AND EPS IS THE TOLERANCE USED. C IT IS ASSUMED THAT LAMBDA IS NONNEGATIVE AND THAT C A AND B ARE GREATER THAN OR EQUAL TO 15. C C Modification of BASYM from: C DiDinato, A. R. and Morris, A. H. Algorithm 708: Significant C Digit Computation of the Incomplete Beta Function Ratios. ACM C Trans. Math. Softw. 18 (1993), 360-373. C C----------------------------------------------------------------------- C C .. Scalar Arguments .. DOUBLE PRECISION a,b,eps,lambda C .. C .. Local Scalars .. DOUBLE PRECISION bsum,dsum,e0,e1,f,h,h2,hn,j0,j1,r,r0,r1,s,sum,t0, + t1,u,w,w0,z,z0,z2,zn,znm1 INTEGER i,im1,imj,j,m,mm1,mmj,n,np1,num C .. C .. Local Arrays .. DOUBLE PRECISION a0(21),b0(21),c(21),d(21) C .. C .. External Functions .. DOUBLE PRECISION bcorr,erfc1,rlog1 EXTERNAL bcorr,erfc1,rlog1 C .. C .. Intrinsic Functions .. INTRINSIC abs,sqrt,log C .. C .. Data statements .. C------------------------ C ****** NUM IS THE MAXIMUM VALUE THAT N CAN TAKE IN THE DO LOOP C ENDING AT STATEMENT 50. IT IS REQUIRED THAT NUM BE EVEN. C THE ARRAYS A0, B0, C, D HAVE DIMENSION NUM + 1. C C------------------------ C E0 = 2/SQRT(PI) C E1 = 2**(-3/2) C------------------------ DATA num/20/ DATA e0/1.12837916709551D0/,e1/.353553390593274D0/ C .. C .. Executable Statements .. C------------------------ IF (a.GE.b) GO TO 10 h = a/b r0 = 1.0D0/ (1.0D0+h) r1 = (b-a)/b w0 = 1.0D0/sqrt(a* (1.0D0+h)) GO TO 20 10 h = b/a r0 = 1.0D0/ (1.0D0+h) r1 = (b-a)/a w0 = 1.0D0/sqrt(b* (1.0D0+h)) C 20 f = a*rlog1(-lambda/a) + b*rlog1(lambda/b) z0 = sqrt(f) z = 0.5D0* (z0/e1) z2 = f + f C a0(1) = (2.0D0/3.0D0)*r1 c(1) = -0.5D0*a0(1) d(1) = -c(1) j0 = (0.5D0/e0)*erfc1(1,z0) j1 = e1 sum = j0 + d(1)*w0*j1 C s = 1.0D0 h2 = h*h hn = 1.0D0 w = w0 znm1 = z zn = z2 DO 70 n = 2,num,2 hn = h2*hn a0(n) = 2.0D0*r0* (1.0D0+h*hn)/ (n+2.0D0) np1 = n + 1 s = s + hn a0(np1) = 2.0D0*r1*s/ (n+3.0D0) C DO 60 i = n,np1 r = -0.5D0* (i+1.0D0) b0(1) = r*a0(1) DO 40 m = 2,i bsum = 0.0D0 mm1 = m - 1 DO 30 j = 1,mm1 mmj = m - j bsum = bsum + (j*r-mmj)*a0(j)*b0(mmj) 30 CONTINUE b0(m) = r*a0(m) + bsum/m 40 CONTINUE c(i) = b0(i)/ (i+1.0D0) C dsum = 0.0D0 im1 = i - 1 DO 50 j = 1,im1 imj = i - j dsum = dsum + d(imj)*c(j) 50 CONTINUE d(i) = - (dsum+c(i)) 60 CONTINUE C j0 = e1*znm1 + (n-1.0D0)*j0 j1 = e1*zn + n*j1 znm1 = z2*znm1 zn = z2*zn w = w0*w t0 = d(n)*w*j0 w = w0*w t1 = d(np1)*w*j1 sum = sum + (t0+t1) IF (abs(t0+t1).LE.eps) GO TO 80 70 CONTINUE GO TO 90 C 80 u = -bcorr(a,b) lasym = log(e0) - f + u + log(sum) RETURN 90 END DOUBLE PRECISION FUNCTION lbfrac(a,b,x,y,lambda,eps) C----------------------------------------------------------------------- C C CONTINUED FRACTION EXPANSION FOR IX(A,B) WHEN A,B .GT. 1. C IT IS ASSUMED THAT LAMBDA = (A + B)*Y - B. C C Modification of BFRAC from: C DiDinato, A. R. and Morris, A. H. Algorithm 708: Significant C Digit Computation of the Incomplete Beta Function Ratios. ACM C Trans. Math. Softw. 18 (1993), 360-373. C C----------------------------------------------------------------------- C .. Parameters .. DOUBLE PRECISION otnten PARAMETER (otnten=1.0D-10) DOUBLE PRECISION otten PARAMETER (otten=1.0D10) DOUBLE PRECISION lotten PARAMETER (lotten=23.0258509299404568402D0) C .. Scalar Arguments .. DOUBLE PRECISION a,b,eps,lambda,x,y C .. C .. Local Scalars .. DOUBLE PRECISION alpha,an,anp1,beta,bn,bnp1,c,c0,c1,e,n,p,r,r0,s, + t,w,yp1 INTEGER scala,scalb C .. C .. Intrinsic Functions .. INTRINSIC abs C .. C .. Executable Statements .. C-------------------- scala = 0 scalb = 0 C c = 1.0D0 + lambda c0 = b/a c1 = 1.0D0 + 1.0D0/a yp1 = y + 1.0D0 C n = 0.0D0 p = 1.0D0 s = a + 1.0D0 an = 0.0D0 bn = 1.0D0 anp1 = 1.0D0 bnp1 = c/c1 r = c1/c r0 = r C C CONTINUED FRACTION CALCULATION C 10 n = n + 1.0D0 t = n/a w = n* (b-n)*x e = a/s alpha = (p* (p+c0)*e*e)* (w*x) e = (1.0D0+t)/ (c1+t+t) beta = n + w/s + e* (c+n*yp1) p = 1.0D0 + t s = s + 2.0D0 C C UPDATE AN, BN, ANP1, AND BNP1 C t = alpha*an + beta*anp1 an = anp1 anp1 = t t = alpha*bn + beta*bnp1 bn = bnp1 bnp1 = t C r = anp1/bnp1 IF (abs(r-r0).LE.eps*r) GO TO 70 C C RESCALE AN, BN, ANP1, AND BNP1 C r0 = r 20 IF (.NOT. (abs(anp1).GT.otten)) GO TO 30 anp1 = anp1*otnten an = an*otnten r0 = r0*otnten scala = scala + 1 GO TO 20 30 IF (.NOT. (abs(anp1).LT.otnten)) GO TO 40 anp1 = anp1*otten an = an*otten r0 = r0*otten scala = scala - 1 GO TO 30 40 IF (.NOT. (abs(bnp1).GT.otten)) GO TO 50 bnp1 = bnp1*otnten bn = bn*otnten r0 = r0*otten scalb = scalb + 1 GO TO 40 50 IF (.NOT. (abs(bnp1).LT.otnten)) GO TO 60 bnp1 = bnp1*otten bn = bn*otten r0 = r0*otnten scalb = scalb - 1 GO TO 50 60 GO TO 10 C C TERMINATION C 70 CONTINUE lbfrac = log(r) + (scala-scalb)*lotten RETURN END SUBROUTINE ltlf(w,dfn,dfd,lcum,ltail) C********************************************************************** C C SUBROUTINE LTLF( W, DFN, DFD, LCUM, LTAIL) C Logarithms of the Tails of the Log-F Distribution C C C Function C C C Let F(Z|DFN,DFD) be the cumulative F distribution with degrees C of freedom DFN and DFD. Let W have a Log-F distribtuion with C the same degrees of freedom. That is, exp(W) is distributed C as F. C C This routine calculates the cumulative and tail of the log-F C LCUM = log(F(exp(W)|DFN,DFD)) C LTAIL = log(1 - F(exp(W)|DFN,DFD)) C C C Arguments C C C W --> Argument at which the tails of the Log-F are to C be evaluated C DOUBLE PRECISION W C C DFN --> Numerator degrees of freedom of the F and Log-F C distribution C DOUBLE PRECISION DFN C C DFD --> Denominator degrees of freedom of the F and Log-F C distribution C DOUBLE PRECISION DFD C C LCUM <-- Cumulative of Log-F and -infinity to W, i.e., C LOG(F(EXP(W)|DFN,DFD)) C DOUBLE PRECISION LCUM C C LTAIL <-- Tail of Log-F from WW to infinity, i.e., C LOG(1-F(EXP(W)|DFN,DFD)) C DOUBLE PRECISION LTAIL C C C Method C C C The overall strategy is to compute accurately the smaller of C LCUM and or LTAIL and to derive the other from it. Five C steps are taken in this calculation. C C (1) See if the argument to the F is small enough that the C associated incomplete beta density is well approximated C by a polynomial. This is done for both (W,DFN,DFD) and C (-W,DFD,DFN). If W cannot be exponentiated, this case C will return the answer. C C (2) Use BRATIO to return both the cumulative and tail F. C Accept the answer unless the smaller of the two numbers is C zero. C C (3) If BRATIO returns 0 try asymptotic calculation in C LAYMP. If a and b are large and x or y is approximately C the mean this method is used. C C (4) If methods 1 to 3 fail try using the Continued Fraction C approximation to the incomplete beta. C C (5) If methods 1 to 4 fail use series 26.6.5 of Abramowitz C and Stegun "Handbook of Mathematical Functions". C C********************************************************************** C .. Parameters .. DOUBLE PRECISION zero PARAMETER (zero=0.0D0) DOUBLE PRECISION thp PARAMETER (thp=0.03D0) DOUBLE PRECISION half PARAMETER (half=0.5D0) DOUBLE PRECISION pt7 PARAMETER (pt7=0.7D0) DOUBLE PRECISION one PARAMETER (one=1.0D0) DOUBLE PRECISION fiften PARAMETER (fiften=15.0D0) DOUBLE PRECISION forty PARAMETER (forty=40.0D0) DOUBLE PRECISION hundrd PARAMETER (hundrd=100.0D0) DOUBLE PRECISION tiny PARAMETER (tiny=-1.0D-13) DOUBLE PRECISION loghaf PARAMETER (loghaf=-0.6931471805599453D0) C .. C .. Scalar Arguments .. DOUBLE PRECISION w,dfd,dfn,lcum,ltail C .. C .. Local Scalars .. DOUBLE PRECISION eps,epsold,eps3,eps5,dfdold,dfnold,a,b,la,lb,bda, + lbda,l1padb,l1pbda,trm,thpab,logz,logx,logy,z,x, + y,lambda,frac,sum INTEGER ierr LOGICAL qagb,qtail C .. C .. Intrinsic Functions .. INTRINSIC abs,exp,log,max,min C .. C .. Save statement .. SAVE dfdold,dfnold,a,b,la,lb,bda,lbda,l1padb,l1pbda,thpab,trm, + qagb,eps,epsold,eps3,eps5 C .. C .. External Functions .. DOUBLE PRECISION dln1px,spmpar,dln1pe,dbetrm,lbfrac,lasym,series EXTERNAL dln1px,spmpar,dln1pe,dbetrm,lbfrac,lasym,series C .. C .. External Subroutines .. EXTERNAL bratio C .. C .. Statement Functions .. C C The following statement functions are defined: C (1) CTC - Calculates LTAIL from LCUM or LCUM from LTAIL. C DOUBLE PRECISION ctc ctc(x) = dln1px(-exp(x)) C .. C .. Data statements .. DATA dfnold/-1.0D0/,dfdold/-1.0D0/ DATA eps/-1.0D0/,epsold/-2.0D0/ C .. C .. Executable Statements .. C C EPS, EPS3 and EPS5 are machine dependent and only need to be C calculated once per execution of a program calling ltlf. C IF (eps.NE.epsold) THEN eps = spmpar(1) epsold = eps eps3 = hundrd*eps eps5 = fiften*eps END IF C C This subroutine is designed so that it can efficiently be C called multiple times with the same DFN and DFD but different C values of the other parameters. The calculations C inside the next if statement are done the first time C the subroutine is called with a specific DFN and DFD C but not on subsequent calls. C IF ((dfnold.NE.dfn) .OR. (dfdold.NE.dfd)) THEN dfnold = dfn dfdold = dfd a = half*dfn b = half*dfd C C Compute values based on a and b only. The following values C are defined: C (1) LA = LOG(A) C (2) LB = LOG(B) C (3) BDA = B/A C (4) LBDA = LOG(B/A) C (5) L1PADB = LOG(1 + A/B) C (6) L1PBDA = LOG(1 + B/A) C (7) TRM = DBETRM(A,B) C (8) THPAB = THP*MIN(A,B) C (9) QAGB = A .GE. B C la = log(a) lb = log(b) bda = b/a lbda = log(bda) trm = dbetrm(a,b) l1padb = dln1px(one/bda) l1pbda = dln1px(bda) thpab = thp*min(a,b) qagb = a .GE. b END IF C C Calculate logx and logy. C logz = lbda - w logx = -dln1pe(-logz) logy = -dln1pe(logz) x = exp(logx) y = exp(logy) C C Try Extreme Value Calculations. C C First try for ltail C IF ((abs(a-one)*logy).GE.tiny) THEN IF (qagb) THEN ltail = -half*lb + (a+b-half)*l1pbda + b* (logy-w) - trm ELSE ltail = (-a+half)*la + (a-one)*lb + (a+b-half)*l1padb + + b*logx - trm END IF IF (ltail.LE.loghaf) THEN lcum = ctc(ltail) RETURN END IF END IF C C If this fails try lcum C IF ((abs(b-one)*logx).GE.tiny) THEN IF (qagb) THEN lcum = (-b+half)*lb + (b-one)*la + (a+b-half)*l1pbda + + a*logy - trm ELSE lcum = -half*la + (a+b-half)*l1padb + a* (logx+w) - trm END IF IF (lcum.LE.loghaf) THEN ltail = ctc(lcum) RETURN END IF END IF C C If asymptotic don't work try using bratio to calculate cum and tai C We will accept the answer if both cum and tail are > 0 C CALL bratio(b,a,x,y,ltail,lcum,ierr) qtail = ltail .LE. lcum IF (min(ltail,lcum).GT.zero) THEN IF (qtail) THEN ltail = log(ltail) lcum = ctc(ltail) ELSE lcum = log(lcum) ltail = ctc(lcum) END IF RETURN END IF C C Now asymptotics and bratio haven't worked. If qtail is true C we will calculate tail. C IF (qtail) THEN C C If a > 100 and b > 100 and x close to the mean we will use lasym C to calculate ltail. C IF (qagb) THEN lambda = b - (a+b)*x ELSE lambda = (a+b)*y - a END IF C IF ((a.GT.hundrd) .AND. (b.GT.hundrd) .AND. + (lambda.GT.zero) .AND. (lambda.LE.thpab)) THEN ltail = lasym(b,a,lambda,eps3) lcum = ctc(ltail) RETURN END IF C C Use LBFRAC C IF ((a.GT.forty) .AND. (b.GT.forty) .AND. + (lambda.GE.thpab) .AND. (a*x.GE.pt7)) THEN frac = lbfrac(b,a,x,y,lambda,eps5) IF (qagb) THEN ltail = half*lb + (a+b-half)*l1pbda + (b+a)*logy - + b*w - trm + frac ELSE ltail = half*la + (a+b-half)*l1padb + (b+a)*logx + + a*w - trm + frac END IF lcum = ctc(ltail) RETURN END IF C C Since all other methods haven't work we must use a series C evaluation. Note, we are computing the incomplete beta with C arguement X and parameters B and A. C z = exp(logz) sum = series(a,b,z) IF (qagb) THEN ltail = -half*lb + (a+b-half)*l1pbda + (b+a-one)*logy - + b*w - trm + sum ELSE ltail = -half*la + (a+b-half)*l1padb + (b+a-one)*logx + + (a-one)*w - trm + sum END IF lcum = ctc(ltail) RETURN C C If qtail is false we will calculate tail. C ELSE C C LASYMP. C IF (qagb) THEN lambda = (a+b)*x - b ELSE lambda = a - (a+b)*y END IF C IF ((a.GT.hundrd) .AND. (b.GT.hundrd) .AND. + (lambda.GT.zero) .AND. (lambda.LE.thpab)) THEN lcum = lasym(a,b,lambda,eps3) ltail = ctc(lcum) RETURN END IF C C Use LBFRAC C IF ((a.GT.forty) .AND. (b.GT.forty) .AND. + (lambda.GE.thpab) .AND. (b*y.GE.0.7D0)) THEN frac = lbfrac(a,b,y,x,lambda,eps5) IF (qagb) THEN lcum = half*lb + (a+b-half)*l1pbda + (b+a)*logy - + b*w - trm + frac ELSE lcum = half*la + (a+b-half)*l1padb + (b+a)*logx + + a*w - trm + frac END IF ltail = ctc(lcum) RETURN END IF C C Since all other methods haven't work we must use a series C evaluation. C z = one/exp(logz) sum = series(b,a,z) IF (qagb) THEN lcum = -half*lb + (a+b-half)*l1pbda + (b+a-one)*logy - + (b-one)*w - trm + sum ELSE lcum = -half*la + (a+b-half)*l1padb + (b+a-one)*logx + + a*w - trm + sum END IF ltail = ctc(lcum) RETURN C END IF END DOUBLE PRECISION FUNCTION psi(xx) C--------------------------------------------------------------------- C C EVALUATION OF THE DIGAMMA FUNCTION C C ----------- C C PSI(XX) IS ASSIGNED THE VALUE 0 WHEN THE DIGAMMA FUNCTION CANNOT C BE COMPUTED. C C THE MAIN COMPUTATION INVOLVES EVALUATION OF RATIONAL CHEBYSHEV C APPROXIMATIONS PUBLISHED IN MATH. COMP. 27, 123-127(1973) BY C CODY, STRECOK AND THACHER. C C--------------------------------------------------------------------- C PSI WAS WRITTEN AT ARGONNE NATIONAL LABORATORY FOR THE FUNPACK C PACKAGE OF SPECIAL FUNCTION SUBROUTINES. PSI WAS MODIFIED BY C A.H. MORRIS (NSWC). C--------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION xx C .. C .. Local Scalars .. DOUBLE PRECISION aug,den,dx0,piov4,sgn,upper,w,x,xmax1,xmx0, + xsmall,z INTEGER i,m,n,nq C .. C .. Local Arrays .. DOUBLE PRECISION p1(7),p2(4),q1(6),q2(4) C .. C .. External Functions .. DOUBLE PRECISION spmpar INTEGER ipmpar EXTERNAL spmpar,ipmpar C .. C .. Intrinsic Functions .. INTRINSIC abs,cos,dble,dlog,dmin1,int,sin C .. C .. Data statements .. C--------------------------------------------------------------------- C C PIOV4 = PI/4 C DX0 = ZERO OF PSI TO EXTENDED PRECISION C C--------------------------------------------------------------------- C--------------------------------------------------------------------- C C COEFFICIENTS FOR RATIONAL APPROXIMATION OF C PSI(X) / (X - X0), 0.5 .LE. X .LE. 3.0 C C--------------------------------------------------------------------- C--------------------------------------------------------------------- C C COEFFICIENTS FOR RATIONAL APPROXIMATION OF C PSI(X) - LN(X) + 1 / (2*X), X .GT. 3.0 C C--------------------------------------------------------------------- DATA piov4/.785398163397448D0/ DATA dx0/1.461632144968362341262659542325721325D0/ DATA p1(1)/.895385022981970D-02/,p1(2)/.477762828042627D+01/, + p1(3)/.142441585084029D+03/,p1(4)/.118645200713425D+04/, + p1(5)/.363351846806499D+04/,p1(6)/.413810161269013D+04/, + p1(7)/.130560269827897D+04/ DATA q1(1)/.448452573429826D+02/,q1(2)/.520752771467162D+03/, + q1(3)/.221000799247830D+04/,q1(4)/.364127349079381D+04/, + q1(5)/.190831076596300D+04/,q1(6)/.691091682714533D-05/ DATA p2(1)/-.212940445131011D+01/,p2(2)/-.701677227766759D+01/, + p2(3)/-.448616543918019D+01/,p2(4)/-.648157123766197D+00/ DATA q2(1)/.322703493791143D+02/,q2(2)/.892920700481861D+02/, + q2(3)/.546117738103215D+02/,q2(4)/.777788548522962D+01/ C .. C .. Executable Statements .. C--------------------------------------------------------------------- C C MACHINE DEPENDENT CONSTANTS ... C C XMAX1 = THE SMALLEST POSITIVE FLOATING POINT CONSTANT C WITH ENTIRELY INTEGER REPRESENTATION. ALSO USED C AS NEGATIVE OF LOWER BOUND ON ACCEPTABLE NEGATIVE C ARGUMENTS AND AS THE POSITIVE ARGUMENT BEYOND WHICH C PSI MAY BE REPRESENTED AS ALOG(X). C C XSMALL = ABSOLUTE ARGUMENT BELOW WHICH PI*COTAN(PI*X) C MAY BE REPRESENTED BY 1/X. C C--------------------------------------------------------------------- xmax1 = ipmpar(3) xmax1 = dmin1(xmax1,1.0D0/spmpar(1)) xsmall = 1.D-9 C--------------------------------------------------------------------- x = xx aug = 0.0D0 IF (x.GE.0.5D0) GO TO 50 C--------------------------------------------------------------------- C X .LT. 0.5, USE REFLECTION FORMULA C PSI(1-X) = PSI(X) + PI * COTAN(PI*X) C--------------------------------------------------------------------- IF (abs(x).GT.xsmall) GO TO 10 IF (x.EQ.0.0D0) GO TO 100 C--------------------------------------------------------------------- C 0 .LT. ABS(X) .LE. XSMALL. USE 1/X AS A SUBSTITUTE C FOR PI*COTAN(PI*X) C--------------------------------------------------------------------- aug = -1.0D0/x GO TO 40 C--------------------------------------------------------------------- C REDUCTION OF ARGUMENT FOR COTAN C--------------------------------------------------------------------- 10 w = -x sgn = piov4 IF (w.GT.0.0D0) GO TO 20 w = -w sgn = -sgn C--------------------------------------------------------------------- C MAKE AN ERROR EXIT IF X .LE. -XMAX1 C--------------------------------------------------------------------- 20 IF (w.GE.xmax1) GO TO 100 nq = int(w) w = w - dble(nq) nq = int(w*4.0D0) w = 4.0D0* (w-dble(nq)*.25D0) C--------------------------------------------------------------------- C W IS NOW RELATED TO THE FRACTIONAL PART OF 4.0 * X. C ADJUST ARGUMENT TO CORRESPOND TO VALUES IN FIRST C QUADRANT AND DETERMINE SIGN C--------------------------------------------------------------------- n = nq/2 IF ((n+n).NE.nq) w = 1.0D0 - w z = piov4*w m = n/2 IF ((m+m).NE.n) sgn = -sgn C--------------------------------------------------------------------- C DETERMINE FINAL VALUE FOR -PI*COTAN(PI*X) C--------------------------------------------------------------------- n = (nq+1)/2 m = n/2 m = m + m IF (m.NE.n) GO TO 30 C--------------------------------------------------------------------- C CHECK FOR SINGULARITY C--------------------------------------------------------------------- IF (z.EQ.0.0D0) GO TO 100 C--------------------------------------------------------------------- C USE COS/SIN AS A SUBSTITUTE FOR COTAN, AND C SIN/COS AS A SUBSTITUTE FOR TAN C--------------------------------------------------------------------- aug = sgn* ((cos(z)/sin(z))*4.0D0) GO TO 40 30 aug = sgn* ((sin(z)/cos(z))*4.0D0) 40 x = 1.0D0 - x 50 IF (x.GT.3.0D0) GO TO 70 C--------------------------------------------------------------------- C 0.5 .LE. X .LE. 3.0 C--------------------------------------------------------------------- den = x upper = p1(1)*x C DO 60 i = 1,5 den = (den+q1(i))*x upper = (upper+p1(i+1))*x 60 CONTINUE C den = (upper+p1(7))/ (den+q1(6)) xmx0 = dble(x) - dx0 psi = den*xmx0 + aug RETURN C--------------------------------------------------------------------- C IF X .GE. XMAX1, PSI = LN(X) C--------------------------------------------------------------------- 70 IF (x.GE.xmax1) GO TO 90 C--------------------------------------------------------------------- C 3.0 .LT. X .LT. XMAX1 C--------------------------------------------------------------------- w = 1.0D0/ (x*x) den = w upper = p2(1)*w C DO 80 i = 1,3 den = (den+q2(i))*w upper = (upper+p2(i+1))*w 80 CONTINUE C aug = upper/ (den+q2(4)) - 0.5D0/x + aug 90 psi = aug + dlog(x) RETURN C--------------------------------------------------------------------- C ERROR RETURN C--------------------------------------------------------------------- 100 psi = 0.0D0 RETURN END DOUBLE PRECISION FUNCTION rexp(x) C----------------------------------------------------------------------- C EVALUATION OF THE FUNCTION EXP(X) - 1 C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION x C .. C .. Local Scalars .. DOUBLE PRECISION p1,p2,q1,q2,q3,q4,w C .. C .. Intrinsic Functions .. INTRINSIC abs,exp C .. C .. Data statements .. DATA p1/.914041914819518D-09/,p2/.238082361044469D-01/, + q1/-.499999999085958D+00/,q2/.107141568980644D+00/, + q3/-.119041179760821D-01/,q4/.595130811860248D-03/ C .. C .. Executable Statements .. C----------------------- IF (abs(x).GT.0.15D0) GO TO 10 rexp = x* (((p2*x+p1)*x+1.0D0)/ ((((q4*x+q3)*x+q2)*x+q1)*x+1.0D0)) RETURN C 10 w = exp(x) IF (x.GT.0.0D0) GO TO 20 rexp = (w-0.5D0) - 0.5D0 RETURN 20 rexp = w* (0.5D0+ (0.5D0-1.0D0/w)) RETURN END DOUBLE PRECISION FUNCTION rlog1(x) C----------------------------------------------------------------------- C EVALUATION OF THE FUNCTION X - LN(1 + X) C----------------------------------------------------------------------- C .. Scalar Arguments .. DOUBLE PRECISION x C .. C .. Local Scalars .. DOUBLE PRECISION a,b,h,p0,p1,p2,q1,q2,r,t,w,w1 C .. C .. Intrinsic Functions .. INTRINSIC dble,dlog C .. C .. Data statements .. C------------------------ DATA a/.566749439387324D-01/ DATA b/.456512608815524D-01/ DATA p0/.333333333333333D+00/,p1/-.224696413112536D+00/, + p2/.620886815375787D-02/ DATA q1/-.127408923933623D+01/,q2/.354508718369557D+00/ C .. C .. Executable Statements .. C------------------------ IF (x.LT.-0.39D0 .OR. x.GT.0.57D0) GO TO 40 IF (x.LT.-0.18D0) GO TO 10 IF (x.GT.0.18D0) GO TO 20 C C ARGUMENT REDUCTION C h = x w1 = 0.0D0 GO TO 30 C 10 h = dble(x) + 0.3D0 h = h/0.7D0 w1 = a - h*0.3D0 GO TO 30 C 20 h = 0.75D0*dble(x) - 0.25D0 w1 = b + h/3.0D0 C C SERIES EXPANSION C 30 r = h/ (h+2.0D0) t = r*r w = ((p2*t+p1)*t+p0)/ ((q2*t+q1)*t+1.0D0) rlog1 = 2.0D0*t* (1.0D0/ (1.0D0-r)-r*w) + w1 RETURN C C 40 w = (x+0.5D0) + 0.5D0 rlog1 = x - dlog(w) RETURN END DOUBLE PRECISION FUNCTION series(a,b,z) C---------------------------------------------------------------------- C C Calculates log of C 1 + [Beta(A+1,n+1)/Beta(B-n-1,n+1)]*(x/(1-x))^(n+1)] n=0,1,... C This summation is part of Abramowitz and Stegun series 26.5.5 C [(x^b)*((1-x)^(a-1))/(b*Beta(a,b))]*SUM C which can be used to calculate IX(A,B). C C---------------------------------------------------------------------- C .. Parameters .. DOUBLE PRECISION zero PARAMETER (zero=0.0D0) DOUBLE PRECISION one PARAMETER (one=1.0D0) DOUBLE PRECISION tiny PARAMETER (tiny=1.0D-13) C .. C .. Scalar Arguments .. DOUBLE PRECISION a,b,z C .. C .. Local Scalars .. DOUBLE PRECISION am2,bp2,term,sum,xn,ratio LOGICAL qdone C .. C .. Intrinsic Functions .. INTRINSIC abs C .. C .. External Functions .. DOUBLE PRECISION dln1px EXTERNAL dln1px C .. C .. Executable Statements .. C C initialize variables C C qdone = .FALSE. am2 = a - one - one bp2 = b + one + one term = (a-one)*z/ (b+one) sum = zero xn = zero C C Compute sum C GO TO 20 10 IF (qdone .OR. (xn.GT.100D0)) GO TO 30 20 sum = sum + term qdone = abs(term/sum) .LE. tiny IF (.NOT.qdone) THEN ratio = (am2-xn)*z/ (bp2+xn) term = term*ratio xn = xn + one END IF GO TO 10 30 series = dln1px(sum) RETURN END DOUBLE PRECISION FUNCTION spmpar(i) C----------------------------------------------------------------------- C C SPMPAR PROVIDES THE SINGLE PRECISION MACHINE CONSTANTS FOR C THE COMPUTER BEING USED. IT IS ASSUMED THAT THE ARGUMENT C I IS AN INTEGER HAVING ONE OF THE VALUES 1, 2, OR 3. IF THE C SINGLE PRECISION ARITHMETIC BEING USED HAS M BASE B DIGITS AND C ITS SMALLEST AND LARGEST EXPONENTS ARE EMIN AND EMAX, THEN C C SPMPAR(1) = B**(1 - M), THE MACHINE PRECISION, C C SPMPAR(2) = B**(EMIN - 1), THE SMALLEST MAGNITUDE, C C SPMPAR(3) = B**EMAX*(1 - B**(-M)), THE LARGEST MAGNITUDE. C C----------------------------------------------------------------------- C WRITTEN BY C ALFRED H. MORRIS, JR. C NAVAL SURFACE WARFARE CENTER C DAHLGREN VIRGINIA C----------------------------------------------------------------------- C MODIFIED BY BARRY W. BROWN TO RETURN DOUBLE PRECISION MACHINE C CONSTANTS FOR THE COMPUTER BEING USED. THIS MODIFICATION WAS C MADE AS PART OF CONVERTING BRATIO TO DOUBLE PRECISION C----------------------------------------------------------------------- C .. Scalar Arguments .. INTEGER i C .. C .. Local Scalars .. DOUBLE PRECISION b,binv,bm1,one,w,z INTEGER emax,emin,ibeta,m C .. C .. External Functions .. INTEGER ipmpar EXTERNAL ipmpar C .. C .. Intrinsic Functions .. INTRINSIC dble C .. C .. Executable Statements .. C IF (i.GT.1) GO TO 10 b = ipmpar(4) m = ipmpar(8) spmpar = b** (1-m) RETURN C 10 IF (i.GT.2) GO TO 20 b = ipmpar(4) emin = ipmpar(9) one = dble(1) binv = one/b w = b** (emin+2) spmpar = ((w*binv)*binv)*binv RETURN C 20 ibeta = ipmpar(4) m = ipmpar(8) emax = ipmpar(10) C b = ibeta bm1 = ibeta - 1 one = dble(1) z = b** (m-1) w = ((z-one)*b+bm1)/ (b*z) C z = b** (emax-2) spmpar = ((w*z)*b)*b RETURN END SHAR_EOF fi # end of overwriting check if test -f 'port.f' then echo shar: will not over-write existing file "'port.f'" else cat << \SHAR_EOF > 'port.f' 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 ON RARE MACHINES A STATIC STATEMENT MAY NEED TO BE ADDED. C (BUT PROBABLY MORE SYSTEMS PROHIBIT IT THAN REQUIRE IT.) C C FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), ONE OF THE FIRST C TWO SETS OF CONSTANTS BELOW SHOULD BE APPROPRIATE. 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 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 IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T C 3B SERIES AND MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T C PC 7300), IN WHICH THE MOST SIGNIFICANT BYTE IS STORED FIRST. 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 IEEE ARITHMETIC MACHINES AND 8087-BASED C MICROS, SUCH AS THE IBM PC AND AT&T 6300, IN WHICH THE LEAST C SIGNIFICANT BYTE IS STORED FIRST. 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 AMDAHL MACHINES. C C DATA SMALL(1),SMALL(2) / 1048576, 0 / C DATA LARGE(1),LARGE(2) / 2147483647, -1 / C DATA RIGHT(1),RIGHT(2) / 856686592, 0 / C DATA DIVER(1),DIVER(2) / 873463808, 0 / C DATA LOG10(1),LOG10(2) / 1091781651, 1352628735 / 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 CONVEX C-1 C C DATA SMALL(1),SMALL(2) / '00100000'X, '00000000'X / C DATA LARGE(1),LARGE(2) / '7FFFFFFF'X, 'FFFFFFFF'X / C DATA RIGHT(1),RIGHT(2) / '3CC00000'X, '00000000'X / C DATA DIVER(1),DIVER(2) / '3CD00000'X, '00000000'X / C DATA LOG10(1),LOG10(2) / '3FF34413'X, '509F79FF'X / C C MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3. C C DATA SMALL(1) / 201354000000000000000B / C DATA SMALL(2) / 000000000000000000000B / C C DATA LARGE(1) / 577767777777777777777B / C DATA LARGE(2) / 000007777777777777776B / C C DATA RIGHT(1) / 376434000000000000000B / C DATA RIGHT(2) / 000000000000000000000B / C C DATA DIVER(1) / 376444000000000000000B / 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 LINE - 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 SLASH 6 AND SLASH 7 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 DPS 8/70 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 THE INTERDATA 8/32 C WITH THE UNIX SYSTEM FORTRAN 77 COMPILER. C C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S. C C DATA SMALL(1),SMALL(2) / Z'00100000', Z'00000000' / C DATA LARGE(1),LARGE(2) / Z'7EFFFFFF', Z'FFFFFFFF' / C DATA RIGHT(1),RIGHT(2) / Z'33100000', Z'00000000' / C DATA DIVER(1),DIVER(2) / Z'34100000', Z'00000000' / C DATA LOG10(1),LOG10(2) / Z'41134413', Z'509F79FF' / 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, "047674776746 / C C MACHINE CONSTANTS FOR PDP-11 FORTRANS 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 FORTRANS 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 PRIME 50 SERIES SYSTEMS C WTIH 32-BIT INTEGERS AND 64V MODE INSTRUCTIONS, C SUPPLIED BY IGOR BRAY. C C DATA SMALL(1),SMALL(2) / :10000000000, :00000100001 / C DATA LARGE(1),LARGE(2) / :17777777777, :37777677775 / C DATA RIGHT(1),RIGHT(2) / :10000000000, :00000000122 / C DATA DIVER(1),DIVER(2) / :10000000000, :00000000123 / C DATA LOG10(1),LOG10(2) / :11504046501, :07674600177 / C C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000 C C DATA SMALL(1),SMALL(2) / $00000000, $00100000 / C DATA LARGE(1),LARGE(2) / $FFFFFFFF, $7FEFFFFF / C DATA RIGHT(1),RIGHT(2) / $00000000, $3CA00000 / C DATA DIVER(1),DIVER(2) / $00000000, $3CB00000 / C DATA LOG10(1),LOG10(2) / $509F79FF, $3FD34413 / 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 MACHINE CONSTANTS FOR THE VAX UNIX F77 COMPILER C C DATA SMALL(1),SMALL(2) / 128, 0 / C DATA LARGE(1),LARGE(2) / -32769, -1 / C DATA RIGHT(1),RIGHT(2) / 9344, 0 / C DATA DIVER(1),DIVER(2) / 9472, 0 / C DATA LOG10(1),LOG10(2) / 546979738, -805796613 / C C MACHINE CONSTANTS FOR THE VAX-11 WITH C FORTRAN IV-PLUS COMPILER C C DATA SMALL(1),SMALL(2) / Z00000080, Z00000000 / C DATA LARGE(1),LARGE(2) / ZFFFF7FFF, ZFFFFFFFF / C DATA RIGHT(1),RIGHT(2) / Z00002480, Z00000000 / C DATA DIVER(1),DIVER(2) / Z00002500, Z00000000 / C DATA LOG10(1),LOG10(2) / Z209A3F9A, ZCFF884FB / C C MACHINE CONSTANTS FOR VAX/VMS VERSION 2.2 C C DATA SMALL(1),SMALL(2) / '80'X, '0'X / C DATA LARGE(1),LARGE(2) / 'FFFF7FFF'X, 'FFFFFFFF'X / C DATA RIGHT(1),RIGHT(2) / '2480'X, '0'X / C DATA DIVER(1),DIVER(2) / '2500'X, '0'X / C DATA LOG10(1),LOG10(2) / '209A3F9A'X, 'CFF884FB'X / C IF (i.LT.1 .OR. i.GT.5) GO TO 10 d1mach = dmach(i) RETURN 10 WRITE (i1mach(2),9000) i 9000 FORMAT (' D1MACH - I OUT OF BOUNDS',I10) STOP END INTEGER FUNCTION I1MACH(I) C C I/O UNIT NUMBERS. C C I1MACH( 1) = THE STANDARD INPUT UNIT. C C I1MACH( 2) = THE STANDARD OUTPUT UNIT. C C I1MACH( 3) = THE STANDARD PUNCH UNIT. C C I1MACH( 4) = THE STANDARD ERROR MESSAGE UNIT. C C WORDS. C C I1MACH( 5) = THE NUMBER OF BITS PER INTEGER STORAGE UNIT. C C I1MACH( 6) = THE NUMBER OF CHARACTERS PER INTEGER STORAGE UNIT. C FOR FORTRAN 77, THIS IS ALWAYS 1. FOR FORTRAN 66, C CHARACTER STORAGE UNIT = INTEGER STORAGE UNIT. C C INTEGERS. C C ASSUME INTEGERS ARE REPRESENTED IN THE S-DIGIT, BASE-A FORM C C SIGN ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) ) C C WHERE 0 .LE. X(I) .LT. A FOR I=0,...,S-1. C C I1MACH( 7) = A, THE BASE. C C I1MACH( 8) = S, THE NUMBER OF BASE-A DIGITS. C C I1MACH( 9) = A**S - 1, THE LARGEST MAGNITUDE. C C FLOATING-POINT NUMBERS. C C ASSUME FLOATING-POINT NUMBERS ARE REPRESENTED IN THE T-DIGIT, C BASE-B FORM C C SIGN (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) C C WHERE 0 .LE. X(I) .LT. B FOR I=1,...,T, C 0 .LT. X(1), AND EMIN .LE. E .LE. EMAX. C C I1MACH(10) = B, THE BASE. C C SINGLE-PRECISION C C I1MACH(11) = T, THE NUMBER OF BASE-B DIGITS. C C I1MACH(12) = EMIN, THE SMALLEST EXPONENT E. C C I1MACH(13) = EMAX, THE LARGEST EXPONENT E. C C DOUBLE-PRECISION C C I1MACH(14) = T, THE NUMBER OF BASE-B DIGITS. C C I1MACH(15) = EMIN, THE SMALLEST EXPONENT E. C C I1MACH(16) = EMAX, THE LARGEST EXPONENT E. 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. ALSO, THE VALUES OF C I1MACH(1) - I1MACH(4) SHOULD BE CHECKED FOR CONSISTENCY C WITH THE LOCAL OPERATING SYSTEM. FOR FORTRAN 77, YOU MAY WISH C TO ADJUST THE DATA STATEMENT SO IMACH(6) IS SET TO 1, AND C THEN TO COMMENT OUT THE EXECUTABLE TEST ON I .EQ. 6 BELOW. C ON RARE MACHINES A STATIC STATEMENT MAY NEED TO BE ADDED. C (BUT PROBABLY MORE SYSTEMS PROHIBIT IT THAN REQUIRE IT.) C C FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), THE FIRST C SET OF CONSTANTS BELOW SHOULD BE APPROPRIATE, EXCEPT PERHAPS C FOR IMACH(1) - IMACH(4). C INTEGER IMACH(16),OUTPUT,SANITY C EQUIVALENCE (IMACH(4),OUTPUT) C C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T C 3B SERIES, MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T C PC 7300), AND 8087 BASED MICROS (E.G. IBM PC AND AT&T 6300). DATA IMACH( 1) / 5 / DATA IMACH( 2) / 6 / DATA IMACH( 3) / 7 / DATA IMACH( 4) / 6 / DATA IMACH( 5) / 32 / DATA IMACH( 6) / 4 / DATA IMACH( 7) / 2 / DATA IMACH( 8) / 31 / DATA IMACH( 9) / 2147483647 / DATA IMACH(10) / 2 / DATA IMACH(11) / 24 / DATA IMACH(12) / -125 / DATA IMACH(13) / 128 / DATA IMACH(14) / 53 / DATA IMACH(15) / -1021 / DATA IMACH(16) / 1024 /, SANITY/987/ C C MACHINE CONSTANTS FOR AMDAHL MACHINES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 63 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 63 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. C C DATA IMACH( 1) / 7 / C DATA IMACH( 2) / 2 / C DATA IMACH( 3) / 2 / C DATA IMACH( 4) / 2 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 33 / C DATA IMACH( 9) / Z1FFFFFFFF / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -256 / C DATA IMACH(13) / 255 / C DATA IMACH(14) / 60 / C DATA IMACH(15) / -256 / C DATA IMACH(16) / 255 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 48 / C DATA IMACH( 6) / 6 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 39 / C DATA IMACH( 9) / O0007777777777777 / C DATA IMACH(10) / 8 / C DATA IMACH(11) / 13 / C DATA IMACH(12) / -50 / C DATA IMACH(13) / 76 / C DATA IMACH(14) / 26 / C DATA IMACH(15) / -50 / C DATA IMACH(16) / 76 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 48 / C DATA IMACH( 6) / 6 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 39 / C DATA IMACH( 9) / O0007777777777777 / C DATA IMACH(10) / 8 / C DATA IMACH(11) / 13 / C DATA IMACH(12) / -50 / C DATA IMACH(13) / 76 / C DATA IMACH(14) / 26 / C DATA IMACH(15) / -32754 / C DATA IMACH(16) / 32780 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 60 / C DATA IMACH( 6) / 10 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 48 / C DATA IMACH( 9) / 00007777777777777777B / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 48 / C DATA IMACH(12) / -974 / C DATA IMACH(13) / 1070 / C DATA IMACH(14) / 96 / C DATA IMACH(15) / -927 / C DATA IMACH(16) / 1070 /, SANITY/987/ C C MACHINE CONSTANTS FOR CONVEX C-1. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 53 / C DATA IMACH(15) /-1024 / C DATA IMACH(16) / 1023 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 102 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 64 / C DATA IMACH( 6) / 8 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 63 / C DATA IMACH( 9) / 777777777777777777777B / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 47 / C DATA IMACH(12) / -8189 / C DATA IMACH(13) / 8190 / C DATA IMACH(14) / 94 / C DATA IMACH(15) / -8099 / C DATA IMACH(16) / 8190 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200. C C DATA IMACH( 1) / 11 / C DATA IMACH( 2) / 12 / C DATA IMACH( 3) / 8 / C DATA IMACH( 4) / 10 / C DATA IMACH( 5) / 16 / C DATA IMACH( 6) / 2 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 15 / C DATA IMACH( 9) /32767 / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 63 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 63 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 0 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 24 / C DATA IMACH( 6) / 3 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 23 / C DATA IMACH( 9) / 8388607 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 23 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 38 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 43 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / O377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 63 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ 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 IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / Z7FFFFFFF / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 63 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 63 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE INTERDATA 8/32 C WITH THE UNIX SYSTEM FORTRAN 77 COMPILER. C C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 6 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / Z'7FFFFFFF' / C DATA IMACH(10) / 16 / C DATA IMACH(11) / 6 / C DATA IMACH(12) / -64 / C DATA IMACH(13) / 62 / C DATA IMACH(14) / 14 / C DATA IMACH(15) / -64 / C DATA IMACH(16) / 62 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 5 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / "377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 54 / C DATA IMACH(15) / -101 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 5 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / "377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 62 / C DATA IMACH(15) / -128 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 32-BIT INTEGER ARITHMETIC. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 56 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING C 16-BIT INTEGER ARITHMETIC. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 16 / C DATA IMACH( 6) / 2 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 15 / C DATA IMACH( 9) / 32767 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 56 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE PRIME 50 SERIES SYSTEMS C WTIH 32-BIT INTEGERS AND 64V MODE INSTRUCTIONS, C SUPPLIED BY IGOR BRAY. C C DATA IMACH( 1) / 1 / C DATA IMACH( 2) / 1 / C DATA IMACH( 3) / 2 / C DATA IMACH( 4) / 1 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / :17777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 23 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / +127 / C DATA IMACH(14) / 47 / C DATA IMACH(15) / -32895 / C DATA IMACH(16) / +32637 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000. C C DATA IMACH( 1) / 0 / C DATA IMACH( 2) / 0 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 0 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 1 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -125 / C DATA IMACH(13) / 128 / C DATA IMACH(14) / 53 / C DATA IMACH(15) / -1021 / C DATA IMACH(16) / 1024 /, SANITY/987/ C C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. C C NOTE THAT THE PUNCH UNIT, I1MACH(3), HAS BEEN SET TO 7 C WHICH IS APPROPRIATE FOR THE UNIVAC-FOR SYSTEM. C IF YOU HAVE THE UNIVAC-FTN SYSTEM, SET IT TO 1. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 36 / C DATA IMACH( 6) / 6 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 35 / C DATA IMACH( 9) / O377777777777 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 27 / C DATA IMACH(12) / -128 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 60 / C DATA IMACH(15) /-1024 / C DATA IMACH(16) / 1023 /, SANITY/987/ C C MACHINE CONSTANTS FOR VAX. C C DATA IMACH( 1) / 5 / C DATA IMACH( 2) / 6 / C DATA IMACH( 3) / 7 / C DATA IMACH( 4) / 6 / C DATA IMACH( 5) / 32 / C DATA IMACH( 6) / 4 / C DATA IMACH( 7) / 2 / C DATA IMACH( 8) / 31 / C DATA IMACH( 9) / 2147483647 / C DATA IMACH(10) / 2 / C DATA IMACH(11) / 24 / C DATA IMACH(12) / -127 / C DATA IMACH(13) / 127 / C DATA IMACH(14) / 56 / C DATA IMACH(15) / -127 / C DATA IMACH(16) / 127 /, SANITY/987/ C C *** ISSUE STOP 777 IF ALL DATA STATEMENTS ARE COMMENTED... IF (SANITY .NE. 987) STOP 777 IF (I .LT. 1 .OR. I .GT. 16) GO TO 999 I1MACH=IMACH(I) C/6S C/7S IF(I.EQ.6) I1MACH=1 C/ RETURN 999 WRITE(OUTPUT,1999) I 1999 FORMAT(' I1MACH - I OUT OF BOUNDS',I10) STOP END SHAR_EOF fi # end of overwriting check cd .. cd .. # End of shell archive exit 0