]>
Commit | Line | Data |
---|---|---|
21886bb6 | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
5 | * Revision 1.1.1.2 1996/10/30 08:27:34 cernlib | |
6 | * Version 7.04 | |
7 | * | |
8 | * Revision 1.1.1.1 1996/04/12 15:29:02 plothow | |
9 | * Version 7.01 | |
10 | * | |
11 | * | |
12 | #include "pdf/pilot.h" | |
13 | C | |
14 | FUNCTION AUGETFV(X,FVL) | |
15 | C LOGARITHMIC INTERPOLATOR - WATCH OUT FOR NEGATIVE | |
16 | C FUNCTIONS AND/OR X VALUES OUTSIDE THE RANGE 0 TO 1. | |
17 | C NOTE: DIMENSION OF FVL IS OVERWRITTEN BY VALUE USED | |
18 | C IN MAIN ROUTINE. | |
19 | DIMENSION FVL(25),XGRID(25) | |
20 | DATA NX,XGRID/25,.001,.002,.004,.008,.016,.032,.064,.1,.15, | |
21 | *.2,.25,.3,.35,.4,.45,.5,.55,.6,.65,.7,.75,.8,.85,.9,.95/ | |
22 | AUGETFV=0. | |
23 | DO 1 I=1,NX | |
24 | IF(X.LT.XGRID(I)) GO TO 2 | |
25 | 1 CONTINUE | |
26 | 2 I=I-1 | |
27 | IF(I.EQ.0) THEN | |
28 | I=I+1 | |
29 | ELSE IF(I.GT.23) THEN | |
30 | I=23 | |
31 | ENDIF | |
32 | J=I+1 | |
33 | K=J+1 | |
34 | AXI= LOG(XGRID(I)) | |
35 | BXI= LOG(1.-XGRID(I)) | |
36 | AXJ= LOG(XGRID(J)) | |
37 | BXJ= LOG(1.-XGRID(J)) | |
38 | AXK= LOG(XGRID(K)) | |
39 | BXK= LOG(1.-XGRID(K)) | |
40 | FI= LOG(ABS(FVL(I)) +1.E-15) | |
41 | FJ= LOG(ABS(FVL(J)) +1.E-16) | |
42 | FK= LOG(ABS(FVL(K)) +1.E-17) | |
43 | DET=AXI*(BXJ-BXK)+AXJ*(BXK-BXI)+AXK*(BXI-BXJ) | |
44 | ALOGA=(FI*(AXJ*BXK-AXK*BXJ)+FJ*(AXK*BXI-AXI*BXK)+FK*(AXI*BXJ-AXJ* | |
45 | $ BXI))/DET | |
46 | ALPHA=(FI*(BXJ-BXK)+FJ*(BXK-BXI)+FK*(BXI-BXJ))/DET | |
47 | BETA=(FI*(AXK-AXJ)+FJ*(AXI-AXK)+FK*(AXJ-AXI))/DET | |
48 | IF(ABS(ALPHA).GT.99..OR.ABS(BETA).GT.99..OR.ABS(ALOGA).GT.99.) | |
49 | 1RETURN | |
50 | C IF(ALPHA.GT.50..OR.BETA.GT.50.) THEN | |
51 | C WRITE(6,2001) X,FVL | |
52 | C 2001 FORMAT(8E12.4) | |
53 | C WRITE(6,2001) ALPHA,BETA,ALOGA,DET | |
54 | C ENDIF | |
55 | AUGETFV=EXP(ALOGA)*X**ALPHA*(1.-X)**BETA | |
56 | RETURN | |
57 | END |