aboutsummaryrefslogtreecommitdiff
path: root/orrs/src/ask1.f
diff options
context:
space:
mode:
Diffstat (limited to 'orrs/src/ask1.f')
-rwxr-xr-xorrs/src/ask1.f226
1 files changed, 226 insertions, 0 deletions
diff --git a/orrs/src/ask1.f b/orrs/src/ask1.f
new file mode 100755
index 0000000..281a17a
--- /dev/null
+++ b/orrs/src/ask1.f
@@ -0,0 +1,226 @@
+C
+C==== user input routines with prompting and error trapping
+C
+C
+ SUBROUTINE ASKI(PROMPT,IINPUT)
+C
+C---- integer input
+C
+ CHARACTER*(*) PROMPT
+ INTEGER IINPUT
+C
+ NP = INDEX(PROMPT,'^') - 1
+ IF(NP.LE.0) NP = LEN(PROMPT)
+C
+ 10 WRITE(*,1000) PROMPT(1:NP)
+ READ (*,*,ERR=10) IINPUT
+ RETURN
+C
+ 1000 FORMAT(/A,' i> ',$)
+ END ! ASKI
+
+
+ SUBROUTINE ASKR(PROMPT,RINPUT)
+C
+C---- real input
+C
+ CHARACTER*(*) PROMPT
+ REAL RINPUT
+C
+ NP = INDEX(PROMPT,'^') - 1
+ IF(NP.LE.0) NP = LEN(PROMPT)
+C
+ 10 WRITE(*,1000) PROMPT(1:NP)
+ READ (*,*,ERR=10) RINPUT
+ RETURN
+C
+ 1000 FORMAT(/A,' r> ',$)
+ END ! ASKR
+
+
+ SUBROUTINE ASKL(PROMPT,LINPUT)
+C
+C---- logical input
+C
+ CHARACTER*(*) PROMPT
+ LOGICAL LINPUT
+ CHARACTER*1 CHAR
+C
+ NP = INDEX(PROMPT,'^') - 1
+ IF(NP.LE.0) NP = LEN(PROMPT)
+C
+ 10 WRITE(*,1000) PROMPT(1:NP)
+ READ (*,1010) CHAR
+ IF(CHAR.EQ.'y') CHAR = 'Y'
+ IF(CHAR.EQ.'n') CHAR = 'N'
+ IF(CHAR.NE.'Y' .AND. CHAR.NE.'N') GO TO 10
+C
+ LINPUT = CHAR .EQ. 'Y'
+ RETURN
+C
+ 1000 FORMAT(/A,' y/n> ',$)
+ 1010 FORMAT(A)
+ END ! ASKL
+
+
+ SUBROUTINE ASKS(PROMPT,INPUT)
+C
+C---- string of arbitrary length input
+C
+ CHARACTER*(*) PROMPT
+ CHARACTER*(*) INPUT
+C
+ NP = INDEX(PROMPT,'^') - 1
+ IF(NP.LE.0) NP = LEN(PROMPT)
+C
+ WRITE(*,1000) PROMPT(1:NP)
+ READ (*,1010) INPUT
+C
+ RETURN
+C
+ 1000 FORMAT(/A,' s> ',$)
+ 1010 FORMAT(A)
+ END ! ASKS
+
+
+ SUBROUTINE ASKC(PROMPT,CINPUT)
+C
+C---- 4-byte character string input
+C converted to uppercase
+C
+ CHARACTER*(*) PROMPT
+ CHARACTER*4 CINPUT
+C
+ NP = INDEX(PROMPT,'^') - 1
+ IF(NP.LE.0) NP = LEN(PROMPT)
+C
+ WRITE(*,1000) PROMPT(1:NP)
+ READ (*,1020) CINPUT
+ CALL LC2UC(CINPUT)
+C
+ RETURN
+C
+ 1000 FORMAT(/A,' c> ',$)
+ 1020 FORMAT(A4)
+ END ! ASKC
+
+
+ SUBROUTINE ASKC2(PROMPT,COMAND,CARGS)
+C
+C---- returns 4-byte character string input converted to uppercase
+C---- also returns rest of input characters in CARGS string
+C
+ CHARACTER*(*) PROMPT
+ CHARACTER*(*) COMAND, CARGS
+C
+ CHARACTER*128 LINE
+C
+ IZERO = ICHAR('0')
+C
+ NP = INDEX(PROMPT,'^') - 1
+ IF(NP.EQ.0) NP = LEN(PROMPT)
+C
+ WRITE(*,1000) PROMPT(1:NP)
+ READ (*,1020) LINE
+C
+C---- strip off leading blanks
+ DO K=1, 128
+ IF(LINE(1:1) .EQ. ' ') THEN
+ LINE = LINE(2:128)
+ ELSE
+ GO TO 5
+ ENDIF
+ ENDDO
+ 5 CONTINUE
+C
+C---- find position of first blank, "+", "-", ".", ",", or numeral
+ K = INDEX(LINE,' ')
+ KI = INDEX(LINE,'-')
+ IF(KI.NE.0) K = MIN(K,KI)
+ KI = INDEX(LINE,'+')
+ IF(KI.NE.0) K = MIN(K,KI)
+ KI = INDEX(LINE,'.')
+ IF(KI.NE.0) K = MIN(K,KI)
+ KI = INDEX(LINE,',')
+ IF(KI.NE.0) K = MIN(K,KI)
+ DO I=0, 9
+ KI = INDEX(LINE,CHAR(IZERO+I))
+ IF(KI.NE.0) K = MIN(K,KI)
+ ENDDO
+C
+C---- there is no blank between command and argument... use first 4 characters
+ IF(K.LE.0) K = 5
+C
+ IF(K.EQ.1) THEN
+C------ the "command" is a number... set entire COMAND string with it
+ COMAND = LINE
+ ELSE
+C------ the "command" is some string... just use the part up to the argument
+ COMAND = LINE(1:K-1)
+ ENDIF
+C
+C---- convert it to uppercase
+ CALL LC2UC(COMAND)
+C
+ CARGS = LINE(K:128)
+ CALL STRIP(CARGS,NCARGS)
+ RETURN
+C
+ 1000 FORMAT(/A,' c> ',$)
+ 1020 FORMAT(A)
+ END ! ASKC2
+
+
+ SUBROUTINE LC2UC(INPUT)
+ CHARACTER*(*) INPUT
+C
+ CHARACTER*26 LCASE, UCASE
+ DATA LCASE / 'abcdefghijklmnopqrstuvwxyz' /
+ DATA UCASE / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
+C
+ N = LEN(INPUT)
+C
+ DO 10 I=1, N
+ K = INDEX( LCASE , INPUT(I:I) )
+ IF(K.GT.0) INPUT(I:I) = UCASE(K:K)
+ 10 CONTINUE
+C
+ RETURN
+ END ! LC2UC
+
+
+ SUBROUTINE STRIP(STRING,NS)
+ CHARACTER*(*) STRING
+C-------------------------------------------
+C Strips leading blanks off string
+C and returns length of non-blank part.
+C-------------------------------------------
+ N = LEN(STRING)
+C
+C---- find last non-blank character
+ DO 10 K2=N, 1, -1
+ IF(STRING(K2:K2).NE.' ') GO TO 11
+ 10 CONTINUE
+ K2 = 0
+ 11 CONTINUE
+C
+C---- find first non-blank character
+ DO 20 K1=1, K2
+ IF(STRING(K1:K1).NE.' ') GO TO 21
+ 20 CONTINUE
+ 21 CONTINUE
+C
+C---- number of non-blank characters
+ NS = K2 - K1 + 1
+ IF(NS.EQ.0) RETURN
+C
+C---- shift STRING so first character is non-blank
+ STRING(1:NS) = STRING(K1:K2)
+C
+C---- pad tail of STRING with blanks
+ DO 30 K=NS+1, N
+ STRING(K:K) = ' '
+ 30 CONTINUE
+C
+ RETURN
+ END