00001 SUBROUTINE CUCHK(Y, NZ, ASCLE, TOL) 00002 C***BEGIN PROLOGUE CUCHK 00003 C***REFER TO CSERI,CUOIK,CUNK1,CUNK2,CUNI1,CUNI2,CKSCL 00004 C 00005 C Y ENTERS AS A SCALED QUANTITY WHOSE MAGNITUDE IS GREATER THAN 00006 C EXP(-ALIM)=ASCLE=1.0E+3*R1MACH(1)/TOL. THE TEST IS MADE TO SEE 00007 C IF THE MAGNITUDE OF THE REAL OR IMAGINARY PART WOULD UNDER FLOW 00008 C WHEN Y IS SCALED (BY TOL) TO ITS PROPER VALUE. Y IS ACCEPTED 00009 C IF THE UNDERFLOW IS AT LEAST ONE PRECISION BELOW THE MAGNITUDE 00010 C OF THE LARGEST COMPONENT; OTHERWISE THE PHASE ANGLE DOES NOT HAVE 00011 C ABSOLUTE ACCURACY AND AN UNDERFLOW IS ASSUMED. 00012 C 00013 C***ROUTINES CALLED (NONE) 00014 C***END PROLOGUE CUCHK 00015 C 00016 COMPLEX Y 00017 REAL ASCLE, SS, ST, TOL, YR, YI 00018 INTEGER NZ 00019 NZ = 0 00020 YR = REAL(Y) 00021 YI = AIMAG(Y) 00022 YR = ABS(YR) 00023 YI = ABS(YI) 00024 ST = AMIN1(YR,YI) 00025 IF (ST.GT.ASCLE) RETURN 00026 SS = AMAX1(YR,YI) 00027 ST=ST/TOL 00028 IF (SS.LT.ST) NZ = 1 00029 RETURN 00030 END
1.7.1
