adg_tab.f [SRC] [CPP] [JOB] [SCAN]
src



   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:
cor_tab_ck.f [src] - 16 - 17