00001 *DECK ALBETA 00002 FUNCTION ALBETA (A, B) 00003 C***BEGIN PROLOGUE ALBETA 00004 C***PURPOSE Compute the natural logarithm of the complete Beta 00005 C function. 00006 C***LIBRARY SLATEC (FNLIB) 00007 C***CATEGORY C7B 00008 C***TYPE SINGLE PRECISION (ALBETA-S, DLBETA-D, CLBETA-C) 00009 C***KEYWORDS FNLIB, LOGARITHM OF THE COMPLETE BETA FUNCTION, 00010 C SPECIAL FUNCTIONS 00011 C***AUTHOR Fullerton, W., (LANL) 00012 C***DESCRIPTION 00013 C 00014 C ALBETA computes the natural log of the complete beta function. 00015 C 00016 C Input Parameters: 00017 C A real and positive 00018 C B real and positive 00019 C 00020 C***REFERENCES (NONE) 00021 C***ROUTINES CALLED ALNGAM, ALNREL, GAMMA, R9LGMC, XERMSG 00022 C***REVISION HISTORY (YYMMDD) 00023 C 770701 DATE WRITTEN 00024 C 890531 Changed all specific intrinsics to generic. (WRB) 00025 C 890531 REVISION DATE from Version 3.2 00026 C 891214 Prologue converted to Version 4.0 format. (BAB) 00027 C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 00028 C 900326 Removed duplicate information from DESCRIPTION section. 00029 C (WRB) 00030 C 900727 Added EXTERNAL statement. (WRB) 00031 C***END PROLOGUE ALBETA 00032 EXTERNAL GAMMA 00033 SAVE SQ2PIL 00034 DATA SQ2PIL / 0.9189385332 0467274 E0 / 00035 C***FIRST EXECUTABLE STATEMENT ALBETA 00036 P = MIN (A, B) 00037 Q = MAX (A, B) 00038 C 00039 IF (P .LE. 0.0) CALL XERMSG ('SLATEC', 'ALBETA', 00040 + 'BOTH ARGUMENTS MUST BE GT ZERO', 1, 2) 00041 IF (P.GE.10.0) GO TO 30 00042 IF (Q.GE.10.0) GO TO 20 00043 C 00044 C P AND Q ARE SMALL. 00045 C 00046 ALBETA = LOG(GAMMA(P) * (GAMMA(Q)/GAMMA(P+Q)) ) 00047 RETURN 00048 C 00049 C P IS SMALL, BUT Q IS BIG. 00050 C 00051 20 CORR = R9LGMC(Q) - R9LGMC(P+Q) 00052 ALBETA = ALNGAM(P) + CORR + P - P*LOG(P+Q) + 00053 1 (Q-0.5)*ALNREL(-P/(P+Q)) 00054 RETURN 00055 C 00056 C P AND Q ARE BIG. 00057 C 00058 30 CORR = R9LGMC(P) + R9LGMC(Q) - R9LGMC(P+Q) 00059 ALBETA = -0.5*LOG(Q) + SQ2PIL + CORR + (P-0.5)*LOG(P/(P+Q)) 00060 1 + Q*ALNREL(-P/(P+Q)) 00061 RETURN 00062 C 00063 END
1.7.1
