lxsd / fvn

Download as
Browse Code ยป

Commit 0c3098aed95e9e568f02887c9ae6145422e8d857

Authored by cwaterkeyn
1 parent e711bb807c
Exists in master and in 2 other branches geevx_2020, multi

ChW 02/2010 for type definitions and dcmplx replacements in accordance to ANSI 

git-svn-id: https://lxsd.femto-st.fr/svn/fvn@69 b657c933-2333-4658-acf2-d3c7c2708721

Showing 27 changed files with 107 additions and 100 deletions Side-by-side Diff

1   - complex(8) function z0lgmc (z)
  1 + complex(kind(1.d0)) function z0lgmc (z)
2 2 implicit none
3 3 c august 1980 edition. w. fullerton c3, los alamos scientific lab.
4 4 c
... ... @@ -8,8 +8,8 @@
8 8 c = (z+0.5)*q**3*c9ln2r(q) - q**2/4,
9 9 c where c9ln2r is (clog(1+q) - q + 0.5*q**2) / q**3.
10 10 c
11   - complex(8) z, q, z9ln2r
12   - real(8) zabsz
  11 + complex(kind(1.d0)) z, q, z9ln2r
  12 + real(kind(1.d0)) zabsz
13 13  
14 14 external z9ln2r
15 15 c
1   - complex(8) function z8lgmc (zin)
  1 + complex(kind(1.d0)) function z8lgmc (zin)
2 2 implicit none
3 3 c may 1978 edition. w. fullerton, c3, los alamos scientific lab.
4 4 c
5 5  
... ... @@ -9,9 +9,10 @@
9 9 c when real(z) is negative, c8lgmc merely returns a correction which
10 10 c may be wrong by a multiple of 2*pi*i.
11 11 c
12   - complex(8) zin, z, corr, z9lgmc, z0lgmc, zexp, zlnrel
13   - real(8) d1mach,pi,bound,sqeps,eps,x,y,absz,test
  12 + complex(kind(1.d0)) zin, z, corr, z9lgmc, z0lgmc, zexp, zlnrel
  13 + real(kind(1.d0)) d1mach,pi,bound,sqeps,eps,x,y,absz,test
14 14 integer nterm,n,i,irold,ir
  15 +c complex(kind(1.d0)) tmp_arg
15 16 external z0lgmc, z9lgmc, zlnrel,
16 17 1 d1mach
17 18 data pi / 3.1415926535 8979324d0 /
... ... @@ -55,7 +56,9 @@
55 56 c
56 57 z = zin
57 58 if (y.lt.0.0) z = conjg(z)
58   - corr = -dcmplx(0.0,pi) + zlnrel(-exp(dcmplx(0.,2.*pi)*z))
  59 +c tmp_arg = -exp(cmplx(0.,2.*pi,kind(1.d0))*z)
  60 + corr = -cmplx(0.0,pi,kind(1.d0)) +
  61 + 1 zlnrel(-exp(cmplx(0.,2.*pi,kind(1.d0))*z))
59 62 if (y.lt.0.0) corr = conjg(corr)
60 63 c
61 64 z8lgmc = corr - z8lgmc
1   - complex(8) function z9lgmc (zin)
  1 + complex(kind(1.d0)) function z9lgmc (zin)
2 2 implicit none
3 3 c april 1978 edition. w. fullerton c3, los alamos scientific lab.
4 4 c
... ... @@ -7,8 +7,8 @@
7 7 c c9lgmc so that
8 8 c clog(cgamma(z)) = 0.5*alog(2.*pi) + (z-0.5)*clog(z) - z + c9lgmc(z).
9 9 c
10   - complex(8) zin, z, z2inv
11   - real(8) d1mach,bern,xbig,xmax,bound,cabsz,x,y
  10 + complex(kind(1.d0)) zin, z, z2inv
  11 + real(kind(1.d0)) d1mach,bern,xbig,xmax,bound,cabsz,x,y
12 12 integer nterm,i,ndx
13 13 external d1mach
14 14 c
1   - complex(8) function z9ln2r (z)
  1 + complex(kind(1.d0)) function z9ln2r (z)
