integer function iskfr (qdummy,r,rmin,rmax,rdflt) 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 22-Mar-83 C C Revised: Ray Carpenter 29-Feb-84 C C*********************************************************************** C C Function: C C Prints a question and requests a real response C C Parameter inputs: C C qdummy- the question to be printed. Not referenced by this module C rmin - an optional minimum value C rmax - an optional maximum value C rdflt - an optional default value C C Global inputs: C C qmin - true if min. supplied C qmax - true if max. suppiled C qdflt - true if default supplied C qdsply - true if display not required C C Parameter outputs: C C r - the output real value C iskr - Function value. 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 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 no repropmt after ^Z. 3,qvtmd !set if user wants video mode 4,qprmpt(3) !prompt string (default is ' ? ') 5,qs(12) !temporary string storage C if((.not. qmin) .or. (.not. qmax)) goto 5 if(rmin .le. rmax) goto 5 C qmin = .false. qmax = .false. C 5 if (qdsply) goto 40 C call askfpb(3,' [R') C if(qmin .eq. .false. .and. qmax .eq. .false.) goto 20 C call askfpb(3,' R:') C if (.not. qmin ) goto 10 C call askfnr(rmin) C 10 call askfpb(1,':') C if( .not. qmax) goto 20 C call askfnr(rmax) C 20 if(.not. qdflt) goto 30 C call askfpb(3,' D:') C call askfnr(rdflt) C 30 call askfpb(1,']') C 40 call asktto C call errset(64,,,,.false.,) C 50 call asktti C if(ipoint) 999,100,110 c 100 if(qdflt) r=rdflt goto 999 C 110 decode(ipoint,111,qlin,err=150) rin 111 format(f12.0) goto 200 C C 150 ipoint = -1 goto 900 C C 200 if(.not. qmin) goto 210 if( rin .ge. rmin) goto 210 ipoint = -2 goto 900 C C 210 if(.not. qmax) goto 300 if(rin .le. rmax) goto 300 ipoint = -2 goto 900 C 300 r=rin C call errset(64,,,,.true.,) c goto 999 c 900 if(qvtmd) goto 999 c call askerr(ipoint) c goto 50 C 999 iskr = ipoint C return C C end