Blame view
fvn_fnlib/z9ln2r.f
1.94 KB
0c3098aed ChW 02/2010 for t... |
1 |
complex(kind(1.d0)) function z9ln2r (z) |
38581db0c git-svn-id: https... |
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 |
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 |
0c3098aed ChW 02/2010 for t... |
30 31 32 |
complex(kind(1.d0)) z real(kind(1.d0)) x,y,xz,yz,cabsz,d9ln2r,d9atn1,arg,rpart,aipart, 1 y1x |
38581db0c git-svn-id: https... |
33 34 35 36 37 38 39 40 41 |
external d9atn1, d9ln2r c x = real (z) y = aimag (z) c cabsz = abs(z) if (cabsz.gt.0.8125) go to 20 c |
0c3098aed ChW 02/2010 for t... |
42 |
z9ln2r = cmplx (1.0/3.0, 0.0, kind(1.d0)) |
38581db0c git-svn-id: https... |
43 44 45 46 47 48 49 50 51 52 |
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 |
0c3098aed ChW 02/2010 for t... |
53 54 |
z9ln2r = cmplx(xz,-yz,kind(1.d0))**3 * 1 cmplx(rpart,aipart,kind(1.d0)) |
38581db0c git-svn-id: https... |
55 56 57 58 59 60 |
return c 20 z9ln2r = (log(1.0+z) - z*(1.0-0.5*z)) / z**3 return c end |