2 2 implicit none
3 3 c april 1978 edition. w. fullerton c3, los alamos scientific lab.
4 4 c
... ... @@ -27,8 +27,9 @@
27 27 c + 0.5*(2*xz+cabs(z))**3 * r9ln2r(2*x+cabs(z)**2)
28 28 c + i*yz/(1+x) * (xz**2 + (yz/(1+x))**2*r9atn1(y/(1+x)) ))
29 29 c
30   - complex(8) z
31   - real(8) x,y,xz,yz,cabsz,d9ln2r,d9atn1,arg,rpart,aipart,y1x
  30 + complex(kind(1.d0)) z
  31 + real(kind(1.d0)) x,y,xz,yz,cabsz,d9ln2r,d9atn1,arg,rpart,aipart,
  32 + 1 y1x
32 33  
33 34 external d9atn1, d9ln2r
34 35 c
... ... @@ -38,7 +39,7 @@
38 39 cabsz = abs(z)
39 40 if (cabsz.gt.0.8125) go to 20
40 41 c
41   - z9ln2r = dcmplx (1.0/3.0, 0.0)
  42 + z9ln2r = cmplx (1.0/3.0, 0.0, kind(1.d0))
42 43 if (cabsz.eq.0.0) return
43 44 c
44 45 xz = x/cabsz
... ... @@ -49,7 +50,8 @@
49 50 y1x = yz/(1.0+x)
50 51 aipart = y1x * (xz**2 + y1x**2*d9atn1(cabsz*y1x) )
51 52 c
52   - z9ln2r = dcmplx(xz,-yz)**3 * dcmplx(rpart,aipart)
  53 + z9ln2r = cmplx(xz,-yz,kind(1.d0))**3 *
  54 + 1 cmplx(rpart,aipart,kind(1.d0))
53 55 return
54 56 c
55 57 20 z9ln2r = (log(1.0+z) - z*(1.0-0.5*z)) / z**3
1   - complex(8) function zacos (z)
  1 + complex(kind(1.d0)) function zacos (z)
2 2 implicit none
3 3 c april 1977 version. w. fullerton, c3, los alamos scientific lab.
4   - complex(8) z, zasin
5   - real(8) pi2
  4 + complex(kind(1.d0)) z, zasin
  5 + real(kind(1.d0)) pi2
6 6 external zasin
7 7 data pi2 /1.5707963267 9489661923d0/
8 8 c
1   - complex(8) function zacosh (z)
  1 + complex(kind(1.d0)) function zacosh (z)
2 2 implicit none
3 3 c april 1977 version. w. fullerton, c3, los alamos scientific lab.
4   - complex(8) z, ci, zacos
  4 + complex(kind(1.d0)) z, ci, zacos
5 5 external zacos
6 6 data ci /(0.d0,1.d0)/
7 7 c
1   - real(8) function zarg (z)
  1 + real(kind(1.d0)) function zarg (z)
2 2 implicit none
3 3 c april 1977 version. w. fullerton, c3, los alamos scientific lab.
4   - complex(8) z
  4 + complex(kind(1.d0)) z
5 5  
6 6 c
7 7 zarg = 0.0
1   - complex(8) function zasin (zinp)
  1 + complex(kind(1.d0)) function zasin (zinp)
2 2 implicit none
3 3 c august 1980 edition. w. fullerton, c3, los alamos scientific lab.
4 4 c
5 5 c ref -- l. l. pennisi, elements of complex variables, holt, rinehart
6 6 c and winston, 1963. page 126.
7 7 c
8   - complex(8) zinp, z, z2, sqzp1, ci
9   - real(8) d1mach,pi2,pi,rmin,r
  8 + complex(kind(1.d0)) zinp, z, z2, sqzp1, ci
  9 + real(kind(1.d0)) d1mach,pi2,pi,rmin,r
10 10 integer nterms,i,twoi
11 11 external d1mach
12 12  
1   - complex(8) function zasinh (z)
  1 + complex(kind(1.d0)) function zasinh (z)
2 2 implicit none
3 3 c april 1977 version. w. fullerton, c3, los alamos scientific lab.
4 4 complex z, ci, zasin
1   - complex(8) function zatan (z)
  1 + complex(kind(1.d0)) function zatan (z)
2 2 implicit none
3 3 c jan 1984 edition. w. fullerton, los alamos scientific lab.
4 4 c
5   - complex(8) z, z2
6   - real(8) pi2,sqeps,rmin,rmax,r2sml,r,d1mach,x,y,r2,xans,yans
7   - external d1mach
  5 + complex(kind(1.d0)) z, z2
  6 + real(kind(1.d0)) pi2,sqeps,rmin,rmax,r2sml,r,x,y,r2,xans,yans
  7 + real(kind(1.d0)) d1mach
