staden-lg/src/staden/userface.f

C  user interface routines: i.e. they deal with user interaction
C  like string input, dialogue boxes, radio buttons, check boxes
C  19-11-90 New version of radion to look more like other routines
C  11-12-90 Set maxbox in radion to 20 (was 14)
C  8-7-91 removed radio, modified openf1 to deal with blank file names
C
C   HELP
C   HELP OPTION
C   THE HELP FILE IS HELPF. THE FIRST AND LAST RECORD NUMBERS
C   DESCRIBING EACH OPTION IN THIS FILE ARE STORED IN HELPS(OPTION)
C   AND HELPE(OPTION). THIS ROUTINE SIMPLY LISTS THE INTERVENING RECORDS
      SUBROUTINE HELP(HELPS,HELPE,BOTOPT,TOPOPT,HELPF,IDEV,KBIN,KBOUT)
C   AUTHOR: RODGER STADEN
      PARAMETER (IPAGE=22)
      INTEGER BOTOPT,TOPOPT
      CHARACTER HELPF*(*),SPACE
      INTEGER HELPS(BOTOPT:TOPOPT),HELPE(BOTOPT:TOPOPT)
        CHARACTER LINE*80
      INTEGER NOTIRL
      EXTERNAL NOTIRL
      SAVE SPACE
      DATA SPACE/' '/
1002  FORMAT(' ',A)
      CALL OPENRS(IDEV,HELPF,IOK,20,5)
      IF(IOK.NE.0)GO TO 100
20    CONTINUE
      WRITE(KBOUT,1005)
1005  FORMAT(' For information on any option type its option number.'
     +,/,
     +' In addition,',/,
     +'             0 = Introduction to the program,',/,
     +'             1 = List of options')
      NOPT = 1
      CALL GETINT(BOTOPT,TOPOPT,NOPT,'Option number',IVAL,
     +KBIN,KBOUT,HELPS(1),HELPE(1),HELPF,IDEV,IOK)
      IF(IOK.NE.0) GO TO 40
      NOPT = IVAL
C   COUNT LINES OUTPUT
      IDONE=0
      ISTART=HELPS(NOPT)
      IEND=HELPE(NOPT)
      I=ISTART-1
21    CONTINUE
      I=I+1
      READ(IDEV,REC=I,ERR=110)LINE
      WRITE(KBOUT,1002)LINE(1:MAX(1,NOTIRL(LINE,79,SPACE)))
      IDONE=IDONE+1
      IF(IDONE.EQ.IPAGE)THEN
        CALL BPAUSE(KBIN,KBOUT,IQUIT)
        IF(IQUIT.NE.0) GO TO 20
        IDONE=0
      END IF
      IF(I.LT.IEND)GO TO 21
      CALL BPAUSE(KBIN,KBOUT,IQUIT)
      IF(IQUIT.NE.0) GO TO 40
      GO TO 20
40    CONTINUE
      CLOSE(UNIT=IDEV)
      RETURN
100   CONTINUE
1001  FORMAT(' Error opening help file')
      WRITE(KBOUT,1001)
      RETURN
110   CONTINUE
      WRITE(KBOUT,1010)
1010  FORMAT(' Error reading help file')
      END
C   HELP2
C   HELP OPTION FOR SINGLE FUNCTION
C   THE HELP FILE IS HELPF. THE FIRST AND LAST RECORD NUMBERS
C   DESCRIBING EACH OPTION IN THIS FILE ARE STORED IN HELPS
C   AND HELPE. THIS ROUTINE SIMPLY LISTS THE INTERVENING RECORDS
      SUBROUTINE HELP2(HELPS,HELPE,HELPF,IDEV,KBIN,KBOUT)
C   AUTHOR: RODGER STADEN
      PARAMETER (IPAGE=22)
      CHARACTER HELPF*(*),SPACE
      INTEGER HELPS,HELPE
        CHARACTER LINE*80
      INTEGER NOTIRL
      EXTERNAL NOTIRL
      SAVE SPACE
      DATA SPACE/' '/
