******************************************************************* * * * program PEN93.FOR * * * * Sample program to read the Compustat Industrial Annual * * file. * * * * This is a copy of the version of the program was written * * by Qiang Wang on Augest 9, 1993; modified by Qihua Mao on * * 7/26/94; tailored to gather pension data for 1993 by Ellen * * Engel on 7/28/94 * * * ******************************************************************* character*8332 in_data(8) ! input data for a company character*8332 in_data1 ! input data for a record character*70 bad_data(960) ! bad record data integer dnum ! Industry classification number character*6 cnum ! CUSIP Issuer Code character*3 cic ! Issuer Number integer rec ! Record Number(1,2,3 or 4) integer file ! File Identification Code integer zlist ! Exchange Listing character*28 name ! Industry Name character*8 smbl ! Stock Ticker Symbol integer fyr(5) ! Fiscal Year integer yeara(5) ! Data Year integer xrel ! S&P Industrial Index Relative Code integer stk ! Stock Ownership Code integer dup ! Duplicate File Code integer blank ! Blank integer ucode(5) ! Updata Code character*2 aftnt(35,5) ! Annual Footnotes for record 1-4 real data(175,5) ! Data Array for record 1-4 integer state ! Company Location ID Code - State integer county ! Company Location ID Code - County integer finc ! Incorporation Code - Foreign integer source(5) ! Source Document Code character*19 blank1 ! Blank character*10 ein ! Employer Identification Number character*30 blank2 ! Blank character*2 aftnt1(35,5) ! Annual Footnotes for record 5-8 real data1(175,5) ! Data Array for record 5-8 integer num_rec integer num_rec1 integer num_rec2 integer num_com integer max_num_com equivalence(in_data, bad_data(1)) open (unit=1,file='research:[scratch.newind] * 1993_industrial_annual.dat',status='old', * form='formatted',access='sequential',readonly) open (unit=ounit,name='pen93.dat',status='new', * form='formatted') open (unit=3,name='bad1993.dat',status='new', * form='formatted') num_rec=0 num_com=0 max_num_com=1000000000 do 1000 ii=1,max_num_com num_com=num_com+1 c write (6,5) num_com c 5 format(x,'num_com =', i8) do 100 jj=1,8 num_rec=num_rec+1 read (1,10,end=2000) in_data(jj) 10 format(a8332) 100 continue do 200 kk=1,4 k1=kk k2=kk+4 decode(8332, 20, in_data(k1), err=50) dnum, cnum, cic, * rec, file, zlist, name, smbl, fyr, yeara, xrel, stk, * dup, blank, ucode, aftnt,data decode(8332, 30, in_data(k2), err=51) dnum, cnum, cic, * rec, file, state, county, finc, source, blank, ein, * blank, aftnt1,data1 20 format(i4, a6, a3, i1, 2i2, a28, a8, 10i2, i4,i1,i2, * i6, 5i1, 175a2, 5(13f10.3, f8.3,f10.3,f8.3,5f10.3, * 3f8.3, f10.3, f8.3, f10.6, f10.3, f8.3, 3f10.3, * f8.3, f10.3, f8.3, 2f10.3, 2f8.3, 6f10.3, f8.3, * 3f10.3, 3f8.3, f10.4, 6f8.3, 3f10.3, 3f8.3, f10.3, * f8.3, 3f10.3, f8.3, f10.3, 2f8.3, f10.3, 6f8.3, * 3f10.3, 2f8.3, f10.3, 4f8.3, f10.3, 4f8.3, 4f10.3, * 8f8.3, 2f10.3, f8.3, 7f10.3, f8.3, 6f10.3, 5f8.3, * 3f10.3, f8.3, 5f10.3, f8.3, 4f10.3, 2f8.3, f10.3, * 3f8.3, f10.3, 11f8.3, f10.3, 6f8.3, f10.3, f8.3, * f10.3, 2f8.3, f10.3)) 30 format(i4, a6, a3, i1, 2i2, i3, 6i2, a19, a10, a30, * 175a2, 5(13f10.3, f8.3, f10.3, f8.3, 5f10.3, 3f8.3, * f10.3, f8.3, f10.6, f10.3,f8.3,3f10.3,f8.3,f10.3, * f8.3, 2f10.3, 2f8.3, 6f10.3, f8.3, 3f10.3, 3f8.3, * f10.4, 6f8.3, 3f10.3, 3f8.3, f10.3, f8.3, 3f10.3, * f8.3, f10.3, 2f8.3, f10.3, 6f8.3, 3f10.3, 2f8.3, * f10.3, 4f8.3, f10.3, 4f8.3, 4f10.3, 8f8.3, 2f10.3, * f8.3, 7f10.3, f8.3, 6f10.3, 5f8.3, 3f10.3, f8.3, * 5f10.3, f8.3, 4f10.3, 2f8.3, f10.3, 3f8.3, f10.3, * 11f8.3, f10.3, 6f8.3, f10.3, f8.3, f10.3, 2f8.3, * f10.3)) if(dnum.lt.6020.or.dnum.gt.6030)go to 1000 write(ounit,40) dnum, cnum,cic,yeara(i1),fyr(i1), * data(6,5), data1(109,5), data1(110,5), * data1(111,5), data1(112,5), data1(113,5), * data1(114,5), data1(115,5), data1(116,5), * data1(118,5), data1(119,5), data1(121,5), * data1(122,5), data1(123,5), data1(124,5), * data1(125,5) 40 format(i4, x, a6, x, a3, x, i2, x, i2, /, 4(x, f10.3), /, * 4(x, f10.3), /, 4(x, f10.3), /, 4(x,f10.3)) 200 continue ************************************************************ * * * insert your code here * * * data items above translate as: * 6=total assets,109=VBO-OF(#284), 110=ABO-OF(#285),111=PBO-OF(#286), * 112=pension assets-OF(#287), 113=unrec PSC-OF(#288), 114=pens adj(#289) * 115=pens accr/ppd(#290), 116=VBO-UF(#291), 118=ABO-UF(#293), * 119=PBO-UF(#294), 121=pension assets_UF(#296), 122=unrec PSC-UF(#297), * 123=pens min'm liab(#298), 124=pens adj-UF(#299), 125=pens accr/ppd(#300) * * ************************************************************ goto 1000 50 num_rec1=num_rec-8+k1 write(ounit,60) num_rec1 write(3,60) num_rec1 60 format(1x,'ERROR at record ',i6,/) go to 55 51 num_rec2=num_rec-8+k2 write(ounit,60) num_rec2 write(3,60) num_rec2 55 write(3,70) bad_data 70 format(x,960(x,a70,/)) 1000 continue *********************************************** **write number of records and number of records *********************************************** 2000 write(6,80) num_com, num_rec 80 format(x,'Number of companys = ',i6,2x,'Number of records = ',i6) close (unit=1) close (unit=ounit) close (unit=3) stop end