Subroutine MATHCV(Data) c c *********************************************************************** c * * c * Subroutine MATHCV - to add, subtract, multiply, or divide * c * two columns. This routine requires that both columns have * c * the same number of points. The routine is simple; the Ith * c * element of one column is operated on by the Ith element of * c * the other column - one-to-one correspondence. (in * c * otherwords, if you have two curves and you want to "operate" * c * on then (the Y value columns), it would be up to the user to * c * ensure that the corresponding X value columns are identical) * c * If division is selected, and the denominator is zero, a * c * value of 1E-20 will be substituted instead. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' Include 'Cflags' c Double Precision String(6) Virtual Data(1) Integer Choice Byte Blank(4) Dimension Lop(4) Data String/'A + B','A - B','B - A','A * B','A / B','B / A'/ Data Blank /4*' '/ c c See if there is data in the program c If (Ncols .EQ. 0) Then Write(6,100) 100 Format(' ERROR - No Data in the program - routine aborted') Return Endif c c Get the column numbers to work with c Write(6,125) 27,27,27 125 Format(1X,1A1,'[H',1A1,'[J'//1X,1A1,'#6 MATH OPERATIONS ', $ 'ON COLUMNS'//' Routine enables user to add, subtract, ', $ 'multiply, and divide two'/' columns. Both columns must ha', $ 've the same "X" values,'/' and the same number of points'/) 10 Continue Write(6,150) 150 Format(' Enter the two column numbers to use: ') Call Indata(2,'II',Ix,Iy) c c Check the data c If ( Ix .GE. 1 .AND. Iy .GE. 1 .AND. Ix .LE. Ncols .AND. Iy .LE. $ NCOLS) Then If (Npoint(Ix) .NE. Npoint(Iy)) Then Write(6,200) 200 Format(' The number of points per column do not match') Go To 10 End If Else Write(6,300) 300 Format(' Column number(s) are out of range') Go To 10 End If c If (Npoint(Ix) .EQ. 1) Then Write(6,350) 350 Format(' Only one point in each column - routine aborted') Return End If c c Write out the column titles c Call Name(Titl,Ix,Title,TTllen) Write(6,360) (Titl(I),I=1,TTllen(Ix)) 360 Format(' Column A: ',80(:,1A1)) Call Name(Titl,Iy,Title,TTllen) Write(6,370) (Titl(I),I=1,Ttllen(Iy)) 370 Format(' Column B: ',80(:,1A1)) c c See if the user likes their column choices c Write(6,400) 400 Format(/' Are these column numbers correct? (y/n) '$) Call Instrg('YyNn',4,Choice) If (Choice .GT. 2) Then Write(6,450) 450 Format(' Do you wish to stop? (y/n) '$) Call Instrg('YyNn',4,Choice) If (Choice .GT. 2) Go To 10 Return End If c c Input the column operations c Write(6,500) 500 Format(' Select the operations on the columns:'// $ ' 1) A + B'/ $ ' 2) A - B'/ $ ' 3) B - A'/ $ ' 4) A * B'/ $ ' 5) A / B'/ $ ' 6) B / A'//' Select 1-6 '$) Call Inchek(1,6,Iflag) c c Get the new data title c Write(6,525) 525 Format(' Enter a title for the resultant column if you wish', $ ' to save it') Call Linedt(Titl,Nchars,80,0) If (Nchars .EQ. 1 .AND. Titl(1) .EQ. ' ') Nchars = 0 If (Ncols .EQ. Ncolmx .AND. Nchars .GT. 0) Then Write(6,545) 7 545 Format(1X,1A1,'No room for additional columns'/) Return End If Call Point(I,Ncols+1,Npoint) If (I+Npoint(Ix)-1 .GT. Last) Then Write(6,545) 7 Return End If c c Get the data from the main array c Call Getvec(Data,Npoint,Ix,X,Number) Call Getvec(Data,Npoint,Iy,Y,Number) c c Compute the result of the operation, and store it c Call Point(Ipoint,Ncols+1,Npoint) Ipoint = Ipoint - 1 Do 30 I = 1,Number If (Iflag .EQ. 1) Then Data(I+Ipoint) = X(I) + Y(I) Else If (Iflag .EQ. 2) Then Data(I+Ipoint) = X(I) - Y(I) Else If (Iflag .EQ. 3) Then Data(I+Ipoint) = Y(I) - X(I) Else If (Iflag .EQ. 4) Then Data(I+Ipoint) = X(I) * Y(I) Else If (Iflag .EQ. 5) Then If (Y(I) .EQ. 0.0) Then Data(I+Ipoint) = 1E20 * X(I) Else Data(I+Ipoint) = X(I) / Y(I) End If Else If (X(I) .EQ. 0.0) Then Data(I+Ipoint) = 1E20 * Y(I) Else Data(I+Ipoint) = Y(I) / X(I) End If End If 30 Continue c c Update the pointers for the new column c If (Nchars .GT. 0) Then Ncols = Ncols + 1 c c Set flag to show that the data has been modified c Idflag = 1 Npoint(Ncols) = Number Ttllen(Ncols) = Nchars Call Point(Jpoint,Ncols,Ttllen) Do 40 I=1, Nchars Title(I+Jpoint-1) = Titl(I) 40 Continue End If c c See if every value is to be printed c Iprt = 1 Istart = 1 If (Number .GT. 100) Then Write(6,546) Number 546 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 45 Continue Write(6,547) 547 Format(' Enter the starting point, and the Nth point', $ ' to print') Call Indata(2,'II',Istart,Iprt) If (Istart .LT. 1 .OR. Istart .GT. Number .OR. Iprt $ .LT. 1 .OR. Iprt .GT. Number) Go To 45 End If End If c c Write out the values - first, set up the way to print the c numbers on the screen c Num = (Number-Istart)/Iprt + 1 Nc = Num / 20 + 1 If (Nc .GT. 2) Nc = 2 Loop = Num / Nc Mod = Num - Loop * Nc Lop(1) = 0 Lop(2) = (Loop + Mod) * Iprt c c Write the data headers c Write(6,550) 27,27 550 Format(1X,1A1,'[H',1A1,'[J') c Call Name(Titl,Ix,Title,TTllen) Write(6,360) (Titl(I),I=1,TTllen(Ix)) Call Name(Titl,Iy,Title,TTllen) Write(6,370) (Titl(I),I=1,Ttllen(Iy)) c Write(6,600) (Blank(K),String(Iflag),K=1,Nc) 600 Format(/2(1A1,5X,'A',12X,'B',10X,1A5,4X)) c Write(6,650) 650 Format(5X) c c Print the data in neat columns c Is = Istart - 1 If (Loop .NE. 0) Then L = 4 Do 50 I=1,Loop*Iprt,Iprt Write(6,700)(X(I+Is+Lop(K)),Y(I+Is+Lop(K)), $ Data(Ipoint+Is+I+Lop(K)),K=1,Nc) 700 Format(2(1X,G12.5,1X,G12.5,1X,G12.5)) c c If the screen is full, have the user press return to continue c L = L + 1 If ( L .EQ. 20) Then Call Spause L = 0 End If c 50 Continue End If c c Last numbers to print out c If (Mod .NE. 0) Then Write(6,700) (X(I+Is+Lop(K)),Y(I+Is+Lop(K)), $ Data(Ipoint+Is+I+Lop(K)),K=1,Mod) End If Return End Subroutine SCADAT(Data) c c *********************************************************************** c * * c * Subroutine SCADAT - To scale data columns by constants. * c * This routine multiplies a column by a constant, and adds * c * in another constant (New = A * OLD + B), with the constants * c * user supplied. The scaled data can either be saved by * c * replacing the old column data, or it can be saved as a new * c * data column. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' Include 'Cflags' c Virtual Data(1) Byte Char Dimension Lop(2) c c See if there is any data in the program c If (Ncols .EQ. 0) Then Write(6,110) 110 Format(' ERROR - No data is in the program. Routine aborted') Return End If c c Clear the screen, and get the data column number to scale c Write(6,100) 27,27,27 100 Format(1X,1A1,'[H',1A1,'[J'/1X,1A1,'#6 SCALE DATA ROUTINE'/) c 10 Continue Write(6,150) 150 Format(' Enter the data column number to scale '$) Call Inchek(1,Ncols,Icol) c c Check to see if the title is correct c Call Name(Titl,Icol,Title,Ttllen) Write(6,200) (Titl(I),I=1,Ttllen(Icol)) 200 Format(/' Title is: ',A1) Write(6,250) 250 Format(/' Is the title correct? (y/n) '$) Call Instrg('YynN',4,Iflag) If (Iflag .GT. 2) Then Write(6,300) 300 Format(' Do you wish to stop? (y/n) '$) Call Instrg('YyNn',4,Iflag) If (Iflag .LE. 2) Return Go To 10 End If c c Get the calibration factors A and B c Write(6,350) 350 Format(' Enter the calibration values A and B, where'/ $ ' the new values = A * (old values) + B'/) Call Indata(2,'RR',Aval,Bval) c c Compute the calibrated values c Call Point(Ipoint,Icol,Npoint) Ipoint = Ipoint - 1 Do 30 I=1,Npoint(Icol) X(I) = Data(Ipoint+I) * Aval + Bval 30 Continue c Iprt = 1 Istart = 1 If (Npoint(Icol) .GT. 100) Then Write(6,360) Npoint(Icol) 360 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 35 Continue Write(6,370) 370 Format(' Enter the starting point, and the Nth point', $ ' to print') Call Indata(2,'II',Istart,Iprt) If (Istart .LT. 1 .OR. Istart .GT. Npoint(Icol) .OR. $ Iprt .LT. 1 .OR. Iprt .GT. Npoint(Icol)) Go To 35 End If End If c c Write the header for the display c Call Digit(Aval,Is,Id) Call Digit(Bval,Is1,Id1) Write(6,400) 27,27,Icol,(Titl(I),I=1,Ttllen(Icol)),Aval,Bval 400 Format(1X,1A1,'[H',1A1,'[J',' Column number ',I3/' Title: ', $ A1//' New Values = ',F.,' * (old ', $ 'values) + ',F./) c c Compute the format to print the numbers c Num = (Npoint(Icol)-Istart)/Iprt + 1 Nc = Num / 20 + 1 If (Nc .GT. 2) Nc = 2 Loop = Num / Nc Mod = Num - Loop * Nc Lop(1) = 0 Lop(2) = (Loop + Mod) * Iprt Write(6,450) 450 Format((3X,'No.',3X,'Original',8X,'New',8X)/) c c Print out the values c Is = Istart - 1 If (Loop .NE. 0) Then L = 4 Do 50 I=1,Loop*Iprt,Iprt Write(6,500)(I+Is+Lop(K),Data(Ipoint+Is+I+Lop(K)), $ X(I+Is+Lop(K)),K=1,Nc) 500 Format(2(1X,I4,2X,G13.6,1X,G13.6,2X)) c c If the screen is full, have the user press return to continue c L = L + 1 If (L .EQ. 20) Then Call Spause L = 0 End If c 50 Continue End If If (Mod .NE. 0) Then Write(6,500) (I+Is+Lop(K),Data(Ipoint+Is+I+Lop(K)), $ X(I+Is+Lop(K)),K=1,Mod) End If c c See if the data is to be saved, and where (new column?) c 55 Continue Write(6,650) 650 Format(/' Do you wish to save the calibrated data values? ', $ '(y/n) '$) Call Instrg('YyNn',4,Iflag) If (Iflag .GT. 2) Return Write(6,700) 700 Format(' Do you want to save the data as a new column? (y/n) '$) Call Instrg('YyNn',4,Iflag) If (Iflag .GT. 2) Then c c Save, replacing the original data column c Do 60 I=1,Npoint(Icol) Data(Ipoint+I) = X(I) 60 Continue Else c c Save the calibrated values as a new column c If (Ncols .EQ. Ncolmx) Then Write(6,725) Ncolmx 725 Format(' Insufficient space - only',I4,' columns', $ ' allowed'/) Return End If c c See if we have exceeded the maximum number of total points c Call Point(I,Ncols+1,Npoint) If (I+Npoint(Icol)-1 .GT. Last) Then Write(6,730) Last 730 Format(' Insufficient space - only',I6,' total points', $ ' allowed') Return End If c Write(6,750) 750 Format(' Enter the title for the new data column') Call Point(Ititl,Ncols+1,Ttllen) Call Linedt(Title(Ititl),Nchars,70,0) Ncols = Ncols + 1 Call Point(Ipoint,Ncols,Npoint) Do 70 I=1,Npoint(Icol) Data(Ipoint-1+I) = X(I) 70 Continue Npoint(Ncols) = Npoint(Icol) Ttllen(Ncols) = Nchars End If c c Set flag to show that DATA has been changed c Idflag = 1 c Return End