1 | SUBROUTINE adg_tab(phi,g,a)
2 | IMPLICIT NONE
3 |
4 | DOUBLE PRECISION phi,g,a
5 | DOUBLE PRECISION lphi,alphaphi,betaphi
6 | INTEGER iphi
7 | DOUBLE PRECISION fg,alphag,betag
8 | INTEGER ig
9 | DOUBLE PRECISION tmp1,tmpa1,tmpa2
10 |
11 | INCLUDE 'tab_ck.inc'
12 |
13 | lphi=dlog(phi)
14 | IF (lphi.LE.lphitab(0)) THEN
15 | iphi=0
16 | betaphi=0.D+0
17 | alphaphi=1.D+0
18 | ELSEIF (lphi.GE.lphitab(n_phitab)) THEN
19 | iphi=n_phitab-1
20 | betaphi=1.D+0
21 | alphaphi=0.D+0
22 | ELSE
23 | tmp1=
24 | & (lphi-lphitab(0))
25 | & /(lphitab(n_phitab)-lphitab(0))
26 | & *n_phitab
27 | iphi=int(tmp1)
28 | betaphi=tmp1-iphi
29 | alphaphi=1.D+0-betaphi
30 | ENDIF
31 |
32 | fg=(1.D+0-g)**coef_fg
33 | IF (fg.GE.fgtab(0)) THEN
34 | ig=0
35 | betag=0.D+0
36 | alphag=1.D+0
37 | ELSEIF (fg.LE.fgtab(n_gtab)) THEN
38 | ig=n_gtab-1
39 | betag=1.D+0
40 | alphag=0.D+0
41 | ELSE
42 | tmp1=
43 | & (fg-fgtab(0))
44 | & /(fgtab(n_gtab)-fgtab(0))
45 | & *n_gtab
46 | ig=int(tmp1)
47 | betag=tmp1-ig
48 | alphag=1.D+0-betag
49 | ENDIF
50 | c ig=0
51 | c DO i_gtab=1,n_gtab
52 | c IF (gtab(i_gtab).LE.g) ig=i_gtab
53 | c ENDDO
54 | c IF (ig.EQ.n_gtab) THEN
55 | c alphag=1.D+0
56 | c betag=0.D+0
57 | c ELSE
58 | c tmp1=(g-gtab(ig))/(gtab(ig+1)-gtab(ig))
59 | c betag=tmp1
60 | c alphag=1.D+0-betag
61 | c ENDIF
62 |
63 | tmpa1=alphaphi*atab(iphi,ig)+betaphi*atab(iphi+1,ig)
64 | tmpa2=alphaphi*atab(iphi,ig+1)+betaphi*atab(iphi+1,ig+1)
65 | a=alphag*tmpa1+betag*tmpa2
66 |
67 | RETURN
68 | END
adg_tab.f could be called by: