Subroutine Getdir c c *********************************************************************** c * * c * Subroutine Getdir - To list out the user's files. * c * This routine allows the use of wildcards in the file * c * descriptor, so that only portions of the total directory * c * can be selected. This is a VAX/VMS routine - It will * c * Not work on other types of computers! * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cflags' c Integer*4 Index,LIB$Find_File,Idum1,Idum2,Icontex, $ LIB$Find_File_End,Lib$Match_Cond Character*80 Direct,File_Out,File_Name Byte File_Print(80) Character*255 Fspec c Equivalence (File_Print(1),File_Out) c Include '($RMSDEF)' c Do 5 I=1,80 File_Print(I) = 0 5 Continue File_Name = File_Out c c Get the directory name. The user can give it c in the form [directory]filename, and can use c wildcards in the directory and filenames. c 10 Continue c Write(6,100) 100 Format(' Directory listing routine - Enter the directory name:'/ $ ' (Press return for the current directory)') c Read(5,150,END=10,ERR=10) Direct 150 Format(A) If (Iabort .EQ. .TRUE.) Call Abort ! Test for Ctrl-C c c Since the VMS routines are sensitive to the presence c (or lack of) asterisks (wildcards), we will add them if c necessary, to the filename. c Ilast = 80 Call Comprs(Direct,Ilast) ! Remove blanks from the descriptor c c No filename given, or no filename and directory given c If (Direct(Ilast:Ilast) .EQ. ']') File_Name = '*.*' If (Ilast .EQ. 0) File_Name = '*.*' c c Search for periods in the filename, and directory c closing brackets "]" c Iflag = 0 Iperid = 0 Do 20 I=1,Ilast If (Direct(I:I) .EQ. ']') Then Iflag = I Iperid = 0 End If If (Direct(I:I) .EQ. '.') Iperid = I 20 Continue c c If the user inputted [xxxxx].xxx, make the filename *.xxx c If (Iflag .GT. 1 .AND. Iflag .LT. Ilast) Then If (Direct(Iflag+1:Iflag+1) .EQ. '.') Then File_Name = '*'//Direct(Iflag+1:Ilast) End If End If c c If the user inputted [xxxxx]xxx, make the filename xxx.* c If (Iperid .EQ. 0) Then Fspec = File_Name//'.*' File_Name = Fspec End If c c If the user inputted .xxx, make the filename *.xxx c If (Iperid .EQ. 1) Then Fspec = '*'//File_Name File_Name = Fspec End If c c Initialize the pointers for the loop c Icontex = 0 Icount = 0 Iloop = 0 Irow = 3 c 30 Continue c c Loop to get the file names c Index = Lib$Find_File(File_Name,File_Out,Icontex, $ Direct,Fspec,RMS,Idum1,Idum2) c c Checking for errors, and to see if we have the last file c Iresult = LIB$Match_Cond(Index,RMS$_Nmf,RMS$_Dev,RMS$_Dir, $ RMS$_Dnf,RMS$_Dnr,RMS$_Fnf,RMS$_Fnm, $ RMS$_Fnd,RMS$_Nod,RMS$_Syn) If (Iresult .GT. 0) Go To 60 If (.NOT. Index) Call Lib$Signal(%Val(Index)) c If (Iabort .EQ. .TRUE.) Call Abort ! Test for Ctrl-C c c Find the start of the file name c Do 40 I=1,80 If (File_Out(I:I) .EQ.']') Go To 50 40 Continue c 50 Continue c c Write the screen header c If (Iloop .EQ. 0 .AND. Icount .EQ. 0) Then Middle = 40 - (I + 13)/2 Write(6,200) 27,27,27,(File_Print(J),J=1,I),32,27 200 Format(1X,1A1,'[H',1A1,'[J',X,1A1,'[1;7m Directory ', $ A1,'[0m') End If c c Set up the pointers for the screen c Iline = 80 Call Comprs(File_Out,Iline) If (Iline-I-1 .GE. 19 .AND. Icount .EQ. 3) Icount = Icount + 1 c If (Icount .EQ. 4) Then Icount = 0 Iloop = Iloop + 1 If ((Iloop/20)*20 .EQ. Iloop) Call Spause Irow = Irow + 1 Write(6,250) 27 250 Format('+',1A1,'D',$) If (Irow .GT. 23) Irow = 23 End If c c Set up pointers for the write statements c I1 = 1 If (Irow .GT. 9) I1 = 2 I2 = 1 If (Icount .GT. 0) I2 = 2 Icol = (Icount*20) + 1 c Write(6,300) 27,Irow,Icol 300 Format(1X,1A1,'[',I,';',I,'H',$) Write(6,350) (File_Print(J),J=I+1,I+Iline) 350 Format('+',A1,$) If (Icount .LT. 3 .AND. Iline-I-1 .GE. 19) Icount = Icount+1 Icount = Icount + 1 Go To 30 c c Release stuff held by LIB$_Find_File c 60 Index = LIB$Find_File_End(Icontex) c Return End Subroutine Comprs(String,Ipoint) c c *********************************************************************** c * * c * Subroutine Comprs - To remove blanks from the file * c * descriptor. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Character*1 String c Jpoint = Ipoint Do 10 I=1,Jpoint 15 Continue If (I .GT. Ipoint) Go To 30 If (String(I:I) .EQ. ' ') Then Do 20 K=I+1,Ipoint String(K-1:K-1) = String(K:K) 20 Continue Ipoint = Ipoint - 1 Go To 15 End If 10 Continue 30 Return End Subroutine Getax(Amin,Amax,Aminn,Amaxx,Amajor,Aminor) c c *********************************************************************** c * * c * Subroutine GETAX - To determine the axis data for a plot * c * given only the minimum and maximum values of the data to * c * be plotted. * c * * c * Input values: * c * * c * Amin - The minimum data value to plot * c * Amax - The maximum data value to plot * c * * c * Output values: * c * * c * Aminn - The minimum value of the plotting area * c * Amaxx - The maximum value of the plotting area * c * Amajor - The major tick increment * c * Aminor - The minor tick increment * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Delta = Amax - Amin If (Delta .GE. 1.0) Then Ipower = Int(Log10(Delta)) Else Ipower = Int(Log10(Delta) - 0.999999) End If If (Ipower .GT. 0) Then Dnorm = Delta / 10.0**Ipower Else If (Ipower .LT. 0) Then Dnorm = Delta * 10.0**(-Ipower) Else Dnorm = Delta End If c c Set the major and minor tick values c If (Dnorm .LT. 2.0) Then Amajor = 0.2 Aminor = 0.05 Else If (Dnorm .LT. 5.0) Then Amajor = 0.5 Aminor = 0.1 Else If (Dnorm .LT. 7.0) Then Amajor = 1.0 Aminor = 0.25 Else if (Dnorm .GE. 7.0) Then Amajor = 1.0 Aminor = 0.5 End If c If (Ipower .GT. 0) Then Amajor = Amajor * 10.0**Ipower Aminor = Aminor * 10.0**Ipower Else If (Ipower .LT. 0) Then Amajor = Amajor / 10.0**(-Ipower) Aminor = Aminor / 10.0**(-Ipower) End If c c Compute the minimum, maximum values of the plotting area c If (Amin .GE. 0.0) Then Aminn = Amajor * Int(Amin / Amajor) Amaxx = Amajor * Int(Amax / Amajor + 0.999999) Else Aminn = Amajor * Int(Amin / Amajor - 0.999999) c If (Amax .LE. 0.0) Then Amaxx = Amajor * Int(Amax / Amajor) Else Amaxx = Amajor * Int(Amax / Amajor + 0.999999) End If End If c Return End