Commit 41811905dd1aa615518402c6b0e078d5c5d44d75
1 parent
ba393a2696
Exists in
master
and in
3 other branches
Correction of a bad type declaration in ztan.f
git-svn-id: https://lxsd.femto-st.fr/svn/fvn@67 b657c933-2333-4658-acf2-d3c7c2708721
Showing 1 changed file with 1 additions and 1 deletions Inline Diff
fvn_fnlib/ztan.f
| complex(8) function ztan (z) | 1 | 1 | complex(8) function ztan (z) | |
| implicit none | 2 | 2 | implicit none | |
| c march 1979 edition. w. fullerton, c3, los alamos scientific lab. | 3 | 3 | c march 1979 edition. w. fullerton, c3, los alamos scientific lab. | |
| complex z | 4 | 4 | complex(8) z | |
| real(8) d1mach,eps, xmax, ylarge, ybig, ymin,sn2x,den | 5 | 5 | real(8) d1mach,eps, xmax, ylarge, ybig, ymin,sn2x,den | |
| real(8) x,y,x2,y2 | 6 | 6 | real(8) x,y,x2,y2 | |
| integer irold,irold2 | 7 | 7 | integer irold,irold2 | |
| external d1mach | 8 | 8 | external d1mach | |
| data eps, xmax, ylarge, ybig, ymin / 4*0.0, 1.50 / | 9 | 9 | data eps, xmax, ylarge, ybig, ymin / 4*0.0, 1.50 / | |
| c | 10 | 10 | c | |
| if (eps.ne.0.0) go to 10 | 11 | 11 | if (eps.ne.0.0) go to 10 | |
| eps = d1mach(4) | 12 | 12 | eps = d1mach(4) | |
| xmax = 1.0/eps | 13 | 13 | xmax = 1.0/eps | |
| ylarge = -0.5*log(0.5*d1mach(3)) | 14 | 14 | ylarge = -0.5*log(0.5*d1mach(3)) | |
| ybig = -0.5*log(0.5*sqrt(d1mach(3))) | 15 | 15 | ybig = -0.5*log(0.5*sqrt(d1mach(3))) | |
| c | 16 | 16 | c | |
| 10 x = real(z) | 17 | 17 | 10 x = real(z) | |
| y = aimag(z) | 18 | 18 | y = aimag(z) | |
| if (abs(y).gt.ylarge) go to 30 | 19 | 19 | if (abs(y).gt.ylarge) go to 30 | |
| c | 20 | 20 | c | |
| x2 = 2.0*x | 21 | 21 | x2 = 2.0*x | |
| y2 = 2.0*y | 22 | 22 | y2 = 2.0*y | |
| if (abs(x2).gt.xmax) go to 20 | 23 | 23 | if (abs(x2).gt.xmax) go to 20 | |
| c | 24 | 24 | c | |
| call entsrc (irold, 1) | 25 | 25 | call entsrc (irold, 1) | |
| sn2x = sin(x2) | 26 | 26 | sn2x = sin(x2) | |
| call erroff | 27 | 27 | call erroff | |
| den = cos(x2) + cosh(y2) | 28 | 28 | den = cos(x2) + cosh(y2) | |
| call erroff | 29 | 29 | call erroff | |
| call entsrc (irold2, irold) | 30 | 30 | call entsrc (irold2, irold) | |
| c | 31 | 31 | c | |
| if (den.lt.x*x2*eps*eps) call seteru ( 72hztan tan is nearly si | 32 | 32 | if (den.lt.x*x2*eps*eps) call seteru ( 72hztan tan is nearly si | |
| 1ngular, x is near pi/2 or 3*pi/2 and y is near 0, 72, 3, 2) | 33 | 33 | 1ngular, x is near pi/2 or 3*pi/2 and y is near 0, 72, 3, 2) | |
| if (den.lt.x*x2*eps) call seteru (74hztan answer lt half precis | 34 | 34 | if (den.lt.x*x2*eps) call seteru (74hztan answer lt half precis | |
| 1ion, x is near pi/2 or 3*pi/2 and y is near 0, 74, 1, 1) | 35 | 35 | 1ion, x is near pi/2 or 3*pi/2 and y is near 0, 74, 1, 1) | |
| c | 36 | 36 | c | |
| ztan = dcmplx (sn2x/den, sinh(y2)/den) | 37 | 37 | ztan = dcmplx (sn2x/den, sinh(y2)/den) | |
| return | 38 | 38 | return | |
| c | 39 | 39 | c | |
| 20 if (abs(y).lt.ymin) call seteru (75hztan answer would have no p | 40 | 40 | 20 if (abs(y).lt.ymin) call seteru (75hztan answer would have no p | |
| 1recision, abs(x) is very big and abs(y) small, 75, 4, 2) | 41 | 41 | 1recision, abs(x) is very big and abs(y) small, 75, 4, 2) | |
| if (abs(y).lt.ybig) call seteru (69hztan answer lt half precisi | 42 | 42 | if (abs(y).lt.ybig) call seteru (69hztan answer lt half precisi | |
| 1on, abs(x) is very big and abs(y) small, 69, 2, 1) | 43 | 43 | 1on, abs(x) is very big and abs(y) small, 69, 2, 1) | |
| c | 44 | 44 | c | |
| ztan = dcmplx (0.0, tanh(y2)) | 45 | 45 | ztan = dcmplx (0.0, tanh(y2)) | |
| return | 46 | 46 | return | |
| c | 47 | 47 | c | |
| 30 ztan = dcmplx (0.0, -sign(1.0d0, y)) | 48 | 48 | 30 ztan = dcmplx (0.0, -sign(1.0d0, y)) | |
| return | 49 | 49 | return | |
| c | 50 | 50 | c | |
| end | 51 | 51 | end | |
| 52 | 52 |