Subroutine Convrt(Data) *********************************************************************** * * * Subroutine CONVRT - To convert a datafile into a PLTPRG * * compatible datafile. * * * * * * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * * * *********************************************************************** Include 'Cmain' Include 'Cflags' Virtual Data(1) Character*60 File_Name Integer*4 Ich(20) Data Ich/' (1)',' (2)',' (3)',' (4)',' (5)',' (6)',' (7)', $ ' (8)',' (9)','(10)','(11)','(12)','(13)','(14)','(15)', $ '(16)','(17)','(18)','(19)','(20)'/ Ntail = 0 Iblock = 1 Nadd = 0 Clear the screen & get the filename to convert Write(6,100) 27,27,27 00 Format(1X,1A1,'[H',1A1,'[J'//1X,1A1,'#6 SUBROUTINE CONVRT'// $ ' To convert datafiles to a PLTPRG compatable format'// $ ' Enter the filename containing your data') Read(5,150,ERR=97,END=97) File_name 50 Format(A) Call Chknam(File_Name,Iflag) If (Iflag .EQ. 1) Return Open(Unit=12,NAME=File_Name,TYPE='OLD',ERR=98,ReadOnly) Set the flag to show that the data is changed Idflag = 1 See if this data will be added, or will it replace the current data in the program If (Ncols .GT. 0) Then Write(6,175) 75 Format(' Do you want to add to the existing data? (y/n) ',$) Call Instrg('YyNn',4,Iflag) If (Iflag .GT. 2) Ncols = 0 End If Call Point(Ipoint,Ncols+1,Npoint) See if the column titles are stored in the file Write(6,200) 00 Format(/' Are the column titles stored in the file? (y/n) ',$) Call Instrg('YyNn',4,Iflag) Set the unit to read the column titles from If (Iflag .GT. 2) Then Idev = 5 Else Idev = 12 End If Prompt the user for the number of columns Iwrap = 0 0 Continue If (Ncols .EQ. Ncolmx) Then Write(6,225) 25 Format(' Program cannot accept more data columns') Close(Unit=12) Return End If Nold = Nadd Write(6,250) Iblock 50 Format(/' Enter the number of columns stored in block number ',I2/ $ ' (enter 0 to skip block, or "S" to stop) ',$) Read in the number of columns, and verify value 11 Continue Call Inpt(X,N,Iflag,2) If (Iflag .NE. 0) Go To 95 If (N .EQ. 0 .OR. X(1) .GT. 20.0 .OR. X(1) .LT. 0.0) Then Write(6,260) 60 Format(' Bad input value. Value has to be between 0 and ', $ '20, or "S" ',$) Go To 11 End If Nadd = X(1) Skip this block; If (Nadd .EQ. 0) Then 2 Continue Read(12,450,END=95,ERR=95) Nchars,(Titl(I),I=1,Nchars) If (Titl(1) .EQ. '$') Then Iblock = Iblock + 1 Go To 10 End If Go To 12 End If See if we will exceed the number of colums allowed If (Nadd+Ncols .GT. Ncolmx) Write(6,275) -Ncols+Ncolmx 75 Format(' WARNING - Only ',I2,' columns will be added') Get the title for the columns: If (Nold .NE. Nadd) Then Write(6,300) 00 Format(/' Do you want to enter:'//' 1) One global title'/ $ ' 2) Individual titles for each column'// $ ' Enter 1 or 2: ',$) Call Inchek(1,2,Kflag) Else Write(6,350) 50 Format(/' Do you want to enter:'//' 1) One global title'/ $ ' 2) Individual titles for each column'/ $ ' 3) Same titles as last block'// $ ' Enter 1 - 3: ',$) Call Inchek(1,3,Kflag) End If Ncol1 = Ncols If (Kflag .EQ. 1) Then The titles are global titles: If (Idev .EQ. 5) Then Write(6,400) 00 Format(' Enter the global column title ') Call Linedt(Titl,Nchars,80,0) Else Read(Idev,450,END=95,ERR=95) Nchars,(Titl(I),I=1,Nchars) 50 Format(Q,80A1) End If Store the title, appending 1-20 to the end of the global title Na = Min0(Ncolmx-Ncols,Nadd) Do 15 I=1,Na Call Point(Ititle,Ncol1+1,Ttllen) Call Rep(Title,Ititle-1,Ititle,0,Titl,Nchars) Ttllen(Ncol1+1) = Nchars + 4 Ncol1 = Ncol1 + 1 Call Rep(Title,Ititle+Nchars-1,Ititle+Nchars,0,Ich(I),4) 5 Continue Else If (Kflag .EQ. 2) Then The titles are individual: Do 25 I=1,Nadd Call Point(Ititle,Ncol1+1,Ttllen) If (Idev .EQ. 5 .AND. Ncol1+1 .LE. Ncolmx) Then Write(6,500) I 00 Format(' Enter the title for column number',I2,':') Call Linedt(Title(Ititle),Nchars,70,0) Else If (Idev .NE. 5) Then Read(Idev,450,ERR=95,END=95) Nchars,(Title(Ititle+J-1), $ J=1,Nchars) End If If (Ncol1 + 1 .LE. Ncolmx) Then Ttllen(Ncol1+1) = Nchars Ncol1 = Ncol1 + 1 End If 5 Continue Else Use the last column titles Do 35 I=1,Nadd If (Ncols + I .LE. Ncolmx) Then Ncl = Ncols - Nold + I Call Point(Ititle,Ncl,Ttllen) Call Point(Itit,Ncols+I,Ttllen) Do 30 J=1,Ttllen(Ncl) - Ntail Title(Itit+J-1) = Title(Ititle+J-1) 0 Continue Ttllen(Ncols+I) = Ttllen(Ncl) - Ntail End If 5 Continue End If Only allow Ncolmx columns to be total; Nadd = Min0(Nadd,Ncolmx-Ncols) Add an addendum to the titles Write(6,510) 10 Format(' Is there an addendum to these titles? (y/n) ',$) Call Instrg('YyNn',4,Ichr) If (Ichr .LT. 3) Then Titl(1) = ' ' Titl(2) = ' ' If (Idev .EQ. 5) Then Write(6,520) Iblock 20 Format(' Enter the Addendum to block ',I3) Call Linedt(Titl(3),Ntail,70,0) Else Read(Idev,450,ERR=95,END=95) Ntail,(Titl(I),I=3,Ntail+2) End If Ntail = Ntail + 2 Do 38 I=1,Nadd Call Point(Ititle,I+Ncols+1,Ttllen) Call Point(Itittl,Ncols+Nadd+1,Ttllen) Call Rep(Title,Itittl,Ititle,0,Titl,Ntail) Ttllen(I+Ncols) = Ttllen(I+Ncols) + Ntail 8 Continue Else Ntail = 0 End If Data input loop: Loop = 1 Read the data using subroutine INPTT 0 Continue Call Inptt(X,Numbr,Iflag) Note - Numbr is the number of values read on a line by INPTT If (Numbr .GT. 0) Then Store the data in array "DATA" If (Numbr .LT. Nadd .AND. Iwrap .EQ. 0) Then Write(6,530) 30 Format(' Is the data in the file "wrapped"? ',$) Call Instrg('YyNn',4,Isee) If (Isee .LT. 3) Then Iwrap = 1 Else Iwrap = -1 End If End If 43 Continue If (Numbr .LT. Nadd .AND. Iwrap .EQ. 1) Then Call Inptt(X(Numbr+1),Numbr1,Iflag) Numbr = Numbr1 + Numbr Go To 43 End If If (Loop .LE. Npt_Max) Then Do 45 I = 1,Nadd If (Numbr .LT. I) X(I) = 1E20 Data((Loop-1)*Nadd+Ipoint-1+I+Ilastp) = X(I) 5 Continue End If Loop = Loop + 1 Make certain that the "DATA" array isn't overfilled If ((Loop*Nadd+Ipoint) .GT. Last .OR. Iflag .NE. 0) $ Go To 50 Else Exit the data input routine if an end of file occurs (this condition will also occur if a "$" is in column 1) Go To 50 End If Send a warning if too few points are read in If (Numbr .LT. Nadd) Write(6,550) 7,Loop-1 50 Format(1X,1A1,' WARNING - Insufficient number of values at ', $ 'point ',I4) Loop back for more data Go To 40 0 Continue If too many points were read in; If (Loop .GT. Npt_Max+1) Then Write(6,555) Loop-1,Npt_Max,7 55 Format(/' WARNING - A total of ',I5,' points/column were', $ ' read in'/ ' - only the first',I5,' are kept',A1) Loop = Npt_Max+1 End If If (Loop .NE. 1) Then Update the data pointers Do 60 I=1,Nadd Npoint(Ncols+I) = Loop - 1 0 Continue Loop = Loop - 1 Ncols = Ncols + Nadd Nad = Nadd This next part of the program will convert the data stored in "DATA" from a sequential X(1),Y(1),Z(1),....X(2),Y(2),... to a X(1),X(2),X(3),...Y(1),Y(2),Y(3),...Z(1),Z(2),... format as is used in PLTPRG. Do 85 K = 2,Nadd Get the last column data and save it in array X Do 65 I=1,Loop X(I) = Data(Ipoint + Nad*I - 1) 5 Continue J = 0 Nad = Nad - 1 Squeeze data, removing the last column data Do 70 I=1,Nad*Loop J = J + 1 If (((I-1)/(Nad))*(Nad) .EQ. I-1 .AND. I .GT. 1) $ J = J+1 Data(I+Ipoint-1) = Data (J+Ipoint-1) 0 Continue Itop = Nad * Loop + Ipoint Restore the data saved in X at the end of data Do 80 I = 1,Loop Data (Itop + I - 1) = X(I) 80 Continue 85 Continue Display the columns just read in Write(6,560) 27,27 60 Format(/15X,1A1,'[1;7mAdded Columns:',1A1,'[0m'// $ ' Col. #Pts Title'/) Do 90 I=1,Nadd K = Ncols - Nadd + I Call Name(Titl,K,Title,Ttllen) Write(6,570) K,Npoint(K),(Titl(J),J=1,Ttllen(K)) 70 Format(I4,1X,I4,4X,A1) 90 Continue Else Loop = 0 End If See if there is another datablock to read in. This is done if a "$" was encountered. If so, go back to read more data. (This is determined if Iflag, returned from INPTT, = 2) If (Iflag .EQ. 2) Then Iblock = Iblock + 1 Ipoint = Ipoint + Loop * Nadd Go To 10 ! Go read the next block End If 95 Continue Close(Unit=12) Return 96 Continue Write(6,585) 7 85 Format(' ERROR - End of file encountered - routine halted',1A1) Close(Unit=12) Return 97 Continue Write(6,590) 90 Format(' ERROR - Bad filename - routine aborted') Return 98 Continue Write(6,600) 00 Format(' ERROR encountered in opening the datafile - routine', $ ' aborted') Return End Subroutine INPTT(Array,Npoint,Istop) ************************************************************************ * * * Subroutine Inptt - To input real data, when the number of * * points in an input line are unknown. Similar to INPT, * * but this reads files attached to unit 12. * * * * Input values: None * * * * Output values: * * * * Array - The array in which the points read in are stored * * Npoint - The number of points read in * * Istop - A flag to indicate whether a "$" (Istop = 2), * * or end-of-file (Istop = 1) was encountered. * * * * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * * * ************************************************************************ Dimension Array(1) Byte Indata(256),Period,Plus,Minus,Zero,Nine Set up the control characters to look for Data Period,Plus,Minus,Zero,Nine/'.','+','-','0','9'/ Istop = 0 Npoint = 0 0 Continue Read in the character string Read(12,100,END=99,ERR=99) Nchars, (Indata(I),I=1,Nchars) 00 Format(Q,256A1) If a "$" is encountered in the first column, a new set of data is next, so set the flag and return. If (Indata(1) .EQ. '$' .AND. Nchars .GT. 0) Then Istop = 2 Return End If See if there are any numbers in the string Do 30 I=1,Nchars If (Indata(I) .GE. Zero .AND. Indata(I) .LE. Nine) Go To 40 0 Continue 0 Continue If there are no numbers, try reading again If (I .GT. Nchars) Go To 10 Find the starting position of the current number Istart = 1 0 Continue Do 60 I=Istart,Nchars If ((Indata(I) .GE. Zero .AND. Indata(I) .LE. Nine) .OR. $ (Indata(I) .EQ. Plus) .OR. (Indata(I) .EQ. Minus) .OR. $ (Indata(I) .EQ. Period) .OR. Indata(I) .EQ. 'E' .OR. $ Indata(I) .EQ. 'e') Go To 70 0 Continue If no numbers left (Istart greater than Nchars) then exit Go To 95 0 Continue Istart = I If (Istart .EQ. Nchars+1) Go To 95 Find the ending position of the current number Iperd = 0 Ieflag = 0 Ierr = 0 If (Indata(Istart) .EQ. Period) Iperd = 1 If (Indata(Istart) .EQ. 'E' .OR. Indata(Istart) .EQ. 'e') Ierr = 1 Do 80 I=Istart+1,Nchars Look for an ending character - Jump out if found If ((Indata(I) .LT. Zero .OR. Indata(I) .GT. Nine) .AND. $ (Indata(I) .NE. Plus) .AND. (Indata(I) .NE. Minus) .AND. $ (Indata(I) .NE. Period) .AND. (Indata(I) .NE. 'E' .AND. $ Indata(I) .NE. 'e')) Go To 90 If (Indata(I) .EQ. Period) Iperd = Iperd + 1 Check for illegal +/- signs, or multiple periods If (((Indata(I) .EQ. '-' .OR. Indata(I) .EQ. '+') .AND. $ (Indata(I-1) .NE. 'E' .AND. Indata(I) .NE. 'e')) .OR. $ Iperd .GT. 1) Ierr = 1 Check for E format in the input data If ((Indata(I) .EQ. 'E' .OR. Indata(I) .EQ. 'e') .AND. $ (Indata(I+1) .LT. Zero .OR. $ Indata(I+1) .GT. Nine) .AND. (Indata(I+1) .NE. Plus) .AND. $ (Indata(I+1) .NE. Minus) .AND. (Indata(I+1) .NE. Period)) $ Go To 90 See, If we have an exponent, if the exponent is of legal form. If not, set Ierr = 1 If (Indata(I) .EQ. 'E' .OR. Indata(I) .EQ. 'e') Then More than 1 "E" found? If so, set error flag If (Ieflag .GT. 0) Ierr = 1 If (Indata(I+1) .EQ. '+' .OR. Indata(I+1) .EQ. '-') Then L = I + 1 Else L = I End If Ieflag = L Exponent greater than +/- 29? If so, set error flag If ((Indata(L+1) .GT. '2' .AND. Indata(L+1) .LE. Nine) $ .AND. (Indata(L+2) .GE. Zero .AND. Indata(L+2) $ .LE. Nine)) Ierr = 1 Decimal point in exponent? If so set error flag If (Indata(L+1) .EQ. Period) Ierr = 1 If (Indata(L+2) .EQ. Period .AND. Indata(L+1) .GE. $ Zero .AND. Indata(L+1) .LE. 9) Ierr = 1 End If 0 Continue 0 Continue Ifinis = I Check the exponent length (if present), and if an error occured. If it did, then jump to section to notify user of problem If ((Ieflag .GT. 0 .AND. (Ifinis-Ieflag) .GT. 3) .OR. Ierr .GT. $ 0) Then Iend = Ifinis - 1 If (Istart-Iend .EQ. 0) Go To 93 Go To 97 End If Decode the character string and stick it into Array Numlen = Ifinis-Istart Npoint = Npoint + 1 Decode(Numlen,200,Indata(Istart)) Array(Npoint) 00 Format(E16.0) Go back and get the next number 93 Continue Istart = Ifinis If (Istart .EQ. Nchars) Go To 95 Go to 50 See if we are to read another line; if so, loop back 95 Continue Return 97 Continue Display the input error to the user, correct it and continue Write(6,300) 7,27,(Indata(L),L=1,Istart-1),27,(Indata(L),L= $ Istart,Iend),27,(Indata(L),L=Iend+1,Nchars),27,27, $ 27,(Indata(L),L=Istart,Iend),27 00 Format(1X,1A1,1A1,'[1m',A1,'[5;7m',A1,'[0;1m',A1,'[0;1m'/ $ ' ERROR',1A1,'[0m - Bad value encountered - "',1A1,'[1;4m', $ A1,'[0m - Value Replaced with "1.E20"') Npoint = Npoint + 1 Array(Npoint) = 1E20 Istart = Ifinis If (Istart .EQ. Nchars) Return Go To 50 99 Continue ERROR return for end of file; set Istop to 1 Istop = 1 Return End