C FUNCTION IASK(STRING) C SUBROUTINE ASKI(STRING,INUM,I1,I2,I3,I4) C SUBROUTINE ASKF(STRING,INUM,R1,R2,R3,R4) C SUBROUTINE ASKS(STRING,STR,ICNT) C------------------------------------------------------------ C C MK 1.3 18-JAN-82 MEY C C (C) E.MEYER 13-JAN-82 C C------------------------------------------------------------ C C THE 'ASK' SUBROUTINE PACKAGE PRINTS A SPECIFIED C MESSAGE ON THE TERMINAL AND ASKS FOR: C IASK - YES/NO C ASKI - 1..4 INTEGER VALUES C ASKF - 1..4 REAL VALUES (F FORMAT) C C------------------------------------------------------------ C FUNCTION IASK(STRING) C C INPUT: STRING - BYTE ARRAY WITH MESSAGE TEXT (MAX 80 CHAR) C LAST CHAR MUST BE '\' C C OUTPUT: IASK - 'Y' IF YES ELSE 'N' C C CALLS: ./. C C------------------------------------------------------------ C BYTE STRING(80) CALL PRTASK(STRING) WRITE(7,901) 901 FORMAT(1H+,' [Y/N]? ',$) C C READ CHARCTER C READ(5,800) J 800 FORMAT(A1) C IF(J .EQ. 'Y') GOTO 30 C J='N' 30 IASK=J CONTINUE RETURN END C------------------------------------------------------------ C SUBROUTINE ASKI(STRING,INUM,I1,I2,I3,I4) C C INPUT: STRING - BYTE ARRAY WITH MESSAGE TEXT (MAX 80 CHAR) C LAST CHAR MUST BE '\' C C INUM - NO. OF INTERGERS TO BE READ C I1..I4 - INTEGERS FOR THE RETURN VALUES C C OUTPUT: I1..I4 - INTEGER VALUES READ C C CALLS: ./. C C------------------------------------------------------------ BYTE STRING(80) INTEGER INUM,I1,I2,I3,I4 C INTEGER IREAD(4) BYTE FMT(5) DATA FMT/'(','1','I','7',')'/ C IF(INUM .LT. 1) GOTO 50 IF(INUM .GT. 4) GOTO 50 FMT(2)=INUM+'0' CALL PRTASK(STRING) WRITE(7,900) INUM 900 FORMAT(1H+,' [',I1,'I]: ',$) READ(5,FMT) (IREAD(I), I=1,INUM) I1=IREAD(1) IF(INUM .GE. 2) I2=IREAD(2) IF(INUM .GE. 3) I3=IREAD(3) IF(INUM .EQ. 4) I4=IREAD(4) RETURN C 50 WRITE(7,901) 901 FORMAT(' ASK -- Illegal number of varibales') STOP END C------------------------------------------------------------ C SUBROUTINE ASKF(STRING,INUM,R1,R2,R3,R4) C C INPUT: STRING - BYTE ARRAY WITH MESSAGE TEXT (MAX 80 CHAR) C LAST CHAR MUST BE '\' C C INUM - NO. OF INTERGERS TO BE READ C R1..R4 - REALS FOR THE RETURN VALUES C C OUTPUT: R1..R4 - REAL VALUES READ C C CALLS: ./. C C------------------------------------------------------------ BYTE STRING(80) INTEGER INUM REAL R1,R2,R3,R4 C REAL RREAD(4) BYTE FMT(8) DATA FMT/'(','1','F','1','2','.','6',')'/ C IF(INUM .LT. 1) GOTO 50 IF(INUM .GT. 4) GOTO 50 FMT(2)=INUM+'0' CALL PRTASK(STRING) WRITE(7,900) INUM 900 FORMAT(1H+,' [',I1,'F]: ',$) READ(5,FMT) (RREAD(I), I=1,INUM) R1=RREAD(1) IF(INUM .GE. 2) R2=RREAD(2) IF(INUM .GE. 3) R3=RREAD(3) IF(INUM .EQ. 4) R4=RREAD(4) RETURN C 50 WRITE(7,901) 901 FORMAT(' ASK -- Illegal number of varibales') STOP END C------------------------------------------------------------ C SUBROUTINE ASKS(STRING,STR,ICNT) C C INPUT: STRING - BYTE ARRAY WITH MESSAGE TEXT (MAX 80 CHAR) C LAST CHAR MUST BE '\' C C STR - BYTE ARRAY FOR INPUT STRING C C ICNT - INTEGER C C OUTPUT: STR - BYTE ARRAY WITH INPUT STRING C C ICNT - INTEGER VALUE WITH STRING LENGTH IN BYTS C C CALLS: PRTASK C C------------------------------------------------------------ C BYTE STRING(80), STR(80) INTEGER ICNT C CALL PRTASK(STRING) WRITE(7,900) 900 FORMAT(1H+,' [S] : ',$) READ(5,800) STR 800 FORMAT(80A1) DO 10 I=1,81 J=81-I IF( STR(J) .NE. ' ') GOTO 20 10 CONTINUE 20 ICNT=J RETURN END C------------------------------------------------------------ C SUBROUTINE PRTASK(STRING) C C CALCULATE MESSAGE LENGTH IN BYTES AND OUTPUT TEXT C C INPUT: - STRING (SEE ABOVE) C C OUTPUT: - ./. C C CALLS: - ./. C C------------------------------------------------------------ BYTE STRING(80) I1=1 2 IF(STRING(I1) .NE. '/') GOTO 5 I1=I1+1 WRITE(7,902) 902 FORMAT(1H ) GOTO 2 C 5 I=I1 10 IF(STRING(I) .EQ. '\') GOTO 20 I=I+1 GOTO 10 20 I=I-1 C C OUTPUT MESSAGE TEXT C WRITE(7,900) (STRING(J), J=I1,I) 900 FORMAT((1H+,A1),$) RETURN END