program read_fof
!
!  Convert .prn files from the Flow of Funds to numerical matrices.
!  
!  Input file:  
!
!     names.inp: each line is the name of a .prn file, example:
!
!                atab7d
!                atab6d
!                atab117d
!  
!  Output file(s): *.dat where * is each name in names.inp
!
!
!  Ellen McGrattan, 10-24-00
!

   implicit none
   integer                           :: status,i,j,j1,j2,k,l,nper,idoc
   integer, dimension(10)            :: ncol
   real, dimension(250,100)          :: x
   character*15                      :: str0,str1,str2,str3 
   character*7                       :: c
   character*7, dimension(250)       :: date
   character*16                      :: codes


   open(unit=5, file='names.inp')

   i = 10
   do
     !
     ! Next .prn file to be read
     !
     read(5,*,iostat=status)  str0
     if (status < 0) exit
     l             = len_trim(str0)
     str1          = str0
     str2          = str0
     str3          = str0
     str1(l+1:l+4) = ".prn"
     str2(l+1:l+4) = ".dat"
     str3(l+1:l+4) = ".doc"
     open(unit=i,   file=str1, action="read")
     open(unit=i+1, file=str2)
     open(unit=i+2, file=str3)
     idoc = 1
     write(i+2,*) 'Codes for Flow of Funds Table ',str0
     write(i+2,*)

     k = 0
     l = 0 
     do 
       read(i,"(a7)",advance="no",iostat=status) c
       !
       ! Exit if at end-of-file
       !
       if (status < 0) exit
       !
       ! New sections start with `DATES'
       ! Store info about file
       !
       if (c == '"DATES"')  then
         j = 0
         do 
           j = j+1 
           read(i,"(a16)",advance="no",iostat=status) codes
           if (status < 0) exit
           if (idoc == 1) write(i+2,"(3x,a13)") codes(3:15)
         end do
         idoc    = 0
         k       = 0
         l       = l+1
         ncol(l) = j-1
       else
         read(i,*)
         k       = k+1
       end if
     end do
     nper = k


     rewind(i)
     !
     ! Use info about file and read in data
     !
     read(i,*)
     do k=1,nper
       read(i,*) date(k), x(k,1:ncol(1))
     end do
     j1 = 1
     j2 = ncol(1)
     do j=2,l
       read(i,*)
       j1 = j1 + ncol(j-1)
       j2 = j1 + ncol(j) - 1
       do k=1,nper
         read(i,*) c, x(k,j1:j2)
       end do
     end do
     !
     ! Write to .dat file
     !
     do k=1,nper
       c = date(k)
       write(i+1,"(1x,a4,a1,a1,1x,100f12.2)") c(1:4),'.',c(6:6),x(k,1:j2)
     end do
     close(i)
     close(i+1)
     close(i+2)

     i = i+3

   end do

end program read_fof


function len_trim(string) result(len_trim_result)
!
!  Compute the length of a the substring that includes all characters
!  up to and including the last nonblank character.
!
   character(len = *), intent(in)    :: string
   integer                           :: len_trim_result, k
   
   len_trim_result = 0
   do k = len(string), 1, -1
      ! or until nonblank found
      if (string(k:k) /= " ") then
         len_trim_result = k
         exit
      end if
   end do
end function len_trim