Subroutine INPT(Array,Npoint,Istop,Many) c c ************************************************************************ c * * c * Subroutine INPT - To input real data, when the number of * c * points in an input line are unknown. To stop input, * c * enter 'S'. * c * * c * Input values: * c * * c * Many - This is a control variable which tells the routine * c * to keep reading input lines until an S (to stop) * c * is encountered. If zero, only one line is read. * c * If nonzero, it will keep reading. * c * * c * Output values: * c * * c * Array - The array in which the points read in are stored * c * Npoint - The number of points read in * c * Istop - A flag to indicate whether an S (to stop) was * c * read in. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c ************************************************************************ c Dimension Array(1) Byte Indata(132),Newval(80),Period,Plus,Minus,Stop,Zero,Nine, $ Stop1,Ictrlc c c Set up the control characters to look for c Data Period,Plus,Minus,Stop,Zero,Nine/'.','+','-','S','0','9'/ Data Stop1,Ictrlc/'s',3/ c Npoint = 0 10 Continue c c Read in the character string c If (Many .EQ. 2) Then Read(5,100,END=10,ERR=10) Nchars,(Indata(I),I=1,Nchars) 100 Format(Q,132A1) Do 15 I=1,Nchars If (Indata(I) .EQ. Ictrlc) Call Abort 15 Continue Else Call Linedt(Indata,Nchars,132,0) End If c c See if there are any numbers in the string, and whether to c stop here (an S encountered) c Istop = 0 Do 20 I=1,Nchars If (Indata(I) .EQ. Stop .OR. Indata(I) .EQ. Stop1) Istop = 1 20 Continue Do 30 I=1,Nchars If (Indata(I) .GE. Zero .AND. Indata(I) .LE. Nine) Go To 40 30 Continue 40 Continue c c If there are no numbers, and no stop was given, try reading again c If (Istop .EQ. 0 .AND. I .GT. Nchars) Go To 10 c c If there are no numbers, and a stop was given, return c If (Istop .NE. 0 .AND. I .GT. Nchars) Return c c Find the starting position of the current number c Istart = 1 50 Continue Do 60 I=Istart,Nchars If ((Indata(I) .GE. Zero .AND. Indata(I) .LE. Nine) .OR. $ (Indata(I) .EQ. Plus) .OR. (Indata(I) .EQ. Minus) .OR. $ (Indata(I) .EQ. Period) .OR. Indata(I) .EQ. 'E' .OR. $ Indata(I) .EQ. 'e') Go To 70 60 Continue c c If no numbers left (Istart greater than Nchars) then exit c Go To 95 c 70 Continue Istart = I If (Istart .EQ. Nchars+1) Go To 95 c c Find the ending position of the current number c Iperd = 0 Ieflag = 0 Ierr = 0 If (Indata(Istart) .EQ. Period) Iperd = 1 If (Indata(Istart) .EQ. 'E' .OR. Indata(Istart) .EQ. 'e') $ Ierr = 1 c Do 80 I=Istart+1,Nchars c c Look for an ending character - Jump out if found c If ((Indata(I) .LT. Zero .OR. Indata(I) .GT. Nine) .AND. $ (Indata(I) .NE. Plus) .AND. (Indata(I) .NE. Minus) .AND. $ (Indata(I) .NE. Period) .AND. (Indata(I) .NE. 'E' .AND. $ Indata(I) .NE. 'e')) Go To 90 If (Indata(I) .EQ. Period) Iperd = Iperd + 1 c c Check for illegal +/- signs, or multiple periods c If (((Indata(I) .EQ. Minus .OR. Indata(I) .EQ. Plus) .AND. $ (Indata(I-1) .NE. 'E' .AND. Indata(I-1) .NE. 'e')) .OR. $ Iperd .GT. 1) Ierr = 1 c c Check for E format in the input data c If ((Indata(I) .EQ. 'E' .OR. Indata(I) .EQ. 'e') .AND. $ (Indata(I+1) .LT. Zero .OR. $ Indata(I+1) .GT. Nine) .AND. (Indata(I+1) .NE. Plus) .AND. $ (Indata(I+1) .NE. Minus) .AND. (Indata(I+1) .NE. Period)) $ Go To 90 c c See, if we have an exponent, if the exponent is of legal form. c If not set Ierr = 1 c If (Indata(I) .EQ. 'E' .OR. Indata(I) .EQ. 'e') Then c c More than 1 "E" found? if so, set error flag c If (Ieflag .GT. 0) Ierr = 1 c If (Indata(I+1) .EQ. Plus .OR. Indata(I+1) .EQ. Minus) Then L = I + 1 If (L .EQ. Nchars) Then Ierr = 1 Go To 90 End If Else L = I End If Ieflag = L c c Exponent greater than +/- 29? if so, set error flag c If ((Indata(L+1) .GT. '2' .AND. Indata(L+1) .LE. Nine) $ .AND. (Indata(L+2) .GE. Zero .AND. Indata(L+2) $ .LE. Nine .AND. L+2 .LE. Nchars)) Ierr = 1 c c Decimal point in exponent? if so, set error flag c If (Indata(L+1) .EQ. Period) Ierr = 1 If ((Indata(L+2) .EQ. Period .AND. Nchars .LE. L+2) $ .AND. Indata(L+1) .GE. $ Zero .AND. Indata(L+1) .LE. Nine) Ierr = 1 End If 80 Continue 90 Continue c c End of "number" string is found c Ifinis = I c c Check the exponent length (if present), and if an error occured. c If it did, then jump to section to get correct value from the user. c If ((Ieflag .GT. 0 .AND. (Ifinis-Ieflag) .GT. 3) .OR. Ierr .GT. $ 0 ) Then Iend = Ifinis - 1 If (Iend-Istart .EQ. 0) Go To 93 Go To 96 End If c c Decode the character string and stick it into Array c Numlen = Ifinis-Istart Npoint = Npoint + 1 Decode(Numlen,200,Indata(Istart)) Array(Npoint) 200 Format(E16.0) c c Go back and get the next number c 93 Continue Istart = Ifinis If (Istart .EQ. Nchars) Go To 95 Go to 50 c c See if we are to read another line; if so, loop back; otherwise, c return to the calling routine. c 95 Continue If (Istop .EQ. 0 .AND. Many .EQ. 1) Go To 10 Return c c Error returns.... Get the correct value from the user. c 96 Continue c c Display the error, and prompt the user for a new value c Write(7,300) 7,27,(Indata(L),L=1,Istart-1),27,(Indata(L),L= $ Istart,Iend),27,(Indata(L),L=Iend+1,Nchars),27,27, $ 27,(Indata(L),L=Istart,Iend),27 300 Format(1X,1A1,1A1,'[1m',A1,'[5;7m',A1,'[0;1m',A1,'[0;1m'/ $ ' ERROR',1A1,'[0m - Bad value encountered - "',1A1,'[1;4m', $ A1,'[0m" - Please re-enter the bad value') c c Read in the new value as a string c If (Many .EQ. 2) Then Read(5,100,END=96,ERR=96) Nchar1,(Newval(I1),I1=1,Nchar1) Else Call Linedt(Newval,Nchar1,80,0) End If c c Add this string to the existing string, replacing the bad c number string. First, we move the string to the right of the c "bad" string further right. c Do 97 L=Nchars,Iend+1,-1 Indata(L+Nchar1) = Indata(L) 97 Continue c c Now we replace the "bad" string with the new string c Do 98 L=1,Nchar1 Indata(L+Istart-1) = Newval(L) 98 Continue c c Finally, we move the string to the right, back to the left c to fill in the gaps c Do 99 L=1,Nchars-Iend Indata(Istart+Nchar1+L-1) = Indata(Nchar1+Iend+L) 99 Continue c c Update the number of characters in the main string, and go back c and try to translate the string starting from the new piece c Nchars = Nchars - Iend + Istart - 1 + Nchar1 Go To 50 c End Subroutine Abort c c *********************************************************************** c * * c *********************************************************************** c Include 'Cflags' c External Contin c Iabort = 1 Write(7,300) 29,'T',29,'E' Write(7,100) 27,27 100 Format('+',1A1,'7',1A1,'EDo you wish to abort? (y/n) ',$) Call Instrg('YyNn',4,Ich) If (Ich .LT. 3) Call Aborta Write(7,200) 200 Format(' Do you want to start back at the main menu? (y/n) ',$) Call Instrg('YyNn',4,Icont) c If (Icont .LE. 2) Then Iabort = 0 Write(7,250) 27,27,27 250 Format('+',1A1,'7',1A1,'[1;24r',1A1,'8',$) Close(Unit=12) Call Branch(Istack,Contin) End If c If (Iecho .EQ. 1) Write(7,300) 29,'F',29,'S' 300 Format('+',1A1,$) Write(7,400) 27,27 400 Format(1X,1A1,'8',1A1,'[J',$) c c No aborts c Iabort = 0 Return c End