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