ADAS Subroutine r8fctn
FUNCTION R8FCTN( STR , IABT ) C----------------------------------------------------------------------- C C **************** FORTRAN77 REAL*8 FUNCTION: R8FCTN ****************** C C PURPOSE : TO CONVERT A FLOATING POINT NUMBER STORED IN A STRING C INTO A REAL*8 VARIABLE. C C CALLING PROGRAM: GENERAL USE C C FUNCTION: C C (R*8) R8FCTN = FUNCTION NAME C (C*(*)) STR = STRING CONTAINING SINGLE FLOATING POINT NO. C (I*4) IABT = RETURN CODE: C 0 => NO ERROR C 2 => ERROR (A VALUE 'R8FCTN=0.0' WILL BE C RETURNED). C 9 => OVERFLOW ERROR (EXPONENT > IUOFLW) C (A VALUE 'R8FCTN=0.0' RETURNED) C 10 => UNDERFLOW ERROR (EXPONENT <-IUOFLW) C (A VALUE 'R8FCTN=0.0' RETURNED) C C (I*4) IUOFLW = PARAMETER = MODULUS OF MAXIMUM ALLOWED C EXPONENT = 60 C C (C*1) CH0 = PARAMETER = '0' C (C*1) CH9 = PARAMETER = '9' C (C*1) BLANK = PARAMETER = ' ' C (C*1) CPLUS = PARAMETER = '+' C (C*1) CMINUS = PARAMETER = '-' C (C*1) CPNT = PARAMETER = '.' C (C*1) CHE = PARAMETER = 'E' C (C*1) CHD = PARAMETER = 'D' C (C*1) CLE = PARAMETER = 'e' C (C*1) CLD = PARAMETER = 'd' C C (I*4) ILEN = LENGTH OF 'STR' STRING IN BYTES C (I*4) M1 = STARTING BYTE IN 'STR' OF NUMBER C INCLUDING SIGN C (I*4) M2 = LAST BYTE IN 'STR' OF NUMBER C (I*4) IE = STARTING BYTE OF EXPONENT IN 'STR' C IGNORING ANY SIGN PRESENT. C (I*4) MS = 0 => MANTISSA HAS NO SIGN C 1 => MANTISSA HAS A SIGN C (I*4) IS = 0 => EXPONENT HAS NO SIGN C 1 => EXPONENT HAS A SIGN C (I*4) IPOW = EXPONENT C (I*4) ICH0 = ICHAR('0') C (I*4) ICH9 = ICHAR('9') C (I*4) ISTR = ICHAR(CURRENT BYTE POSITION IN 'STR') C (I*4) I = GENERAL USE C C (L*4) LMANT = .TRUE. => MANTISSA BEING ANALYSED C .FALSE. => EXPONENT BEING ANALYSED C (L*4) LPOINT = .TRUE. => DECIMAL POINT FOUND IN MANTISSA C .FALSE. => NO DECIMAL POINT FOUND IN MANT. C (L*4) LFOUND = .TRUE. => ALL OF THE INPUT NUMBER BYTES C HAVE BEEN ASSESSED. C .FALSE. => INPUT NUMBER BYTES STILL BEING C ASSESSED. C C NOTE: AN ERROR WILL OCCUR (IABT=2) IF THERE IS MORE THAN ONE C NUMBER OCCURING IN THE STRING 'STR()' C C C AUTHOR: PAUL E. BRIDEN (TESSELLA SUPPORT SERVICES PLC) C K1/0/81 C JET EXT. 4569 C C DATE: 26/10/90 C C VERSION : 1.2 C DATE : 20-12-2001 C MODIFIED : Martin O'Mullane C - Removed mainframe listing information beyond column 72. C C VERSION : 1.3 C DATE : 03-12-2003 C MODIFIED : Hugh Summers C - Allowed lower case 'e' or 'd' in the real number spec. C C VERSION : 1.4 C DATE : 10-04-2007 C MODIFIED : Allan Whiteford C - Modified documentation as part of automated C subroutine documentation preparation. C C----------------------------------------------------------------------- C C----------------------------------------------------------------------- CHARACTER*(*) STR INTEGER IABT