1002  FORMAT(' ',A)
      CALL OPENRS(IDEV,HELPF,IOK,20,5)
      IF(IOK.NE.0)GO TO 100
C   COUNT LINES OUTPUT
      IDONE=0
      ISTART=HELPS
      IEND=HELPE
      I=ISTART-1
21    CONTINUE
      I=I+1
      READ(IDEV,REC=I,ERR=110)LINE
      WRITE(KBOUT,1002)LINE(1:MAX(1,NOTIRL(LINE,79,SPACE)))
      IDONE=IDONE+1
      IF(IDONE.EQ.IPAGE)THEN
        CALL BPAUSE(KBIN,KBOUT,IQUIT)
        IF(IQUIT.NE.0) GO TO 50
        IDONE=0
      END IF
      IF(I.LT.IEND)GO TO 21
      WRITE(KBOUT,1000)
1000  FORMAT(' End of file')
      CALL BPAUSE(KBIN,KBOUT,IQUIT)
50    CONTINUE
      CLOSE(UNIT=IDEV)
      RETURN
100   CONTINUE
1001  FORMAT(' Error opening help file')
      WRITE(KBOUT,1001)
      RETURN
110   CONTINUE
      WRITE(KBOUT,1010)
1010  FORMAT(' Error reading help file')
      CLOSE(UNIT=IDEV)
      END
C   SETHLP
C  READS POINTERS TO HELP FILE
C  THESE POINTERS HAVE BEEN WRITTEN TO A FILE WHOSE NAME IS IN POINTF
C  BY PROGRAM SETUPHELP.
C  EACH OPTION (WITH NUMBERS BETWEEN BOTOPT AND TOPOPT)
C  HAS ITS HELP TEXT POINTERS STORED IN HELPS(OPTION) AND HELPE(OPTION)
C  WHERE HELPS CONTAINS THE FIRST RECORD NUMBER AND HELPE THE LAST
C  RECORD NUMBER OF THE TEXT FILE HELPF THAT DESCRIBES THE OPTION
      SUBROUTINE SETHLP(HELPS,HELPE,BOTOPT,TOPOPT,POINTF,IDEV,KBOUT)
C   AUTHOR: RODGER STADEN
      INTEGER BOTOPT,TOPOPT
      CHARACTER POINTF*(*)
      INTEGER HELPS(BOTOPT:TOPOPT),HELPE(BOTOPT:TOPOPT)
      CALL OPENRS(IDEV,POINTF,IOK,LRECL,2)
      IF(IOK.NE.0)GO TO 100
1     CONTINUE
      READ(IDEV,1004,END=11,ERR=110)I,J,K
      IF((I.GE.BOTOPT).AND.(I.LE.TOPOPT))THEN
        HELPS(I)=J
        HELPE(I)=K
      END IF
      GO TO 1
1004  FORMAT(3I6)
11    CONTINUE
      CLOSE(UNIT=IDEV)
      RETURN
100   CONTINUE
      WRITE(KBOUT,1001)
1001  FORMAT(' Error opening help record pointer file')
      RETURN
110   CONTINUE
      WRITE(KBOUT,1005)
1005  FORMAT(' Error reading help record pointer file')
      RETURN
      END
      SUBROUTINE SHOWFU(KBOUT,STRING)
      CHARACTER STRING*(*)
      WRITE(KBOUT,1000)STRING
1000  FORMAT(' ',A)
      END
      SUBROUTINE SHOWFI(KBOUT,STRING)
      CHARACTER STRING*(*)
      END
      SUBROUTINE ERROM(KBOUT,STRING)
      CHARACTER STRING*(*)
      WRITE(KBOUT,1000)STRING
1000  FORMAT(' ',A)
      END
      SUBROUTINE BUSY(KBOUT)
      WRITE(KBOUT,1000)
