Read fails and debug wont work

I have a simple program:

Program MkCallTree

Implicit None

Character(50) :: Cfile, Dfile
Character(135):: Buffer(5000)
Character(26)::  Progr(20), Csv, P1, P2, P3
Character(76)::  Calling(5000)
Integer(4)::     Ndx = 0, Nd2 = 0, I, Ndxs, Nof

Interface
 Function ToLower (Input_String) Result (Output_String)
     Character(*), Intent(In)     :: Input_String
     Character(Len(Input_String)) :: Output_String
 End Function ToLower
End Interface

   Call System("Dir /B  *.Lst > List")

   Open ( Unit=4,                 &
          File="Calltree.Txt",    &
          Status='replace',       &
          Form='formatted')

   Open ( Unit=8,                 &
          File="List",            &
          Status='old',           &
          Form='formatted')

   Rewind (4)
   Rewind (8)
   Csv = ""
   Ndx = 0

   Do
      Read(8,"(A)",End=999) Cfile
      If (Cfile == "") Go To 999
      I = 1
      Dfile = ""
      Do While(Cfile(I:I) /= '.')
         I = I + 1
      End Do
      Dfile = Cfile(1:I) // "F90"C
      Dfile = ToLower(Dfile)
      Write(4,"(A,5X,A)") "Dfile = ", Dfile

      Open ( Unit=3,         &
          File="Cfile",       &
          Status='old',       &
          Form='formatted')
      Rewind (3)
      Nof = 0
!     Now Read In The Entire Cfile Entry
      Do While (1 == 1)
         Nof = Nof + 1
         Write(4,'(A,I5)') 'nof = ', Nof
         Buffer(Nof) = ""C
         Read(3,'(A135)',End=100) Buffer(Nof)
      End Do
 100  Close (3)

      Nof = Nof - 1
      Write (4,'(A,I5)') 'read Nof = ', Nof
      Ndx = 1
      Progr(Ndx) = ToLower(Trim(Buffer(1)(50:75)))
      Ndxs = Nd2

      Write(4,'(A)') "At Stmt No 100"
      Do I = 3, Nof
         If (Buffer(I)(1:4) == "Page") Then
            P3 = ToLower(Buffer(I)(50:75))
            If (Progr(Ndx) /= P3) Then
               Csv = Progr(Ndx)
               Ndx = Ndx + 1
               Progr(Ndx) = P3
               If (Progr(Ndx) == "") Then
                  Progr(Ndx) = Csv
               End If
            End If
            Cycle
         End If
         P1 = ToLower(Trim(Buffer(I)(2:19)))
         P2 = ToLower(Trim(Buffer(I)(29:35)))
         P3 = ToLower(Buffer(I)(50:75))
         Write(4,600) 'progr', Progr(Ndx), Ndx
         Write(4,600) 'p1=',P1
         Write(4,600) 'p2=', P2
 600     Format(A5, 5X, A, I5)
         Write(4,600) 'p3=',P3
         If (P1 == Progr(Ndx)) Then
            Write(4,601) 'p1='
 601        Format(A3, ' Cycle')
            Cycle
         Elseif (P1 == Csv) Then
            Write(4,601) 'csv'
            Cycle
         End If
         Write(4,602) Progr(Ndx), P1
 602     Format ('is ', A, ' /=  ', A)
         If (Progr(Ndx) /= P1) Then
            If (P2 == "Func  ") Then
               Nd2 = Nd2 + 1
               Write(Calling(Nd2),500) Dfile, Progr(Ndx), "Func  ", P1
 500           Format (A20,1X,A20,1X,A6,1X,A)
            Else If (P2 == "Subr  ") Then
               Nd2 = Nd2 + 1
                Write(Calling(Nd2),500) Dfile, Progr(Ndx), "Subr  ", P3
            Else If (P2 == "Module") Then
               Nd2 = Nd2 + 1
               Write(Calling(Nd2),500) Dfile, Progr(Ndx), "Module", P3
            Else If (P2 == "Intrin") Then
               Nd2 = Nd2 + 1
               Write(Calling(Nd2),500) Dfile, Progr(Ndx), "Intrin", P3
            End If
            If (I /= Nd2) Then
               Write(4,"(A)") Calling(Nd2)
            End If
         End If
      End Do
      If (Ndxs == Nd2) Then
         Nd2 = Nd2 + 1
         Write(Calling(Nd2),500) Dfile, Progr(Ndx), "*None*"
      End If
!     Go Process Another Cfile From List On (8)
   End Do
999 Close (8)
   Do I = 1, Nd2
      Write(4,'(A)') Calling(I)
   End Do
   Close (4)

End Program MkCallTree

Function ToLower ( Input_String ) Result ( Output_String )
     Character(*),Intent(In)      :: Input_String
     Character(Len(Input_String)) :: Output_String

     Character(*),Parameter :: Lower_Case = 'abcdefghijklmnopqrstuvwxyz'
     Character(*),Parameter :: Upper_Case = 'abcdefghijklmnopqrstuvwxyz'
     Integer :: I, N

     Output_String = Input_String
     Do I = 1, Len(Output_String)
       ! -- Find Location Of Letter In Upper Case Constant String
       N = Index( Upper_Case, Output_String( I:I ) )
       If ( N /= 0 ) Output_String( I:I ) = Lower_Case( N:N )
     End Do
     N = Index(Lower_Case, Output_String(1:1))
! Capitalize First Letter In String
     If (N /= 0) Output_String(1:1) = Upper_Case(N:N)
     Return
End Function ToLower

And a data file list that the system command produces:

BoxIt.lst
Browse.lst
ClrScreen.lst
DlgChanged.lst
DoColor.lst
DoGraphs.lst
DoGrids.lst
DoHisto.lst
DoInput.lst
DoMoments.lst
DrawIt.lst
FitOut.lst
FitSamp.lst
GetK.lst
GetLength.lst
GetPT.lst
GetRS.lst
GetValue.lst
Heap.lst
Horn.lst
Howe.lst
Integrate.lst
Kolmo.lst
KS.lst
LnGamma.lst
MyHearderOut.lst
MyScreen.lst
MyTextOut.lst
NormalCDF.lst
OnSpinEdit.lst
Pearson.lst
Pearsonglobals.lst
PlotCDF.lst
PlotEDF.lst
PlotHist.lst
PlotPDF.lst
Print.lst
Purge.lst
RadioChanged.lst
RanF.lst
SaveAll.lst
SetupMyDlg.lst
Special.lst
TypeI.lst
TypeII.lst
TypeIII.lst
TypeIV.lst
TypeV.lst
TypeVI.lst
TypeVII.lst
TypeVIII.lst
Van.lst
zData.lst

I read the first entry from list into cfile and create dfile and all goes well until the first read of the .lst file and it jumps to 999. I've put in a lot of debug to unit 4 but that doesn't get printed. I'm at a loss.

Thanks for any suggestion.

Brooks