GNU Octave  3.8.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
cuchk.f
Go to the documentation of this file.
1  SUBROUTINE cuchk(Y, NZ, ASCLE, TOL)
2 C***BEGIN PROLOGUE CUCHK
3 C***REFER TO CSERI,CUOIK,CUNK1,CUNK2,CUNI1,CUNI2,CKSCL
4 C
5 C Y ENTERS AS A SCALED QUANTITY WHOSE MAGNITUDE IS GREATER THAN
6 C EXP(-ALIM)=ASCLE=1.0E+3*R1MACH(1)/TOL. THE TEST IS MADE TO SEE
7 C IF THE MAGNITUDE OF THE REAL OR IMAGINARY PART WOULD UNDER FLOW
8 C WHEN Y IS SCALED (BY TOL) TO ITS PROPER VALUE. Y IS ACCEPTED
9 C IF THE UNDERFLOW IS AT LEAST ONE PRECISION BELOW THE MAGNITUDE
10 C OF THE LARGEST COMPONENT; OTHERWISE THE PHASE ANGLE DOES NOT HAVE
11 C ABSOLUTE ACCURACY AND AN UNDERFLOW IS ASSUMED.
12 C
13 C***ROUTINES CALLED (NONE)
14 C***END PROLOGUE CUCHK
15 C
16  COMPLEX y
17  REAL ascle, ss, st, tol, yr, yi
18  INTEGER nz
19  nz = 0
20  yr = REAL(y)
21  yi = aimag(y)
22  yr = abs(yr)
23  yi = abs(yi)
24  st = amin1(yr,yi)
25  IF (st.GT.ascle) RETURN
26  ss = amax1(yr,yi)
27  st=st/tol
28  IF (ss.LT.st) nz = 1
29  RETURN
30  END