Subroutine Mms(Data) c c *********************************************************************** c * * c * Subroutine Mms - To call the merge, sort, and move column * c * suboptions of PLTPRG. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Virtual Data(1) c 10 Continue Write(6,100) 27,27,27 100 Format(//1X,1A1,'[1m',1A1,'#6 MERGE, SORT, AND MOVE COLUMNS', $ 1A1,'[0m'//' Select:'// $ ' 1) Merge Data Columns Together'/ $ ' 2) Sort Data Columns'/ $ ' 3) Move Data Columns'/ $ ' 4) Stop'//' Select 1-4: ',$) Call Instrg('1234Ss',6,Ichose) c If (Ichose .GE. 4) Return If (Ichose .EQ. 1) Then Call Merge(Data) Else If (Ichose .EQ. 2) Then Call Sorter(Data) Else Call Mvcol(Data) End If Return End Subroutine Mvcol(Data) c c *********************************************************************** c * * c * Subroutine Mvcol - To move data columns around. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' Include 'Cflags' c Virtual Data(1) Character*16 Label c Label = ' ' Nl = 1 Write(6,100) 27,27,27 100 Format(/1X,A,'[1m',A,'#6 MOVE DATA COLUMN ROUTINE',A,'[0m'/) 10 Continue c c Input the column numbers c Write(6,125) Label 125 Format(' Enter the column number or range [first,last]', $ ' to move ',A,' ',$) Call Inpt(X,I,Iflag,2) If (Iflag .EQ. 1) Return If (I .GT. 2 .OR. I .LT. 1) Go To 10 Istart = X(1) If (I .EQ. 2) Then Iend = X(2) Else Iend = Istart End If c If (Istart .GT. Ncols .OR. Istart .LT. 1 .OR. Iend .GT. Ncols $ .OR. Iend .LT. 1 .OR. Istart .GT. Iend) Go To 10 c c Do 15 I=Istart,Iend X(I-Istart+1) = I 15 Continue Number = Iend - Istart + 1 c c Write out the column titles to see if the user agrees c Write(6,150) 27,27 150 Format(/3X,1A1,'[1;7mCOLUMNS TO BE MOVED:',1A1,'[0m'// $ ' No. Title'/) Do 20 I=1,Number Icol = Istart-1+I Call Name(Titl,Icol,Title,Ttllen) Write(6,200) Icol,(Titl(J),J=1,Ttllen(Icol)) 200 Format(I4,3x,80(:,A1)) 20 Continue c c Ask the user if they are correct c Write(6,250) 250 Format(/' Are the columns correct? (y/n) '$) Call Instrg('YyNn',4,Iflag) If (Iflag .GT. 2) Then Label = '(or "S" to stop)' Nl = 16 Go To 10 End If c c Get the column number to insert after c Label = ' ' Nl = 1 25 Continue Write(6,300) Label 300 Format(' Enter the column number to insert after ',A, $ ' ',$) Call Inpt(X,I,Iflag,2) If (Iflag .EQ. 1) Return If (I .NE. 1) Go To 25 I = X(1) Insert = Min0(I,Ncols) Insert = Max0(0,Insert) If ((Insert-Istart)*(Insert-Iend) .LE. 0) Then Write(6,350) 350 Format(' Error - the columns to move conflict with the', $ ' insertion spot') Label = '(or "S" to Stop)' Nl = 16 Go To 25 Else If (Istart-Insert .EQ. 1) Then Return End If c c See if the insertion point is correct c If (Istart .LT. Insert) Then Is = Max0(Insert-2,Iend+1) Is1 = Min0(Insert+3,Ncols) If (Insert-Is .LE. 1) Is1 = Min0(Is1+1,Ncols) Else Is = Max0(Insert-2,1) Is1 = Min0(Insert+3,Istart-1) If (Is1-Insert .LE. 2) Is = Max0(Is-1,1) End If c Write(6,400) 27,27 400 Format(/3X,1A1,'[1;7m COLUMN INSERTION LOCATION:',1A1,'[0m'// $ ' No. Title'/) Do 30 I=Is,Insert Call Name(Titl,I,Title,Ttllen) Write(6,200) I,(Titl(J),J=1,Ttllen(I)) 30 Continue Write(6,450) 27,27 450 Format(3X,1A1,'[1;7m**** Insertion Location ****',1A1,'[0m') Do 35 I=Insert+1,Is1 Call Name(Titl,I,Title,Ttllen) Write(6,200) I,(Titl(J),J=1,Ttllen(I)) 35 Continue Write(6,500) 500 Format(/' Is the insertion location correct? (y/n) ',$) Call Instrg('YyNn',4,Ic) If (Ic .GT. 2) Then Label = '(or "S" to stop)' Nl = 16 Go To 25 End If c c Set flag showing the data has been changed c Idflag = 1 c c Move the columns c Do 40 I=1,Number If (Insert .GT. Istart) Then Icol = Istart Else Icol = Iend End If Call Movcol(Data,Icol,Insert) 40 Continue c c List out the new columns c If (Insert .GT. Istart) Then Icol = Istart Is = Insert Else Icol = Insert + 1 Is = Iend End If Call Lisrng('CHANGED',7,Icol,Is) Write(6,550) 27,27 550 Format(/1X,1A1,'[5m THE ABOVE ARE THE ONLY COLUMNS WHOSE ', $ 'NUMBERS HAVE CHANGED',1A1,'[0m') Return End Subroutine Movcol(Data,Icol,Insert) c c *********************************************************************** c * * c * Subroutine Movcol - To move columns from the * c * array DATA. It also updates the table and plot * c * presentations. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' Include 'Cplot' Include 'Ctable' Include 'Cflags' c Virtual Data(1) c c Save the data to move c Call Getvec(Data,Npoint,Icol,X,Npts) c c Get the title of the data column c Call Name(Titl,Icol,Title,Ttllen) c c Find the starting location of the data in DATA c Call Point(Ipoint,Icol+1,Npoint) Call Point(Iend,Insert+1,Npoint) c c Move the data up/down in DATA, writing over the old values c If (Icol .LT. Insert) Then Do 20 I=Ipoint,Iend-1 Data(I-Npts) = Data(I) 20 Continue Iend = Iend - Npts Else Do 25 I=Ipoint-1,Iend+Npts,-1 Data(I) = Data(I-Npts) 25 Continue End If c c Load in the data being moved c Do 27 I=1,Npts Data(Iend-1+I) = X(I) 27 Continue c c Remove column title c Call Point(Ittl,Icol,Ttllen) Call Point(Itend,Ncols+1,Ttllen) Itend = Itend-1 Nchars = Ttllen(Icol) Call Rep(Title,Itend,Ittl,Ttllen(Icol),' ',0) Ttllen(Icol) = 0 c c Insert back the title c If (Icol .LT. Insert) Then Call Point(Ittl,Insert+1,Ttllen) Else Call Point(Ittl,Insert+1,Ttllen) End If c Call Point(Itend,Ncols+1,Ttllen) Itend = Itend - 1 Call Rep(Title,Itend,Ittl,0,Titl,Nchars) c c Update the pointers c If (Icol .LT. Insert) Then Do 30 I=Icol,Insert-1 Npoint(I) = Npoint(I+1) Ttllen(I) = Ttllen(I+1) 30 Continue Npoint(Insert) = Npts Ttllen(Insert) = Nchars Else Do 35 I=Icol,Insert+1,-1 Npoint(I) = Npoint(I-1) Ttllen(I) = Ttllen(I-1) 35 Continue Npoint(Insert+1) = Npts Ttllen(Insert+1) = Nchars End If c c Update the table presentation to reflect the deleted column c c If (Icol .LT. Insert) Then Do 40 K=2,Ntab If (Tabcol(K) .GT. Icol .AND. Tabcol(K) .LE. Insert) Then Tabcol(K) = Tabcol(K) - 1 Itflag = 1 Else If (Tabcol(K) .EQ. Icol) Then Tabcol(K) = Insert Itflag = 1 End If 40 Continue Else Do 45 K=2,Ntab If (Tabcol(K) .LT. Icol .AND. Tabcol(K) .GT. Insert) Then Tabcol(K) = Tabcol(K) + 1 Itflag = 1 Else If (Tabcol(K) .EQ. Icol) Then Tabcol(K) = Insert + 1 Itflag = 1 End If 45 Continue End If c c Update the plot presentation to reflect the deleted column c If (Icol .LT. Insert) Then Do 50 K = 1,Ncurve If (Xcurve(K) .GT. Icol .AND. Xcurve(K) .LE. Insert) Then Xcurve(K) = Xcurve(K) - 1 Ipflag = 1 Else If (Xcurve(K) .EQ. Icol) Then Xcurve(K) = Insert Ipflag = 1 End If If (Ycurve(K) .GT. Icol .AND. Ycurve(K) .LE. Insert) Then Ycurve(K) = Ycurve(K) - 1 Ipflag = 1 Else If (Ycurve(K) .EQ. Icol) Then Ycurve(K) = Insert Ipflag = 1 End If 50 Continue Else Do 55 K = 1,Ncurve If (Xcurve(K) .LT. Icol .AND. Xcurve(K) .GT. Insert) Then Xcurve(K) = Xcurve(K) + 1 Ipflag = 1 Else If (Xcurve(K) .EQ. Icol) Then Xcurve(K) = Insert + 1 Ipflag = 1 End If If (Ycurve(K) .LT. Icol .AND. Ycurve(K) .GT. Insert) Then Ycurve(K) = Ycurve(K) + 1 Ipflag = 1 Else If (Ycurve(K) .EQ. Icol) Then Ycurve(K) = Insert + 1 Ipflag = 1 End If 55 Continue End If Return End