Blame view

fvn_fnlib/z9ln2r.f 1.87 KB
38581db0c   daniau   git-svn-id: https...
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
        complex(8) function z9ln2r (z)
        implicit none
  c april 1978 edition.  w. fullerton c3, los alamos scientific lab.
  c
  c evaluate  clog(1+z)  from 2-nd order with relative error accuracy so
  c that     clog(1+z) = z - z**2/2 + z**3*c9ln2r(z).
  c
  c now  clog(1+z) = 0.5*alog(1+2*x+cabs(z)**2) + i*carg(1+z),
  c where x = real(z)  and  y = aimag(z).
  c we find
  c     z**3 * c9ln2r(z) = -x*cabs(z)**2 - 0.25*cabs(z)**4
  c        + (2*x+cabs(z)**2)**3 * r9ln2r(2*x+cabs(z)**2)
  c        + i * (carg(1+z) + (x-1)*y)
  c the imaginary part must be evaluated carefully as
  c     (atan(y/(1+x)) - y/(1+x)) + y/(1+x) - (1-x)*y
  c       = (y/(1+x))**3 * r9atn1(y/(1+x)) + x**2*y/(1+x)
  c
  c now we divide through by z**3 carefully.  write
  c     1/z**3 = (x-i*y)/cabs(z)**3 * (1/cabs(z)**3)
  c then   c9ln2r(z) = ((x-i*y)/cabs(z))**3 * (-x/cabs(z) - cabs(z)/4
  c        + 0.5*((2*x+cabs(z)**2)/cabs(z))**3 * r9ln2r(2*x+cabs(z)**2)
  c        + i*y/(cabs(z)*(1+x)) * ((x/cabs(z))**2 +
  c          + (y/(cabs(z)*(1+x)))**2 * r9atn1(y/(1+x)) ) )
  c
  c if we let  xz = x/cabs(z)  and  yz = y/cabs(z)  we may write
  c     c9ln2r(z) = (xz-i*yz)**3 * (-xz - cabs(z)/4
  c        + 0.5*(2*xz+cabs(z))**3 * r9ln2r(2*x+cabs(z)**2)
  c        + i*yz/(1+x) * (xz**2 + (yz/(1+x))**2*r9atn1(y/(1+x)) ))
  c
        complex(8) z
        real(8) x,y,xz,yz,cabsz,d9ln2r,d9atn1,arg,rpart,aipart,y1x
        
        external d9atn1, d9ln2r
  c
        x = real (z)
        y = aimag (z)
  c
        cabsz = abs(z)
        if (cabsz.gt.0.8125) go to 20
  c
        z9ln2r = dcmplx (1.0/3.0, 0.0)
        if (cabsz.eq.0.0) return
  c
        xz = x/cabsz
        yz = y/cabsz
  c
        arg = 2.0*xz + cabsz
        rpart = 0.5*arg**3*d9ln2r(cabsz*arg) - xz - 0.25*cabsz
        y1x = yz/(1.0+x)
        aipart = y1x * (xz**2 + y1x**2*d9atn1(cabsz*y1x) )
  c
        z9ln2r = dcmplx(xz,-yz)**3 * dcmplx(rpart,aipart)
        return
  c
   20   z9ln2r = (log(1.0+z) - z*(1.0-0.5*z)) / z**3
        return
  c
        end