cuchk.f
42 lines
| 1.3 KiB
| text/x-fortran
|
FortranFixedLexer
| r1601 | *DECK CUCHK | |||
| SUBROUTINE CUCHK (Y, NZ, ASCLE, TOL) | ||||
| C***BEGIN PROLOGUE CUCHK | ||||
| C***SUBSIDIARY | ||||
| C***PURPOSE Subsidiary to SERI, CUOIK, CUNK1, CUNK2, CUNI1, CUNI2 and | ||||
| C CKSCL | ||||
| C***LIBRARY SLATEC | ||||
| C***TYPE ALL (CUCHK-A, ZUCHK-A) | ||||
| C***AUTHOR Amos, D. E., (SNL) | ||||
| C***DESCRIPTION | ||||
| C | ||||
| C Y ENTERS AS A SCALED QUANTITY WHOSE MAGNITUDE IS GREATER THAN | ||||
| C EXP(-ALIM)=ASCLE=1.0E+3*R1MACH(1)/TOL. THE TEST IS MADE TO SEE | ||||
| C IF THE MAGNITUDE OF THE REAL OR IMAGINARY PART WOULD UNDER FLOW | ||||
| C WHEN Y IS SCALED (BY TOL) TO ITS PROPER VALUE. Y IS ACCEPTED | ||||
| C IF THE UNDERFLOW IS AT LEAST ONE PRECISION BELOW THE MAGNITUDE | ||||
| C OF THE LARGEST COMPONENT; OTHERWISE THE PHASE ANGLE DOES NOT HAVE | ||||
| C ABSOLUTE ACCURACY AND AN UNDERFLOW IS ASSUMED. | ||||
| C | ||||
| C***SEE ALSO CKSCL, CUNI1, CUNI2, CUNK1, CUNK2, CUOIK, SERI | ||||
| C***ROUTINES CALLED (NONE) | ||||
| C***REVISION HISTORY (YYMMDD) | ||||
| C ?????? DATE WRITTEN | ||||
| C 910415 Prologue converted to Version 4.0 format. (BAB) | ||||
| C***END PROLOGUE CUCHK | ||||
| C | ||||
| COMPLEX Y | ||||
| REAL ASCLE, SS, ST, TOL, YR, YI | ||||
| INTEGER NZ | ||||
| C***FIRST EXECUTABLE STATEMENT CUCHK | ||||
| NZ = 0 | ||||
| YR = REAL(Y) | ||||
| YI = AIMAG(Y) | ||||
| YR = ABS(YR) | ||||
| YI = ABS(YI) | ||||
| ST = MIN(YR,YI) | ||||
| IF (ST.GT.ASCLE) RETURN | ||||
| SS = MAX(YR,YI) | ||||
| ST=ST/TOL | ||||
| IF (SS.LT.ST) NZ = 1 | ||||
| RETURN | ||||
| END | ||||