1000  FORMAT(' Working')
      END
      SUBROUTINE RADION(TITLE,PROMPT,NB,CHOICE,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      PARAMETER (MAXBOX = 20,MAXCHR = 3)
      CHARACTER HELPF*(*),PROMPT(NB)*(*),CHECK*(MAXBOX)
      CHARACTER TITLE*(*)
      INTEGER CHOICE
      CHARACTER*(MAXCHR) STR2,STR3
      EXTERNAL NOTILR
      EXTERNAL IGET
      IF((CHOICE.LT.1).OR.(CHOICE.GT.NB)) THEN
        WRITE(KBOUT,*)'Error in call to radion, default set to 1'
        CHOICE = 1
      END IF
      IN = CHOICE
      CALL FILLC(CHECK,NB,' ')
      CHECK(IN:IN) = 'X'
1002  FORMAT(I3)
      WRITE(STR2,1002,ERR=30)NB
      WRITE(STR3,1002,ERR=30)CHOICE
10    CONTINUE
      WRITE(KBOUT,1001)TITLE
1001  FORMAT(' ',A)
      DO 20 I = 1,NB
        WRITE(KBOUT,1000)CHECK(I:I),I,PROMPT(I)
1000  FORMAT(' ',A,I3,' ',A)
20    CONTINUE
      WRITE(KBOUT,1003)
     +STR2(NOTILR(STR2,MAXCHR,' '):MAXCHR),
     +STR3(NOTILR(STR3,MAXCHR,' '):MAXCHR)
1003  FORMAT(' ? Selection ',' (1','-',A,') (',A,') =',$)
      I = IGET(J,KBIN)
      IF(I.EQ.1) THEN
        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        GO TO 10
      END IF
      IF(I.EQ.2) THEN
        CHOICE = -1
        RETURN
      END IF
      IF(I.EQ.3) RETURN
      IF(I.GT.0) GO TO 10
      IF(J.GT.NB) GO TO 10
      IF(J.LT.1) GO TO 10
      CHOICE = MAX(1,J)
      RETURN
30    CONTINUE
      WRITE(KBOUT,*)'Error in RADION! Choice set to default'
      END
      SUBROUTINE CHECKB(PROMPT,BOXES,NB,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
      PARAMETER (MAXBOX = 14)
      CHARACTER HELPF*(*),PROMPT(NB)*(*),CHECK*(MAXBOX),D*35
      INTEGER BOXES(NB)
      INTEGER TOGGLE
      EXTERNAL TOGGLE,IGET
      SAVE D
      DATA D/' ? 1,2,3,4,5,6,7,8,9,10,11,12,13,14'/
      IOK = 1
10    CONTINUE
      CALL FILLC(CHECK,NB,' ')
      DO 15 I = 1,NB
        IF(BOXES(I).EQ.1) CHECK(I:I) = 'X'
15    CONTINUE
      WRITE(KBOUT,1002)
1002  FORMAT(/,' checkbox: those set are marked X')
      DO 20 I = 1,NB
      WRITE(KBOUT,1000)CHECK(I:I),I,PROMPT(I)
1000  FORMAT(' ',A,I3,' ',A)
20    CONTINUE
      WRITE(KBOUT,1001)NB+1
1001  FORMAT('  ',I3,' ','ALL')
      IF(NB.LE.9)THEN
        WRITE(KBOUT,1003)D(1:2+2*NB)
      ELSE
        WRITE(KBOUT,1003)D(1:20+3*(NB-9))
      END IF
1003  FORMAT(A,' =',$)
      IN = IGET(J,KBIN)
      IF(IN.EQ.1) THEN
        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        GO TO 10
      END IF
      IF(IN.EQ.2) RETURN
      IF(IN.GT.3) GO TO 10
      IF((IN.EQ.3).OR.(J.EQ.0)) THEN
        IOK = 0
        RETURN
      END IF
      IF((J.LE.NB).AND.(J.GT.0)) THEN
        BOXES(J) = TOGGLE(BOXES(J))
      ELSE IF(J.EQ.NB+1) THEN
        CALL FILLI(BOXES,NB,1)
      END IF
      GO TO 10
      END
      INTEGER FUNCTION SIN(KBIN,STRING)
C  AUTHOR: RODGER STADEN
C  RETURNS:
C          1 FOR HELP
C          2 FOR QUIT
C          3 FOR ALL BLANKS
C          0 OTHERWISE
C          ABOVE FROM HQN
C          4 FOR READ ERROR
      CHARACTER STRING*(*)
      INTEGER HQN
      EXTERNAL HQN
      READ(KBIN,1000,ERR=10,END=10)STRING
1000  FORMAT(A)
      SIN = HQN(STRING)
      RETURN
10    CONTINUE      
      SIN = 4
      END
      INTEGER FUNCTION IGET(IN,KBIN)
C  AUTHOR: RODGER STADEN
C  RETURNS:
C          1 FOR HELP
C          2 FOR QUIT
C          3 FOR ALL BLANKS
C          4 FOR READ ERROR
C          0 OTHERWISE
      CHARACTER STRING*10
      INTEGER SIN
      EXTERNAL SIN
      IN = 0
      IGET = SIN(KBIN,STRING)
      IF(IGET.NE.0) RETURN
1001  FORMAT(I10)
      CALL RJST(STRING)
      READ(STRING,1001,ERR=10,END=10)IN
      RETURN
10    CONTINUE
      IN = 0
      IGET = 4
      END
      INTEGER FUNCTION IGETR(RIN,KBIN)
C  AUTHOR: RODGER STADEN
C  RETURNS:
C          1 FOR HELP
C          2 FOR QUIT
C          3 FOR ALL BLANKS
C          4 FOR READ ERROR
C          0 OTHERWISE
      CHARACTER STRING*12
      INTEGER SIN
      EXTERNAL SIN
      RIN = 0.
      IGETR = SIN(KBIN,STRING)
      IF(IGETR.NE.0) RETURN
1001  FORMAT(F12.0)
      CALL RJST(STRING)
      READ(STRING,1001,ERR=10,END=10)RIN
      RETURN
10    CONTINUE
      RIN = 0.
      IGETR = 4
      END
      SUBROUTINE GTSTR(P,STRING,NEW,LENGTH,KBOUT,KBIN,INFLAG)
      CHARACTER STRING*(*),NEW*(*),P*(*)
      INTEGER SIN
      EXTERNAL NOTRL,SIN
10    CONTINUE
      IF(LENGTH.GT.0)WRITE(KBOUT,1000)P,STRING(1:LENGTH)
1000  FORMAT(' Default ',A,'=',A)
      WRITE(KBOUT,1001)P
1001  FORMAT(' ? ',A,'=',$)
      INFLAG = SIN(KBIN,NEW)
      IF(INFLAG.EQ.4) GO TO 10
      IF(INFLAG.EQ.0) THEN
        MAXSTR = LEN(NEW)
        LENGTH = NOTRL(NEW,MAXSTR,' ')
        RETURN
      END IF
      IF(INFLAG.EQ.3) THEN
        LENGTH = 0
        RETURN
      END IF
      LENGTH = 1
      END
      SUBROUTINE GETSTR(P,STRING,NEW,MAXSTR,LENGTH,KBOUT,KBIN,INFLAG)
      CHARACTER STRING(MAXSTR),NEW(MAXSTR),P*(*),NEWT*80
      INTEGER SIN
      EXTERNAL NOTRL,SIN
      PARAMETER (MAXST = 80)
10    CONTINUE
      IF(LENGTH.GT.0)WRITE(KBOUT,1000)P,(STRING(K),K=1,LENGTH)
1000  FORMAT(' Default ',A,'=',75A1)
      WRITE(KBOUT,1001)P
1001  FORMAT(' ? ',A,'=',$)
      INFLAG = SIN(KBIN,NEWT)
      IF(INFLAG.EQ.4) GO TO 10
      IF(INFLAG.EQ.0) THEN
        LENGTH = MIN(MAXSTR,NOTRL(NEWT,MAXST,' '))
        CALL STOA(NEWT,NEW,LENGTH)
        RETURN
      END IF
      IF(INFLAG.EQ.3) THEN
        LENGTH = 0
        RETURN
      END IF
      LENGTH = 1
      END
      SUBROUTINE STOA(STRING,ARRAY,LENGTH)
      CHARACTER STRING*(*),ARRAY(LENGTH)
      DO 10 I = 1,LENGTH
        ARRAY(I) = STRING(I:I)
10    CONTINUE
      END
      SUBROUTINE GETOPT(KBIN,KOPT,IOPT)
      CHARACTER TCLASS,STRING*10,STRNG2*10
      INTEGER SIN
      EXTERNAL NOTILR,NOTIRL,SIN
      IOPT = 0
      KOPT = 0
10    CONTINUE
      INFLAG = SIN(KBIN,STRING)
      IF(INFLAG.EQ.1) THEN
        KOPT = 2
      END IF
      IF(INFLAG.EQ.2) THEN
        KOPT = 0
        IOPT = 2
        RETURN
      END IF
      IF(INFLAG.EQ.4) GO TO 10
      K = NOTIRL(STRING,10,' ')
      L = NOTILR(STRING,10,' ')
      IF(K.LT.L) RETURN
      TCLASS = STRING(L:L)
      IF((TCLASS.EQ.'D').OR.(TCLASS.EQ.'d')) THEN
        KOPT = 1
      ELSE IF((TCLASS.EQ.'M').OR.(TCLASS.EQ.'m')) THEN
        KOPT = 3
      END IF
      IF(KOPT.NE.0) L = L + 1
      IF((KOPT.EQ.2).AND.(L.GT.K)) THEN
        KOPT = 0
        IOPT = 1
        RETURN
      END IF  
      J = 11
      STRNG2 = ' '
      DO 50 I = K,L,-1
        J = J-1
        STRNG2(J:J) = STRING(I:I)
50    CONTINUE
      READ(STRNG2,1001,ERR=60)IOPT
1001  FORMAT(I10)
      IF(KOPT.EQ.3) THEN
        IOPT = -IOPT
        KOPT = 0
      END IF
      RETURN
60    CONTINUE
      KOPT = 4
      RETURN
70    CONTINUE
      KOPT = 4
      END
      SUBROUTINE YESNO(ANSWER,PROMPT,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      INTEGER ANSWER,SIN
      CHARACTER PROMPT*(*),HELPF*(*),STRING,YESU,YESL,NOU,NOL
      PARAMETER (YESU='Y',YESL='y',NOU='N',NOL='n')
      EXTERNAL SIN
10    CONTINUE
      WRITE(KBOUT,1000)PROMPT
1000  FORMAT(' ? ',A,' (y/n) (y) = ',$)
      I = SIN(KBIN,STRING)
      IF(I.EQ.1) THEN
        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        GO TO 10
      END IF
      IF(I.EQ.2) THEN
        ANSWER = -1
        RETURN
      END IF
      IF(I.EQ.3) THEN
        ANSWER = 0
        RETURN
      END IF
      I = MAX(INDEX(STRING,NOU),INDEX(STRING,NOL))
      IF(I.NE.0) THEN
        ANSWER = 1
        RETURN
      END IF
      I = MAX(INDEX(STRING,YESU),INDEX(STRING,YESL))
      IF(I.NE.0) THEN
        ANSWER = 0
        RETURN
      END IF
      GO TO 10
      END
      SUBROUTINE YESONO(CHOICE,P1,P2,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      CHARACTER HELPF*(*),P1*(*),P2*(*)
      INTEGER CHOICE
      IF(CHOICE.EQ.0) THEN
        CALL YESNO(I,P1,
     +  IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      ELSE IF(CHOICE.EQ.1) THEN
        CALL YESNO(I,P2,
     +  IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        IF(I.EQ.1) THEN
          I = 0
        ELSE IF(I.EQ.0) THEN
          I = 1
        END IF
      ELSE
        WRITE(KBOUT,*)'ERROR IN INPUT TO YESONO'
      END IF
      CHOICE = I
      END
      SUBROUTINE GETINT(MININ,MAXIN,DEF,PROMPT,VALUE,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
C   AUTHOR: RODGER STADEN
      PARAMETER (MAXCHR = 8)
      CHARACTER HELPF*(*),PROMPT*(*)
      CHARACTER*8 STR1,STR2,STR3
      INTEGER DEF,VALUE
      EXTERNAL NOTILR,IGET
      IOK = 1
1000  FORMAT(I8)
      WRITE(STR1,1000,ERR=20)MININ
      WRITE(STR2,1000,ERR=20)MAXIN
      WRITE(STR3,1000,ERR=20)DEF
10    CONTINUE
      WRITE(KBOUT,1003)PROMPT,
     +STR1(NOTILR(STR1,MAXCHR,' '):MAXCHR),
     +STR2(NOTILR(STR2,MAXCHR,' '):MAXCHR),
     +STR3(NOTILR(STR3,MAXCHR,' '):MAXCHR)
1003  FORMAT(' ? ',A,' (',A,'-',A,') (',A,') =',$)
      IN = IGET(IVAL,KBIN)
      IF(IN.EQ.1)THEN
        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        GO TO 10
      END IF
      IF(IN.EQ.2)RETURN
      IF(IN.EQ.3) THEN
        VALUE = DEF
        IOK = 0
        RETURN
      END IF
      IF(IN.GT.0) GO TO 10
      IF(IVAL.GT.MAXIN)GO TO 10
      IF(IVAL.LT.MININ)GO TO 10
      VALUE = IVAL
      IOK = 0
      RETURN
20    CONTINUE
      WRITE(KBOUT,*)'Error in routine getint'
      END
      SUBROUTINE GETRL(MININ,MAXIN,DEF,PROMPT,VALUE,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
C   AUTHOR: RODGER STADEN
      PARAMETER (MAXCHR = 8)
      CHARACTER HELPF*(*),PROMPT*(*)
      CHARACTER*8 STR1,STR2,STR3
      REAL MININ,MAXIN,IVAL
      EXTERNAL NOTILR,IGETR
      IOK = 1
1000  FORMAT(F8.2)
      WRITE(STR1,1000,ERR=20)MININ
      WRITE(STR2,1000,ERR=20)MAXIN
      WRITE(STR3,1000,ERR=20)DEF
10    CONTINUE
      WRITE(KBOUT,1003)PROMPT,
     +STR1(NOTILR(STR1,MAXCHR,' '):MAXCHR),
     +STR2(NOTILR(STR2,MAXCHR,' '):MAXCHR),
     +STR3(NOTILR(STR3,MAXCHR,' '):MAXCHR)
1003  FORMAT(' ? ',A,' (',A,'-',A,') (',A,') =',$)
      IN = IGETR(IVAL,KBIN)
      IF(IN.EQ.1)THEN
        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        GO TO 10
      END IF
      IF(IN.EQ.2)RETURN
      IF(IN.EQ.3) THEN
        VALUE = DEF
        IOK = 0
        RETURN
      END IF
      IF(IN.GT.0) GO TO 10
      IF(IVAL.GT.MAXIN)GO TO 10
      IF(IVAL.LT.MININ)GO TO 10
      VALUE = IVAL
      IOK = 0
      RETURN
20    CONTINUE
      WRITE(KBOUT,*)'Error in routine getrl'
      END
      SUBROUTINE GETRLS(MININ,MAXIN,DEF,PROMPT,VALUE,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
C   AUTHOR: RODGER STADEN
      PARAMETER (MAXCHR = 12)
      CHARACTER HELPF*(*),PROMPT*(*)
      CHARACTER*12 STR1,STR2,STR3
      REAL MININ,MAXIN,IVAL
      EXTERNAL NOTILR,IGETR,NOTIRL
      IOK = 1
1000  FORMAT(F12.10)
      WRITE(STR1,1000,ERR=20)MININ
      WRITE(STR2,1000,ERR=20)MAXIN
      WRITE(STR3,1000,ERR=20)DEF
10    CONTINUE
      WRITE(KBOUT,1003)PROMPT,
     +STR1(NOTILR(STR1,MAXCHR,' '):NOTIRL(STR1,MAXCHR,'0')),
     +STR2(NOTILR(STR2,MAXCHR,' '):NOTIRL(STR2,MAXCHR,'0')),
     +STR3(NOTILR(STR3,MAXCHR,' '):NOTIRL(STR3,MAXCHR,'0'))
1003  FORMAT(' ? ',A,' (',A,'-',A,') (',A,') =',$)
      IN = IGETR(IVAL,KBIN)
      IF(IN.EQ.1)THEN
        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        GO TO 10
      END IF
      IF(IN.EQ.2)RETURN
      IF(IN.EQ.3) THEN
        VALUE = DEF
        IOK = 0
        RETURN
      END IF
      IF(IN.GT.0) GO TO 10
      IF(IVAL.GT.MAXIN)GO TO 10
      IF(IVAL.LT.MININ)GO TO 10
      VALUE = IVAL
      IOK = 0
      RETURN
20    CONTINUE
      WRITE(KBOUT,*)'Error in routine getrls'
      END
      SUBROUTINE CHECK4(P1,P2,P3,P4,C1,C2,C3,C4,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
      CHARACTER HELPF*(*),P1*(*),P2*(*),P3*(*),P4*(*),C*4
      INTEGER C1,C2,C3,C4,CA(4)
      INTEGER TOGGLE
      EXTERNAL TOGGLE,IGET
      IOK = 1
      CA(1) = C1
      CA(2) = C2
      CA(3) = C3
      CA(4) = C4
10    CONTINUE
      CALL FILLC(C,4,' ')
      DO 15 I = 1,4
        IF(CA(I).EQ.1) C(I:I) = 'X'
15    CONTINUE
      WRITE(KBOUT,1002)
1002  FORMAT(/,' checkbox: those set are marked X')
      WRITE(KBOUT,1000)
     +C(1:1),P1,
     +C(2:2),P2,
     +C(3:3),P3,
     +C(4:4),P4
1000  FORMAT(
     +' ',A,' 1 ',A,/,
     +' ',A,' 2 ',A,/,
     +' ',A,' 3 ',A,/,
     +' ',A,' 4 ',A,/,
     +' ? 0,1,2,3,4 =',$)
      IN = IGET(J,KBIN)
      IF(IN.EQ.1) THEN
        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        GO TO 10
      END IF
      IF(IN.EQ.2) RETURN
      IF(IN.GT.3) GO TO 10
      IF((IN.EQ.3).OR.(J.EQ.0)) THEN
        C1 = CA(1)
        C2 = CA(2)
        C3 = CA(3)
        C4 = CA(4)
        IOK = 0
        RETURN
      END IF
      IF((J.LT.5).AND.(J.GT.0)) CA(J) = TOGGLE(CA(J))
      GO TO 10
      END
      INTEGER FUNCTION TOGGLE(I)
      IN = I
      IF(IN.EQ.0) THEN
        IN = 1
      ELSE 
        IN = 0
      END IF
      TOGGLE = IN
      END