program read_bea ! ! Convert National Income and Product Accounts files from BEA's format ! to numerical matrices. (Make sure that the word Table is not ! preceeded by any quotes.) ! ! Users need to edit this file to include the specific input file ! (e.g., Section1All_csv.csv) in the open file. In tables.inp ! put the frequency (A for annual and Q for quarterly) and the ! specific table numbers to be extracted,e.g, ! ! A 1.1.1 ! Q 1.12 ! A 1.16 ! ! The output files have names like table1_1_1A.dat for the annual ! data and table1_1_1Q.dat for the quarterly data. ! ! Ellen McGrattan, 9-8-05 ! implicit none integer :: status,i,j,l,lf,ifound1,ifound2,iunit,dunit,icom character (len=20) :: tabnum,table,doc character (len=2000) :: c2000 open(unit=5, file='NIPA/NIPA_Sect1.asp') open(unit=7, file='tables.inp') iunit=10 dunit=50 do ! ! Read in the next line of tables.inp ! read(7,'(a)',iostat=status) tabnum if (status < 0) exit l = len_trim(tabnum) table(1:5) = 'table' table(6:l+3) = tabnum(3:l) table(l+4:l+4) = tabnum(1:1) table(l+5:l+8) = '.dat' do i=6,l+3 if (table(i:i)=='.') table(i:i)='_' enddo doc(1:l+4) = table(1:l+4) doc(l+5:l+8) = '.doc' lf = l+8 ! ! Open the output and document files for this table ! open(unit=iunit, file=table(1:lf)) open(unit=dunit, file=doc(1:lf)) ! ! Read the BEA .csv file until desired table is found ! ifound1 = 0 do while (ifound1==0) read(5,'(a)',iostat=status) c2000 if (status < 0) exit if (((c2000(1:5)=='Table').and.(c2000(7:4+l)==tabnum(3:l))).or. & ((c2000(2:6)=='Table').and.(c2000(8:5+l)==tabnum(3:l)))) then write(dunit,'(a)') c2000(1:40) read(5,'(a)',iostat=status) c2000 write(dunit,'(a)') c2000(1:40) ! ! Continue down the file until the frequency is given ! ifound2 = 0 do while (ifound2==0) read(5,'(a)',iostat=status) c2000 if (status < 0) exit if (((c2000(1:6)=='Quarte').and.(tabnum(1:1)=='Q')).or. & ((c2000(1:6)=='Annual').and.(tabnum(1:1)=='A'))) then write(dunit,'(a)') c2000(1:32) ifound2 = 1 ifound1 = 1 endif enddo endif enddo ! ! Continue down to the line with dates marked `Line' ! ifound1 = 0 do while (ifound1==0) read(5,'(a)',iostat=status) c2000 if (status < 0) exit if (c2000(1:4)=='Line') then ifound1 = 1 l = len_trim(c2000) ! ! Write dates to output file ! do i=5,l if (c2000(i:i)==',') then write(iunit,'(a)',advance='no') ' ' else write(iunit,'(a)',advance='no') c2000(i:i) endif enddo write(iunit,'(a)') ' ' ! ! Quarterly series have an additional line noting the quarter ! if (tabnum(1:1)=='Q') then read(5,'(a)',iostat=status) c2000 if (status < 0) exit l = len_trim(c2000) do i=1,l if (c2000(i:i)==',') then write(iunit,'(a)',advance='no') ' ' else write(iunit,'(a)',advance='no') c2000(i:i) endif enddo write(iunit,'(a)') ' ' endif endif enddo ! ! Read in BEA series and write them out cleanly to a new file ! ifound1 = 0 do while (ifound1==0) read(5,'(a)',iostat=status) c2000 if (status < 0) exit l = len_trim(c2000) ! ! Lines with data will start with an integer ! (as will some of the footnote lines) ! if ((c2000(1:1)=='1').or.(c2000(1:1)=='2').or. & (c2000(1:1)=='3').or.(c2000(1:1)=='4').or. & (c2000(1:1)=='5').or.(c2000(1:1)=='6').or. & (c2000(1:1)=='7').or.(c2000(1:1)=='8').or. & (c2000(1:1)=='9') ) then i = 1 ! ! Count 3 commas separating line #, description, and variable name ! icom = 0 do while (icom<1) write(dunit,'(a)',advance='no') c2000(i:i) if (c2000(i:i)==',') icom=icom+1 i = i+1 enddo ! ! Sometimes a description contains a comma but will appear in quotes ! if (c2000(i:i)=='"') then i = i+1 do while (c2000(i:i)/='"') write(dunit,'(a)',advance='no') c2000(i:i) i = i+1 enddo endif ! ! Continue counting the commas ! do while (icom<3) write(dunit,'(a)',advance='no') c2000(i:i) if (c2000(i:i)==',') icom=icom+1 i = i+1 enddo write(dunit,'(a)') ' ' ! ! Write out series in output file ! call writeout(iunit,lf,table(1:lf),l-i+1,c2000(i:l)) endif if ((c2000(1:5)=='Table').or.(c2000(2:6)=='Table')) ifound1 = 1 enddo write(dunit,'(a)') ' ' ! ! Rewind and move on to reading the next table ! rewind(5) iunit = iunit+1 dunit = dunit+1 enddo contains 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 subroutine writeout(iunit,lf,filestr,l,string) ! ! Write out series of numbers that are comma deliminated. They may ! have quotes around them if they are larger than 1,000 and may ! have missing values with periods, eg., ! ! 910.0,984.6,"1,038.5",.....,"1,127.1","1,238.3","1,382.7" ! ! would be written out to iunit without quotes or commas and with a ! Not-a-Number symbol replacing periods: ! ! 910.0 984.6 1038.5 NaN 1127.1 1238.3 1382.7 ! integer, intent(in) :: iunit,lf,l character (len=l), intent(in) :: string character (len=lf), intent(in) :: filestr open(unit=iunit, file=filestr(1:lf)) ! ! Some lines have missing variables in the first period ! i = 1 if (string(1:2)=='..') then write(iunit,'(a)',advance='no') 'NaN' i = 3 do while (string(i:i)/=',') i = i+1 enddo endif ! ! Clean up the remainder of the line ! do while (i<=l) if (string(i:i)==',') then ! ! Replace missing observations with NaN ! write(iunit,'(a)',advance='no') ' ' i = i+1 if ((i