8 8 integer nterms,i,twoi
9 9 data pi2 /1.5707963267 9489661923d0 /
10   - data nterms, sqeps, rmin, rmax, r2sml / 0, 4*0.0 /
  10 + data nterms, sqeps, rmin, rmax, r2sml / 0, 4*0.0d0 /
  11 + external d1mach
  12 +
11 13 c
12 14 if (nterms.ne.0) go to 10
13 15 c nterms = alog(eps)/alog(rbnd) where rbnd = 0.1
14 16  
15 17  
... ... @@ -42,16 +44,16 @@
42 44 1 seteru (
43 45 2 55hzatan no precision because z is too close to +i or -i,
44 46 3 55, 2, 2)
45   - if (abs(dcmplx(1.0,0.0)+z*z).lt.sqeps) call seteru (
  47 + if (abs(cmplx(1.0d0,0.0d0,kind(1.d0))+z*z).lt.sqeps) call seteru (
46 48 1 50hzatan answer lt half precision, z**2 close to -1, 50, 1, 1)
47 49 c
48 50 40 xans = 0.5*atan2 (2.0*x, 1.0-r2)
49 51 yans = 0.25*log((r2+2.0*y+1.0)/(r2-2.0*y+1.0))
50   - zatan = dcmplx (xans, yans)
  52 + zatan = cmplx (xans, yans, kind(1.d0))
51 53 return
52 54 c
53   - 50 zatan = dcmplx (pi2, 0.0)
54   - if (real(z).lt.0.0) zatan = dcmplx (-pi2, 0.0)
  55 + 50 zatan = cmplx (pi2, 0.0d0, kind(1.d0))
  56 + if (real(z).lt.0.0) zatan = cmplx (-pi2, 0.0d0, kind(1.d0))
55 57 return
56 58 c
57 59 end
1   - complex(8) function zatan2 (csn, ccs)
  1 + complex(kind(1.d0)) function zatan2 (csn, ccs)
2 2 implicit none
3 3 c april 1977 version. w. fullerton, c3, los alamos scientific lab.
4   - complex(8) csn, ccs, zatan
5   - real(8) pi
  4 + complex(kind(1.d0)) csn, ccs, zatan
  5 + real(kind(1.d0)) pi
6 6 external zatan
7 7 data pi / 3.1415926535 8979323846d0 /
8 8 c
... ... @@ -16,7 +16,7 @@
16 16 10 if (abs(csn).eq.0.) call seteru (
17 17 1 34hzatan2 called with both args zero, 34, 1, 2)
18 18 c
19   - zatan2 = dcmplx (sign(0.5*pi,real(csn)), 0.0)
  19 + zatan2 = cmplx (sign(0.5*pi,real(csn)), 0.0, kind(1.d0))
20 20 c
21 21 return
22 22 end
1   - complex(8) function zatanh (z)
  1 + complex(kind(1.d0)) function zatanh (z)
2 2 implicit none
3 3 c april 1977 version. w. fullerton, c3, los alamos scientific lab.
4   - complex(8) z, ci, zatan
  4 + complex(kind(1.d0)) z, ci, zatan
5 5 external zatan
6 6 data ci /(0.,1.)/
7 7 c
1   - complex(8) function zbeta (a, b)
  1 + complex(kind(1.d0)) function zbeta (a, b)
2 2 implicit none
3 3 c july 1977 edition. w. fullerton, c3, los alamos scientific lab.
4   - complex(8) a, b, zgamma, zlbeta
5   - real(8) xmax,xmin
  4 + complex(kind(1.d0)) a, b, zgamma, zlbeta
  5 + real(kind(1.d0)) xmax,xmin
6 6 external zgamma, zlbeta
7 7 data xmax / 0.0 /
8 8 c
1   - complex(8) function zcbrt (z)
  1 + complex(kind(1.d0)) function zcbrt (z)
2 2 implicit none
3 3 c april 1977 version. w. fullerton, c3, los alamos scientific lab.
4   - complex(8) z
5   - real(8) theta,zarg,r,dcbrt
  4 + complex(kind(1.d0)) z
  5 + real(kind(1.d0)) theta,zarg,r,dcbrt
6 6 external zarg, dcbrt
7 7 c
8 8 theta = zarg(z) / 3.0
9 9 r = dcbrt (abs(z))
10 10 c
11   - zcbrt = dcmplx (r*cos(theta), r*sin(theta))
  11 + zcbrt = cmplx (r*cos(theta), r*sin(theta), kind(1.d0))
12 12 c
13 13 return
14 14 end
1   - complex(8) function zcosh (z)
  1 + complex(kind(1.d0)) function zcosh (z)
2 2 implicit none
3 3 c april 1977 version. w. fullerton, c3, los alamos scientific lab.
4   - complex(8) z, ci
  4 + complex(kind(1.d0)) z, ci
5 5 data ci /(0.,1.)/
6 6 c
7 7 zcosh = cos (ci*z)
1   - complex(8) function zcot (z)
  1 + complex(kind(1.d0)) function zcot (z)
2 2 implicit none
3 3 c march 1979 edition. w. fullerton, c3, los alamos scientific lab.
4   - complex(8) z
5   - real(8) d1mach
6   - real(8) eps, xmax, ylarge, ybig, rmin, ymin
7   - real(8) x,y,x2,y2,sn2x,den
  4 + complex(kind(1.d0)) z
  5 + real(kind(1.d0)) d1mach
  6 + real(kind(1.d0)) eps, xmax, ylarge, ybig, rmin, ymin
  7 + real(kind(1.d0)) x,y,x2,y2,sn2x,den
8 8 integer irold,irold2
9 9 external d1mach
10 10 data eps, xmax, ylarge, ybig, rmin, ymin / 5*0.0, 1.5 /
... ... @@ -38,7 +38,7 @@
38 38 if (den.lt.x*x2*eps .and. abs(x).gt.0.5) call seteru (65hzcot a
39 39 1nswer is lt half precision, x is near pi and y is near 0, 65, 1,1)
40 40 c
41   - zcot = dcmplx (sn2x/den, -sinh(y2)/den)
  41 + zcot = cmplx (sn2x/den, -sinh(y2)/den, kind(1.d0))
42 42 return
43 43 c
44 44 20 if (abs(y).lt.ymin) call seteru (75hzcot answer would have no p
45 45  
... ... @@ -46,10 +46,10 @@
46 46 if (abs(y).lt.ybig) call seteru (69hzcot answer lt half precisi
47 47 1on, abs(x) is very big and abs(y) small, 69, 2, 1)
48 48 c
49   - zcot = dcmplx (0.0, 1.0/tanh(y2))
  49 + zcot = cmplx (0.0, 1.0/tanh(y2), kind(1.d0))
50 50 return
51 51 c
52   - 30 zcot = dcmplx (0.0, sign (1.0d0, y))
  52 + 30 zcot = cmplx (0.0, sign (1.0d0, y), kind(1.d0))
53 53 return
54 54 c
55 55 end
1   - complex(8) function zexprl (z)
  1 + complex(kind(1.d0)) function zexprl (z)
2 2 implicit none
3 3 c august 1980 edition. w. fullerton, c3, los alamos scientific lab.
4 4 c
... ... @@ -8,8 +8,8 @@
8 8 c = (x*exprel(x) * (1 - 2*sin(y/2)**2) - 2*sin(y/2)**2
9 9 c + i*sin(y)*(1+x*exprel(x))) / z
10 10 c
11   - complex(8) z
12   - real(8) sqeps,r,xn,xln,rbnd,d1mach,alneps
  11 + complex(kind(1.d0)) z
  12 + real(kind(1.d0)) sqeps,r,xn,xln,rbnd,d1mach,alneps
13 13 external d1mach
14 14 integer nterms,irold,irold2,i
15 15 data nterms, rbnd, sqeps / 0, 2*0.0 /
1   - complex(8) function zgamma (z)
  1 + complex(kind(1.d0)) function zgamma (z)
2 2 implicit none
3 3 c july 1977 edition. w. fullerton, c3, los alamos scientific lab.
4 4 c a preliminary version that is portable, but not accurate enough.
5   - complex(8) z, zlngam
  5 + complex(kind(1.d0)) z, zlngam
6 6 external zlngam
7 7 c
8 8 zgamma = exp (zlngam(z))
1   - complex(8) function zgamr (z)
  1 + complex(kind(1.d0)) function zgamr (z)
2 2 implicit none
3 3 c july 1977 edition. w. fullerton, c3, los alamos scientific lab.
4 4 c this version is an inaccurate preliminary one. eventually this
5 5 c routine should be a fundamental routine with no dependence on cgamma.
6 6 c
7   - complex(8) z, zlngam
8   - real(8) x
  7 + complex(kind(1.d0)) z, zlngam
  8 + real(kind(1.d0)) x
9 9 integer irold,ir
10 10 external zlngam
11 11 c
1   - complex(8) function zlbeta (a, b)
  1 + complex(kind(1.d0)) function zlbeta (a, b)
2 2 implicit none
3 3 c july 1977 edition. w. fullerton, c3, los alamos scientific lab.
4 4 c a preliminary version that is portable, but not accurate enough.
5   - complex(8) a, b, zlngam
  5 + complex(kind(1.d0)) a, b, zlngam
6 6 external zlngam
7 7 c
8 8 if (real(a).le.0.0 .or. real(b).le.0.0) call seteru (
1   - complex(8) function zlngam (zin)
  1 + complex(kind(1.d0)) function zlngam (zin)
2 2 implicit none
3 3 c august 1980 edition. w. fullerton c3, los alamos scientific lab.
4 4 c eventually clngam should make use of c8lgmc for all z except for
5 5 c z in the vicinity of 1 and 2.
6   - complex(8) zin, z, corr, zlnrel, z9lgmc
7   - real(8) d1mach,pi,sq2pil,bound,dxrel,rmax,cabsz
8   - real(8) x,y,argsum,zarg
  6 + complex(kind(1.d0)) zin, z, corr, zlnrel, z9lgmc
  7 + real(kind(1.d0)) d1mach,pi,sq2pil,bound,dxrel,rmax,cabsz
  8 + real(kind(1.d0)) x,y,argsum,zarg
9 9 integer irold,ir,i,n
10 10 external z9lgmc, zarg, zlnrel,d1mach
11   - data pi / 3.1415926535 8979324e0 /
12   - data sq2pil / 0.9189385332 0467274e0 /
  11 + data pi / 3.1415926535 8979324d0 /
  12 + data sq2pil / 0.9189385332 0467274d0 /
13 13 c
14 14 data bound, dxrel, rmax / 3*0.0 /
15 15 c
16 16  
... ... @@ -38,12 +38,12 @@
38 38 c
39 39 call entsrc (irold, 1)
40 40 if (y.gt.0.0) z = conjg (z)
41   - corr = exp (-dcmplx(0.0,2.0*pi)*z)
  41 + corr = exp (-cmplx(0.0,2.0*pi,kind(1.d0))*z)
42 42 if (real(corr).eq.1.0 .and. aimag(corr).eq.0.0) call seteru (
43 43 1 31hzlngam z is a negative integer, 31, 3, 2)
44 44 c
45   - zlngam = sq2pil + 1.0 - dcmplx(0.0,pi)*(z-0.5) - zlnrel(-corr)
46   - 1 + (z-0.5)*log(1.0-z) - z - z9lgmc(1.0-z)
  45 + zlngam = sq2pil + 1.0 - cmplx(0.0,pi,kind(1.d0))*(z-0.5) -
  46 + 1 zlnrel(-corr) + (z-0.5)*log(1.0-z) - z - z9lgmc(1.0-z)
47 47 if (y.gt.0.0) zlngam = conjg (zlngam)
48 48 c
49 49 call erroff
... ... @@ -72,7 +72,7 @@
72 72 c
73 73 if (real(corr).eq.0.0 .and. aimag(corr).eq.0.0) call seteru (
74 74 1 31hzlngam z is a negative integer, 31, 3, 2)
75   - corr = -dcmplx (log(abs(corr)), argsum)
  75 + corr = -cmplx (log(abs(corr)), argsum, kind(1.d0))
76 76 c
77 77 c use stirling-s approximation for large z.
78 78 c
1   - complex(8) function zlnrel (z)
  1 + complex(kind(1.d0)) function zlnrel (z)
2 2 implicit none
3 3 c april 1977 version. w. fullerton, c3, los alamos scientific lab.
4 4 c
... ... @@ -10,8 +10,8 @@
10 10 c = cmplx (0.5*alog(r**2), carg(1+z))
11 11 c = cmplx (0.5*alnrel(2*x+rho**2), carg(1+z))
12 12 c
13   - complex(8) z
14   - real(8) dlnrel,d1mach,zarg,sqeps,x,rho
  13 + complex(kind(1.d0)) z
  14 + real(kind(1.d0)) dlnrel,d1mach,zarg,sqeps,x,rho
15 15 external dlnrel, zarg, d1mach
16 16 data sqeps /0.0/
17 17 c
... ... @@ -26,7 +26,7 @@
26 26 if (rho.gt.0.375) return
27 27 c
28 28 x = real(z)
29   - zlnrel = dcmplx (0.5*dlnrel(2.*x+rho**2), zarg(1.0+z))
  29 + zlnrel = cmplx (0.5*dlnrel(2.*x+rho**2), zarg(1.0+z), kind(1.d0))
30 30 c
31 31 return
32 32 end
1   - complex(8) function zlog10 (z)
  1 + complex(kind(1.d0)) function zlog10 (z)
2 2 implicit none
3 3 c april 1977 version. w. fullerton, c3, los alamos scientific lab.
4   - complex(8) z
5   - real(8) aloge
  4 + complex(kind(1.d0)) z
  5 + real(kind(1.d0)) aloge
6 6 data aloge / 0.4342944819 0325182765d0 /
7 7 c
8 8 zlog10 = aloge * log(z)
1   - complex(8) function zpsi (zin)
  1 + complex(kind(1.d0)) function zpsi (zin)
2 2 implicit none
3 3 c may 1978 edition. w. fullerton, c3, los alamos scientific lab.
4   - complex(8) zin, z, z2inv, corr, zcot
  4 + complex(kind(1.d0)) zin, z, z2inv, corr, zcot
5 5 dimension bern(13)
6   - real(8) bern,d1mach,pi,bound, dxrel, rmin, rbig
7   - real(8) x,y,cabsz
  6 + real(kind(1.d0)) bern,d1mach,pi,bound, dxrel, rmin, rbig
  7 + real(kind(1.d0)) x,y,cabsz
8 8 integer nterm,ndx,n,i
9 9 external zcot, d1mach
10 10 c
1   - complex(8) function zsinh (z)
  1 + complex(kind(1.d0)) function zsinh (z)
2 2 implicit none
3 3 c april 1977 version. w. fullerton, c3, los alamos scientific lab.
4   - complex(8) z, ci
  4 + complex(kind(1.d0)) z, ci
5 5 data ci /(0.,1.)/
6 6 c
7 7 zsinh = -ci*sin(ci*z)
1   - complex(8) function ztan (z)
  1 + complex(kind(1.d0)) function ztan (z)
2 2 implicit none
3 3 c march 1979 edition. w. fullerton, c3, los alamos scientific lab.
4   - complex(8) z
5   - real(8) d1mach,eps, xmax, ylarge, ybig, ymin,sn2x,den
6   - real(8) x,y,x2,y2
  4 + complex(kind(1.d0)) z
  5 + real(kind(1.d0)) d1mach,eps, xmax, ylarge, ybig, ymin,sn2x,den
  6 + real(kind(1.d0)) x,y,x2,y2
7 7 integer irold,irold2
8 8 external d1mach
9 9 data eps, xmax, ylarge, ybig, ymin / 4*0.0, 1.50 /
... ... @@ -34,7 +34,7 @@
34 34 if (den.lt.x*x2*eps) call seteru (74hztan answer lt half precis
35 35 1ion, x is near pi/2 or 3*pi/2 and y is near 0, 74, 1, 1)
36 36 c
37   - ztan = dcmplx (sn2x/den, sinh(y2)/den)
  37 + ztan = cmplx (sn2x/den, sinh(y2)/den, kind(1.d0))
38 38 return
39 39 c
40 40 20 if (abs(y).lt.ymin) call seteru (75hztan answer would have no p
41 41  
... ... @@ -42,10 +42,10 @@
42 42 if (abs(y).lt.ybig) call seteru (69hztan answer lt half precisi
43 43 1on, abs(x) is very big and abs(y) small, 69, 2, 1)
44 44 c
45   - ztan = dcmplx (0.0, tanh(y2))
  45 + ztan = cmplx (0.0, tanh(y2), kind(1.d0))
46 46 return
47 47 c
48   - 30 ztan = dcmplx (0.0, -sign(1.0d0, y))
  48 + 30 ztan = cmplx (0.0, -sign(1.0d0, y), kind(1.d0))
49 49 return
50 50 c
51 51 end
1   - complex(8) function ztanh (z)
  1 + complex(kind(1.d0)) function ztanh (z)
2 2 c april 1977 version. w. fullerton, c3, los alamos scientific lab.
3   - complex(8) z, ci, ztan
  3 + complex(kind(1.d0)) z, ci, ztan
4 4 external ztan
5 5 data ci /(0.,1.)/
6 6 c