subroutine cexfam Use declarations $debug ! program CEXFAM.FOR !******************************************************************** ! This program reads the processed quarterly records (from ! cexqtr.for) for each of the four quarters a household ! can show up, and creates complete record for each family. It ! produces household records with aggregated consumption and income ! variables and demographic information. details on output variables ! and output format are found in the write section of main program. ! Main group of variables is the set of five quarterly ! values for each of the variables output from cexqtr; ! first four are read from cexq<> files; fifth is average or final ! value to be written. !******************************************************************** !******************************************************************** ! Parameters copied from cexqtr !******************************************************************** !******************************************************************** ! Input variables from CEXQTR.FOR !******************************************************************** integer newid(5),intno(5),fullyear(5),& numearn(5),numauto(5),weeksin(5,20), hrswkd(5,20),wkswkd(5,20),& vehq(5),famsize(5),grospay(5,20), membcnt(5),age(5,20),membnum(5,20),membinc(5,20,12) real onumearn,onumauto,ofamsize,ovehq,qvar(5,109), qvarl(5,109),cuwt(5),extracat(5,45),qtax(5,13) character*1 cutenur(5),repstat(5),blsurbn(5),relation(5,20),emplcont(5,20),famtype(5),& nonwork(5,20),marital(5,20),origin1(5), race(5,20),sex(5,20),region(5),pubhous(5),& govhous(5),tflagl(5,109), tflag(5,109),incoll(5,20),gradcom(5,20),& empstat(5,20),emptype(5,20),payprd(5,20), repflag(5,109),srepstat(5) character*2 intmo(5),intyr(5),building(5), educ(5,20),occup(5,20),indust(5,20) !******************************************************************** ! Constructed output variables !******************************************************************** integer in4th(20),memb4th real laginc(22),ocuwt(num_years) !******************************************************************** ! Program control variables !******************************************************************** integer cucnt,doneqtr,numintv, mapwtc(4,num_qtrs),mapwtl(4,num_qtrs),& ageclass,numch18,head,age65p, qtrcnt real moscopec,moscopel,cuwttot,goodqtr,table1(3,20),& table2(3,133),table3(3,133),totexp(3),totinc(3) character*64 cexf,sumf character*64 cexffile,sumffile character*64 cexq character*64 cexqnum1,cexqnum2,cexqnum3,cexqnum4 character*50 cexcat(109) !******************************************************************** ! Data Initializations !******************************************************************** data numintv/4/ !******************************************************************** ! Before starting, read mapwts from file -- initializations were ! moved becauase of compiler size problem -- put back in some pt. ! ! The variables mapwtc and mapwtl "map" the cuwt into the correct ! year. Each line of the data initialization represents a quarter, ! i.e., the first line is those people who begin in 80:1. the four ! entries tell you what year to place the four quarterly weights ! for those households. For example, on the second line, the first ! three quarterly weights for those beginning 1980:2 are placed ! in year 1 (1980), and the last in year 2 (1981). The second ! variable mapwtl is analagous, but controls for the fact that ! if the weight refers to a lagged period, it is placed there. ! For example, those beginning 1980:2, last entry is a "1". If ! last weight for the household (appears 1981:1 data set) should ! be lagged, it is put back in 1980. This occurs if the interview ! covered part of 1980, and is controlled by the bls moscope ! variable in code. !******************************************************************** open(unit=30,file='I:\cexnber\files needed for input processing\mapwtv2.txt') do 58,i=1,num_qtrs read(30,'(bz,4(i2))') (mapwtc(j,i),j=1,4) 58 continue do 59,i=1,num_qtrs read(30,'(bz,4(i2))') (mapwtl(j,i),j=1,4) 59 continue close(unit=30) !******************************************************************** ! Read category titles !******************************************************************** open(unit=19,file='I:\cexnber\files needed for input processing\cextitle') do 65,i=1,109 read(19,'(3x,a50)') cexcat(i) 65 continue close(unit=19) !*************************************************************************** ! Initialize variables and open files for next quarter to process ! Before main loop, qtrcnt is set to startqtr. At end of program, ! qtrcnt is incremented by one and tested against endqtr to specify ! whether return to 75 is needed. ! ! The if qtrcnt eq 64 statement is to skip over the 961 file (uses 955) then ! goes to 962 !*************************************************************************** qtrcnt=startqtr 75 continue write(77,*) 'Processing ',yearqtr(qtrcnt) cucnt=0. doneqtr=0. do 77,i=1,3 do 76,j=1,133 if (j.le.20) then table1(i,j)=0 end if table2(i,j)=0 table3(i,j)=0 76 continue totexp(i)=0 totinc(i)=0 77 continue ! unit 12 is the first cexq input file cexq='I:\cexnber\intermediate files\data files\cexq' cexqnum1=cexq(1:46)//yearqtr(qtrcnt)//'a' open(unit=12,file=cexqnum1,form='unformatted') ! unit 13 is the second cexq input file if (numintv.ge.2) then cexqnum2=cexq(1:46)//yearqtr(qtrcnt+1)//'b' open(unit=13,file=cexqnum2,form='unformatted') end if ! unit 14 is the third cexq input file if (numintv.ge.3) then cexqnum3=cexq(1:46)//yearqtr(qtrcnt+2)//'c' if (qtrcnt.eq.65) cexqnum3=cexq(1:46)//yearqtr(qtrcnt+3)//'c' open(unit=14,file=cexqnum3,form='unformatted') end if ! unit 15 is the fourth cexq input file if (numintv.eq.4) then cexqnum4=cexq(1:46)//yearqtr(qtrcnt+3)//'d' if ((qtrcnt.eq.64).or.(qtrcnt.eq.65))cexqnum4=cexq(1:46) & //yearqtr(qtrcnt+4)//'d' open(unit=15,file=cexqnum4,form='unformatted') end if ! unit 18 is the summary (sumf<>) output file sumf='I:\cexnber\intermediate files\logs\sum' sumffile=sumf(1:39)//yearqtr(qtrcnt) open(unit=18,file=sumffile) ! unit 23 is the cexf<> (unformatted) output file cexf='I:\cexnber\intermediate files\data files\cexf' cexffile=cexf(1:45)//yearqtr(qtrcnt) open(unit=23,file=cexffile,form='binary') 100 continue ! initialize five values for cexq variables do 110,i=1,5 newid(i)=0 intno(i)=0 cutenur(i)=' ' intmo(i)=' ' intyr(i)=' ' building(i)=' ' govhous(i)=' ' pubhous(i)=' ' repstat(i)=' ' srepstat(i)=' ' blsurbn(i)=' ' cuwt(i)=0 fullyear(i)=0 numearn(i)=0 numauto(i)=0 vehq(i)=0 famsize(i)=0 membcnt(i)=0 region(i)=' ' famtype(i)=' ' origin1(i)=' ' do 102,j=1,20 age(i,j)=0 relation(i,j)=' ' educ(i,j)=' ' emplcont(i,j)=' ' incoll(i,j)=' ' nonwork(i,j)=' ' marital(i,j)=' ' membnum(i,j)=0 race(i,j)=' ' sex(i,j)=' ' gradcom(i,j)=' ' emptype(i,j)=' ' empstat(i,j)=' ' grospay(i,j)=0 weeksin(i,j)=0 hrswkd(i,j)=0 occup(i,j)=' ' indust(i,j)=' ' payprd(i,j)=' ' do 101,k=1,12 membinc(i,j,k)=0 101 continue 102 continue do 103,j=1,109 qvar(i,j)=0 qvarl(i,j)=0 tflag(i,j)=' ' tflagl(i,j)=' ' repflag(i,j)=' ' 103 continue do 104,j=1,13 qtax(i,j)=0 104 continue do 105,j=1,45 extracat(i,j)=0 105 continue 110 continue ! initialize created variables do 115,i=1,20 in4th(i)=0 115 continue do 116,i=1,num_years ocuwt(i)=0 116 continue do 117,i=1,22 laginc(i)=0 117 continue onumearn=0 onumauto=0 ovehq=0 ofamsize=0 memb4th=0 if (doneqtr.eq.1) goto 140 if (doneqtr.eq.2) goto 150 if (doneqtr.eq.3) goto 160 read (12,end=795)& newid(1),intno(1),blsurbn(1),region(1),& cutenur(1),govhous(1),pubhous(1),building(1),& repstat(1),srepstat(1),intmo(1),intyr(1),& cuwt(1),fullyear(1),numearn(1),numauto(1),& vehq(1),famsize(1),membcnt(1),& (qvar(1,i),i=1,109),(tflag(1,i),i=1,109),& (extracat(1,i),i=1,45),& (repflag(1,i),i=1,109),(qvarl(1,i),i=1,109),& (tflagl(1,i),i=1,109),& (qtax(1,i),i=1,13),famtype(1),origin1(1) do 135,i=1,membcnt(1) read (12)& age(1,i),relation(1,i),educ(1,i),gradcom(1,i),& emplcont(1,i), incoll(1,i),& nonwork(1,i),marital(1,i),membnum(1,i),& race(1,i),sex(1,i),& empstat(1,i),emptype(1,i),grospay(1,i),& weeksin(1,i),hrswkd(1,i),& wkswkd(1,i),occup(1,i),payprd(1,i),indust(1,i),& (membinc(1,i,j),j=1,12) 135 continue ! use cucnt to pretest program cucnt=cucnt+1 ! if(cucnt.gt.100) goto 800 140 continue if (numintv.eq.1) goto 170 if (doneqtr.ne.1) then read(13) newid(2) backspace 13 if (newid(2).gt.newid(1)) then newid(2)=0. goto 150 end if end if read (13,end=795)& newid(2),intno(2),blsurbn(2),region(2),& cutenur(2),govhous(2),pubhous(2),building(2),& repstat(2),srepstat(2),intmo(2),intyr(2),& cuwt(2),fullyear(2),numearn(2),numauto(2),& vehq(2),famsize(2),membcnt(2),& (qvar(2,i),i=1,109),(tflag(2,i),i=1,109),& (extracat(2,i),i=1,45),& (repflag(2,i),i=1,109),(qvarl(2,i),i=1,109),& (tflagl(2,i),i=1,109),& (qtax(2,i),i=1,13),famtype(2),origin1(2) do 145,i=1,membcnt(2) read (13)& age(2,i),relation(2,i),educ(2,i),gradcom(2,i),& emplcont(2,i), incoll(2,i),& nonwork(2,i),marital(2,i),membnum(2,i),& race(2,i),sex(2,i),& empstat(2,i),emptype(2,i),grospay(2,i),& weeksin(2,i),hrswkd(2,i),& wkswkd(2,i),occup(2,i),payprd(2,i),indust(2,i),& (membinc(2,i,j),j=1,12) 145 continue if (doneqtr.eq.1) then newid(1)=newid(2) end if if (newid(2).lt.newid(1)) then write(77,*) 'misaligned -- file #2, newid=',newid(2),newid(1) newid(2)=0. goto 140 end if 150 continue if (numintv.eq.2) goto 170 if (doneqtr.ne.2) then read(14) newid(3) backspace 14 if (newid(3).gt.newid(1)) then newid(3)=0. goto 160 end if end if read (14,end=795)& newid(3),intno(3),blsurbn(3),region(3),& cutenur(3),govhous(3),pubhous(3),building(3),& repstat(3),srepstat(3),intmo(3),intyr(3),& cuwt(3),fullyear(3),numearn(3),numauto(3),& vehq(3),famsize(3),membcnt(3),& (qvar(3,i),i=1,109),(tflag(3,i),i=1,109),& (extracat(3,i),i=1,45),& (repflag(3,i),i=1,109),(qvarl(3,i),i=1,109),& (tflagl(3,i),i=1,109),& (qtax(3,i),i=1,13),famtype(3),origin1(3) do 155,i=1,membcnt(3) read (14)& age(3,i),relation(3,i),educ(3,i),gradcom(3,i),& emplcont(3,i), incoll(3,i),& nonwork(3,i),marital(3,i),membnum(3,i),& race(3,i),sex(3,i),& empstat(3,i),emptype(3,i),grospay(3,i),& weeksin(3,i),hrswkd(3,i),& wkswkd(3,i),occup(3,i),payprd(3,i),indust(3,i),& (membinc(3,i,j),j=1,12) 155 continue if (doneqtr.eq.2) then newid(1)=newid(3) end if if (newid(3).lt.newid(1)) then write(77,*) 'misaligned -- file #3, newid=',newid(3),newid(1) newid(3)=0. goto 150 end if 160 continue if (numintv.eq.3) goto 170 if (doneqtr.ne.3) then read(15) newid(4) backspace 15 if (newid(4).gt.newid(1)) then newid(4)=0. goto 170 end if end if read (15,end=795)& newid(4),intno(4),blsurbn(4),region(4),& cutenur(4),govhous(4),pubhous(4),building(4),& repstat(4),srepstat(4),intmo(4),intyr(4),& cuwt(4),fullyear(4),numearn(4),numauto(4),& vehq(4),famsize(4),membcnt(4),& (qvar(4,i),i=1,109),(tflag(4,i),i=1,109),& (extracat(4,i),i=1,45),& (repflag(4,i),i=1,109),(qvarl(4,i),i=1,109),& (tflagl(4,i),i=1,109),& (qtax(4,i),i=1,13),famtype(4),origin1(4) do 165,i=1,membcnt(4) read (15)& age(4,i),relation(4,i),educ(4,i),gradcom(4,i),& emplcont(4,i),& incoll(4,i),& nonwork(4,i),marital(4,i),membnum(4,i),& race(4,i),sex(4,i),& empstat(4,i),emptype(4,i),grospay(4,i),& weeksin(4,i),hrswkd(4,i),& wkswkd(4,i),occup(4,i),payprd(4,i),indust(4,i),& (membinc(4,i,j),j=1,12) 165 continue if (doneqtr.eq.3) then newid(1)=newid(4) end if if (newid(4).lt.newid(1)) then write(77,*) 'misaligned -- file #4, newid=',newid(4),newid(1) newid(4)=0. goto 160 end if !******************************************************************** ! All quarterly records read, begin processing annual record. ! This section is the guide to how the annual variables are ! constructed from quarterly values. !******************************************************************** 170 continue if (doneqtr.ne.0) then newid(1)=0. end if 200 continue !******************************************************************** ! Set fullyear status to correspond to 72-73 coding; 1=all ! 4 quarters present, 2=not all 4 !******************************************************************** fullyear(5)=1. do 201,i=1,4 if(newid(i).eq.0) then fullyear(5)=2. end if 201 continue !******************************************************************** ! Set age and in4th for all members !******************************************************************** do 206,i=1,20 do 204,j=1,4 if(membnum(5-j,i).ne.0) then if (j.eq.1) then in4th(i)=1. memb4th=memb4th+1 end if age(5,i)=age(5-j,i) goto 205 end if 204 continue 205 continue 206 continue !******************************************************************** ! Output weights are for each year 1980 to 1994 where ! household's four quarterly weights are mapped to the ! appropriate year. ! ! Initially set month of scope current (moscopec) at three, ! and moscope lagged (moscopel) at zero; i.e., all weight to ! the current quarter. Test if interview is occuring at the ! beginning of a year; a function of starting qtr and interview ! number. If interview at beginning of the year, split weight ! according to month of interview. !******************************************************************** do 210,i=1,4 moscopec=3. moscopel=0. if (iqtr(qtrcnt).eq.1) then if (intno(i).ne.2) then goto 208 end if end if if (iqtr(qtrcnt).eq.2) then if (intno(i).ne.5) then goto 208 end if end if if (iqtr(qtrcnt).eq.3) then if (intno(i).ne.4) then goto 208 end if end if if (iqtr(qtrcnt).eq.4) then if (intno(i).ne.3) then goto 208 end if end if if (intmo(i).eq.'01') then moscopec=0. moscopel=3. end if if (intmo(i).eq.'02') then moscopec=1. moscopel=2. end if if (intmo(i).eq.'03') then moscopec=2. moscopel=1. end if 208 continue if (mapwtc(i,qtrcnt).le.0) then write(77,*) 'MAPWT',mapwtc(i,qtrcnt) end if if (mapwtc(i,qtrcnt).le.num_years) then ocuwt(mapwtc(i,qtrcnt))=ocuwt(mapwtc(i,qtrcnt))+cuwt(i)*(moscopec/3.) end if if (mapwtl(i,qtrcnt).le.num_years) then ocuwt(mapwtl(i,qtrcnt))=ocuwt(mapwtl(i,qtrcnt))+ cuwt(i)*(moscopel/3.) end if 210 continue !******************************************************************** ! create sum of weights for table production !******************************************************************** cuwttot=0. do i = 1,num_years cuwttot=ocuwt(i)+cuwttot end do !******************************************************************** ! Annual totals for the various categories are the sum of the ! quarterly values. Income categories (1 through 21) and ! ira/keogh (109) use four times 5th quarter value to get ! survey year estimate. If any of the four quarters are topcoded, ! the annual variable is topcoded. !******************************************************************** !******************************************************************** ! Sum current and lagged (qvar/qvarl) values unless split needed !******************************************************************** do 215,i=1,109 do 214,j=1,4 qvar(j,i)=qvar(j,i)+qvarl(j,i) if (tflagl(j,i).eq.'T') then tflag(j,i)='T' end if 214 continue 215 continue !******************************************************************** ! Annual extracats and qtax are straight sums !******************************************************************** do 220,i=1,45 do 219,j=1,4 extracat(5,i)=extracat(5,i)+extracat(j,i) if (i.le.13) then qtax(5,i)=qtax(5,i)+qtax(j,i) end if 219 continue 220 continue !******************************************************************** ! Sum all expenditure and wealth except ira/keogh !******************************************************************** do 225,i=22,109 if (i.ne.99) then do 224,j=1,4 qvar(5,i)=qvar(5,i)+qvar(j,i) if (tflag(j,i).eq.'T') then tflag(5,i)='T' end if 224 continue end if 225 continue !******************************************************************** ! Use 4*5th qtr for incomes and ira/keogh (#99) !******************************************************************** do 227,i=1,21 qvar(5,i)=4*qvar(4,i) do 226,j=1,4 if (tflag(j,i).eq.'T') then tflag(5,i)='T' end if 226 continue 227 continue qvar(5,99)=4*qvar(4,99) do 228,j=1,4 if (tflag(j,99).eq.'T') then tflag(5,99)='T' end if 228 continue !******************************************************************** ! set the variables laginc(i), i=1,21, equal to first quarter ! values (*4 to make annual) for their respective income components !******************************************************************** do 229,i=1,21 laginc(i)=4*qvar(1,i) 229 continue !******************************************************************** ! last element of laginc is ira/keogh deductions, category 109 !******************************************************************** laginc(22)=4*qvar(1,99) !******************************************************************** ! blow up non-vehicle interest to make annual !******************************************************************** qvar(5,72)=qvar(5,72)*4 !******************************************************************** ! If any of the four repstats are=2 (incomplete income reporter) ! then the annual repstat=2. !******************************************************************** repstat(5)='1' srepstat(5)='1' do 230,i=1,4 if(repstat(i).eq.'2') then repstat(5)='2' end if if(srepstat(i).eq.'2') then srepstat(5)='2' end if 230 continue !******************************************************************** ! Set annual response flags; precedence to b=invalid, nonresponse, c= ! don't know, refusal, t=topcoded, d=valid or good, a=valid blank; ! method is to check all four quarterly in precedence order; ie, if ! any of four = 'b' then annual='b', etc !******************************************************************** do 235,i=1,109 if (repflag(1,i).eq.'B') then repflag(5,i)='B' goto 234 end if if (repflag(2,i).eq.'B') then repflag(5,i)='B' goto 234 end if if (repflag(3,i).eq.'B') then repflag(5,i)='B' goto 234 end if if (repflag(4,i).eq.'B') then repflag(5,i)='B' goto 234 end if if (repflag(1,i).eq.'C') then repflag(5,i)='C' goto 234 end if if (repflag(2,i).eq.'C') then repflag(5,i)='C' goto 234 end if if (repflag(3,i).eq.'C') then repflag(5,i)='C' goto 234 end if if (repflag(4,i).eq.'C') then repflag(5,i)='C' goto 234 end if if (repflag(1,i).eq.'T') then repflag(5,i)='T' goto 234 end if if (repflag(2,i).eq.'T') then repflag(5,i)='T' goto 234 end if if (repflag(3,i).eq.'T') then repflag(5,i)='T' goto 234 end if if (repflag(4,i).eq.'T') then repflag(5,i)='T' goto 234 end if if (repflag(1,i).eq.'D') then repflag(5,i)='D' goto 234 end if if (repflag(2,i).eq.'D') then repflag(5,i)='D' goto 234 end if if (repflag(3,i).eq.'D') then repflag(5,i)='D' goto 234 end if if (repflag(4,i).eq.'D') then repflag(5,i)='D' goto 234 end if if (repflag(1,i).eq.'A') then repflag(5,i)='A' goto 234 end if if (repflag(2,i).eq.'A') then repflag(5,i)='A' goto 234 end if if (repflag(3,i).eq.'A') then repflag(5,i)='A' goto 234 end if if (repflag(4,i).eq.'A') then repflag(5,i)='A' goto 234 end if 234 continue 235 continue !******************************************************************** ! Annual cutenur, region, blsurbn, govhous, pubhous, building ! set to last observed quarterly value. !******************************************************************** do 236,i=1,4 if (newid(5-i).ne.0) then newid(5)=newid(5-i) cutenur(5)=cutenur(5-i) blsurbn(5)=blsurbn(5-i) region(5)=region(5-i) govhous(5)=govhous(5-i) pubhous(5)=pubhous(5-i) building(5)=building(5-i) famtype(5)=famtype(5-i) origin1(5)=origin1(5-i) goto 237 end if 236 continue 237 continue !******************************************************************** ! Set interview month/year to first quarterly !******************************************************************** intmo(5)=intmo(1) intyr(5)=intyr(1) !******************************************************************** ! Goodqtr is a real counter for the number of quarters a ! household shows up; needed to compute averages below !******************************************************************** goodqtr=0 do 238,i=1,4 if(newid(i).ne.0) then goodqtr=goodqtr+1 if (newid(i).ne.newid(5)) then write(77,*) 'serious matching error -- newids dont match' end if end if 238 continue ! if (goodqtr.eq.4) write(77,*) 'matched all four qtrs' !******************************************************************** ! Set membcnt to maximum observed; average number earners, ! number autos, number vehicles, number durables, and family size !******************************************************************** membcnt(5)=membcnt(1) do 239,i=1,4 onumearn=onumearn+numearn(i) onumauto=onumauto+numauto(i) ovehq=ovehq+vehq(i) ofamsize=ofamsize+famsize(i) if(membcnt(i).gt.membcnt(5)) then membcnt(5)=membcnt(i) if (membcnt(5).gt.20) then goto 997 end if end if 239 continue onumearn=onumearn/goodqtr onumauto=onumauto/goodqtr ovehq=ovehq/goodqtr ofamsize=ofamsize/goodqtr !******************************************************************** ! For each household member, set age, relation, education, ! employer contributes to pension, in college, reason not ! working, marital status, member number, race, and sex to ! last observed value for that person !******************************************************************** do 242,i=1,20 do 240,j=1,4 if(membnum(5-j,i).ne.0) then relation(5,i)=relation(5-j,i) marital(5,i)=marital(5-j,i) educ(5,i)=educ(5-j,i) gradcom(5,i)=gradcom(5-j,i) membnum(5,i)=membnum(5-j,i) race(5,i)=race(5-j,i) sex(5,i)=sex(5-j,i) goto 241 end if 240 continue 241 continue weeksin(5,i)=weeksin(1,i)+weeksin(2,i)+weeksin(3,i)+weeksin(4,i) 242 continue !******************************************************************** ! Write output records !******************************************************************** !******************************************************************** ! Family record layout ! ! variable format ! ! newid(5) i7 ! blsurbn(5) a1 ! region(5) a1 ! cutenur(5) a1 ! govhous(5) a1 ! pubhous(5) a1 ! building(5) a2 ! repstat(5) a1 ! srepstat(5) a1 ! intmo(5) a2 ! intyr(5) a2 ! ocuwt(i=1,18) 18(f11.3) ! fullyear(5) i1 ! numearn(5) f4.1 ! numauto(5) f4.1 ! vehq(5) f4.1 ! famsize(5) f4.1 ! membcnt(5) i2 ! qvar(5,i=1,109) 109(f10.2) ! tflag(5,i=1,109) 109(a1) ! laginc(i=1,22) 22(f10.2) ! repflag(i=1,109) 109(a1) ! memb4th i2 ! extracat(5,i=1,45) 45f10.2 ! famtype a1 ! origin1 a1 ! ! Member record layout (j=1,20) ! ! variable format ! ! age(5,j) i3 ! relation(5,j) a1 ! educ(5,j) a2 ! gradcom(5,j) a1 ! membnum(5,j) i2 ! race(5,j) a1 ! sex(5,j) a1 ! weeksin(5,j) i2 ! emplcont(4,j) a1 ! incoll(4,j) a1 ! nonwork(4,j) a1 ! marital(4,j) a1 ! empstat(4,j) a1 ! emptype(4,j) a1 ! grospay(4,j) i10 ! hrswkd(4,j) i3 ! wkswkd(4,j) i2 ! occup(4,j) a2 ! payprd(4,j) a1 ! indust(4,j) a2 ! membinc(4,j,i=1,12) 12(i10) ! emplcont(1,j) a1 ! incoll(1,j) a1 ! nonwork(1,j) a1 ! marital(1,j) a1 ! empstat(1,j) a1 ! emptype(1,j) a1 ! grospay(1,j) i10 ! hrswkd(1,j) i3 ! wkswkd(1,j) i2 ! occup(1,j) a2 ! payprd(1,j) a1 ! indust(1,j) a2 ! membinc(1,j,i=1,12) 12(i10) !******************************************************************** !******************************************************************** ! Output variable descriptions, possible values ! ! Family record ! ! 1. newid (i7) id number ! 2. blsurbn (a1) 1=urban, 2=rural ! 3. region (a1) ! 4. cutenur (a1) 1=owner w/ mortgage, 2=owner w/o mortgage, ! 3=owner mortgage unknown, 4=renter, 5=occupied no payment, ! 6=student (1982+ only) ! 5. govhous ! 6. pubhous ! 7. building ! 8. repstat (a1) 1=complete reporter, 2=incomplete ! 9. srepstat (a1) (super) 1=complete reporter, 2=incomplete ! 10. intmo (a2) month of first interview, 01-12 ! 11. intyr (a2) year=80, 81, ..., 86 ! 12. ocuwt(18) (f11.3) consumer unit weight allocated by year ! 13. fullyear (i1) 1=full year, 2=part year ! 14. numearn (f4.1) average number of earners ! 15. numauto (f4.1) average number of autos ! 16. vehq (f4.1) average number of vehicles ! 17. famsize (f4.1) average family size ! 18. membcnt (i2) no. of members w/ information ! 19. qvar(109) (109(f10.2)) annual variables (survey year) ! 20. tflag(109) (109(a1)) topcode flags; blank=ok, 't'=topcoded ! 21. laginc(22) (22(f10.2)) annualized income vars based on 1st ! quarter answers. last element is ira/keo. ! 22. repflag(109) (109(a1)) response flag -- values from doc ! 23. memb4th (i2) ! 24. extracat(45) (45f10.2) ! 25. famtype (a1) ! 26. origin1 (a1) ! ! Member records (j=1,20) ! ! 1. age(j) (i3) age of each person ! 2. relation(j) (a1) relationship to cu head; 1=head, ! 2=spouse, 3=child/adopted child, 4=grandchild, 5=in-law, ! 6=brother/sister, 7=mother/father, 8=other relatives, ! 9=unrelated, 10=na (actually=0 because written a1) ! 3. educ(j) (a2) education; 00=never, 01-12=year of school ! completed, 21=ist yr college/equivalent, 22=2nd, 23=3rd, ! 24=4th, 31=1st yr grad school, 32=2nd grad school + ! 4. gradcom(j) (a1) highest grade in educ completed? 1=yes, 2=no. ! 5. membnum(j) (i2) member number for all full/part time in cu ! 6. race(j) (a1) 1=white, 2=black, 3=american indian, aleut, ! eskimo, 4=asian or pacific islander, 5=other ! 7. sex(j) (a1) 1=male, 2=female ! 8. weeksin(j) (i2) number of weeks in cu --rounded to 13, 26, 39, 52 ! 9. emplcont(j) (a1) employer contributed to pension ! fund? (1=yes, 2=no) (not available 1980-81) ! 10. incoll(j) (a1) in college? (1=full time, 2=part ! time, 3=not at all) ! 11. nonwork(j) (a1) reason not worling; 1=ill, disabled, ! 2=taking care of home, family, 3=going to school, 4=could not ! find work, 5=retired, 6=doing something else ! 12. marital(j) (a1) marital status; 1=married, 2=widowed, ! 3=divorced, 4=separated, 5=never married ! 13. empstat(j) (a1) 1=member worked full time for a full year, ! 2=member worked part time for a full year, 3=member worked ! full time for part year, 4=member worked part time for part year. ! 14. emptype(j) (a1) type of employee. 1=private company, ! 2=government employee, 3=self-employed, 4=working without pay. ! 15. grospay(j) (i10) amount of last gross pay. ! 16. hrswkd(j) (i3) number of hours worked per week. ! 17. wkswkd(j) (i2) number of weeks full or part time last year. ! 18. occup(j) (a2) occupation -- applies to job for "most" earnings; ! 01=managerial and professional specialty ! occupation, 02=technical, sales, and ! administrative support occupations, ! 03=service occupations, 04=farming, ! forestry, and fishing occupations, ! 05=precision production, craft, and repair ! occupations, 06=operators, fabricators, and ! laborers, 07=armed forces, 08=self ! employed, 09=not working, 10=retired, ! 11=other, including not reported. ! 19. payprd(j) (a1) pay period associated with last gross ! pay: 1=week, 2=two weeks, 3=month, 4=quarter, ! 5=year, 6=other, 7=semi monthly. ! 20. indust(j) (a2) industry -- applies to job for "most" earnings; ! 01=agriculture, forestry, fisheries, and mining, ! 02=construction, 03=manufacturing, 04=transportation, communication, ! public utilities, 05=wholesale and retail trade, ! 06=finance, insurance, real estate, ! 07=professional and related services, ! 08=other services, 09=public administration, ! 10=industry not reported or nonresponse. ! 21. membinc(j,12) (12(i10)) twelve element income vector; ! 1=annual federal tax ! 2=annual gov retirement deducted ! 3=annual priv pension deducted ! 4=annual rr retirement deducted ! 5=annual s&l tax deducted ! 6=annual farm income/loss ! 7=self employed retirement contributions (ira/keo) ! 8=estimated annual soc sec deducted ! 9=annual nonfarm income/loss ! 10=annual salary ! 11=annual soc sec/rr retirement received ! 12=annual suppl security inc received ! ! elements 22 through 34 are lagged values for 9 through 21 ! ! 22. emplcont(j) (a1) employer contributed to pension ! fund? (1=yes, 2=no) (not available 1980-81) ! 23. incoll(j) (a1) in college? (1=full time, 2=part ! time, 3=not at all) ! 24. nonwork(j) (a1) reason not worling; 1=ill, disabled, ! 2=taking care of home, family, 3=going to school, 4=could not ! find work, 5=retired, 6=doing something else ! 25. marital(j) (a1) marital status; 1=married, 2=widowed, ! 3=divorced, 4=separated, 5=never married ! 26. empstat(j) (a1) 1=member worked full time for a full year, ! 2=member worked part time for a full year, 3=member worked ! full time for part year, 4=member worked part time for part year. ! 27. emptype(j) (a1) type of employee. 1=private company, ! 2=government employee, 3=self-employed, 4=working without pay. ! 28. grospay(j) (i10) amount of last gross pay. ! 29. hrswkd(j) (i3) number of hours worked per week. ! 30. wkswkd(j) (i2) number of weeks full or part time last year. ! 31. occup(j) (a2) occupation -- applies to job for "most" earnings; ! 01=managerial and professional specialty ! occupation, 02=technical, sales, and ! administrative support occupations, ! 03=service occupations, 04=farming, ! forestry, and fishing occupations, ! 05=precision production, craft, and repair ! occupations, 06=operators, fabricators, and ! laborers, 07=armed forces, 08=self ! employed, 09=not working, 10=retired, ! 11=other, including not reported. ! 32. payprd(j) (a1) pay period associated with last gross ! pay: 1=week, 2=two weeks, 3=month, 4=quarter, ! 5=year, 6=other, 7=semi monthly. ! 33. indust(j) (a2) industry -- applies to job for "most" earnings; ! 01=agriculture, forestry, fisheries, and mining, ! 02=construction, 03=manufacturing, 04=transportation, communication, ! public utilities, 05=wholesale and retail trade, ! 06=finance, insurance, real estate, ! 07=professional and related services, ! 08=other services, 09=public administration, ! 10=industry not reported or nonresponse. ! 34. membinc(j,12) (12(i10)) twelve element income vector; ! 1=annual federal tax ! 2=annual gov retirement deducted ! 3=annual priv pension deducted ! 4=annual rr retirement deducted ! 5=annual s&l tax deducted ! 6=annual farm income/loss ! 7=self employed retirement contributions (ira/keo) ! 8=estimated annual soc sec deducted ! 9=annual nonfarm income/loss ! 10=annual salary ! 11=annual soc sec/rr retirement received ! 12=annual suppl security inc received ! 35. in4th ! 36. incoll(j) (a1) last observed college status !******************************************************************** write(23)& newid(5),blsurbn(5),region(5),& cutenur(5),govhous(5),pubhous(5),building(5),& repstat(5),& srepstat(5),intmo(5),intyr(5),(ocuwt(i),i=1,num_years),& fullyear(5),onumearn,onumauto,& ovehq,& ofamsize,membcnt(5),& (qvar(5,i),i=1,109),(tflag(5,i),i=1,109),& (laginc(i),i=1,22),& (repflag(5,i),i=1,109),memb4th,& (extracat(5,i),i=1,45),goodqtr,& famtype(5),origin1(5),(qtax(5,i),i=1,13),& iyear(qtrcnt),iqtr(qtrcnt) do 599,j=1,membcnt(5) write(23)& age(5,j),relation(5,j),educ(5,j),gradcom(5,j),& membnum(5,j),race(5,j),sex(5,j),weeksin(5,j),& emplcont(4,j),incoll(4,j),nonwork(4,j),marital(5,j),& empstat(4,j),emptype(4,j),grospay(4,j),hrswkd(4,j),& wkswkd(4,j),occup(4,j),payprd(4,j),indust(4,j),& (membinc(4,j,i),i=1,12),& emplcont(1,j),incoll(1,j),nonwork(1,j),marital(1,j),& empstat(1,j),emptype(1,j),grospay(1,j),hrswkd(1,j),& wkswkd(1,j),occup(1,j),payprd(1,j),indust(1,j),& (membinc(1,j,i),i=1,12),in4th(j),incoll(5,j) 599 continue 600 continue !******************************************************************** ! Produce summary data for table production at end of ! program; check populations, etc. ! ! First table argument is 1=all sample, 2=complete income, ! 3=full year complete income ! ! Second table argument in table1 is 1=sample size, 2=population, ! 3=percent homeowners, 4=average family size, 5=% super repstats, ! 6=% topcoded,7=average number of earners,... ! ! Second table argument in table2 corresponds to the 109 categories ! plus 22 lagged incomes, mbal ! ! Second table argument in table3 corresponds to percentages of total ! income for categories 1 to 22 and of total ! expenditures for categories 23 to 69 !******************************************************************** age65p=0 do 601,i=1,membcnt(5) if (age(5,i).gt.64) age65p=age65p+1 601 continue ! set demographics for tables head=1. numch18=0. do 603,i=1,membcnt(5) if (relation(5,i).eq.'1') then head=i end if if (relation(5,i).eq.'3') then if (in4th(i).eq.1) then if (age(5,i).le.17) then numch18=numch18+1 end if end if end if if (relation(5,i).eq.'4') then if (in4th(i).eq.1) then if (age(5,i).le.17) then numch18=numch18+1 end if end if end if 603 continue ! set ageclass ageclass=0 if (age(5,head).lt.25) then ageclass=1 end if if (age(5,head).ge.25) then if (age(5,head).lt.35) then ageclass=2. end if end if if (age(5,head).ge.35) then if (age(5,head).lt.45) then ageclass=3. end if end if if (age(5,head).ge.45) then if (age(5,head).lt.55) then ageclass=4. end if end if if (age(5,head).ge.55) then if (age(5,head).lt.65) then ageclass=5. end if end if if (age(5,head).ge.65) then ageclass=6. end if do 650,j=1,3 if (j.eq.2) then if (repstat(5).ne.'1') goto 640 endif if (j.eq.3) then if ((repstat(5).ne.'1').or.(fullyear(5).ne.1)) goto 640 endif table1(j,1)=table1(j,1)+1 table1(j,2)=table1(j,2)+(cuwttot/1000000) if (cutenur(5).eq.'1') then table1(j,3)=table1(j,3)+(cuwttot/1000000) end if if(cutenur(5).eq.'2') then table1(j,3)=table1(j,3)+(cuwttot/1000000) end if if(cutenur(5).eq.'3') then table1(j,3)=table1(j,3)+(cuwttot/1000000) end if table1(j,4)=table1(j,4)+ofamsize*(cuwttot/1000000) if(srepstat(5).eq.'1') then table1(j,5)=table1(j,5)+(cuwttot/1000000) end if do 605,i=1,21 if (tflag(5,i).eq.'T') then table1(j,6)=table1(j,6)+(cuwttot/1000000) goto 606 end if 605 continue 606 continue table1(j,7)=table1(j,7)+onumearn*(cuwttot/1000000) if (blsurbn(5).eq.'1') then table1(j,8)=table1(j,8)+(cuwttot/1000000) endif if (region(5).eq.'1') then table1(j,9)=table1(j,9)+(cuwttot/1000000) endif if (region(5).eq.'2') then table1(j,10)=table1(j,10)+(cuwttot/1000000) endif if (region(5).eq.'3') then table1(j,11)=table1(j,11)+(cuwttot/1000000) endif if (region(5).eq.'4') then table1(j,12)=table1(j,12)+(cuwttot/1000000) endif table1(j,13)=table1(j,13)+age65p*(cuwttot/1000000) table1(j,14)=table1(j,14)+numch18*(cuwttot/1000000) if (ageclass.eq.1) then table1(j,15)=table1(j,15)+(cuwttot/1000000) endif if (ageclass.eq.2) then table1(j,16)=table1(j,16)+(cuwttot/1000000) endif if (ageclass.eq.3) then table1(j,17)=table1(j,17)+(cuwttot/1000000) endif if (ageclass.eq.4) then table1(j,18)=table1(j,18)+(cuwttot/1000000) endif if (ageclass.eq.5) then table1(j,19)=table1(j,19)+(cuwttot/1000000) endif if (ageclass.eq.6) then table1(j,20)=table1(j,20)+(cuwttot/1000000) endif do 610,i=1,109 table2(j,i)=table2(j,i)+((cuwttot*qvar(5,i))/1000000) 610 continue do 611,i=1,22 table2(j,109+i)=table2(j,109+i)+ ((cuwttot*laginc(i))/1000000) 611 continue 640 continue 650 continue goto 100 !******************************************************************** ! Reset doneqtr as each possible starting point reaches ! end of file !******************************************************************** 795 continue doneqtr=doneqtr+1 if (doneqtr.le.3) goto 100 !******************************************************************** ! End of family record processing loop: prepare and ! write summary tables !******************************************************************** 800 continue ! convert table2 variables to averages; table1 variables to % do 803,i=1,3 do 802,j=1,133 table2(i,j)=table2(i,j)/table1(i,2) 802 continue table1(i,3)=100*table1(i,3)/table1(i,2) table1(i,4)=table1(i,4)/table1(i,2) table1(i,5)=100*table1(i,5)/table1(i,2) table1(i,6)=100*table1(i,6)/table1(i,2) table1(i,7)=table1(i,7)/table1(i,2) table1(i,8)=100*table1(i,8)/table1(i,2) table1(i,9)=100*table1(i,9)/table1(i,2) table1(i,10)=100*table1(i,10)/table1(i,2) table1(i,11)=100*table1(i,11)/table1(i,2) table1(i,12)=100*table1(i,12)/table1(i,2) table1(i,13)=table1(i,13)/table1(i,2) table1(i,14)=table1(i,14)/table1(i,2) table1(i,15)=100*table1(i,15)/table1(i,2) table1(i,16)=100*table1(i,16)/table1(i,2) table1(i,17)=100*table1(i,17)/table1(i,2) table1(i,18)=100*table1(i,18)/table1(i,2) table1(i,19)=100*table1(i,19)/table1(i,2) table1(i,20)=100*table1(i,20)/table1(i,2) 803 continue do 806,i=1,3 do 804,j=23,69 totexp(i)=totexp(i)+table2(i,j) 804 continue do 805,j=1,13 totinc(i)=totinc(i)+table2(i,j) 805 continue 806 continue do 812,j=1,3 do 810,i=23,69 table3(j,i)=100*(table2(j,i)/totexp(j)) 810 continue do 811,i=1,22 table3(j,i)=100*(table2(j,i)/totinc(j)) 811 continue 812 continue write(18,'(''Summary Table for 19'', i2,'' quarter '',i1)') iyear(qtrcnt),iqtr(qtrcnt) write(18,'('' '')') write(18,'(a65)') cexqnum1 write(18,'(a65)') cexqnum2 write(18,'(a65)') cexqnum3 write(18,'(a65)') cexqnum4 write(18,'(''Table 1: Sample Size, Population, etc.'')') write(18,'('' '')') write(18,'('' '',''Total '',''Complete '',''Full yr '')') write(18,'('' '',''Sample '',& ''Income '',''Complete'')') write(18,'('' '')') write(18,'(''sample size '',3(f10.2))') (table1(i,1),i=1,3) write(18,'(''number of households '',3(f10.2))') (table1(i,2),i=1,3) write(18,'(''percentage homeowners '',3(f10.2))') (table1(i,3),i=1,3) write(18,'(''family size '',3(f10.2))') (table1(i,4),i=1,3) write(18,'(''percentage super repstat '',3(f10.2))') (table1(i,5),i=1,3) write(18,'(''percent income topcoded '',3(f10.2))') (table1(i,6),i=1,3) write(18,'(''number of earners '',3(f10.2))')(table1(i,7),i=1,3) write(18,'(''percent urban '',3(f10.2))')(table1(i,8),i=1,3) write(18,'(''percent northeast '',3(f10.2))') (table1(i,9),i=1,3) write(18,'(''percent midwest '',3(f10.2))') (table1(i,10),i=1,3) write(18,'(''percent south '',3(f10.2))') (table1(i,11),i=1,3) write(18,'(''percent west '',3(f10.2))') (table1(i,12),i=1,3) write(18,'(''number 65 + '',3(f10.2))') (table1(i,13),i=1,3) write(18,'(''number children < 18 '',3(f10.2))') (table1(i,14),i=1,3) write(18,'(''percent w/ head < 25 '',3(f10.2))') (table1(i,15),i=1,3) write(18,'(''percent w/head 25 - 34 '',3(f10.2))') (table1(i,16),i=1,3) write(18,'(''percent w/head 35 - 44 '',3(f10.2))') (table1(i,17),i=1,3) write(18,'(''percent w/head 45 - 54 '',3(f10.2))') (table1(i,18),i=1,3) write(18,'(''percent w/head 55 - 64 '',3(f10.2))') (table1(i,19),i=1,3) write(18,'(''percent w/head 65 + '',3(f10.2))') (table1(i,20),i=1,3) write(18,'('' '')') write(18,'('' '')') write(18,'(''Table 2: Category Averages '')') write(18,'('' '')') write(18,'('' '', '' '',''Total '',& ''Complete '',''Full yr '')') write(18,'('' '',& '' '',''Sample '',& ''Income '',''Complete'')') write(18,'('' '')') do 830,j=1,109 write(18,'(a50,3(f9.0))') cexcat(j),(table2(i,j),i=1,3) 830 continue write(18,'('' '')') write(18,'(''lagged incomes'')') do 831,j=1,21 write(18,'(a50,3(f9.0))') cexcat(j),(table2(i,109+j),i=1,3) 831 continue write(18,'(a50,3(f9.0))') cexcat(99),(table2(i,131),i=1,3) write(18,'('' '')') 840 continue write(18,'('' '')') write(18,'('' '')') write(18,'(''Table 3: Percentage of Total '')') write(18,'('' '')') write(18,'('' '',& '' '',''Total '',& ''Complete '',''Full yr '')') write(18,'('' '',& '' '',''Sample '',& ''Income '',''Complete'')') write(18,'('' '')') do 850,j=1,22 write(18,'(a50,3(f9.1))') cexcat(j),(table3(i,j),i=1,3) 850 continue write(18,'('' '')') write(18,'('' Total Income '' ,3(f9.0))') (totinc(i),i=1,3) write(18,'('' '')') do 860,j=23,69 write(18,'(a50,3(f9.1))') cexcat(j),(table3(i,j),i=1,3) 860 continue write(18,'('' '')') write(18,'('' Total Expenditures '' ,3(f9.0))') (totexp(i),i=1,3) 900 continue ! close files, check if qtrcnt le endqtr and return close(unit=12) close(unit=13) close(unit=14) close(unit=15) close(unit=18) close(unit=23) qtrcnt=qtrcnt+1 ! skip 1985:3,4 starting points if (qtrcnt.eq.23) qtrcnt=26 ! skip 1995:5 starting points if (qtrcnt.eq.66) qtrcnt=67 if (qtrcnt.le.endqtr-3) goto 75 997 continue end subroutine cexfam