Subroutine SORT(Xvals,Yvals,Npoint) c c *********************************************************************** c * * c * Subroutine SORT - To Sort numbers in array "Xvals" and * c * "Yvals" in ascending order with respect to "Xvals". * c * The sorting technique used here is called a Heapsort, * c * and is much faster, on the average, than a bubble sort. * c * As an example, for 3000 random elements, the bubble sort * c * (with a flag) took 12 minutes, and the Heapsort took * c * 3 or 4 seconds. I got the routine from the monthly * c * newsletter of the Washington area TI computer users group, * c * in BASIC, so I don't have any internal program comments. * c * * c * Input values: * c * * c * Xvals - The array that contains the data to be sorted * c * Yvals - An array whose elements are sorted with respect * c * to the array Xvals * c * Npoint - The number of points in Xvals * c * * c * Output values: * c * * c * The sorted values in Xvals are returned in Xvals * c * The values in Yvals, sorted with respect to Xvals, are * c * returned in Yvals * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Dimension Xvals(1),Yvals(1) c If (Npoint .EQ. 1) Return Lpoint = Npoint/2+1 Mcount = Npoint 10 If (Lpoint .EQ. 1) Go To 20 Lpoint = Lpoint-1 Xhold = Xvals(Lpoint) Yhold = Yvals(Lpoint) Go To 30 20 Xhold = Xvals(Mcount) Yhold = Yvals(Mcount) Xvals(Mcount) = Xvals(1) Yvals(Mcount) = Yvals(1) Mcount = Mcount-1 If (Mcount .EQ. 1) Go To 70 30 Jpoint = Lpoint 40 Ipoint = Jpoint Jpoint = Jpoint*2 If (Jpoint .EQ. Mcount) Go To 50 If (Jpoint .GT. Mcount) Go TO 60 If (Xvals(Jpoint) .GE. Xvals(Jpoint+1)) Go To 50 Jpoint = Jpoint+1 50 If (Xhold .GT. Xvals(Jpoint)) Go To 60 Xvals(Ipoint) = Xvals(Jpoint) Yvals(Ipoint) = Yvals(Jpoint) Go To 40 60 Xvals(Ipoint) = Xhold Yvals(Ipoint) = Yhold Go To 10 70 Xvals(1) = Xhold Yvals(1) = Yhold Return End Subroutine Inc(Amin,Amax,Ainc,Isfig,Ideci) c c *********************************************************************** c * * c * Subroutine INC - To get the number of significant figures & * c * decimal places for the axis numbers * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c c c Get number of decimals to the right of the decimal point c c Call Incdec(Amin,Ideci1) Call Incdec(Ainc,Ideci2) Ideci = Max0(Ideci1,Ideci2) c c Get the number of decimals to left of decimal point c If (Amin .GE. 1.0) Isf1 = Int(Log10(Amin)) + 1 If (Amin .LT. 1.0 .AND. Amin .GE. 0.0) Isf1 = 1 If (Amin .LT. 0.0 .AND. Amin .GE. -1.0) Isf1 = 2 If (Amin .LT. -1.0) Isf1 = Int(Log10(-Amin)) + 2 If (Amax .GE. 1.0) Isf2 = Int(Log10(Amax)) + 1 If (Amax .LT. 1.0 .AND. Amax .GE. 0.0) Isf2 = 1 If (Amax .LT. 0.0 .AND. Amax .GE. -1.0) Isf2 = 2 If (Amax .LT. -1.0) Isf2 = Int(Log10(-Amax)) + 2 Isfig = Max0(Isf1,Isf2) If (Ideci .GT. 0) Isfig = Isfig + 1 ! Add one for the decimal point c Return End Subroutine Incdec(Ainc,Ideci) c Character*12 Av Byte Bb(12) Equivalence (Bb(1),Av) c Ipower = 0 If (Ainc .LE. 100.0) Then ! If the increment > 100, no decimal place If (Ainc .LT. 1.0 .AND. Ainc .GT. 0.0) Then Ipower = -Int(Log10(Ainc)) If (Ipower .GT. 0) Then Binc = Ainc * 10.0 ** Ipower Else If (Ipower .LT. 0) Then Binc = Ainc / 10.0 ** (-Ipower) Else Binc = Ainc End If Else Binc = Ainc End If Encode(12,100,Av) Binc 100 Format(G12.5) Iflag1 = 0 Iflag2 = 0 Do 10 I=12,1,-1 If (Bb(I) .NE. ' ' .AND. Iflag1 .EQ. 0 .AND. Bb(I) .NE. '0' $ ) Iflag1 = I If (Bb(I) .EQ. '.') Iflag2 = I ! Find the decimal point 10 Continue Ideci = Iflag1 - Iflag2 If (Iflag2 .EQ. 0) Ideci = 0 Else Ideci = 0 Endif Ideci = Ideci + Ipower Return End Subroutine Getl(Vec,Istart,Len,Label) c c ************************************************** c Byte Vec(2,1),Label(1) c Do 10 I=80,1,-1 Len = I If (Vec(Istart,I) .NE. ' ') Go To 20 10 Continue 20 Do 30 I=1,Len Label(I) = Vec(Istart,I) 30 Continue Return End Subroutine Point(Ipoint,Ncol,Iarray) c Dimension Iarray(1) c Ipoint = 1 If (Ncol .GT. 1) Then Do 10 I=1,Ncol-1 Ipoint = Ipoint + Iarray(I) 10 Continue End If Return End Subroutine Strn(String,Nchars,Ichset) Byte String(1), Chset(9) c Data Chset/'1','2','3','4','5','6','7','8','9'/ c If (Ichset .EQ. 0) Return Do 10 I = 1, Nchars If (String(I) .EQ. '\' ) Then String(I) = Chset(Ichset) End If 10 Continue Do 20 I = 1, 3 String(Nchars+I) = '@' 20 Continue Nchars = Nchars + 4 String(Nchars) = Chset(Ichset) Return End Subroutine Tikchk(Tik,Tkincr) c c *********************************************************************** c * * c * Subroutine Tikchk - To check to see if a major tick is not * c * a 4*10^N or 8*10^N, and set it to 5*10^N or 10^N+1. * c * * c * Input values: * c * * c * Tik - The current major tick mark value * c * Tkincr - The tick increment selected by the user (minor * c * tick mark) * c * * c * Output values: * c * * c * Tik - The updated (if necessary) major tick mark * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Double Precision Aa A = Log10(Tik) If (A .LT. 0.0) A = 50.0 + A I = A A = A - I c c See if this is a major tick that needs "fixing" c If (((A .GT. 0.602 .AND. A .LT. 0.6021 ) .OR. (A .GT. 0.903 .AND. $ A .LE. 0.9031)) .AND. Tik/Tkincr .GT. 3.0) Then c c Use double precision to eliminate any possible roundoff errors c Aa = Tik Aa = Aa * 5.0/4.0 Tik = Aa End If c Return End Subroutine Comma(Text,Value,Isfig,Ideci,Ilen) Byte Text(1) c Ilen = Isfig + Ideci Loop = 1 10 Continue A = 10.0**(Loop*3) If (A .GT. Abs(Value)) Go To 30 Istart = Isfig - Loop*3 + 1 Do 20 I=Ilen,Istart,-1 Text(I+1) = Text(I) 20 Continue Text(Istart) = ',' Ilen = Ilen + 1 Loop = Loop + 1 Go To 10 30 Return End Subroutine Comcnt(Amin,Amax,Ainc,Icom) c Amn = Jint((Amin-Ainc/100.)/Ainc)*Ainc If (Amin .GT. 0.0) Amn = Amn + Ainc Amx = Jint((Amax-Amn+Ainc/10000.)/Ainc)*Ainc + Amn Call Coms(Amn,Icom) Call Coms(Amx,Icom1) Icom = Amax0(Icom,Icom1) Return End Subroutine Coms(Value,Icom) If (Value .LE. 0.0) Then Icom = 0 Else B = Log10(Value)/3.0 Icom = B + 1E-7 End If Return End Subroutine Supsub(Text,Len,Iup,Idown) Byte Text(1) Iup = 0 Idown = 0 Do 10 I=1,Len-1 If (Text(I) .NE. 64) Go To 10 If (Text(I+1) .EQ. '^') Iup = 1 If (Text(I+1) .EQ. '`') Then If (Idown .EQ. 0 .OR. Idown .EQ. 4) Idown = Idown + 1 End If If (Text(I+1) .EQ. '<') Then If (Idown .LT. 3) Idown = 4 End If 10 Continue Return End