Subroutine Mod(Data) c c *********************************************************************** c * * c * Subroutine Mod - To modify column data in groups * c * * c * Programmed By Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' Include 'Cflags' c Virtual Data(1) c Dimension Icol(9),Ipoint(9) c Write(7,100) 27 100 Format(/1X,1A1,'#6 MODIFY COLUMNS IN GROUPS'/) c c Prompt the user for the columns to use in the equation c Call Modwho(Icol,Ipoint,Nc,Iflag) If (Iflag .NE. 0) Return c c Convert to 132 column for large numbers of columns c If (Nc .GT. 5) Write(7,625) 27,'h' 625 Format(1X,1A1,'[?3',1A1) c 40 Continue c c Display the data modification options c Write(7,650) 650 Format(' Select:'//' I (I)nsert data'/' A (A)dd data'/ $ ' C (C)hange data'/' D (D)elete data'/ $ ' L (L)ist data'/' S (S)top'/' Enter I, A, C, D, L', $ ', or S: ',$) Call Instrg('IiAaCcDdLlSs',12,Ichose) Ichose = (Ichose + 1) / 2 c If (Ichose .LE. 2) Then c c Insert/Add data c If (Npoint(Icol(1)) .GE. Nptmax) Then Write(7,675) 675 Format(' The column contains the maximum number of points') Go To 40 End If If (Ichose .EQ. 1) Then Write(7,700) 700 Format(' Enter the point number to insert after: ',$) Call Inchek(0,Npoint(Icol(1)),Ipos) Else Ipos = Npoint(Icol(1)) End If c c Write out the data near the place to insert/add c Write(7,725) 27,27 725 Format(1X,1A1,'[H',1A1,'[J') Write(7,875) (Icol(I),I=1,Nc) Ifirst = Max0(1,Ipos-3) Ilast = Min0(Npoint(Icol(1)),Ipos+4) Loop = 1 Iset = 1 Iposit = Ipos c If (Ipos .GT. 0) Write(7,900) $ (L,(Data(Ipoint(K)+L-1),K=1,Nc),L=Ifirst,Ipos) c Write(7,730) Ipos+1 730 Format(I5,' ************** New data values **************') c If (Ipos .LT. Npoint(Icol(1))) Write(7,900) $ (L+1,(Data(Ipoint(K)+L-1),K=1,Nc),L=Ipos+1,Ilast) c Write(7,740) 27,27 740 Format(1X,1A1,'[15;24r',1A1,'[16;1H') c 50 Continue c If (Npoint(Icol(1)) .GE. Nptmax) Then Write(7,675) Go To 54 End If c Ifirst = Max0(1,Ipos-3) c Write(7,750) Ipos + 1 750 Format(' Enter the values for point number ',I4,', or "S"', $ ' to stop') Call Inpt(X(Iset),N,Iflag,2) c c If we exit here, turn scrolling back to 24 columns c If (N .EQ. 0 .AND. Iflag .EQ. 1) Then Write(7,760) 27,27,27 760 Format(1X,1A1,'7',1A1,'[1;24r',1A1,'8') Go To 54 End If c If (N .NE. Nc .AND. Iflag .EQ. 0) Then Write(7,775) 775 Format(' ERROR - Wrong number of points entered - Try', $ ' again') Go To 50 End If c c Insert the values onto the terminal c Iloc = 5 + Ipos-Ifirst c If (Ifirst .EQ. 1 .AND. Ipos-Ifirst .LT. 3) Then Write(7,776) 27,27,27,Iloc+1,27,Ipos+1,X(Iset),27,27 776 Format(1X,1A1,'7',1A1,'[1;15r', $ 1A1,'[',I1,';H',1A1,'[L',I4,3X,G14.5, $ 1A1,'[15;24r',1A1,'8') Else c Write(7,777) 27,27,Iloc,27,Iloc,Ipos+1,X(Iset),27,27 777 Format(1X,1A1,'7',1A1,'[5;',I1,'r',1A1,'[',I1,';H'/ $ I5,3X,G14.5,1A1,'[15;24r',1A1,'8') End If c Last1 = Max0(Ilast+1,Ipos+2) If (Ipos-Ifirst .LT. 3) Iloc = Iloc + 1 c Do 51 I=2,Nc Write(7,773) 27,Iloc,8+(I-1)*14,X(I+Iset-1),27 773 Format('+',1A1,'[',I1,';',I<2+I/8>,'H',G14.5,1A1,'8') 51 Continue c Do 53 I=Ipos+2,Last1+1 If (I .GT. Npoint(Icol(1))+1+Loop) Go To 53 Iloc = Iloc + 1 Write(7,778) 27,Iloc,I,27 778 Format('+',1A1,'[',I<1+Iloc/10>,';1H',I4,1A1,'8') 53 Continue c Loop = Loop + 1 Ilast = Ilast + 1 Iset = Iset + Nc Ipos = Ipos + 1 If (Iset .GT. Nptmax*2-Nc) Go To 54 Go To 50 c 54 Continue c c Insert the values into the data arrays and pointers c If (Loop .EQ. 1) Go To 40 Loop = Loop - 1 Idflag = 1 Call Point(Lastpt,Ncols+1,Npoint) Do 60 I=1,Nc Do 55 J=Lastpt-1,Ipoint(I)+Iposit,-1 Data(J+Loop) = Data(J) 55 Continue Do 56 J=1,Loop Data(Ipoint(I)+Iposit+J-1) = X((J-1)*Nc+I) 56 Continue Lastpt = Lastpt + Loop Npoint(Icol(I)) = Npoint(Icol(I)) + Loop Do 57 J=1,Nc If (Icol(J) .GT. Icol(I)) Ipoint(J) = Ipoint(J) + Loop 57 Continue 60 Continue c Go To 40 c Else If (Ichose .EQ. 3) Then c c Change the data values c 65 Continue Write(7,800) 800 Format(' Enter the point to change, or "S" to stop ',$) Call Inpt(X,N,Iflag,2) If (Iflag .EQ. 1) Go To 40 Ipos = X(1) If (Ipos .LT. 1. .OR. Ipos .GT. Npoint(Icol(1))) Then Write(7,825) 825 Format(' Point number is out of range - Try again') Go To 65 End If 70 Continue c c List out the current values: c Write(7,725) 27,27 Write(7,875) (Icol(I),I=1,Nc) Ifirst = Max0(1,Ipos-4) Ilast = Min0(Npoint(Icol(1)),Ipos+4) c If (Ipos .GT. 1) Write(7,900) $ (L,(Data(Ipoint(K)+L-1),K=1,Nc),L=Ifirst,Ipos-1) Write(7,840) 27,Ipos,27,27 840 Format(1X,1A1,'[1;7m',I4,3X,1A1,'[m',1A1,'7') Do 72 K=1,Nc Write(7,845) 27,27,Data(Ipoint(K)+Ipos-1),27,27 845 Format(1X,1A1,'8',1A1,'[1;7m',G14.5,1A1,'[m',1A1,'7') 72 Continue If (Ipos .LT. Npoint(Icol(1))) Write(7,900) $ (L,(Data(Ipoint(K)+L-1),K=1,Nc),L=Ipos+1,Ilast) c Write(7,850) 850 Format(/' Enter the new values:') Call Inpt(X,N,Iflag,2) If (N .EQ. 0 .AND. Iflag .EQ. 1) Go To 40 If (N .NE. Nc .AND. Iflag .EQ. 0) Then Write(7,775) Go To 65 End If c c Save the new values c Idflag = 1 Write(7,851) 27,27,5+Ipos-Ifirst,27,Ipos,X(1),27,27,7 851 Format(1X,1A1,'7',1A1,'[',I1,';1H',1A1,'[1m',I4,3X,G14.5, $ 1A1,'[m',1A1,'8',1A1) Do 75 I=1,Nc If (I .GT. 1) Write(7,853) 27,5+Ipos-Ifirst, $ (8+(I-1)*14),27,X(I),27,27 853 Format(1X,1A1,'[',I1,';'I<2+I/8>,'H',1A1,'[1m',G14.5,1A1, $ '[m',1A1,'8',1A1) Data(Ipoint(I)+Ipos-1) = X(I) 75 Continue Go To 65 c Else If (Ichose .EQ. 4) Then c c Delete out the data c 80 Continue c Write(7,855) 855 Format(' Enter the point number to delete, or a range'/ $ ' [first, last] to delete, or "S" to stop: ',$) c Call Inpt(X,N,Iflag,2) If (Iflag .EQ. 1) Go To 40 c Ipos = X(1) If (N .GT. 1) Then Idelt = X(2) - Ipos + 1 Else Idelt = 1 End If c If (Ipos .LT. 1 .OR. Ipos .GT. Npoint(Icol(1)) .OR. Idelt $ .LT. 1 .OR. Idelt+Ipos-1 .GT. Npoint(Icol(1))) Then Write(7,825) Go To 80 End If c c List out the points to be deleted c Write(7,857) 27,27 857 Format(/1X,1A1,'[1;5;7mPoints to delete:',1A1,'[0m'/) Write(7,875) (Icol(I),I=1,Nc) Do 83 L=Ipos,Ipos+Idelt-1 Write(7,900) L,(Data(Ipoint(K)+L-1),K=1,Nc) If (((L+3-Ipos)/20)*20 .EQ. L+3-Ipos) Call Spause 83 Continue Write(7,858) 858 Format(/' Are these the correct points to delete? ',$) Call Instrg('YyNn',4,Ic) If (Ic .GT. 2) Go To 40 c c Delete the points c Call Point(Lastpt,Ncols+1,Npoint) Idflag = 1 Do 90 I=1,Nc If (Npoint(Icol(I)) .GT. Idelt) Then Do 85 J=Ipoint(I)+Ipos-1,Lastpt-Idelt Data(J) = Data(J+Idelt) 85 Continue Npoint(Icol(I)) = Npoint(Icol(I)) - Idelt Lastpt = Lastpt - Idelt Do 87 J=1,Nc If (Icol(J) .GT. Icol(I)) Ipoint(J) = Ipoint(J)-Idelt 87 Continue Else c c Delete out all of the columns if all points are deleted c Do 88 J=1,Nc X(J) = Icol(J) 88 Continue Call Sort(X,Y,Nc) Do 89 J=Nc,1,-1 Ic = X(J) Call Dcols(Data,Ic) 89 Continue Return End If c 90 Continue c Else If (Ichose .EQ. 5) Then c c List out the data values c Write(7,860) 860 Format(' Enter the point range [first, last] to list: ',$) Call Indata(2,'II',Ifirst,Ilast) Ifirst = Max0(Ifirst,1) Ilast = Min0(Ilast,Npoint(Icol(1))) c If (Ifirst .GT. Ilast) Go To 40 c Write(7,875) (Icol(I),I=1,Nc) 875 Format(1X,'Data',2X,(5X,'Column',3X)/ $ 2X,'Pt ',2X,(I9,5X)/) Do 95 L=Ifirst,Ilast Write(7,900) L,(Data(Ipoint(K)+L-1),K=1,Nc) If (((L+3-Ifirst)/22)*22 .EQ. L+3-Ifirst) Call Spause 95 Continue c If (L+3-Ifirst - ((L+3-Ifirst)/22)*22 .GT. 13) Call Spause c 900 Format(I5,3X,G14.5) Else c c Stop the changes c If (Nc .GT. 5) Write(7,625) 27,'l' Return End If Go To 40 End