1C $Id$ 2C********************************************************************** 3C CFLOAT 4C********************************************************************** 5C 6 double precision FUNCTION drdy_cfloat(STRING) 7C 8 IMPLICIT DOUBLE PRECISION(A-H,O-Z) 9#include "errquit.fh" 10C 11#include "drdyP.fh" 12C 13 CHARACTER*(*) STRING 14 CHARACTER*80 NUMBER 15 CHARACTER CH 16 LOGICAL LEXP,LDEC 17C 18* write(fu6,*)' drdy_cfloat:string: <',string,'>' 19 LEXP = .FALSE. 20 LDEC = .FALSE. 21 LENGTH = LEN(STRING) 22 IF (LENGTH .EQ. 0) THEN 23 DRDY_CFLOAT = 0.0D0 24 RETURN 25 ENDIF 26C WRITE(fu6,*) LENGTH,STRING 27C 28C Find the first nonblank character 29C 30 I = 1 3110 IF (STRING(I:I) .EQ. ' ' .AND. I .LE. LENGTH) THEN 32 I = I + 1 33 GOTO 10 34 ENDIF 35C 36C If it is a blank string set function to zero 37C 38 IF (I .GT. LENGTH) THEN 39 DRDY_CFLOAT = 0.0D0 40 RETURN 41 ENDIF 42 IBEG = I 43C 44C Find the first blank character after the number 45C 46 I = IBEG+1 4720 IF (STRING(I:I) .NE. ' ' .AND. I .LE. LENGTH) THEN 48 I = I + 1 49 GOTO 20 50 ENDIF 51 IEND = I-1 52C 53C Stripe the blanks before and after the number 54C 55 NUMBER = STRING(IBEG:IEND) 56 LENGTH = IEND - IBEG + 1 57C 58C Make sure there is no blank left 59C 60 IF (INDEX(NUMBER,' ') .LE. LENGTH) THEN 61 WRITE(fu6,1000) STRING 62 call errquit ('drdy_cfloat:1: fatal error',911, UNKNOWN_ERR) 63 ENDIF 64C 65C Find the decimal point 66C 67 IDEC = INDEX(NUMBER,'.') 68 IF (IDEC .NE. 0) LDEC = .TRUE. 69C 70C Find the exponential symbol 71C 72 IUE = INDEX(NUMBER,'E') 73 ILE = INDEX(NUMBER,'e') 74 IUD = INDEX(NUMBER,'D') 75 ILD = INDEX(NUMBER,'d') 76 ISUM = IUE + ILE + IUD + ILD 77 IEXP = MAX0(IUE,ILE,IUD,ILD) 78 IF (ISUM .GT. IEXP) THEN 79 WRITE(fu6,1000) STRING 80 call errquit('drdy_cfloat:2: fatal error',911, UNKNOWN_ERR) 81 ENDIF 82 IF (IEXP .NE. 0) THEN 83 LEXP = .TRUE. 84 ELSE 85 IEXP = LENGTH + 1 86 ENDIF 87C 88 IF (.NOT. LDEC) IDEC = IEXP 89C 90C Get the number before decimal 91C 92 IBEG = 2 93 IF (NUMBER(1:1) .EQ. '+') THEN 94 SIGN = 1.0D0 95 ELSEIF(NUMBER(1:1) .EQ. '-') THEN 96 SIGN = -1.0D0 97 ELSE 98 SIGN = 1.0D0 99 IBEG = 1 100 ENDIF 101 IF (IBEG .EQ. IEXP) THEN 102 F1 = 1.0D0 103 ELSE 104 F1 = 0.0D0 105 ENDIF 106 DO 50 I = IBEG,IDEC-1 107 CH = NUMBER(I:I) 108 IF (CH .GE. '0' .AND. CH .LE. '9') THEN 109 N = ICHAR(CH) - ICHAR('0') 110 F1 = F1 * 10.0D0 + DBLE(N) 111 ELSE 112 WRITE(fu6,1000) STRING 113 call errquit('drdy_cfloat:3: fatal error',911, UNKNOWN_ERR) 114 ENDIF 11550 CONTINUE 116C 117C Get the number after decimal 118C 119 F2 = 0.0D0 120 IF (LDEC) THEN 121 J = 0 122 DO 60 I = IDEC+1,IEXP-1 123 CH = NUMBER(I:I) 124 IF (CH .GE. '0' .AND. CH .LE. '9') THEN 125 N = ICHAR(CH) - ICHAR('0') 126 F2 = F2 * 10.0D0 + DBLE(N) 127 J = J + 1 128 ELSE 129 WRITE(fu6,1000) STRING 130 call errquit('drdy_cfloat:4: fatal error',911, 131 & UNKNOWN_ERR) 132 ENDIF 13360 CONTINUE 134 F2 = F2 / 10.0D0 ** DBLE(J) 135 ENDIF 136C 137C Get the exponent 138C 139 ESIGN = 1.0D0 140 F3 = 0.0D0 141 IF (LEXP) THEN 142 IBEG = IEXP + 2 143 IF (NUMBER(IEXP+1:IEXP+1) .EQ. '+') THEN 144 ESIGN = 1.0D0 145 ELSEIF(NUMBER(IEXP+1:IEXP+1) .EQ. '-') THEN 146 ESIGN = -1.0D0 147 ELSE 148 ESIGN = 1.0D0 149 IBEG = IEXP + 1 150 ENDIF 151 DO 70 I = IBEG,LENGTH 152 CH = NUMBER(I:I) 153 IF (CH .GE. '0' .AND. CH .LE. '9') THEN 154 N = ICHAR(CH) - ICHAR('0') 155 F3 = F3 * 10.0D0 + DBLE(N) 156 ELSE 157 WRITE(fu6,1000) STRING 158 call errquit('drdy_cfloat:5: fatal error',911, 159 & UNKNOWN_ERR) 160 ENDIF 16170 CONTINUE 162 ENDIF 163C 164 DRDY_CFLOAT = (SIGN * (F1 + F2)) * 10.0D0 ** (ESIGN*F3) 165C 166 RETURN 167C 1681000 FORMAT(/1X,'Illegal number: ',A80) 169C 170 END 171