1c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab 2c Copyright (C) INRIA 3c 4c Copyright (C) 2012 - 2016 - Scilab Enterprises 5c 6c This file is hereby licensed under the terms of the GNU GPL v2.0, 7c pursuant to article 5.3.4 of the CeCILL v.2.1. 8c This file was originally licensed under the terms of the CeCILL v2.1, 9c and continues to be available under such terms. 10c For more information, see the COPYING file which you should have received 11c along with this program. 12c 13 subroutine simple(n,d,s) 14c 15 double precision d(*) 16 real s(*),rmax,slamch 17c 18c slamch return wrong value under MacOSX 19c slamch('o') <=> HUGE(ZERO) 20c http://www.netlib.org/lapack/util/slamch.f 21 rmax=HUGE(0.0E+0) 22c 23 do 10 i=1,n 24 if(abs(d(i)).gt.rmax) then 25 s(i)=real(sign(dble(rmax),d(i))) 26 else 27 s(i)=real(d(i)) 28 endif 29 10 continue 30 return 31 end 32