INTEGER*4 FUNCTION JASK (PROMPT, JMIN, JMAX, JDEFLT, DEFPIC, 1 SGLCHR, IRETCH) C***************************************************************************** C C Description : Ask a integer*4 number from terminal C C Arguments : PROMPT = the prompt string C JMIN = minimum value C JMAX = maximum value C JDEFLT = the default value C DEFPIC = string with the picture of default value C SGLCHR = string with characters that can be entered as C single character input C IRETCH = when single character input the ASCII code of the C character entered (output) C C note: all arguments have to be given but MIN, MAX and SGLCHR C field can be empty. IRETCH can be omitted if SGLCHR C is empty or not given. DEFPIC can be omitted if C JDEFLT is not given. C strings are closed by a zero-byte C No default is given if JDEFLT or DEFPIC field is empty C or DEFPIC string is empty C C Author : H.A.M. Fikke C AKZO PHARMA, Oss Holland C dept. SDA C C Version : V1.0 Date : 30-dec-82 C C Module name : JASK.FTN C C Package : RSXLIB C C Compilation/Linking : FOR/F4P/TR:NONE JASK C C Updates : name version C C description : C C***************************************************************************** C BYTE PROMPT(1),DEFLT(1),STRING(12),STR2(12),FMX,FMN INTEGER*4 JDEF,JMIN,JMAX,JDEFLT C FMX = LARG (3) FMN = LARG (2) IF (.NOT. LARG(4)) GOTO 2 IF (.NOT. LARG(5)) GOTO 2 IF (DEFPIC(1) .NE. 0) 1,2,2 C THEN 1 IF (FMN) 3,4,4 C THEN 3 IF (JDEFLT .LT. JMIN) GOTO 99 C ENDIF 4 IF (FMX) 5,2,2 C THEN 5 IF (JDEFLT .GT. JMAX) GOTO 99 C ENDIF C ENDIF 2 IF (FMN .AND. FMX) 7,10,10 C THEN 7 IF (JMAX .LT. JMIN) GOTO 98 C ENDIF C 10 STR2(1)=0 IF (.NOT. LARG(4)) GOTO 19 IF (.NOT. LARG(5)) GOTO 19 IF (DEFPIC(1) .NE. 0) CALL SCVTJ (JDEFLT,DEFPIC,STR2) 19 IRET=0 CALL SASK (PROMPT,STRING,0,9,STR2,SGLCHR,IRET) IF (IRET .NE. 0) 20,21,21 C THEN 20 IRETCH=IRET JASK=0 GOTO 14 C ENDIF 21 I = 1 JASK = JCVTS (STRING,I,IRET) IF (IRET .NE. 1) GOTO 91 IF (FMN) 11,12,12 C THEN 11 IF (JASK .LT. JMIN) GOTO 90 C ENDIF 12 IF (FMX) 13,14,14 C THEN 13 IF (JASK .GT. JMAX) GOTO 90 C ENDIF 14 RETURN C 90 CALL SCOPY ('-2147483648',STRING) CALL SCOPY ('2147483647',STR2) IF (FMN) CALL SCVTJ (JMIN,'Z',STRING) IF (FMX) CALL SCVTJ (JMAX,'Z',STR2) CALL SWRITE (,,'Number out of range; type a value between ', 1 STRING,' and ',STR2) GOTO 10 91 CALL SWRITE (,,'Incorrect number') GOTO 10 C 98 CALL FATAL('JASK','Illegal range specification (MAX