! Copyright(C) 1996 Takuya OOURA (email: ooura@mmm.t.u-tokyo.ac.jp). function erfc09(x) result(erfc) use precision implicit none real(wp), intent(in) :: x real(wp) :: erfc,y real(wp), parameter :: pv = 1.26974899965115684e+01_wp real(wp), parameter :: ph = 6.10399733098688199e+00_wp real(wp), parameter :: p0 = 2.96316885199227378e-01_wp real(wp), parameter :: p1 = 1.81581125134637070e-01_wp real(wp), parameter :: p2 = 6.81866451424939493e-02_wp real(wp), parameter :: p3 = 1.56907543161966709e-02_wp real(wp), parameter :: p4 = 2.21290116681517573e-03_wp real(wp), parameter :: p5 = 1.91395813098742864e-04_wp real(wp), parameter :: p6 = 9.71013284010551623e-06_wp real(wp), parameter :: p7 = 1.66642447174307753e-07_wp real(wp), parameter :: q0 = 6.12158644495538758e-02_wp real(wp), parameter :: q1 = 5.50942780056002085e-01_wp real(wp), parameter :: q2 = 1.53039662058770397e+00_wp real(wp), parameter :: q3 = 2.99957952311300634e+00_wp real(wp), parameter :: q4 = 4.95867777128246701e+00_wp real(wp), parameter :: q5 = 7.41471251099335407e+00_wp real(wp), parameter :: q6 = 1.04765104356545238e+01_wp real(wp), parameter :: q7 = 1.48455557345597957e+01_wp y = x**2 y = exp(-y)*x*( p7/(y + q7) & + p6/(y + q6) & + p5/(y + q5) & + p4/(y + q4) & + p3/(y + q3) & + p2/(y + q2) & + p1/(y + q1) & + p0/(y + q0) ) if (x < ph) y = y + 2.0_wp/(exp(pv*x) + 1.0_wp) erfc = y end function erfc09