function tan (x) c may 1980 edition. w. fullerton, c3, los alamos scientific lab. dimension tancs(11) external aint, csevl, inits, r1mach, sqrt c c series for tan on the interval 0. to 6.25000d-02 c with weighted error 3.14e-18 c log weighted error 17.50 c significant figures required 16.59 c decimal places required 18.02 c data tan cs( 1) / .2262793276 31293578e0 / data tan cs( 2) / .0430179131 465489618e0 / data tan cs( 3) / .0006854461 068256508e0 / data tan cs( 4) / .0000110453 269475970e0 / data tan cs( 5) / .0000001781 747790392e0 / data tan cs( 6) / .0000000028 744968582e0 / data tan cs( 7) / .0000000000 463748541e0 / data tan cs( 8) / .0000000000 007481760e0 / data tan cs( 9) / .0000000000 000120704e0 / data tan cs(10) / .0000000000 000001947e0 / data tan cs(11) / .0000000000 000000031e0 / c c pi2rec = 2/pi - 0.625 data pi2rec / .01161977236 75813430 e0 / data nterms, xmax, xsml, sqeps /0, 0., 0., 0./ c if (nterms.ne.0) go to 10 nterms = inits (tancs, 11, 0.1*r1mach(3)) xmax = 1.0/r1mach(4) xsml = sqrt (3.0*r1mach(3)) sqeps = sqrt (r1mach(4)) c 10 y = abs(x) if (y.gt.xmax) call seteru ( 1 42htan no precision because abs(x) is big, 42, 2, 2) c c carefully compute y * (2/pi) = (aint(y) + rem(y)) * (.625 + pi2rec) c = aint(.625*y) + rem(.625*y) + y*pi2rec = aint(.625*y) + z c = aint(.625*y) + aint(z) + rem(z) c ainty = aint(y) yrem = y - ainty prodbg = 0.625*ainty ainty = aint (prodbg) y = (prodbg-ainty) + 0.625*yrem + y*pi2rec ainty2 = aint (y) ainty = ainty + ainty2 y = y - ainty2 c ifn = amod (ainty, 2.) if (ifn.eq.1) y = 1. - y c if (1.-y.lt.abs(x)*sqeps) call seteru ( $61htan: answer lt half prec, abs(x) big or x near pi/2 or 3*pi/2, 2 69, 1, 1) if (y.eq.1.) call seteru (27htan x is pi/2 or 3*pi/2, 27, 3,2) c if (y.gt.0.25) go to 20 tan = y if (y.gt.xsml) tan = y*(1.5 + csevl(32.*y**2-1., tancs, nterms)) go to 40 c 20 if (y.gt.0.5) go to 30 tan = 0.5*y*(1.5 + csevl (8.*y**2-1., tancs, nterms)) tan = 2.0*tan/(1.-tan**2) go to 40 c 30 tan = 0.25*y*(1.5 + csevl (2.*y**2-1., tancs, nterms)) tan = 2.0*tan/(1.-tan**2) tan = 2.0*tan/(1.-tan**2) c 40 if (x.ne.0.) tan = sign (tan, x) if (ifn.eq.1) tan = -tan c return end