Subroutine MENU c c ********************************************************************** c * * c * Subroutine Menu - To list out the various options under * c * Program PLTPRG. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c ********************************************************************** c c c Clear the screen c Write(6,100) 27,27 100 Format(1x,1A1,'[H',1A1,'[J') c c Write out the options c Write(6,200) 27,27,27 200 Format(1x,1A1,'#3PLTPRG - FOR DATA PLOTTING AND ANALYSIS'/ $ 1X,1A1,'#4PLTPRG - FOR DATA PLOTTING AND ANALYSIS'// $21X,'Written by Steven C. Fisher, Code 1522'// $1X,1A1,'#6 OPTIONS MENU'// $' ME - Display this menu RP - Read present', $'ation from a file'/ $' IN - Input data from keyboard SP - Store presen', $'tation in a file (or PS)'/ $' MD - Modify a single data column LD - List the data '/ $' RD - Read data from a file SC - Scale the data'/ $' SD - (or SB) Store the data in a file AC - Add, subtract, ', $'etc, two columns'/ $' CP - Create presentation DC - Delete data col', $'umns'/ $' PL - Plot the presentation QP - Quick plot'/ $' MP - Modify the presentation CV - Convert datafiles', $' to PLTPRG format'/ $' LC - (or LR) List data column titles ID - Integrate/diffe', $'rentiate data'/ $' IT - Interpolate values from the data DI - File Directory'/ $' TA - Table menu VI - Viewgraphs'/ $' EQ - Equation evaluation MC - Modify multiple', $' data columns'/ $' MS - Merge, sort or move columns VM - Spawn a VMS', $' subprocess'/ $' AR - Users analysis routines IP - Interactive plot', $' modification'/ $' ST - Stop') Return End Subroutine Dcoder(Iflag) c c *********************************************************************** c * * c * Subroutine DCODER - To decode an input to the terminal, and * c * return with a number corresponding to the input string * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cflags' c Integer String(35),Ichar Byte Char(2) Equivalence (Char(1),Ichar) Data String /'ME','HE','IN','MD','RD','SD','CP','PL','MP', $ 'LC','IT','RP','SP','LD','SC','AC','DC','QP','ST','QU','CV', $ 'ID','TA','DI','VI','EQ','MC','MS','LR','AR','SB','VM', $ 'PS','PV','IP'/ c c To increase commands, increase the dimension of 'string', add 1 to c Ncomnd (below), and add the command to the above DATA declaration c Ncomnd = 35 Iflag = 0 5 Continue Iloop = 0 Write(6,100) 100 Format(/' ** SELECT NEXT OPTION ** '$) c c Read in the instruction c 10 Continue c Read(5,150,END=30,ERR=30) Char 150 Format(2A1) Iloop = Iloop + 1 If (Iabort .EQ. .TRUE.) Call Abort c c Check for bad characters (ascii characters between 91 and 96 c aren't checked - c If (Char(1) .LT. 'A' .OR. Char(2) .LT. 'A' .OR. Char(1) .GT. $ 'z' .OR. Char(2) .GT. 'z') Then If (Iloop .GE. 5) Then Call Menu Go To 5 End If Write(6,200) 200 Format(' Input error - try again '$) Go To 10 End If c c c Convert to upper case letters - c If (Char(1) .GT. 'Z') Char(1) = Char(1) - 32 If (Char(2) .GT. 'Z') Char(2) = Char(2) - 32 c c ICHAR is equivalenced with CHAR - so it contains the c uppercase command string. If we compare it to the c elements in STRING, we will have a match - I hope c Do 20 I=1,Ncomnd If (Ichar .EQ. String(I)) Then Iflag = I Return End If 20 Continue c c If we end up here, we don't have any match, so we will try again c If (Iloop .GE. 5) Then Call Menu Go To 5 End If Write(6,200) Go To 10 30 Continue Go To 10 End Subroutine Lisdat(Data) c c *********************************************************************** c * * c * Subroutine LISDAT - To list the current data stored in the * c * program. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' c Virtual Data(1) Dimension Ic(8) Character*14 Ac(8) c c Get the column numbers to list out c Write(6,100) 100 Format(' Data listing routine... Enter the column numbers to ', $ 'list (8 maximum)') Call Inpt(X,N,Iflag,0) If (N .EQ. 0 .OR. Iflag .EQ. 1) Return If (N .GT. 8) N = 8 c c Convert to 132 columns if necessary c If (N .GT. 5) Write(6,150) 27,'h' 150 Format(1X,1A1,'[?3',1A1) c Write(6,200) 27,27 200 Format(1X,1A1,'[H',1A1,'[J Column labels: '/) c c Remove the bad column numbers c Max = 0 K = N Do 10 I=1,N Icol = X(I) If (Icol .LE. 0 .OR. Icol .GT. Ncols) Then If (I .EQ. N) Go To 7 Do 5 J=I,N-1 X(J) = X(J+1) 5 Continue 7 K = K - 1 End If L = X(I) Max = Max0(Max,Npoint(L)) 10 Continue N = K If (N .LE. 0) Then Write(6,250) 250 Format(' ERROR - all column numbers are bad - routine', $ ' aborted') Return End If c c Limit the printout for large column numbers c Iprt = 1 Istart = 1 If (Numbr .GT. 100) Then Write(6,260) Max 260 Format(/' Do you wish to print out every point on the', $ ' screen?'/' (There are',I5,' points per column)', $ ' ',$) Call Instrg('YyNn',4,Iopt) If (Iopt .GE. 3) Then 15 Continue Write(6,270) 270 Format(' Enter the starting point, and the Nth point', $ ' to print') Call Indata(2,'II',Istart,Iprt) If (Istart .LT. 1 .OR. Istart .GT. Max .OR. Iprt $ .LT. 1 .OR. Iprt .GT. Max) Go To 15 End If End If c c Print out the column titles c Do 20 I=1,N Icol = X(I) Call Name(Titl,Icol,Title,Ttllen) Write(6,300) Icol,(Titl(J),J=1,Ttllen(Icol)) 300 Format(' Column ',I3,': ',A1) Ic(I) = X(I) 20 Continue c c Print out the headers c Write(6,400) (Ic(J),J=1,N) 400 Format(/' pt ',(4X,'Column ')/' no. ',(I4,11X)/) c c Write out the rest of the data c L = N + 3 Do 50 I=Istart,Npt_Max,Iprt Iflag = 1 Do 40 J=1,N c c If a column has no data, replace number with a dashed line c If (Npoint(Ic(J)) .GE. I) Then Call Point(K,Ic(J),Npoint) Encode(14,450,Ac(J)) Data(K+I-1) 450 Format(G14.7) Iflag = 0 Else Ac(J) = ' ---- ' End If 40 Continue If (Iflag .EQ. 1) Go To 60 ! No more to print out c c Pause for long listings c L = L + 1 If (L .GE. 20) Then Call Spause L = 0 End If c c Print out on the terminal c Write(6,500) I,(Ac(J),J=1,N) 500 Format(1X,I4,(1X,A14)) c 50 Continue 60 Continue c c Convert back to 80 columns c If (N .GT. 5) Then Write(6,600) 600 Format(' Press return to set the screen back to 80 columns ',$) Read(5,650,END=60,ERR=60) Ichar 650 Format(1A1) Write(6,150) 27,'l' End If c Return End Subroutine Init(Data) c c *********************************************************************** c * * c * Subroutine Init - To initialize the program and read in * c * the scratch files. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' Include 'Cplot' Include 'Caxis' Include 'Ctable' Include 'Clabls' Include 'Clegnd' Include 'Cgrid' Include 'Ctxblk' Include 'Cdefl' Include 'Cflags' c Virtual Data(1) c Byte Xblank(160),Yblank(160) c Equivalence (Xblank(1),Xaxis(1,1)),(Yblank(1),Yaxis(1,1)) c Data Xblank/160*' '/,Yblank/160*' '/ c c ***************************************************************** c c Initialize data and read in the scratch files (if any) c Iabort = .FALSE. Iaborta= 0 Last = 25000 Ncols = 0 Ncurve = 0 Nleg = 0 Ntxbl = 0 Nlabel = 0 Idflag = 0 ! Flag to see if data modified/added Ipflag = 0 ! Flag to see if plot is modified Itflag = 0 ! Flag to see if table is modified c Call Deflt ! Set default plot values Call Rednow(Data) ! Read in data Call Rpldat ! Read in plot data Call Gettab(1) ! Read in table data Call Iostart ! Get the I/O channels, etc. c c c Print out the program menu c Call Menu c c Initialization complete. Return to main program. c Return End