******************************************************************************** * * * 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 ### inpi ### c c This routine reads an integer from the array IA, c starting at IA(istrt(jrec)) and continuing for inumb(jrec)) c elements. Plus signs are ignored, the answer is accumulated c in JBUF. c subroutine inpi(jbuf) implicit integer*4 (i-n) implicit real*8 (a-h,o-z) character*1 ia,ichar(14),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', & '+','&','^','-'/,inpiexit/-99999/ jbuf = inpiexit jrec = jrec + 1 if(jrec.gt.jump)goto 430 jbuf=0 n = inumb(jrec) ifact = 1 ist=istrt(jrec) nstrt = ist + n - 1 do i = 1,n itemp = ia(nstrt) do j=1,14 if(ichar(j).eq.itemp) goto 45 enddo 44 write(iout6,*) 'Error detected in inpi' stop 'inpi' 45 if(j.lt.11)goto 47 if(nstrt.ne.ist)goto 44 if(j.ge.14)jbuf=-jbuf goto 430 47 jbuf=jbuf+(j-1)*ifact ifact = ifact * 10 nstrt=nstrt-1 enddo 430 return end