integer function iskfm (qdummy,jcash,jmin,jmax,jdflt) C C C Copyright (C) Shell Research Ltd. 1983 C C C The copyright in this computer program and associated user C instructions contained in this document is the property of C Shell Research Ltd.. No guarantee is given or may be implied C as to the adequacy of the program or its suitability for any C particular purpose and no liability is accepted for any loss C or damage arising out of its use. C C C C Version: Y07.00 C C C Author: Ray Carpenter 14-Jul-83 C C Revised: Ray Carpenter 29-Feb-84 C C*********************************************************************** C C Function: C C Prints a user suppiled question and seeks currency answer. The C currency is entered as xxxxx.yy. The integer*4 value returned is C xxxx*(10**MAXDP) + yy. MAXDP is the maximun number of digits after the C decimal point, and is clearly defined early on in the code. C C C Parameter inputs: C C qdummy - the user's question. Not referenced by this routine. C jmin - optional minimum value for input C jmax - optional maximum value for input C jdflt - optional default value for input C C C Global inputs: C C qmin - true if jmin supplied C qmax - true if jmax supplied C qdlft - true if jdflt supplied C qdsply - true is display is not required. C C Parameter outputs: C C jcash - the returned value c iskfm - function output C C Global outputs: C C none C C Errors: C C None C C*********************************************************************** C C Code begins :- C C implicit logical*1 (q) C implicit integer*4 (j) C common /askcom/ 1 iparam !parameter word used by some routines 2,ipoint !output terminal buffer pointer 3,iplen !prompt length 4,qlin(82) !terminal I/O buffer 5,qmin !set if user supplied minimum value 6,qmax !set if user supplied maximum value 7,qdflt !set if user supplied default 8,qctrlz !set if ^Z is invalid 9,qclc !set if lower to upper case conversion reqd. 1,qdsply !set if no display of current fields reqd. 2,qspc !set if special characters valid. 3,qvtmd !set if user wants video mode 4,qprmpt(3) !prompt character (default is '?') 5,qs(12) !temporary string storage C C data qeos/0/, qdot/'.'/,qneg/'-'/ C C*********************************************************************** C! ! C! ! C! Define the maximum nuber of digits after the decimal point ! C! ! parameter (maxdp = 2) ! C! ! C! Then define some other constants ! C! ! mul = 10**maxdp ! C! ! jcmax="17777777777/mul ! C! ! C*********************************************************************** C if((.not. qmin) .or. (.not. qmax)) goto 10 C if (jmin .le. jmax) goto 10 C qmin = .false. qmax = .false. C 10 if (qdsply) goto 50 C call askfpb(2,' [') C call askfpb(1,'M') C if(qmin .eq. .false. .and. qmax .eq. .false.) goto 30 C call askfpb(3,' R:') C if (qmin .eq. .false.) goto 20 C call encash(jmin,qs(1),12,maxdp,.false.) call askfpn(8,12) C 20 call askfpb(1,':') C if( qmax .eq. .false.) goto 30 C call encash(jmax,qs(1),12,maxdp,.false.) call askfpn(8,12) C 30 if (.not. qdflt) goto 40 C call askfpb(3,' D:') C call encash(jdflt,qs(1),12,maxdp,.false.) call askfpn(8,12) C 40 call askfpb(1,']') C 50 call asktto C C 60 call asktti C if(ipoint) 999,100,110 C 100 if(qdflt) jcash=jdflt goto 999 C 110 call errset(64,,,,.false.,) C C Ensure we always branch out of the loop (input string is ipoint+1 bytes c long (that is to include the null terminator). C qminus=.false. C do 120 kpoint=1,ipoint+2 if(qlin(kpoint) .eq. qneg) qminus = .true. if (qlin(kpoint) .eq. qeos .or. qlin(kpoint) .eq. qdot) goto 130 120 continue C stop 'how the hell did we get here ?????' C 130 jcash=0 C nchar=kpoint-1 C if (nchar .eq. 0) goto 140 C decode(nchar,131,qlin(1),err=901) jcash 131 format(i) C if(jcash .gt. jcmax) goto 902 C jcash=jcash*mul C 140 nchar=ipoint-kpoint C if(nchar .le. 0) goto 300 C if(nchar .gt. maxdp) goto 901 C decode(nchar,131,qlin(kpoint+1),err=901) jpence C If(jpence .lt. 0) goto 901 C jcash=jcash+jisign(jpence,jcash) C 300 if(jcash .gt. 0 .and. qminus) jcash=-jcash C if (qmin .eq. .false. ) goto 310 if (jcash .lt. jmin) goto 902 C 310 if(qmax .eq. .false.) goto 320 if( jcash .gt. jmax) goto 902 C 320 call errset(64,,,,.true.,) C goto 999 C C come here on errors C 901 ipoint = -1 goto 910 C 902 ipoint = -2 goto 910 C 910 if(qvtmd) goto 999 c call askerr(ipoint) c goto 60 c 999 iskfm = ipoint c return c C end