******************************************************************************** * * * 2DHF version 1-2003 * * Copyright (C) 1996 Jacek Kobus, Leif Laaksonen, Dage Sundholm * * * * This software may be used and distributed according to the terms * * of the GNU General Public License, see README and COPYING. * * * ******************************************************************************** c ### inpf ### c c Extracts a floating point number from an input card. c subroutine inpf(buf) implicit integer*4 (i-n) implicit real*8 (a-h,o-z) character*1 ia,ichar(15),itemp common/iochan/ iinp5,iinp11,iinp12,iinp13,iinp14, & iout6,iout21,iout22,iout23,iout24 common/work/jrec,jump,istrt(40),inumb(40),ia(80) data ichar/'0','1','2','3','4','5','6','7','8','9','+','&','^', &'-','.'/ jrec = jrec + 1 if(jrec .gt. jump) go to 40 buf = 0.d0 fact2 = 0.d0 limit=15 n = inumb(jrec) fact = 1.d0 ist=istrt(jrec) nstrt = ist + n - 1 do i=1,n itemp = ia(nstrt) do j = 1,limit if(ichar(j).eq.itemp)goto 5 enddo 4 write(iout6,*) 'Error detected in inpf' stop 'inpf' 5 if(j.lt.11)goto 7 if(j.le.14)goto 6 fact2 = dble(i-1) limit=14 go to 9 6 if(nstrt .ne. ist) go to 4 if(j.eq.14)buf=-buf go to 20 7 buf = buf + dble(j-1) * fact fact=fact*10.d0 9 continue nstrt = nstrt - 1 enddo 20 buf=(0.1d0**fact2)*buf 40 return end