taxsim9.for 0000664 0004364 0004364 00004142400 14122116242 012572 0 ustar taxsim taxsim c to convert to f77, comment out open statements and call to date and time c and fix zeros in format statements 200 and 201 in out. Also change c format to * for f2c. program webcalc9 implicit double precision(a-h,o-z) parameter(nx=22) dimension data(255),x(nx) character*64 arg,fname,mname common/state/t(12) common /dindiv/ data common/calc/s(12) common/agev/agep,ages common/comold/d(255) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) common/nrecc/nrec common/newshr/comnew(255) character*8 date character*10 time,zone integer values(8),sgn data fname,mname/2*' '/ nrec = 0 call date_and_time(date,time,zone,values) if(date(1:6).gt.'202112') then write(0,*) 'This taxsim binary is out of date and has expired.' write(0,*) 'A more recent version should be available from ', & 'feenberg@nber.org' c stop 0611 endif do 40 i=1,255 d(i) =0. data(i) = 0. comnew(i) = 0. 40 continue data(3) = 1 data(96) = -1 fname = ' ' mtr = 85 idtl = 0 ssaind = 0 swap6870 = 0 do 5 i=1,5 call getarg(i,arg) if(arg.eq.'full') then idtl=2 elseif(arg.eq.'detail') then idtl=5 elseif(arg.eq.'other') then mtr=17 elseif(arg.eq.'wage') then mtr = 11 elseif(arg.eq.'taxpayer') then mtr=85 elseif(arg.eq.'spouse') then mtr=86 elseif(arg.eq.'long') then mtr = 70 elseif(arg.eq.'mortgage') then mtr = 56 elseif(arg.eq.'bother') then mtr=0 elseif(arg.eq.'swap') then swap6870 = 1 elseif(arg.eq.'plan') then call getarg(i+1,arg) read(arg,*) iext1 call getarg(i+2,arg) read(arg,*) iext2 extnd(iext1) = iext2 write(0,*) 'Plan',iext1,iext2 else if(arg(1:1).gt.'@') then fname = arg endif endif 5 continue do 55 i=1,60 mname(i:i) = fname(i:i) if(mname(i:i).eq.' '.or.mname(i:i).eq.'.') then mname(i:i+4) = '.msg' goto 56 endif 55 continue 56 continue if(fname.ne.' ') then open(5,file=fname,status='old') open(0,file=mname,status='unknown') endif write(*,*) ' ' 1 continue do 4 i=1,nx x(i) = 0. 4 continue read(5,*,end=999,err=998) (x(i),i=1,nx) if(x(2).eq.256) then write(0,*) 'TAXSIM OK (Version 9 20181218) ',date stop endif if(x(2).eq.254) goto 999 if(x(5).eq.999) goto 999 c x(2) is a flag identifying the first, control record if too small to be a year if(x(2).lt.255) then if(x(1).le.7) then write(0,*) 'One of 2 possible user errors:' write(0,*) 'If you are using the webpage to upload a file,' write(0,*) 'the second variable in each record must be' write(0,*) 'the tax year - a number >=1960.' write(0,*) write(0,*) 'If you are using Stata for taxsim, ' write(0,*) 'you may have requested version 7 of ' write(0,*) 'which taxsim is no longer supported.' write(0,*) 'Please get version 9 from ' write(0,*) 'http://www.nber.org/stata' write(0,*) 'Webcalc.cgi is asking for version ', x(1) write(0,*) 'but this is version 9. of webcalc.for' write(0,*) x stop endif mtr = x(2) idtl = x(3) if(x(4).gt.0.or.x(6).gt.0) then if(x(4).ne.56.and.x(4).ne.52.and. & x(13).ne.0) then write(0,*) 'Options are disabled - if you need one' write(0,*) 'contact feenberg@nber.org' c write(0,*) 'TAXSIM: Option selection invalid', x(4),x(6) c write(0,*) 'Options must be within 0 - 100 or blank' c write(0,*) c & 'http://www.nber.org/taxsim/taxsim-calc9/options.html' stop endif endif iext1 = x(4) extnd(iext1) = x(5) iext2 = x(6) extnd(iext2) = x(7) if(x(4)+x(6).ne.0) then write(0,*)'MODIFIED LAW. See list of options at' write(0,*) & 'http://www.nber.org/taxsim/taxsim-calc9/options.html' if(iext1.gt.0) write(0,*)'Option ',iext1,' ',extnd(iext1) if(iext2.gt.0) write(0,*)'Option ',iext2,' ',extnd(iext2) endif goto 1 endif nrec=nrec+1 if(x(1).eq.-2) write(0,*) nrec,x data(100) = x(1) data(70) = 0. data(101) = x(2) data(103) = x(2) data(7) = 1 data(8) = x(5) data(105) = 0. if(x(4).eq.1..and.x(5).gt.0.) then data(2) = 4. elseif(x(4).eq.1..and.x(5).eq.0.) then data(2) = 1. elseif(x(4).eq.2.) then data(2) = 2. data(7) = 2. elseif(x(4).eq.8.) then data(2) = 1. data(105) = 1. data(7) = 0. elseif(x(4).eq.5) then data(2) = 5 elseif(x(4).eq.9) then data(2) = 3 data(7) = 1 elseif(x(4).eq.10) then data(2) = 6 data(7) = 2 elseif(x(4).eq.6) then data(2) = 6 else write(0,*) 'Invalid marital status (x(4)), x(4)' write(0,*) x write(0,*) 'Abending' endif data(9) = x(6) data(85) = x(7) data(86) = x(8) data(11) = data(85) + data(86) data(12) = 0. data(56) = 0. data(17) = 0. data(24) = 0. data(200) = 1. data(201) = 0. if(data(11).ne.0) then data(201)=data(86)/data(11) data(200) = x(7)/data(11) endif data(12) = x(9) + .001 data(176) = data(12) data(79) = x(10) data(20) = x(11) data(91) = x(12) data(41) = x(13) if(extnd(54).eq.1) then data(93) = 0. data(58)=x(13) endif data(160) = x(14) data(51) = x(15) data(54) = x(16) data(64) = x(17) data(82) = x(18) data(159) = data(11) + data(12) + data(19) + data(20) & + data(93) + data(82) + data(91) + data(41) & + data(79) lawyr = x(2) data(208) = int(mod(int(x(19)),100)) data(209) = data(8)-mod((int(x(19)-data(208)))/100,100) data(207) = int(x(19)/10000) if(x(19).lt.99) then data(209) = data(8) - x(19) endif if(data(1).lt.0) write(*,*) x(19),(data(ii),ii=207,209) data(56) = x(20) if(extnd(58).eq.1) then data(61) = x(20) data(56) = 0. endif if(swap6870.eq.0) then data(68) = x(21) data(70) = x(22) else data(68) = x(22) data(70) = x(21) endif agep = 0 ages = 0 if(x(6).gt.8) then agep=int(x(6)/100) ages=int(mod(int(x(6)),100)) if(ages.gt.0.and.ages.lt.14) then agep = agep-1 ages = ages+100 endif data(205) = max(ages,agep) data(206) = min(ages,agep) data(9) = 0 if(agep.ge.65) data(9) = 1 if(ages.ge.65) data(9) = data(9) + 1 if(data(100).eq.-1)write(0,*)'age p,s ',agep,ages,data(205) &,data(206) endif call check(idtl,mtr,x,nx,data) c FICA tax and rate call sstax(data,lawyr) fica = comnew(75) if(mtr.eq.85) then ficar = comnew(148) elseif(mtr.eq.86) then ficar = comnew(149) elseif(mtr.eq.11) then ficar = comnew(150) else ficar = 0. endif ficar = ficar*100 c -1 is a special state code meaning do all states if(x(3).eq.-1) then is=1 if=51 elseif(x(3).eq.-3) then is=1 if=10 else is=x(3) if=is endif diff = .01 if(extnd(52).ne.0) diff=extnd(52) datamtr = data(mtr) data85 = data(85) data86 = data(86) data159 = data(159) data11 = data(11) data(93) = 1. do 30 istate=is,if data(mtr) = datamtr data(11) = data85 + data86 data(85) = data85 data(86) = data86 data(159) = data159 data(6) = istate c if(data(100).eq.-1) write(0,*) ' base calculation ' call tcalc (data,lawyr) do 110 i=1,255 d(i) = comnew(i) 110 continue if(data(100).le.-1) then write(0,*) ' comnew=' write(0,'(21(10f8.0/)//)') (d(i),i=1,210) write(0,'(6f10.2)') s endif s(1) = data159 do 120 i=1,12 t(i) = s(i) 120 continue fold = comnew(1) agiold = comnew(2) sold = comnew(74) c if(data(100).eq.-1)write(0,*)'fold ',fold,sold,agiold 1300 format(16(10f10.2/)//(16(10f10.2/)//)) frate = 0. srate = 0. do 39 sgn=1,-1,-2 if(mtr .ne.0) then if(idtl.eq.5) then fdiff = sgn*1. else fdiff = sgn*diff endif data(mtr) = datamtr + fdiff if(mtr.lt.47.or.mtr.gt.63)data(159) = data159 + fdiff if(mtr.eq.11) then if(data11.ne.0) then data(85) = data85 + fdiff*(data85/data11) data(86) = data86 + fdiff*(data86/data11) else data(85) = fdiff/2. data(86) = fdiff/2. endif endif data(11) = data(85) + data(86) c if(data(100).eq.-1)write(0,*) 'Increment Income item ',fdiff call tcalc(data,lawyr) s(1) = data(159) fnew = comnew(1) snew = comnew(74) frate =100* (fnew - fold)/fdiff srate =100* (snew - sold)/fdiff if(data(100).le.-2)write(0,*) 'frate,fnew,fold,fdiff', & frate,fnew,fold,fdiff if(data(100).le.-2) write(0,*) snew,sold,fdiff, & (int(s(i)),i=1,12) ftan = comnew(72) if(abs(frate).lt.100.and.abs(srate).lt.25) goto 91 endif 39 continue 91 continue srate = twn(srate,-99.d0,999.d0) frate = twn(frate,-99.d0,999.d0) call out(mtr,idtl,x,fold,sold,fica,frate,srate,ficar,data) data(mtr) = datamtr 30 continue goto 1 998 continue write(0,*) write(0,*) 'TAXSIM: I/O conversion error on input for record ', & nrec+1 write(0,*) ' Last successful read had record id ',data(100), & ' state ', data(6), ' for year ',data(101) 999 continue if(nrec.eq.0) then write(0,*) 'TAXSIM: No records read.' write(0,*) 'Perhaps you did not chose a file in the' write(0,*) 'dialog box, or perhaps it is a firewall problem.' write(0,*) 'See http://www.nber.org/taxsim/ftp-problem.html' write(0,*) 'for an explanation' endif stop end subroutine check(idtl,mtr,x,nx,data) implicit double precision(a-h,o-z) dimension x(nx),data(255) common/agev/agep,ages common/nrecc/nrec if(idtl.eq.5) then write(6,*) 'NBER TAXSIM Model v9 (20161021)',mtr iext1 = x(4) if(mtr.eq.85) then write(6,*) 'Marginal tax rate wrt taxpayer earnings.' elseif(mtr.le.0.or.mtr.ge.255) then write(0,*) "That MTR is not available." goto 8 elseif(mtr.eq.17) then write(6,*) 'Marginal tax rate wrt non-wage income.' elseif(mtr.eq.86) then write(6,*) 'Marginal tax rate wrt spouse earning.' elseif(mtr.eq.70) then write(6,*) 'Marginal rate wrt long-term gains.' elseif(mtr.eq.56) then write(6,*) 'Marginal rate wrt Mortgage Interest Paid.' elseif(mtr.eq.56) then write(6,*) 'Marginal rate wrt Other deductions.' else write(6,*) 'Marginal rate not requested.' endif write(6,*) write(6,*) 'Input Data: ' write(6,3) ' 1. Record ID: ', x(1) write(6,2) ' 2. Tax Year: ', x(2) write(6,2) ' 3. State Code: ', x(3) write(6,2) ' 4. Marital Status: ', x(4) write(6,2) ' 5. Dependent Exemptions: ', x(5) write(6,2) ' 6. Age of taxpayer(s)" ', agep,ages write(6,2) ' 7. Wages (Primary): ', x(7) write(6,2) ' 8. Wages (Spouse): ', x(8) write(6,2) ' 9. Dividend Income: ', x(9) write(6,2) ' 10. Other Property: ', x(10) write(6,2) ' 11. Taxable Pensions: ', x(11) write(6,2) ' 12. Gross Social Security:', x(12) write(6,2) ' 13. Non-taxable Transfers:', x(13) write(6,2) ' 14. Rent Paid: ', x(14) write(6,2) ' 15. Property Taxes Paid: ', x(15) write(6,2) ' 16. Other Itemized Deds: ', x(16) write(6,2) ' 17. Child Care Expenses: ', x(17) write(6,2) ' 18. UI Compensation: ', x(18) write(6,2) ' 19. Dependents<13/17/18 ', & data(207),data(208),data(8)-data(209) write(6,2) ' 20. Mortgage Interest ', x(20) write(6,2) ' 21. Short Term Gains ', x(21) write(6,2) ' 22. Long Term Gains ', x(22) write(6,*) ' ' endif c if(data(166).eq.-1) write(6,*) 'idtl',idtl,x(2),x(3) if(idtl.lt.0.or.idtl.gt.5) then write(0,*) 'Debug Flag out of bounds : ',idtl write(0,*) '(should not occur)' goto 8 endif if(x(4).eq.3.and.x(5).eq.0) then write(0,*) 'Head-of-household must have dependents' goto 8 endif if((mtr.lt.11.or.mtr.gt.99).and.mtr.ne.0) then write(0,*) 'Request for marginal rate on a code' goto 8 endif if(data(208).gt.data(8)) then write(0,*) 'More children under 17 than total dependents', & data(8),data(208) goto 8 endif if(data(207).ge.data(208)+1) then write(0,*) 'More children under 13 than children under 17', & data(178),data(208) goto 8 endif if(data(209).gt.data(8)) then write(0,*) 'More children over 18 than total dependents', & data(209),data(8) goto 8 endif if(data(8)-data(209).lt.data(208)) then write(0,*) 'More children under 17 than under 18', & data(208),data(8)-data(209) goto 8 endif if(data(8).gt.15.or.data(208).gt.15) then write(0,*) 'More than 15 dependents:',data(8),data(208) goto 8 endif if(data(8).ne.int(data(8))) then write(0,*) 'Must have integer number of dependents:',data(8) goto 8 endif if(agep.lt.0.or.agep.gt.114) then write(0,*) 'Unbelievable agep:',agep,' from',x(6) goto 8 endif if(ages.lt.0.or.agep.gt.114) then write(0,*) 'Unbelievable ages:',ages,' from',x(6) goto 8 endif if(x(3).gt.55..or.x(3).lt.-3) then write(0,*) 'State code must be within [-3,55].',x(3) write(0,*) 'SOI codes are used, not Census codes.' goto 8 endif if(x(3).ne.int(x(3))) then write(0,*) 'State code must be integer.',x(3) goto 8 endif if(x(2).lt.1960.or.x(2).gt.2023) then write(0,*) 'Federal tax calculator available 1960 - 2023 only' goto 8 endif if(x(2).ne.int(x(2))) then write(0,*) 'Tax law year must be integer.',x(2) goto 8 endif if(x(3).ne.0..and. & (x(2).gt.2016.or.x(2).lt.1977)) then write(0,*) 'State tax calculator available 1977 - 2016 only' goto 8 endif if(x(4).ne.2.and.x(8).ne.0) then write(0,*) 'Non-joint return with 2 wage-earners' write(0,*) 'Separate filers should report only own income' goto 8 endif if(ages.gt.0.and.agep.gt.0.and.x(4).ne.2) then write(0,*) 'Non-joint return with age of secondary taxpayer' write(0,*) 'Ages ',ages goto 8 endif do 10 i=4,nx if(i.eq.7.or.i.eq.8.or. & i.eq.10.or.i.eq.21.or.i.eq.22) goto 10 if(x(i).lt.0) goto 9 10 continue if(x(4).ge.9.or.x(4).le.0.or.x(4).eq.5.or.x(4).eq.7) then write(0,*) 'Marital Status (variable 4) not valid',x(4) goto 8 endif return 9 write(0,*) 'Inappropriate negative value:', x(i) write(0,*) 'Perhaps items missing/out of sequence?' write(0,*) 'Item number in error :',i 8 write(0,*) 'Record ID :',x(1) write(0,*) 'Logical Record Number :',nrec write(0,*) 'Law Year :',x(2) write(0,*) 'State id :',x(3) write(0,*) 'Data record, (rounded) :',(int(x(ii)),ii=1,22) write(0,*) 'Abandoning processing' stop 1 2 format( a31,3f11.2 ) 3 format( a31,2f13.0 ) end subroutine tcalc(data,lawyr) implicit double precision(a-h,o-z) dimension data(255) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) common/newshr/comnew(255) if(data(100).lt.0)write(0,*)'d205,6tcalc',data(205),data(206) c Compulsory itemization if(extnd(51).eq.0.or.extnd(51).eq.1) then data(4) = -1 call tcalc2(data,lawyr) taxitm = comnew(1) + comnew(74) endif c Compulsory standard deduction if(extnd(51).eq.0.or.extnd(51).eq.2) then data(4) = -2 call tcalc2(data,lawyr) taxstd = comnew(1) + comnew(74) endif if(data(100).eq.-1)write(0,*)'taxitm,std',taxitm,taxstd c If itemization is better, use it if(extnd(51).eq.0) then if(taxitm.lt.taxstd.or.extnd(51).eq.1) then data(04) = -1 call tcalc2(data,lawyr) endif endif return end subroutine tcalc2(data,lawyr) implicit double precision(a-h,o-z) common/calc/st(12) dimension data(255) common/newshr/comnew(255) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) data(50)=0. if(data(100).lt.0)write(0,*)"data205,6tcalc2",data(205),data(206) call nlaw(data,lawyr) if(extnd(50).eq.1.) then call statax(data,lawyr,comnew) goto 11 endif 100 format(17(10f8.2/)/18(10f8.2/)////) do 10 i=1,3 if(data(100).le.-1) write(0,*) ' iteration ',i call nlaw(data,lawyr) if(data(100).le.-1) write(0,*) 'back from nlaw ',comnew(1), & comnew(24) comnew(74) = 0. lawsta = lawyr do 20 ii=1,12 st(ii) = 0. 20 continue if(data(6).ne.0) then if(data(100).le.-2) write(0,*) 'before statax ',data(6) call statax(data,lawsta,comnew) if(data(100).le.-2) write(0,*) 'back from statax',comnew(74) data(50)=max(saletx(data,lawyr),comnew(74),0.d0) endif if(data(100).le.-3) then write(0,1)(data(j),j=1,210),(comnew(j),j=1,180) write(0,'(6f10.2)') st endif 10 continue 11 continue call sstax(data,lawyr) if(data(100).le.-2)write(0,1)(data(i),i=1,210),(comnew(i),i= & 1,180) 1 format(21(10f10.2/)///18(10f10.2/)///) if(data(100).eq.-1)write(0,*) 'sales tax allowed ',st return end subroutine out(mtr,idtl,x,fold,sold,fica,frate,srate,ficar,data) implicit double precision(a-h,o-z) dimension data(255),x(18) character*20 names(0:55) common/newshr/c(255) common/calc/s(12) common/state/t(12) common/comold/d(255) data names/' ', & 'Alabama', 'Alaska', 'Arizona', 'Arkansas', 'California', & 'Colorado', 'Connecticut', 'Delaware', 'DC', 'Florida', & 'Georgia', 'Hawaii', 'Idaho', 'Illinois', 'Indiana', 'Iowa', & 'Kansas', 'Kentucky', 'Louisiana', 'Maine', 'Maryland', & 'Massachusetts', 'Michigan', 'Minnesota', 'Mississippi', & 'Missouri', 'Montana', 'Nebraska', 'Nevada', 'New Hampshire', & 'New Jersey', 'New Mexico', 'New York', 'North Carolina', & 'NorthDakota', 'Ohio', 'Oklahoma', 'Oregon', 'Pennsylvania', & 'Rhode Island', 'South Carolina', 'South Dakota', 'Tennessee', & 'Texas', 'Utah', 'Vermont', 'Virginia', 'Washington', & 'West Virginia', 'Wisconsin', 'Wyoming',4*' '/ if(data(6).ne.0) then s(12) = s(12)* 100. t(12) = t(12)*100. else s(12) = 0. t(12) = 0. endif d148=d(148)*100 d149=d(149)*100 lawyr = data(101) if(idtl.eq.0) then write(*,200) x(1) ,lawyr,int(data(6)),fold, & sold ,fica ,frate,srate,ficar elseif(idtl.eq.2) then write(*,200) x(1) ,int(data(101)),int(data(6)),fold, & sold,fica,frate,srate,ficar, & d( 2), d(78), d(79), d( 3) ,d(83), & d(39), d(34), d(24), d(29), d(28), & d(174), d(51), d(81), d(93), d(53), & d(59), d(69), d(70), d(52), d(75), & (s(i ),i=1,12) elseif(idtl.eq.3) then write(*,201) x(1) ,int(data(101)),int(data(6)),fold, & sold,fica,frate,srate,ficar, & d( 2), d(78), d(79), d( 3) ,d(83), & d(39), d(34), d(24), d(29), d(28), & d(174), d(51), d(81), d(93), d(53), & d(59), d(69), d(70), d(52), d(75), & (s(i ),i=1,12) if(data(100).eq.-1) write(0,*) 'd(1)',d(1) elseif(idtl.eq.5) then write(*,*) 'Basic Output: ' write(*,6) ' 1. Record ID: ', x(1) write(*,3) ' 2. Year: ', int(x(2)) write(*,5) ' 3. State (SOI code): ', int(data(6)), & names(int(data(6))) write(*,2) ' 4. Federal IIT Liability: ', fold write(*,2) ' 5. State IIT Liability: ', sold write(*,2) ' 6. SS Payroll Tax Liability: ', fica if(mtr.eq.85) then write(*,*) 'Marginal Rates wrt Earner' elseif(mtr.eq.86) then write(*,*) 'Marginal Rates wrt Secondary Earner' elseif(mtr.eq.11) then write(*,*) 'Marginal Rates wrt Weighted Average Earnings' elseif(mtr.eq.17) then write(*,*) 'Marginal Rates wrt Other Income' elseif(mtr.eq.70) then write(*,*) 'Marginal Rates wrt Long-term Gains.' else write(*,*) 'No marginal rates requested' endif write(*,2) ' 7. Federal Marginal Rate: ', frate write(*,2) ' 8. State Marginal Rate: ', srate if(mtr.eq.11) then write(*,2) ' 9. Weighted Payroll Tax Rate:', ficar elseif(mtr.eq.85) then write(*,2) ' 9. Taxpayer SS Rate: ', d148 elseif(mtr.eq.86) then write(*,2) ' 9. Spouse SS Rate: ', d149 else write(*,2) ' 9. No SS Tax on Other Income:', 0. endif write(*,2) ' ' write(*,*) 'Federal Tax Calculation: Base + &$1' write(*,2) ' 10. Federal AGI ', d(2),c( 2) write(*,2) ' 11. UI in AGI 79+ ', d(78),c(78) write(*,2) ' 12. Social Security in AGI 84+', d(79),c(79) write(*,2) ' 13. Zero Bracket Amount ', d( 3),c( 3) write(*,2) ' 14. Personal Exemptions ', d(83),c(83) write(*,2) ' 15. Exemption Phaseout 91+ ', d(39),c(39) write(*,2) ' 16. Deduction Phaseout 91+ ', d(34),c(34) write(*,2) ' 17. Deductions allowed ', d(24),c(24) write(*,2) ' 18. Federal Taxable Income ', d(29),c(29) write(*,2) ' 19. Federal Regular Tax ', d(28),c(28) if(data(101).eq.2000.) & write(*,21) ' (Excludes 2001 Rate Reduction Credit)' if(data(101).eq.2001) & write(*,21) ' (Includes 2001 Rate Reduction Credit)' write(*,2) ' 20. Exemption Surtax 88-96 ', d(174),c(174) write(*,2) ' 21. General Tax Credit 75-78 ', d(51),c(51) if(int(data(208)).eq.0) then write(*,2) ' 22. Child Tax Credit*17/22 98+', d(81),c(81) else write(*,2) ' 22. Child Tax Credit ', d(81),c(81) endif if(lawyr.eq.2009.or.lawyr.eq.2010) then write(*,2) ' Make Work Pay Crdt 2009-10', d(94),c(94) endif write(*,2) ' 23 Refundable Part ', d(93),c(93) write(*,2) ' 24. Child Care Credit 76+ ', d(53),c(53) write(*,2) ' 25. Earned Income Credit 75+ ', d(59),c(59) write(*,2) ' 26. Alternative Min Income: ', d(69),c(69) write(*,2) ' 27. AMT ', d(70),c(70) if(lawyr.eq.2006.and.d(86)+c(86).gt.0) & write(*,2) ' Telephone Tax Refund ', d(86),c(86) write(*,2) ' XX Net Investment Income Tax ', d(173),c(173) write(*,2) ' 28. Income Tax Before Credits ', d(52),c(52) write(*,2) ' 29. FICA ', d(75),c(75) if(data(6).ne.0) then write(*,2) write(*,*) 'State Tax Calculation: ' write(*,2) ' 30. Household Income ',t(1), s(1) write(*,2) ' 31. Imputed Rent ',t(2),s(2) write(*,2) ' 32. AGI ',t(3),s(3) write(*,2) ' 33. Exemptions ',t(4),s(4) write(*,2) ' 34. Standard Deduction ',t(5),s(5) write(*,2) ' 35. Itemized Deductions ',t(6),s(6) write(*,2) ' 36. Taxable Income ',t(7),s(7) write(*,2) ' 37. Property Tax Credit ',t(8),s(8) write(*,2) ' 38. Child Care Credit ',t(9),s(9) write(*,2) ' 39. EIC ',t(10),s(10) write(*,2) ' 40. Total Credits ',t(11),s(11) write(*,2) ' 41. Bracket Rate ',t(12),s(12) write(*,2) ' State Tax after Credits ',d(74),c(74) endif write(*,*) write(*,*) 'Decomposition of the Marginal Rate' write(*,*) ' (taxpayer earned income)' write(*,2) write(*,*) 'Regular Income Tax' write(*,2) ' Bracket rate from X,Y or Z', d( 66) write(*,2) ' Deduction Phaseout: ', d(102) write(*,2) ' Exemption Phaseout: ', d(104) write(*,2) ' Social Security Phasein: ', d(106) write(*,2) ' Child Tax Credit: ', d(114) write(*,2) ' Child Care Credit: ', d(116) write(*,2) ' Refundable Part of CTC: ', d(144) write(*,2) ' Earned Income Credit: ', d(118) write(*,2) ' Surtax on 15% bracket: ', d(130) write(*,2) ' Exemption Surtax: ', d(132) write(*,2) ' Unemployment Insurance: ', d(134) write(*,2) ' Max Tax on Earned Income: ', d(140) write(*,2) ' Elderly Credit: ', d( 54) write(*,2) ' Dependent Care Credit: ', d( 53) write(*,2) ' Percentage Std Deduction ', d(138) write(*,2) write(*,*) 'Alternative Minimum Income Tax ' write(*,2) ' AMT Bracket Rate ', d(99)*100 write(*,2) ' AMT Phaseout ', d(99)*100*(d(9)-1.) write(*,2) if(d(119).eq.0) then write(*,*) 'Only Regular Tax Relevant' else write(*,*) 'Only AMT Rate Relevant' endif write(*,2) ' Total Marginal Rate: ', d( 72) write(*,2) ' FICA (t,s): ', d148,d149 endif 2 format( 3x,a31,f11.2,1x,f11.2) 6 format( 3x,a29,f14.0) 21 format( 3x,a43) 3 format( 3x,a31,i11) 5 format( 3x,a31,i11,8x,a20) 200 format(f14.0,i5,i3,2(1x,f13.2),1x,f10.2,3(1x,f6.2),34(1x,f14.2)) c200 format(f0.0,1x,2(i0,1x),40(f0.2,1x)) 201 format(f0.0,2i12,7f13.2/4(10f13.2/)/) return end c **************************************************************************** c 2018 OLD Tax law c FEDERAL TAX LAW 1960 to 2023 do not rename c150 (Inna 09.07.2016) c Modified 01/08/2018 extnd(88) National Bureau of Economic Research c use extnd if you need :8,21 through 36,62, and 67 c amtsep in 2018 is subject to change to a real amount of F6251 for amtsep $251,450 is my guess c 2017 through 2018 eapct set to 2016 value. Please fix when actual numbers come up c **************************************************************************** c subroutine nlaw(data,lawyr) implicit double precision (A-H,O-Z) common /newshr/ comnew(255) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) dimension data(255) integer lawyr do 1 i=1,255 1 comnew(i)=0. c if (lawyr.lt.1960.or.lawyr.gt.2023) then 91236 write (*,*) 'LAWYR ',lawyr,' must be in range [1960 .. 2023]' stop 666 endif mst = data(2) if (mst.lt.1.or.mst.gt.7) then 91237 write(0,*) 'Marital Status must be in range [1..7] ' 91238 write(0,*) 'Year',data(103),' Value',mst,' Record ID',data(100) continue endif data(3) = 1. if(mst.eq.3.or.mst.eq.6) data(3) = 2. i = extnd(49) if(i.gt.0) then datai = data(i) data(i) = 0. endif if (lawyr.le.1976) call law60(data,lawyr) if (lawyr.ge.1977.and.lawyr.le.1986) call law79(data,lawyr) if (lawyr.ge.1987.and.lawyr.le.2023) call law87(data,lawyr) if(comnew(29).eq.0.) comnew(100)=0. if(i.gt.0) data(i) = datai c return end c c ****************************************************************** c Payroll Tax Calculator for tax Years 1960 to 2013 c Share of husband/wives wages gotten from data(201) c Payroll tax value returned by comnew(75) c Employer contributions are fully borne by employee c ******************************************************************* subroutine sstax(data,lawyr) implicit double precision (A-H,O-Z) dimension data(255) dimension himax(1960:2018),trate(1960:2018) dimension hrate(1960:2018),strate(1960:2018),shrate(1960:2018) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) common /xndxac/ xndxa(1981:2023) common /ssmaxa/ ssmax(1960:2025) common /newshr/ comnew(255) common /ssa/ &fica,fica1,fica2,oas,oas1, oas2,oasw1,oasw2,oasb1,oasb2, 1c11,c12,hi,hi1,hi2, hiw1,hiw2,hib1,hib2,earn, 2earn1,earn2,smax,hmax,wages, wage1,wage2,owrate,obrate,hwrate, 3hbrate data himax/ 6 4800., 4800., 4800., 4800., 4800., 6 4800., 6600., 6600., 7800., 7800., 7 7800., 7800., 9000., 10800., 13200., 7 14100., 15300., 16500., 17700., 22900., 8 25900., 29700., 32400., 35700., 37800., 8 39600., 42000., 43800., 45000., 48000., 9 51300., 125000., 130200., 135000., 9e10 , 9 9e10 , 9e10 , 9e10 , 9e10 , 9e10 , & 9e10 , 9e10 , 9e10 , 16* 9e10/ c c trate is the total tax rate (OASDI plus HI) c hrate is the HI rate c note that in 1984, employer contribution was only 6.7% c data trate/ 6 .03000, .03000, .03125, .03625, .03625, 6 .03625, .04200, .04400, .04400, .04800, 7 .04800, .05200, .05200, .05850, .05850, 7 .05850, .05850, .05850, .06050, .06130, 8 .06130, .06650, .06700, .06700, .07000, 8 .07050, .07150, .07150, .07510, .07510, 9 .07650, .07650, .07650, .07650, .07650, 9 .07650, .07650, .07650, .07650, .07650, & .07650, .07650, .07650, 8*.07650,2*.06650, & 6*.07650 / data hrate/ 6 .00000, .00000, .00000, .00000, .00000, 6 .00000, .00350, .00500, .00600, .00600, 7 .00600, .00600, .00600, .01000, .00900, 7 .00900, .00900, .00900, .01000, .01050, 8 .01050, .01300, .01300, .01300, .01300, 8 .01350, .01450, .01450, .01450, .01450, 9 .01450, .01450, .01450, .01450, .01450, 9 .01450, .01450, .01450, .01450, .01450, & .01450, .01450, .01450, 16*.01450/ c c Self Employment rates, strate is total tax rate, shrate is HI rate c in 1984-1989, there was a non-refundable credit? c 2.7%(1984), 2.3%(1985) and 2.0%(1986-9) c data strate/ 6 .04500, .04500, .04700, .05400, .05400, 6 .05400, .06150, .06400, .06400, .06900, 7 .06900, .07500, .07500, .08000, .07900, 7 .07900, .07900, .07900, .08100, .08100, 8 .08100, .09300, .09350, .09350, .11300, 8 .11800, .12300, .12300, .13020, .13020, 9 .15300, .15300, .15300, .15300, .15300, 9 .15300, .15300, .15300, .15300, .15300, & .15300, .15300, .15300, 8*.15300,2*.14300, &6*.15300/ data shrate/ 6 .00000, .00000, .00000, .00000, .00000, 6 .00000, .00350, .00500, .00600, .00600, 7 .00600, .00600, .00600, .01000, .00900, 7 .00900, .00900, .00900, .01000, .01050, 8 .01050, .01300, .01300, .01300, .02600, 8 .02700, .02900, .02900, .02900, .02900, 9 .02900, .02900, .02900, .02900, .02900, 9 .02900, .02900, .02900, .02900, .02900, & .02900, .02900, .02900, 16*.02900/ c mst = data(02) wages = data(11) if(lawyr.le.1989) then bus = max(0.0d0,data(17)+data(21)) else bus = .9235*max(0.0d0,data(17)+data(21)) endif if(mst.ne.2) then wage1 = wages wage2 = 0. bus1 = bus bus2 = 0. else wage1 = data(85) wage2 = data(86) if(data(85).lt.data(86)) then bus2 = bus bus1 = 0. else bus1 = bus bus2 = 0. endif endif earn = bus+wages earn1 = wage1+bus1 earn2 = wage2+bus2 c oas1 = 0. oas2 = 0. hi1 = 0. hi2 = 0. smax = ssmax(lawyr) if(lawyr.le.2018) then owrate = 2.*(trate(lawyr)-hrate(lawyr)) obrate = strate(lawyr)-shrate(lawyr) hwrate = 2.*hrate(lawyr) hbrate = shrate(lawyr) hmax = himax(lawyr) else owrate = 2.* (trate(2018)-hrate(2018)) obrate = (strate(2018)-shrate(2018)) hwrate = 2.*hrate(2018) hbrate = shrate(2018) hmax = himax(2018)*xndxa(lawyr)/xndxa(2018) endif c r1o=0. r1h=0. r2o=0. r2h=0. if (wage1.ge.smax) then oasw1 = owrate*smax oas1 = oasw1 elseif (earn1.ge.smax) then oasw1 = owrate*wage1 oasb1 = obrate*(smax-wage1) oas1 = oasw1+oasb1 else oasw1 = owrate*wage1 oasb1 = obrate*bus1 oas1 = oasw1+oasb1 r1o = owrate endif if (wage1.ge.hmax) then hiw1 = hwrate*hmax hi1 = hiw1 elseif (earn1.ge.hmax) then hiw1 = hwrate*wage1 hib1 = hbrate*(hmax-wage1) hi1 = hiw1+hib1 else hiw1 = hwrate*wage1 hib1 = hbrate*bus1 r1h = hwrate hi1 = hiw1+hib1 endif c if (wage2.ge.smax) then oasw2 = owrate*smax oas2 = oasw2 elseif (earn2.ge.smax) then oasw2 = owrate*wage2 oasb2 = obrate*(smax-wage2) oas2 = oasw2+oasb2 else oasw2 = owrate*wage2 oasb2 = obrate*bus2 oas2 = oasw2+oasb2 r2o = owrate endif if (wage2.ge.hmax) then hiw2 = hwrate*hmax hi2 = hiw2 elseif (earn2.ge.hmax) then hiw2 = hwrate*wage2 hib2 = hbrate*(hmax-wage2) hi2 = hiw2+hib2 else hiw2 = hwrate*wage2 hib2 = hbrate*bus2 r2h = hwrate hi2 = hiw2+hib2 endif c oas = oas1+oas2 c Additional Medicare Tax .9% on earned income if(lawyr.ge.2013) then thres = 200000. if(mst.eq.2.or.data(3).eq.2) & thres = 250000./data(3) addmtx = 0. addmtx = .009*max(0.0d0,wages - thres) + & .009*max(0.0d0,bus - max(0.0d0,thres - wages)) if(addmtx.gt.0) then r1h = r1h + .009 r2h = r2h + .009 hi1 = hi1 + addmtx*(wage1 + bus1)/(wages+bus) hi2 = hi2 + addmtx*(wage2 + bus2)/(wages+bus) endif endif hi = hi1+hi2 sur1 = 0. sur2 = 0. brk = extnd(37) if(brk.gt.0) then sur1 = owrate*max(0.0d0,earn1-brk) sur2 = owrate*max(0.0d0,earn2-brk) fica = fica + sur1 + sur2 if(sur1.gt.0) r1o = owrate if(sur2.gt.0) r2o = owrate endif fica1 = oas1+hi1+sur1 fica2 = oas2+hi2+sur2 fica = oas+hi if(fica.le.0) fica = 0. comnew(75) = fica comnew(148) = r1o+r1h comnew(149) = r2o+r2h comnew(150) = 0 if(earn.gt.0) & comnew(150) = comnew(148)*earn1/earn + comnew(149)*earn2/earn c SE tax calculation based on reported 'wages' and 'bus' exwage = max(0.d0,smax-wages) bussst = .124*min(exwage,bus) busmed = .029*bus setax = bussst + busmed comnew(175) = setax c Self-Employment Income Imputation if(data(43).gt..153*smax) then sey = (data(43) - .124*smax)/(.029*.9235) else sey = data(43)/(.153*.9235) endif if(lawyr.eq.2011.or.lawyr.eq.2012) then if(data(43).gt..133*smax) then sey = (data(43) - .104*smax)/(.029*.9235) else sey = data(43)/(.133*.9235) endif endif comnew(76) = sey return end c c c ****************************************************************** c 1960 to 1979 Law (1979 law is not used) c ****************************************************************** c subroutine law60(data,lawyr) implicit double precision (A-H,O-Z) dimension data(255) dimension ebs(1971:1979),ebm(1971:1979),ebh(1971:1979), & ebsep(1971:1979) dimension eas(1971:1979),eam(1971:1979),eah(1971:1979), & easep(1971:1979) integer sepret, lawyr double precision kghlim,ira,keogh,ints,iralim,iramax double precision invest common /newshr/ &tax ,agi,zbr,divall,fullcg, capgn,capded,schede,com09,retlim, 1iralim,ira,kghlim,keogh,com15, dislim,adjust,drugs,hins,edical, 2cash,asset,char,deduc,polcon, cded,taxy,regtax,taxinc,deducp, 3dedint,twoded,almpay,dedphs,exded, pref,earned,psinc,com39,com40, 4eacc,eti,etax,avrinc,acgtax, acgsav,avrtax,calt,com49,altax, 5gencr,taxbc,chcr,elder,exagi, edcred,candid,credit,earncr,taxsoi, 6eitc,offset,addmin,addtax,ti, rgrate,yad,exemps,alminy,almtax, 7com71,rate,com73,statax,fica, com76,pretax,untax,ssagi,excess, 8chcred,disab,amex,ssa,com85, c86,capinc,c88,c89,bp, 9 c91, c92, c93, c94, c95, c96, c97, c98,almrat,regrat, &c101,c102,c103,c104,c105,c106,pira,rira,pdical,rdical, &pchar,rchar,c113,c114,pchild,rchild,peic,reic,palm,ralm, &c121,c122,c123,c124,c125,c126,c127,c128,c129,c130, &c131,c132,punemp,runemp,pold,rold,pzbr,rzbr,petax,retax, &pgen,rgen,c143,c144,c145,c146,c147,c148,c149,c150, &c151,c152,c153,taxaft,taxnoa,c156,c157,c158,c159,c160, &c161,c162,c163,c164,c165,c166,c167,c168,c169,c170, &c171,c172,c173,c174,c175,c176,zbrst,comadd(78) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) data ebs/6*38000.,2*40200.,41500./ data ebm/6*52000.,2*55200.,60000./ data ebh/6*38000.,2*40200.,44700./ data ebsep/8*26000.,28300./ data eas/8*13290.,13392./ data eam/8*18060.,19678./ data eah/8*12240.,13961./ data easep/8*9030.,9839./ c Marital status and sepret mstat=data(2) sepret=1 nfile=2 if(mstat.eq.1) then nfile=1 elseif((mstat.eq.3).or.(mstat.eq.6)) then sepret=2 elseif(mstat.eq.4.or.mstat.eq.7) then nfile=3 endif c Taxable income div = data(12) divexc = 50. if(mstat.eq.2) divexc = 2*divexc if(lawyr.gt.1964) divexc = 2*divexc if(data(176)+data(177).gt.0.0d0) then divall = max(0.0d0,data(176)+data(177)-divexc) else divall = max(0.0d0,data(12)-divexc) endif ints=data(14) c capgn- taxable capital gains and losses. Schedule D. capded = 0. caprat = .6 if(lawyr.lt.1978) caprat = .5 if(lawyr.eq.1978) caprat = .167 * .6 + .833 * .5 if(lawyr.ge.1978) clslim = -3000./sepret if(lawyr.eq.1977) clslim = -2000./sepret if(lawyr.le.1976.and.lawyr.ge.1971) clslim = -1000./sepret if(lawyr.le.1970) clslim = -1000. fullcg=data(68)+data(70) capgn = fullcg if(fullcg.gt.0.) then if(data(70).gt.0.) then capded=caprat*data(70) if(data(68).lt.0.) & capded= max(0.0d0,fullcg*caprat) capgn=fullcg-capded endif else if(lawyr.le.1976) then capgn =max(clslim,fullcg) else if(data(70).lt.0.) capgn = 0.5*fullcg if((data(68).lt.0).and.(data(70).lt.0.)) & capgn=.5*data(70)+data(68) capgn = max(clslim,capgn) endif endif c schedule e income schede=data(72)+data(73)+data(74)+data(75)+data(77)+data(79) c ti - total income after exclusions ti=divall+capgn+schede+data(11)+ints+data(17)+ &(1.-caprat)*data(18)+ &data(19)+data(20)+data(21)+data(22)+data(23)+data(24) earned = data(11)+max(0.0d0,data(17)) unearn = ti-earned c Adjustments to income 1960-79 bus=data(17)+data(75)+data(79)+data(21) retlim=max(0.0d0,.15*bus) c kghlim=min(retlim,7500.0d0)*data(7) kghlim=7500*data(7) keogh=min(data(28),kghlim) ira=0. busnet=0. iramax=0. iralim=0. if(lawyr.ge.1975) then iramax=3000./sepret busnet=max(0.0d0,bus-keogh) iralim=min(data(11)+busnet,iramax) ira=min(data(29),iralim) endif preagi = divall+capgn+schede+data(11)+ints+data(17)+(1.-caprat)* & data(18)+ data(19)+data(20)+data(21)+data(22)+data(23)+data(24)- & (ira+data(26)+data(27)+keogh+data(30)-data(62)) exagi = max(0.0d0,preagi - 15000.) untax = 0. dislim = max(0.0d0,5200. - exagi) disab = min(dislim,data(25)) twoded = 0. if (mstat.eq.2.and.lawyr.ge.1982) then wife = min(data(85),data(86)) twoded = min(3000.0d0,.1*wife) if (lawyr.eq.1982) twoded = min(1500.0d0,.05*wife) endif adjust=ira+data(25)+data(26)+data(27)+keogh+data(30)+twoded if(lawyr.ge.1977) adjust = adjust + data(62) c AGI agi = ti-adjust agix = max(0.0d0,agi) alim50 = .5*agix c Schedule A c medical deductions drugs = max(0.0d0,data(48)-.01*agix) hins = min(150.0d0,.5*data(47)) edical = max(0.0d0,drugs+data(49)-.03*agix) if (lawyr.ge.1977) &edical = max(0.0d0,drugs+data(49)-.03*agix+data(47)-hins) edical=edical+hins c charity if(agi.lt.0) then cash = 0. asset = 0. else if(cash.gt.alim50) then cash = alim50 asset = 0. else unchar = alim50-cash asset = min(asset,alim50,unchar) asset = max(0.0d0,asset) endif endif char = cash + asset c casualty or theft loss cas = data(61) c political contributions if (lawyr.le.1974) then polcon = min(50.0d0,data(65)) if(mstat.eq.2) polcon = min(100.0d0,data(65)) else polcon = min(100.0d0,data(65)) if(mstat.eq.2) polcon = min(200.0d0,data(65)) endif dedint = data(56)+data(57) deduc=edical+polcon+char+data(50)+data(51)+data(52)+ &data(53)+data(54)+data(55)+dedint+ &cas+data(63)+data(66) c if(lawyr.eq.1973.or.lawyr.eq.1975) deduc = deduc+data(62) if(lawyr.le.1976) deduc = deduc+data(62) if(lawyr.le.1975) deduc = deduc+data(64) c zbr for [1977,1979] if(lawyr.eq.1978.or.lawyr.eq.1977) then zbr = 2200. if(nfile.eq.2) zbr = 3200./sepret endif if (lawyr.eq.1979) then zbr = 2300. if(nfile.eq.2) zbr = 3400./sepret endif c Exemptions for 1960-1976 exemps=data(7)+data(8)+data(9)+data(10) if(mstat.eq.6.and.(lawyr.ge.1969.and.lawyr.le.1971)) & exemps = exemps + 1 if((lawyr.le.1978).and.(lawyr.ge.1972)) then amex=750.*exemps else if(lawyr.eq.1971) then amex=675.*exemps else if(lawyr.eq.1970) then amex=625.*exemps else if(lawyr.le.1969) then amex=600.*exemps else amex=1000.*exemps endif if (lawyr.eq.1976) then if(nfile.eq.2) then zbr=max(min(2800.0d0/sepret,.16d0*agix),2100.0d0/sepret) else zbr=max(min(2400.0d0,.16*agix),1700.0d0) endif elseif (lawyr.eq.1975) then if(nfile.eq.2)then zbr=max(min(2600.0d0/sepret,.16*agix),1900.0d0/sepret) else zbr=max(min(2300.0d0,.16*agix),1600.0d0) endif elseif((lawyr.le.1974).and.(lawyr.ge.1972)) then zbr=max(min(2000.0d0/sepret,.15*agix),1300.0d0/sepret) elseif (lawyr.eq.1971) then zbr=max(min(1500.0d0/sepret,.13*agix),1050.0d0/sepret) elseif (lawyr.le.1970.and.lawyr.ge.1964) then zbr=max(min(1000.0d0/sepret,.1*agix),min(1000.0d0/sepret, & 200./sepret+100.*exemps)) elseif (lawyr.le.1963) then zbr=min(1000.0d0/sepret,.1*agix) endif c zbrst for state purposes zbrst = zbr c deduc calculated to be the greater of total allowed c itemized deductions or the standard deduction c data(4) fixes the itemizer status of the individual for marginal c tax rate calculations if the value is -1 or -2 cded = 0. excess = 0. c if(data(4).eq.-1.) zbr = 0. c if(data(4).eq.-2.) deduc = 0. taxy=0. pzbr=0 if (lawyr.ge.1977) then if (deduc.gt.zbr) then cded=1. excess = deduc - zbr endif add105 = 0. if (data(105).gt.0..and.unearn.ge.1000.) then c subtract ira so that when ira is limited by earnings, tax be smooth tmp105 = earned - ira if (cded.gt.0.) tmp105 = max(tmp105,deduc) add105 = max(0.0d0,zbr-tmp105) endif yad = agi - deduc + zbr taxy = agi - excess - amex + add105 if(taxy.lt.0) zbr = max(0.0d0,zbr + taxy) if(taxy.lt.0.and.zbr.gt.0) pzbr=1 taxy = max(0.0d0,taxy) taxinc = max(0.0d0, agi - excess - zbr - amex) else yad = agi - deduc if (deduc.gt.zbr) then cded = 1. taxinc = max(0.0d0,agi-deduc-amex) else deduc=0. cded=0. taxinc = max(0.0d0,agi-zbr-amex) endif endif c deducp = deduc dedphs = 0. if(lawyr.le.1970.and.sepret.eq.2) then nfile1 = 1 else nfile1 = nfile endif c Don't itemize unless this is a benefit if(cded.gt.0.and.taxinc.eq.0.and.agi-amex-zbr.le.0) then cded = 0. deduc= 0. excess =0. endif c Tax table calls if (lawyr .le. 1963) & call tax62(regtax,regrat,nfile1,taxinc) if (lawyr.eq.1964) & call tax64(regtax,regrat,nfile1,taxinc) if (lawyr.ge.1965.and.lawyr.le.1970) & call tax70(regtax,regrat,nfile1,taxinc) if (lawyr.ge.1971.and.lawyr.le.1976) & call tax74(regtax,regrat,nfile1,sepret,taxinc) if(lawyr.eq.1977.or.lawyr.eq.1978) & call rtax77(regtax,regrat,nfile1,sepret,taxy) if(lawyr.eq.1979) & call rtax79(regtax,regrat,nfile1,sepret,taxy) if(taxinc.eq.0) regrat=0. rgrate = regrat*100 c Alternative computation of tax (for capital gains) acgtax = -1. garb=0. garb1=0. garb2=0. if (fullcg.gt.0..and.lawyr.le.1978) then cg1 = max(taxinc - capded,0.0d0) if (lawyr.eq.1977.or.lawyr.eq.1978) then cg1 = max(taxy - capded,0.0d0) call rtax77(cgtx1,garb1,nfile1,sepret,cg1) else if(lawyr.ge.1971.and.lawyr.le.1976) then call tax74 (cgtx1,garb1,nfile1,sepret,cg1) else if(lawyr.ge.1965.and.lawyr.le.1970) then call tax70 (cgtx1,garb1,nfile1,cg1) else if(lawyr.eq.1964) then call tax64 (cgtx1,garb1,nfile1,cg1) else call tax62 (cgtx1,garb1,nfile1,cg1) endif cgtx2 = .5*capded cgtx3 = 0. if(min(data(70),data(68)+data(70)).gt.50000/data(3)) then if(lawyr.eq.1970) then c year 1970 call tax70(xl32,garb,nfile1,max(taxinc,capded)) call tax70(xl33,garb,nfile1, & max(taxinc - capded + 25000/data(3),0.0d0)) cgtx2 = min(max(0.0d0,xl32 - xl33), & .295*max(0.0d0, & min(data(70),data(68)+data(70))-50000/data(3))) call tax70(cgtx1,garb1,nfile1,cg1) cgtx3 = .25*50000/data(3) else if (lawyr.eq.1971) then c year 1971 call tax74(xl32,garb,nfile1,sepret,max(taxinc,capded)) call tax74(xl33,garb,nfile1,sepret, & max(taxinc - capded + 25000/data(3),0.0d0)) cgtx2 = min(max(0.0d0,xl32 - xl33), & .325*max(0.0d0, & min(data(70),data(68)+data(70))-50000/data(3))) call tax74(cgtx1,garb1,nfile1,sepret,cg1) cgtx3 = .25*50000/data(3) else if (lawyr.ge.1972.and.lawyr.le.1975) then c year 1972-1975 call tax74(xl32,garb,nfile1,sepret,max(taxinc,capded)) call tax74(xl33,garb,nfile1,sepret, & max(taxinc - capded + 25000/data(3),0.0d0)) cgtx2 = max(0.0d0,xl32 - xl33) call tax74(cgtx1,garb1,nfile1,sepret,cg1) cgtx3 = .25*50000/data(3) endif endif if(lawyr.ge.1976.and.lawyr.le.1978) then c years 1976-1978 if(lawyr.ge.1977) then c years 1977-1978 if (capded * 2..le.50000./sepret) go to 424 call rtax77(cgtx31,garb,nfile1,sepret,taxinc) call rtax77(cgtx32,garb2,nfile1,sepret,cg1+25000./sepret) c Computation of cgtx3 in Alternative Tax 1975 (Sch.D) else c years 1976 c Refund half tax on sale of principal residence subd = data(71) cg3 = max(taxinc,capded) if (subd.le.50000./sepret) go to 424 subd = 50000./sepret call tax74 (cgtx31,garb,nfile1,sepret,cg3) call tax74 (cgtx32,garb2,nfile1,sepret,cg1+subd*0.5) endif cgtx2 = max(12500.0d0/sepret,cgtx2) cgtx3 = max(0.0d0,cgtx31 - cgtx32) endif 424 acgtax = cgtx1 + cgtx2 + cgtx3 endif c Preference Income pref = 0. if (lawyr.le.1978) then exded = deduc - edical - data(62)-.6*agi if (exded.gt.agi*.4) exded = agi *.4 if (exded.lt.0..or.cded.lt.1.) exded = 0. pref = capded + data(18)+data(81)+data(82)-data(83)+ & data(84)-data(87)+exded+data(95) endif pref = max(0.0d0,pref) if (lawyr.eq.1979) then prfded = 0. prfddy = 0. prfded = deduc - edical - data(61) - data(50) prfddy = agi - edical - data(61) - data(50) prfddy = max(0.0d0,prfddy) exded = prfded - .6*prfddy if (exded.lt.0..or.cded.lt.1.) exded = 0. endif c Maximum tax on earned income, data94 is personal service income etax = -1. if (lawyr.le.1979.and.lawyr.ge.1971) then if(mstat.eq.1) then ebot = ebs(lawyr) eacc = eas(lawyr) else if(mstat.eq.2.or.mstat.eq.5) then ebot = ebm(lawyr) eacc = eam(lawyr) else if(mstat.eq.4.or.mstat.eq.7) then ebot = ebh(lawyr) eacc = eah(lawyr) else ebot = ebsep(lawyr) eacc = easep(lawyr) endif psinc = earned + max(0.0d0,data(75))+ & data(20)+data(72)-data(138) if(agi.gt.0) psinc = twn(psinc,0.0d0,agi) if (sepret.eq.2) go to 444 if (agi.ne.0.) go to 4422 eratio = 1.0 go to 4424 4422 eratio = min(psinc/agi,1.0d0) if (agi.le.0.) go to 444 if (eratio.le.0..or.agi.le.0.) goto 444 4424 if(lawyr.le.1976) then eti = taxinc*eratio - (max(0.0d0,pref-30000.)) etinc = eti else if(lawyr.ge.1977.and.lawyr.le.1978) then eti = taxy*eratio-pref etinc = eti - zbr else eti = taxinc*eratio-pref etinc = eti endif etop = eti - ebot if (etop.le.0.) go to 444 if (lawyr.ge.1971.or.lawyr.le.1976) & call tax74(partax,z,nfile1,sepret,etinc) if (lawyr.eq.1977.or.lawyr.eq.1978) & call tax77(etinc,sepret,nfile,z,partax) if (lawyr.eq.1979) call tax79(etinc,sepret,nfile,z,partax) if(lawyr.ge.1972) etax = regtax - partax + .5*etop +eacc if(lawyr.eq.1971) etax = regtax - partax + .6*etop +eacc endif 444 continue c Income Averaging 1960-79 if (lawyr.lt.1965) go to 462 if (data(96).lt.0.) go to 462 avrinc = taxinc - .3*data(96) if (avrinc.lt.3000.) go to 462 c Income Averaging 1965 - 1970 only if (lawyr.ge.1965.and.lawyr.le.1970) then call tax70(atax1,arate1,nfile1,.3*data(96)+.2*avrinc) call tax70(atax2,arate2,nfile1,.3*data(96)) endif c Income Averaging 1971 - 1976 only if (lawyr.ge.1971.and.lawyr.le.1976) then call tax74(atax1,arate1,nfile1,sepret,.3*data(96)+.2*avrinc) call tax74(atax2,arate2,nfile1,sepret,.3*data(96)) endif c Income Averaging 1977 - 1978 only if (lawyr.ge.1977.and.lawyr.le.1978) then call rtax77(atax1,arate1,nfile1,sepret,.3*data(96)+.2*avrinc) call rtax77(atax2,arate2,nfile1,sepret,.3*data(96)) endif c Income Averaging 1979 only if (lawyr.eq.1979) then call rtax79(atax1,arate1,nfile1,sepret,.3*data(96)+.2*avrinc) call rtax79(atax2,arate2,nfile1,sepret,.3*data(96)) endif c avrtax = 4.*(atax1 - atax2) + atax1 go to 464 462 avrtax = -1. 464 continue c Combine alternative tax c calt = 0 regtax c = 1 alternative tax on gains c = 2 maximum tax c = 3 (1) and (2) c = 4 average tax altax = regtax calt = 0. acgsav = 0. if(acgtax.gt.0) then acgsav = max(0.0d0,regtax-acgtax) altax = regtax-acgsav calt = 1. endif if (etax.gt.0) then if (etax.lt.altax) then altax = etax calt = 2. endif if (etax.lt.regtax.and.acgsav.gt.0) then altax = etax - acgsav calt = 3. endif endif if (avrtax.gt.-1.and.avrtax.lt.altax) then altax = avrtax calt = 4. endif tax = altax c IRA marginal rate rira=0. pira=0. if(ira.gt.0.and.data(11)+busnet.lt.iramax.and. &data(29).gt.iralim) then pira=1. rira = -rgrate endif c Charitable contributions marginal rate rchar=0. pchar=0. if(cded.gt.0..and.char.gt.0.and.agi.gt.0.) then if(cash.gt..5*agi) then rchar=.5*rgrate pchar=1. else if(.5*agi.lt.data(59)+data(60).or. & (unchar.lt.data(59)+data(60).and.unchar.gt.0.))then rchar=.5*rgrate pchar=1. endif endif endif c Marginal rate for zbr for years before 1976 rzbr=0 if(cded.lt.1.and.calt.ne.2.and.pira.eq.0) then if (lawyr.eq.1976.and. & ((nfile.eq.2.and.2800./sepret.gt..16*agix.and. & .16*agix.gt.2100./sepret).or.(nfile.ne.2.and. & 2400.gt..16*agix.and..16*agix.gt.1700))) then pzbr=1 rzbr=rgrate*.16 elseif (lawyr.eq.1975.and. & ((nfile.eq.2.and.2600./sepret.gt..16*agix.and. & .16*agix.gt.1900./sepret).or.(nfile.ne.2.and. & 2300.gt..16*agix.and..16*agix.gt.1600))) then pzbr=1 rzbr=rgrate*.16 elseif(lawyr.le.1974.and.lawyr.ge.1972.and. & 2000./sepret.gt..15*agix.and. & .15*agix.gt.1300./sepret) then pzbr=1 rzbr=rgrate*.15 elseif (lawyr.eq.1971.and. & 1500./sepret.gt..13*agix.and. & .13*agix.gt.1050./sepret) then pzbr=1 rzbr=rgrate*.13 elseif (lawyr.le.1970.and.lawyr.ge.1964.and. & 1000./sepret.gt..1*agix.and. & .1*agix.gt.min(1000.0d0/sepret,200./sepret+100.*exemps)) then pzbr=1 rzbr=rgrate*.1 elseif (lawyr.le.1962.and.1000./sepret.gt..1*agix) then pzbr=1 rzbr=rgrate*.1 endif endif c Medical deduction marginal rate pdical=0. rdical=0. if(cded.gt.0.) then if(edical-hins.gt.0) then pdical=1. if(rate.gt.0.) then rdical=.03*rgrate if(data(48).gt..01*agix) rdical=.04*rgrate endif endif endif rate=rgrate+rira+rdical-rchar-rzbr if(lawyr.le.1981.and.calt.eq.1.and.acgtax.lt.regtax. & and.pira.eq.0) then rate=garb1*100*(1+pdical*.03-pchar*.5) if(lawyr.ge.1977) & rate=(garb1+garb-garb2)*100*(1+pdical*.03-pchar*.5) endif c Marginal Tax Rate on Maximum Tax on Earned Income petax=0 retax=0. if((calt.eq.2.or.calt.eq.3).and.agi.gt.0) then petax=1. c f= (taxinc+psinc)/agi -taxinc*psinc/(agi*agi) c retax=(f*(regrat-z+.5)+(1-f)*regrat)*100 c retax=100*(regrat-z+.5+(agi-psinc)*(agi-taxinc)*(z-.5)/ c &(agi*agi)) rpref=0. if(lawyr.le.1978.and.exded.gt.0) then rpref=-.6 if(edical.gt.0) rpref=-.57 if(exded.gt..4*agi) rpref=.4 endif retax=100*(regrat-z+.5+(z-.5)*((agi-psinc)*(agi-taxinc)/ &(agi*agi)+rpref)) c if(lawyr.eq.1979.and.regrat.eq.z) retax=100*(regrat-z+.5) if(calt.eq.3) & retax=retax-100*max(0.0d0,regrat-garb1) if(pira.eq.0) rate=retax*(1+pdical*.03-pchar*.5) if(pira.eq.1) rate=retax+rira endif c Tax Surcharge if(lawyr.eq.1968) then tax = 1.075 * tax rate = 1.075 *rate else if(lawyr.eq.1969) then tax = 1.1 * tax rate = 1.1 * rate else if(lawyr.eq.1970) then tax = 1.025 * tax rate = 1.025 *rate endif taxbc = tax c General tax credit 1976-1978 or c $30 personal exemption credit for 1975 gencr = 0. if(lawyr.eq.1975) then gencr = 30.*exemps else if(lawyr.ge.1976.and.lawyr.le.1978) then gencr = max (35.*exemps, min(180.0d0,.02*taxinc)) endif c Credits c Child care credit chr = 20% for 1976-1979 chcr = 0. chwage = 0. chmax = 0. ncccr = 0 if(data(207).gt.0) then ncccr = min(data(207),2.0d0) else ncccr = min(data(8),2.0d0) endif if (lawyr.ge.1976) then if (ncccr.eq.1) chmax = 2000. if (ncccr.eq.2) chmax = 4000. chwage = max(0.0d0,data(11)+data(17)) if(chwage.le.0) chwage = 0. child = min(chmax,chwage,data(64)) chr = 0.2 chcr = child * chr endif c Limits for elderly exagi=0. eldlim = 0. if (lawyr.ge.1976) then exagi = agi - 10000./sepret if (nfile.eq.2) exagi = agi - 7500. if (exagi.lt.0) exagi = 0. eldlim = 2500. if ((nfile .eq. 2).and.(data(09).gt.1).and.(sepret.eq.1)) & eldlim = 3750. if ((nfile .eq. 2).and.(data(09).eq.1).and.(sepret.eq.2)) & eldlim = 1875. eldlim = .15*(eldlim - .5*exagi) if (eldlim.lt.0) eldlim = 0. elder = min(data(32),eldlim) else elder = data(32) endif c Credit for contributions to candidates for public office if (lawyr.ge.1972) then canlim =25. if(lawyr.eq.1979) canlim = 50. if (mstat.eq.2.) canlim = 2*canlim candid = min(canlim,data(35)/2) else candid = 0. endif c Investment Credit invest =data(33) c Foreign Tax Credit forgn = 0. if (lawyr.gt.1962) forgn = data(34) c Win Credit win = 0. if (lawyr.gt.1971) win =data(36) c Retirement income credit or Jobs Credit if (lawyr.eq.1960.or.lawyr.eq.1969.or.lawyr.eq.1976) then jobs = 0. else jobs =data(37) endif c Residential Energy Credit energy = 0. if (lawyr.gt.1974) energy =data(38) credit = chcr+candid+elder+gencr+win+energy+invest+ & forgn+jobs+data(40) if(credit.ge.tax) rate=0. crdnoa = credit if(taxbc.le.crdnoa) crdnoa = taxbc credit = max(0.0d0,min(credit,tax)) tax = max(0.0d0,tax-credit) taxaft = tax c Marginal Tax Rate for Child Care Credit pchild = 0. rchild = 0. if(chcr.gt.0.and.chwage.lt.chmax.and.chwage.lt.data(64). & and.tax.gt.0) then pchild=1 rchild=20. endif c Marginal rate for elderly credit pold=0. rold=0. if(taxbc.gt.credit.and.eldlim.gt.0.and.eldlim.lt.data(32). & and.exagi.gt.0) then pold=1. rold=.15*.5*100 if(pira.eq.1) rold=0. endif c Marginal rate for General Tax Credit pgen=0 rgen=0 if (lawyr.ge.1976.and.lawyr.le.1978.and.tax.gt.0) then if(mstat.eq.2.or.mstat.eq.5) then if(.02*(taxinc-3200.).lt.180.and.gencr.gt.35.*exemps) then pgen=1 rgen=.02*100*(1.-pchar*.5) endif else if(.02*(taxinc-2200.).lt.180/data(3).and.gencr.gt. & 35*exemps) then pgen=1 rgen=.02*100*(1.-pchar*.5) endif endif endif rate=rate+rold-rgen-rchild c Earned Income Tax Credit earncr = 0. crmax = 400. ymax = 4000. rtbase = .1 rtless = .1 c amax = 8000. if(lawyr.eq.1979) then crmax = 500. ymax = 6000. rtbase = .1 rtless = .125 c amax = 10000. endif peic=0 reic=0. if(lawyr.ge.1975) then earncr = min(crmax,rtbase*earned) ncr=0 if(earncr.lt.crmax) ncr=1 if (agi.gt.ymax.or.earned.gt.ymax) & earncr = max(0.0d0,earncr-rtless*(max(earned,agi)-ymax)) if (data(3).eq.2.or.data(8).eq.0.or.data(105).gt.0) earncr=0. if(data(202).lt.0) earncr = 0. if(earncr.le.0) earncr = 0. if(earncr.gt.0..and.earncr.lt.crmax)then reic=-rtbase peic=1. if((agi.gt.ymax.or.earned.gt.ymax).and.earncr.gt.0) then if(ncr.eq.1)reic=-rtbase+rtless if(ncr.eq.0)reic=rtless if(agi.gt.earned) then if(ncr.eq.1)reic=(-rtbase+rtless)*(1+.5*punemp) if(ncr.eq.0)reic=rtless*(1+.5*punemp) endif endif endif reic=reic*100 endif rate=rate+reic c Minimum tax 1970-79 almtax = 0. addmin = 0. if(taxbc.le.chcr + candid + elder) then credm = chcr + candid + elder - taxbc else credm = 0. endif c credm = chcr + candid + elder + data(38) if(lawyr.le.1975) then offset = 30000./data(3)+ & tax+data(39)+data(40)+data(42)+data(80)-credit addmin = max(0.0d0,(data(81)+ capgn - offset)*.10-credm-gencr) else offset = .5*(tax+data(39)+data(40)+data(42) - credit) if (offset.lt.10000./sepret) offset= 10000./sepret if(lawyr.le.1978) then addmin = max(0.0d0,(data(81) + capgn - offset)*.15 - credm) else c Capital Gains are preferance items for the AMT since 1979 addmin = max(0.0d0,(data(81) - offset)*.15 - credm) endif endif ralm=0. palm=0. if (lawyr.ge.1979) then alminy = agi-amex-excess-zbr+capded+(1.-caprat)* & data(18)+data(116) almtax = .1*(max(alminy-20000./sepret,0.0d0))+ & .1*(max(alminy-60000./sepret,0.0d0))+ & .05*(max(alminy-100000./sepret,0.0d0)) almtax = max(0.0d0,almtax-data(39)-addmin-tax) almtax = max(0.0d0,almtax - data(34)) if(almtax.gt.0) palm=1. tax = tax+almtax+addmin almrat=0.0d0 if(almtax.gt.0..and.alminy.gt.20000/sepret) almrat=.1d0 if(almtax.gt.0..and.alminy.gt.60000/sepret) almrat=.2d0 if(almtax.gt.0..and.alminy.gt.100000/sepret) almrat=.25d0 ralm=almrat*100 if(pira.eq.1) ralm=0 if(taxy.eq.0.and.excess.gt.0.and.zbr.gt.0) ralm=0. if(pdical.eq.1) then rdical=.03*almrat if(data(48).gt..01*agix) rdical=.04*almrat endif if(palm.gt.0.and.(rate.eq.0.or.addmin.eq.0.or. & (addmin.gt.0.and.offset.eq.10000/sepret))) rate=ralm+reic if(palm.gt.0.and.addmin.gt.0.and.offset.gt.10000/sepret) &rate=ralm+100*rdical if(palm.gt.0.and.pchar.gt.0) rate=.5*ralm if(pzbr.gt.0.and.palm.gt.0) rate=reic endif if (lawyr.ge.1969.and.lawyr.le.1978) tax = tax + addmin if (lawyr.ge.1969.and.lawyr.le.1979.and.addmin.gt.0. & and.almtax.lt.1) then if(offset.gt.10000/sepret) rate=rate-rate*.5*.15 if(chcr.gt.0) rate=rate-rchild endif c almtax = max(0.0d0,tax - taxaft) almpay = 0. if (almtax.gt.0.) almpay = 1. c taxsoi is the SOI definition of Total Tax, it does not include the c refundable portion of the EITC eitc = earncr if (tax.lt.eitc) then if (tax.gt.0.) eitc = tax if (tax.le.0.) eitc = 0. endif taxsoi = taxaft - eitc taxnoa = taxbc - crdnoa - earncr tax = tax - earncr pretax = max(regtax,altax,almtax,avrtax,(tax+eitc+credit)) if(palm.gt.0) ralm = ralm - rgrate if(data(100).eq.14482.and.data(103).eq.1971) then 91234 write(0,*) exemps,tax continue endif return end c *************************************************************************** c 1979 to 1986 Law c *************************************************************************** c subroutine law79(data,lawyr) implicit double precision (A-H,O-Z) dimension data(255) double precision ints,iramax,iralim,ira,keogh,kghmax,kghlim double precision jobs,invest,uxemp1(7),uxemp2(7) integer nfile,lawyr,datayr,sepret dimension ebs(1977:1981),ebm(1977:1981),ebh(1977:1981), & ebsep(1977:1981) dimension eas(1977:1981),eam(1977:1981),eah(1977:1981), & easep(1977:1981) logical in common /xndxac/ xndxa(1981:2023) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) common /newshr/ &tax,agi,zbr,divall,fullcg,capgn,capded,schede,c09,retlim, 1iralim,ira,kghlim,keogh,c15,dislim,adjust,drugs,hins,edical, 2cash,asset,char,deduc,polcon, cded,taxy,regtax,taxinc,deducp, 3dedint,twoded,almpay,dedphs,exded, pref,earned,psinc,com39,com40, 4eacc,eti,etax,avrinc,acgtax, acgsav,avrtax,calt,com49,altax, 5gencr,taxbc,chcr,elder,exagi, edcred,candid,credit,earncr,taxsoi, 6eitc,offset,addmin,addtax,ti, rgrate,yad,exemps,alminy,almtax, 7c71,rate,com73,statax,fica, c76,pretax,untax,ssagi,excess, 8chcred,disab,amex,ssa,c85, c86,capinc,c88,c89,bp, 9 c91, c92, c93, c94, c95, c96, c97,c98,almrat,regrat, &c101,c102,c103,c104,pssa,rssa,pira,rira,pdical,rdical, &pchar,rchar,c113,c114,pchild,rchild,peic,reic,palm,ralm, &c121,c122,c123,c124,pcasu,rcasu,pdisab,rdisab,c129,c130, &c131,c132,punemp,runemp,pold,rold,c137,c138,petax,retax, &c141,c142,c143,c144,c145,c146,c147,c148,c149,c150, &c151,c152,c153,c154,taxnoa,c156,c157,c158,c159,c160, &c161,c162,c163,c164,c165,c166,c167,c168,c169,c170, &c171,c172,c173,c174,c175,c176,zbrst,taxltg,comadd(77) data uxemp1 /20000.,25000.,3*20000.,0.,20000./ data uxemp2 /12000.,18000.,3*12000.,0.,12000./ data ebs/2*40200.,3*41500./ data ebm/2*55200.,3*60000./ data ebh/2*40200.,3*44700./ data ebsep/2*26000.,3*28300./ data eas/2*13290.,3*13392./ data eam/2*18060.,3*19678./ data eah/2*12240.,3*13961./ data easep/2*9030.,3*9839./ gencr = 0. xndx = 1. if (lawyr.eq.1985) xndx = 1.04 if (lawyr.eq.1986) xndx = 1.08 if (lawyr.eq.1987) xndx = 1.10 if (lawyr.eq.1988) xndx = 1.14 if (lawyr.eq.1989) xndx = 1.24 datayr = int(data(103)) mstat = data(2) sepret = data(3) nfile = int(filing(mstat,1.,2.,3.,2.)) c ints = data(14) if (lawyr.eq.1981) then divexc = 200. if (mstat.eq.2.) divexc = 400. else if(lawyr.eq.1979) then divexc = data(13) else divexc = 100. if (mstat.eq.2.) divexc = 200. endif if(lawyr.eq.1981) then if(data(176) + data(177).gt.0) then divall = max(0.d0,data(176) + data(177) + ints - divexc) else divall = max(0.0d0,data(12) + ints - divexc) endif ints = 0. else if(data(176) + data(177).gt.0) then divall = max(0.d0,data(176) + data(177) - divexc) else divall = max(0.0d0,data(12) - divexc) endif endif c c Capital gains c caprat = .6d0 if (lawyr.le.1977) caprat = .5d0 clslim = 2000./sepret if (lawyr.ge.1978) clslim = 3000./sepret fullcg = data(68)+data(70) c if(datayr.gt.1986.and.datayr.lt.1989) fullcg=fullcg+data(90) capgn = fullcg if (fullcg.gt.0.) then capded = caprat*min(max(0.0d0,data(70)),fullcg) capgn = fullcg-capded else if (data(68).ge.0.) capgn = .5*fullcg if (data(70).ge.0.) capgn = fullcg if (data(68).lt.0..and.data(70).lt.0.) & capgn = data(68)+.5*data(70) capgn = max(-clslim,capgn) capded = 0. endif c c Adjustments c kghmax = 7500. if (in(lawyr,1982,1983)) kghmax = 15000. if (lawyr.ge.1984) kghmax = 30000. c bus = data(17)+data(75)+data(79) bus = data(17)+max(0.0d0,data(75))+max(0.0d0,data(79))+ &max(0.d0,data(21)) retlim = max(0.0d0,.15*bus) kghlim = min(retlim,kghmax)*data(7) keogh = min(data(28),kghlim) iramax = 3000./sepret if (lawyr.ge.1981) iramax = 4000./sepret if (nfile.ne.2) iramax = iramax/2. busnet = max(0.0d0,bus-keogh) iralim = min(data(11)+busnet,iramax) ira = min(data(29),iralim) c schede = data(73)+data(74)+data(75)+data(76)+ & data(77)+data(78)+data(79) preagi = divall+capgn+schede+data(11)+ints+data(17)+data(18)+ & data(19)+data(20)+data(21)+data(22)+data(23)+ & data(24)-(ira+data(26)+data(27)+keogh+data(30)- & data(62))+data(72) disab = data(25) exagi = preagi-15000. if (exagi.lt.0.) exagi = 0. dislim = 5200.-exagi if (dislim.lt.0.) dislim = 0. if (disab.gt.dislim) disab = dislim c twoded = 0. if (lawyr.ge.1982.and.mstat.eq.2) then wife = max(0.0d0,min(data(85),data(86))) twoded = min(3000.0d0,.1*wife) if (lawyr.eq.1982) twoded = min(1500.0d0,.05*wife) endif adjust = disab+ira+data(26)+data(27)+keogh+data(30)+data(62)+ & twoded c ti = divall+schede+data(11)+ints+data(17)+((1.-caprat)* & data(18))+data(19)+data(20)+data(21)+data(22)+ & data(23)+data(24)+data(72) earned = max(0.0d0,data(11)+data(17)+data(21)) if (capgn.lt.0.) capgn = -min(-capgn,max(ti,0.0d0)) unearn = ti-earned+capgn agi = ti-adjust+capgn c c Unemployment compensation c uxemp = uxemp1(mstat) if (lawyr.ge.1982) uxemp = uxemp2(mstat) untax = min(.5*max(data(82)+agi-uxemp,0.0d0),data(82)) if (lawyr.le.1978) untax = 0. agi = agi+untax c c Ssa in agi c ssagi = 0. ssa = max(0.0d0,data(91)) ssbase = 0. if (lawyr.ge.1984.and.ssa.gt.0.) then ssbase = agi+.5*ssa+twoded ssexcl = filing(mstat,25000.,32000.,25000.,0.) if(extnd(17).ne.0.0d0) ssexcl = & filing(mstat,25000.,32000.,25000.,0.)*xndxa(lawyr)/xndxa(1984) ssbase = max(0.0d0,ssbase-ssexcl) ssagi = min(.5*ssa,.5*ssbase) agi = agi+ssagi endif c Itemized deductions agix = max(0.0d0,agi) c Medical drugs = data(48)-.01*agix if (drugs.lt.0.) drugs = 0. hins = .5*data(47) if (hins.gt.150.) hins = 150. if (lawyr.le.1982) edical = drugs+data(47)-hins+data(49)-.03*agix if (lawyr.ge.1983) edical = drugs+data(47)+data(49)-.05*agix if (edical.lt.0.) edical = 0. if (lawyr.le.1982) edical = edical+hins c Charity unchar = 0. cash = data(58) asset = data(59)+data(60) if (agi.lt.0.) then cash = 0. asset = 0. else if (cash.gt..5*agi) then cash = .5*agi asset = 0. else unchar = .5*agi - cash asset = min(asset,.5*agi,unchar) asset = max(0.0d0,asset) endif endif char = cash+asset c Political Contributions polcon = min(100.0d0,data(65)) if (mstat.eq.2.) polcon =min(200.0d0,data(65)) if (lawyr.ge.1979) polcon = 0. c Casualty or Theft Losses casu = max(0.0d0,data(61)-100.) if(lawyr.ge.1983) casu = max(0.0d0,casu-.1*agix) deduc = edical+polcon+data(50)+data(51)+data(52)+ & data(53)+data(54)+data(55)+data(56)+data(57)+ & casu+data(63)+data(66) if (lawyr.le.1981) deduc = deduc+char zbr = 2300.*xndx if (nfile.eq.2) zbr = (3400.*xndx)/sepret if (lawyr.le.1978) zbr = 2200. if (lawyr.le.1978.and.nfile.eq.2) zbr = 3200./sepret c zbrst for state purposes zbrst = zbr c Non-itemizer deduction for charitable contributions c 1979-1981 no above the line contributions allowed c 1982-1983 25% up to first $100 ($50 if sepret) c 1984 25% up to first $300 ($150 if sepret) c 1985 50% with no limit c 1986 100% c Difference3 c cded = 0. excess = 0. charni = 0. if (in(lawyr,1982,1983)) & charni = .25*min(100.0d0/sepret,char) if (lawyr.eq.1984) & charni = .25*min(300.0d0/sepret,char) if (lawyr.eq.1985) charni = .5*char if(extnd(55).gt.0) charni = 0. if (lawyr.eq.1986) charni = char c if(data(4).eq.-1) zbr = 0. c if(data(4).eq.-2) deduc = 0. deducp = deduc if (lawyr.le.1981) then if (deduc.gt.zbr) then cded = 1. excess = deduc-zbr else deduc = 0. endif else if((deduc+char.gt.zbr+charni.and.data(4).ge.0).or.data(4).eq.-1) & then cded = 1. deduc = deduc + char deducp = deduc excess = deduc - zbr charni = 0. else char = charni deduc = 0. endif endif dedphs = 0. c dependent limitations add105 = 0. if (data(105).gt.0..and.unearn.ge.1000..and.cded.gt.0.) then tmp105 = earned - ira tmp105 = max(tmp105,deduc) add105 = max(0.0d0,zbr-tmp105) endif exemps = data(7)+data(8)+data(9)+data(10) amex = 750.*exemps if (lawyr.ge.1979) amex = 1000.*exemps*xndx taxy = agi-excess-amex-charni+add105 taxinc = agi-excess-amex-zbr-charni+add105 if (taxy.lt.0.) taxy = 0. if (taxinc.lt.0.) taxinc = 0. c Don't itemize unless this is a benefit... if(cded.gt.0.and.taxinc.eq.0.and.agi-amex-zbr-charni.le.0) then cded = 0 deduc= 0 char = charni excess=0. endif c Regular tax if (lawyr.le.1978) call tax77(taxinc,sepret,nfile,regrat,regtax) if (in(lawyr,1979,1981)) & call tax79(taxy,sepret,nfile,regrat,regtax) if (lawyr.eq.1982) call tax82(taxy,sepret,nfile,regrat,regtax) if (lawyr.eq.1983) call tax83(taxy,sepret,nfile,regrat,regtax) if (lawyr.ge.1984) call tax84(taxy,sepret,nfile,regrat,regtax) c Rate Reduction Credit for 1981 if (lawyr.eq.1981) then regtax1 = regtax regtax = .9875*regtax rgrate = .9875*regrat endif tax = regtax rgrate = regrat*100 c SS benefits marginal rate pssa=0. rssa=0. if(ssagi.gt.0.and.ssa.gt.ssbase.and. &agi+.5*ssa+twoded.gt.filing(mstat,25000.,32000.,25000.,0.)) then pssa=1. rssa=.5*rgrate endif c Unemployment compensation marginal rate runemp=0. punemp=0. if(untax.gt.0.and.untax.lt.data(82))then punemp=1. runemp=.5*rgrate endif c IRA marginal rate rira=0. pira=0. if(ira.gt.0.and.data(11)+busnet.lt.iramax.and. &data(29).ge.iralim) then pira=1. rira = -rgrate endif c marginal rate on agi changes ragi=rgrate c Medical deduction marginal rate pdical=0. rdical=0. if(lawyr.le.1982.and.edical-hins.gt.0.) then pdical=1. if(rgrate.gt.0.and.cded.gt.0.and.pira.eq.0) then rdical=.03*rgrate if(data(48).gt..01*agix) rdical=.04*rgrate endif elseif(lawyr.ge.1983.and.edical.gt.0.) then pdical=1. if(rgrate.gt.0.and.cded.gt.0.and.pira.eq.0) then rdical=.05*rgrate if(data(48).gt..01*agix) rdical=.06*rgrate endif endif c Charitable contributions marginal rate rchar=0. pchar=0. if(cded.gt.0..and.char.gt.0.and.agi.gt.0.) then if(data(58).gt..5*agi) then rchar=.5*rgrate pchar=1. else if(.5*agi.lt.data(59)+data(60).or. & (unchar.lt.data(59)+data(60).and.unchar.gt.0.))then rchar=.5*rgrate pchar=1. endif endif endif c Disability marginal rate pdisab=0. rdisab=0. if(disab.gt.0.and.disab.lt.data(25).and.exagi.gt.0)then pdisab=1. rdisab=rgrate endif c Casualty marginal rate pcasu = 0. rcasu = 0. if(lawyr.ge.1983.and.data(61)-100.gt..1*agix) pcasu = 1. if(pcasu.eq.1.) rcasu = .1*rgrate rate = rgrate+rira+runemp+rssa+rdical-rchar-rcasu+rdisab addtax=0. c Alternative computation of tax (for capital gains) acgtax = -1. if (fullcg.gt.0..and.lawyr.le.1978) then cg1 = taxinc-capded if (cg1.lt.0.) cg1 = 0. call tax77(cg1,sepret,nfile,garb1,cgtx1) cgtx2 = 0.5*capded cgtx3 = 0. if (capded*2.0.le.50000./sepret) goto 424 subd = data(71) if (subd.lt.50000./sepret) subd = 50000./sepret if (subd.ge.capded*2.) goto 424 cgtx2 = 0.25*subd cg3 = taxinc if (capded.gt.taxinc) cg3 = capded call tax77(cg3,sepret,nfile,garb,cgtx31) call tax77(cg1+subd*0.5,sepret,nfile,garb2,cgtx32) cgtx3 = cgtx31-cgtx32 424 acgtax = cgtx1+cgtx2+cgtx3 endif if(lawyr.eq.1981.and.min(data(70),data(68)+data(70)).gt.0) then cg1 = max(0.0d0,taxy - .4*min(data(70),data(68)+data(70))) call tax79(cg1,sepret,nfile,garb,cgtx1) cgtx1 = .9875*cgtx1 cgtx2 = .2*min(data(70),data(68)+data(70)) acgtax = cgtx1+cgtx2 endif c Preference income pref = 0. prfded = 0. prfddy = 0. exded = 0. if (cded.gt.0.) then if (lawyr.le.1978) then exded = max(0.0d0,deduc-edical-data(61)-.60*agi) if (exded.gt.agi*.4) exded = agi*.4 pref = capded+data(18)+data(81)+data(82)+data(83)+ & data(84)+data(11)+data(87)+exded pref = max(0.0d0,pref) else prfded = max(0.0d0,deduc-edical-data(61)-data(50)) prfddy = max(0.0d0,agi-edical-data(61)-data(50)) exded = max(0.0d0,prfded-0.6*prfddy) pref = max(0.0d0,data(164)) endif endif c Maximum tax on earned income etax = -1. if (lawyr.le.1981) then if(mstat.eq.1) then ebot = ebs(lawyr) eacc = eas(lawyr) else if(mstat.eq.2.or.mstat.eq.5) then ebot = ebm(lawyr) eacc = eam(lawyr) else if(mstat.eq.4.or.mstat.eq.7) then ebot = ebh(lawyr) eacc = eah(lawyr) else ebot = ebsep(lawyr) eacc = easep(lawyr) endif psinc = earned + max(0.0d0,data(75))+ & data(20)+data(72)-data(138) if(agi.gt.0) psinc = twn(psinc,0.0d0,agi) if (sepret.eq.2) goto 444 if (agi.ne.0.) goto 4422 eratio = 1.0 goto 4424 4422 eratio = min(psinc/agi,1.0d0) if (eratio.le.0..or.agi.le.0.) goto 444 4424 if(lawyr.ge.1979) then eti = taxy*eratio-pref else eti = taxinc*eratio-pref endif etop = eti - ebot if (etop.le.0.) go to 444 if (lawyr.le.1978) call tax77(eti,sepret,nfile,z,partax) if (in(lawyr,1979,1981)) & call tax79(eti,sepret,nfile,z,partax) if(lawyr.eq.1981) then etax = .9875*(regtax1-partax+eacc) + .5*etop else etax = regtax-partax+eacc + .5*etop endif if(capgn.gt.0.and.lawyr.gt.1981) then etax = max(0.0d0,.5*(min(cg1,eti)-ebot))+ & cgtx2+.9875*(eacc+max(0.0d0,cgtx1-partax)) endif endif 444 continue c c Income averageing c Data(96): sum of taxinc for base period (4 years previous to 1984) c .3 is equal to 120%/4 c .3*data(96) is 120% of average income in base period c avrinc is excess of this period income over base c atax1 is tax on base plus .2 of excess for this year c atax2 is tax on base income c 4*(atax1-atax2) is tax on excess spread over 4 years if (data(96).lt.0.) goto 462 avrinc = taxinc-0.3*data(96) if (lawyr.ge.1979) avrinc = taxy-0.3*data(96) if (avrinc.le.3000.) goto 462 if (lawyr.le.1978) then call tax77(0.3*data(96)+0.2*avrinc,sepret,nfile,arate1,atax1) call tax77(0.3*data(96),sepret,nfile,arate2,atax2) endif if (in(lawyr,1979,1981)) then call tax79(0.3*data(96)+0.2*avrinc,sepret,nfile,arate1,atax1) c Rate Reduction Credit for 1981 if (lawyr.eq.1981) atax1 = .9875*atax1 call tax79(0.3*data(96),sepret,nfile,arate2,atax2) c Rate Reduction Credit for 1981 if (lawyr.eq.1981) atax2 = .9875*atax2 endif if (lawyr.eq.1982) then call tax82(0.3*data(96)+0.2*avrinc,sepret,nfile,arate1,atax1) call tax82(0.3*data(96),sepret,nfile,arate2,atax2) endif if (lawyr.eq.1983) then call tax83(0.3*data(96)+0.2*avrinc,sepret,nfile,arate1,atax1) call tax83(0.3*data(96),sepret,nfile,arate2,atax2) endif if (lawyr.ge.1984) then call tax84(0.3*data(96)+0.2*avrinc,sepret,nfile,arate1,atax1) call tax84(0.3*data(96),sepret,nfile,arate2,atax2) endif avrtax = 4.*(atax1-atax2)+atax1 goto 464 462 avrtax = -1. 464 continue c c Combine alternative taxes -- amended 2/27/98 by Dan Feenberg c Select the lowest among the following 5 alternative taxes c calt = 0 regtax comnew(28) c calt = 1 alternative tax on gains (acgtax) comnew(45) c calt = 2 maximum tax on earned income (etax) comnew(43) c calt = 3 (1) and (2) (altax3) comnew(46) c calt = 4 average tax (avrtax) comnew(47) c calt (combined alternative taxes indicator) comnew(48) c altax (combined alternative taxes) comnew(50) c altax = regtax calt = 0. acgsav = 0. if(acgtax.gt.0) then c acgsav = max(0.0d0,regtax-acgtax) c altax = regtax - acgsav altax = min(acgtax,altax) calt = 1 endif if(etax.gt.0) then if(etax.lt.altax) then altax = etax calt = 2 endif if(etax.lt.regtax.and.acgsav.gt.0) then altax = etax - acgsav calt = 3 endif endif if(avrtax.gt.-1..and.avrtax.lt.altax) then altax = avrtax calt = 4 endif taxbc = altax if(lawyr.le.1981.and.calt.eq.1.and.acgtax.lt.regtax. & and.pira.eq.0) rate=garb*100*(1+pdical*.03-pchar*.5+punemp*.5) c Marginal Tax Rate on Maximum Tax on Earned Income petax=0 retax=0. if((calt.eq.2.or.calt.eq.3).and.agi.gt.0) then petax=1. retax=100*(regrat-z+.5+(z-.5)*(agi-psinc)*(agi-taxinc)/ &(agi*agi)) if(calt.eq.3) & retax=retax-100*max(0.0d0,regrat-garb1) if(pira.eq.0) rate=retax+pdical*rdical-pchar*.5*retax if(pira.eq.1.0d0) rate=retax+rira endif c Child care credit ncccr = 0 if(data(207).gt.0) then ncccr = min(data(207),2.0d0) else ncccr = min(data(8),2.0d0) endif if(lawyr.le.1981) then chmax=2000.*ncccr else chmax=2400.*ncccr endif chwage = max(0.0d0,data(11)+data(17)) if(chwage.le.0) chwage = 0. child = min(chmax,chwage,data(64)) chr = 0.2 if(lawyr.ge.1982) chr =max(.2d0,.3-max((agi-8000.)/200000.,0.0d0)) chcr = child*chr c Indicator for Child Care Credit Phaseout pchild = 0. rchild=0. if(child.gt.0) pchild = 1. if(chr.gt..2.and.chr.lt..3.and.pchild.eq.1) rchild=child/2000. if(chwage.lt.chmax.and.chwage.lt.data(64).and.pchild.eq.1) then if(chr.lt..3) then rchild=-(rchild+20.) else rchild=-30. endif endif c Limits for elderly exagi = agi-10000./sepret if (nfile.ne.2) exagi = agi-7500. if (exagi.lt.0.) exagi = 0. eldlim = 2500. if (nfile.eq.2) then eldlim = 3750. if (int(data(9)).eq.1) eldlim = 2500. if (sepret.eq.2) eldlim = 1875. endif if (lawyr.ge.1984) eldlim = 2.*eldlim eldlim = .15*(eldlim-(.5*exagi+data(91)-ssagi)) if (eldlim.lt.0.) eldlim = 0. elder = min(eldlim,data(32)) c Polical campaign credit canlim = 25. if (lawyr.ge.1979) canlim = 50. if (mstat.eq.2) canlim = 2.*canlim candid = min(canlim,data(35)/2.) if (polcon.eq.0.) candid = min(canlim,(data(65)+data(35))/2.) invest = data(33) jobs = data(37) energy = data(38) if (lawyr.le.1983) then credit = chcr+candid+elder+data(36)+energy+invest+ & data(34)+jobs+data(40) else credit = chcr+elder+data(34)+energy+candid+data(40)+invest+jobs endif crdnoa = credit if(taxbc.le.crdnoa) crdnoa = taxbc c Marginal rate for elderly credit pold=0. rold=0. if(taxbc.gt.credit.and.eldlim.gt.0.and.eldlim.lt.data(32). & and.rate.gt.0) then pold=1. rold=.15*.5*100 if(pdisab.gt.0) rold=2*.15*.5*100 endif rate=rate+rold+rchild if(taxbc.le.credit) rate=0. credit = min(credit,taxbc) tax = taxbc-credit taxaft = tax c Earned income credit earncr = 0. peic=0 reic=0. if(lawyr.ge.1975) then if (lawyr.le.1978) then crmax = 400. ymax = 4000. rtbase = .1 rtless = .1 amax = 8000. else if (lawyr.ge.1979.and.lawyr.le.1984) then crmax = 500. ymax = 6000. rtbase = .1 rtless = .125 amax = 10000. else if (lawyr.ge.1985) then crmax = 550. ymax = 6500. rtbase = .11 rtless = .1222 amax = 11000. endif if(max(agi,earned).le.amax) then earncr = min(crmax,rtbase*earned) if(max(agi,earned).gt.ymax) & earncr = max(0.0d0,earncr - rtless*(max(agi,earned)-ymax)) endif ncr=0 if(earncr.lt.crmax) ncr=1 if (data(3).eq.2.or.data(8).eq.0.or.data(105).gt.0) earncr=0. if(data(202).lt.0.or.data(197).lt.0.) earncr = 0. if(earncr.le.0) earncr = 0. if(earncr.gt.0..and.earncr.lt.crmax)then reic=-rtbase peic=1. if((agi.gt.ymax.or.earned.gt.ymax).and.earncr.gt.0) then if(ncr.eq.1)reic=-rtbase+rtless if(ncr.eq.0)reic=rtless if(agi.gt.earned) then if(ncr.eq.1)reic=(-rtbase+rtless)*(1+.5*pssa+.5*punemp) if(ncr.eq.0)reic=rtless*(1+.5*pssa+.5*punemp) endif endif endif reic=reic*100 if(credit.lt.taxbc) then rate=rate+reic else rate=reic endif endif c Alternative Minimum tax almtax = 0. almrat = 0. addmin = 0. if (lawyr.le.1981) then offset = .5*(tax+data(39)+data(40)+data(42)) if (offset.lt.10000./sepret) offset = 10000./sepret if(taxbc.le.chcr + candid + elder + data(38)) then credm = chcr + candid + elder +data(38)- taxbc else credm = 0. endif c credm = chcr + candid + elder + data(38) if(data(155).gt.0)addmin = max(0.0d0,(data(81)-offset)* & .15-credm) if (lawyr.ge.1979) then alminy = agi-amex-excess-zbr+capded+(1.-caprat)* & data(18)+data(116) almtax = .1*(max(alminy-20000./sepret,0.0d0))+ & .1*(max(alminy-60000./sepret,0.0d0))+ & .05*(max(alminy-100000./sepret,0.0d0)) almtax = max(0.0d0,almtax-data(39)-addmin-tax) almtax = max(0.0d0,almtax - data(34)) tax = tax+almtax+addmin if(almtax.gt.0) then if(alminy.gt.20000/sepret) almrat=.1d0 if(alminy.gt.60000/sepret) almrat=.2d0 if(alminy.gt.100000/sepret) almrat=.25d0 endif rach=0. raed=0. raira=0. if(cded.lt.1.and.taxinc.eq.0. & and.((asset.gt.0.and.asset.lt.data(59)+data(60)).or. & data(58).gt..5*agi.and.agi.gt.0)) rach=-.5*almrat if(pdical.eq.1.and.cded.lt.1.and.taxinc.eq.0) then raed=.03*almrat if(data(48).gt..01*agix) raed=.04*almrat endif c if(iralim.gt.0.and.taxinc.eq.0) raira=-almrat almrat=almrat+rach+raed+raira else tax = tax+addmin endif if(addmin.gt.0.and.data(81).gt.offset.and. & offset.gt.10000/sepret) rate=rate*(1-.15*.5) endif if (lawyr.eq.1982) then offset = .5*(tax+data(39)+data(40)+data(42)) if (offset.lt.10000./sepret) offset = 10000./sepret if(taxbc.le.chcr + candid + elder + data(38)) then credm = chcr + candid + elder +data(38)- taxbc else credm = 0. endif c credm = chcr+candid+elder+data(38) if(data(155).gt.0) then addmin = max(0.0d0,(data(81)-offset)*.15) addmin = max(0.0d0,addmin - min(.15*data(116),addmin)) addmin = max(0.0d0,addmin-credm) if(addmin.gt.0.and.data(81).gt.offset.and. & offset.gt.10000/sepret) rate=rate*(1-.15*.5) endif tax = tax+addmin alminy = agi - excess - zbr - amex + capded + exded almtax = .1*(max(alminy-20000./sepret,0.0d0))+ & .1*(max(alminy-60000./sepret,0.0d0)) almtax=max(0.0d0,almtax-taxaft-addmin-data(39)) tax=tax+almtax almr=0. if(almtax.gt.0..and.alminy.gt.20000/sepret) almr=.1 if(almtax.gt.0..and.alminy.gt.60000/sepret) almr=.2 pexc = 0. if(excess.gt.0) pexc = 1. pexded=0. if(exded.gt.0.and.prfddy.gt.0) pexded = 1. almrat=almr*(1-pexc*(pchar*.5-pdical*.03) & +pexded*(pchar*.5-.6*(1+pdical*.03))) if(zbr.gt.0) almrat=almrat-almr*(1+pdical*.03) endif if (lawyr.ge.1983) then if(mstat.eq.1.or.mstat.eq.4.or.mstat.eq.7) then offset = 30000. else offset = 40000./sepret endif if(cded.gt.0) then prfded = max(0.0d0,edical-.05*agix)+char+data(61)+data(116) else prfded = data(116) if(lawyr.eq.1986) prfded = charni+data(116) endif pref = capded+data(81)+(1.-caprat)*max(0.0d0,data(18)) if(fullcg.lt.0) pref = fullcg-capgn+data(81)+ & (1.-caprat)*max(0.0d0,data(18)) alminy = max(0.0d0,agi-prfded+pref) almtax = .2*max(0.0d0,alminy-offset) if(almtax.gt.0) almrat=.2d0 if(cded.lt.1.and.zbr.gt.0) almrat = 0. if ((almtax-data(34)).gt.tax.and.almtax.gt.0.) then tax = almtax -min(almtax,data(34)) endif endif if(lawyr.ge.1983) almtax = max(0.0d0,tax-taxaft) palm=0 ralm=0. if(almtax.gt.0) palm= 1 if(palm.gt.0.) then ralm=almrat*(1+.5*pssa)*100 if(punemp+pssa.le.0.and.pira.gt.0.and.pchar+pdical.le.0..and. & cded.gt.0) ralm=0. rate=ralm+reic if(zbr.gt.0.and.lawyr.lt.1982)then rate=0. if(peic.eq.1) rate=reic endif if(zbr.eq.0)rate=ralm+reic if(cded.gt.0.and.char.gt.0.and.agi.gt.0.and.lawyr.ne.1982)then if(data(58).gt..5*agi) rate=.5*rate if(data(58).lt..5*agi.and. & (.5*agi.lt.data(59)+data(60).or. & (unchar.lt.data(59)+data(60).and.unchar.gt.0.))) & rate=.5*rate endif endif if(palm.gt.0.and.cded.gt.0..and.pdical.gt.0.and.agi.gt.0.) then if(lawyr.ge.1983) then if(data(48).lt..01*agix) rate=rate*(1+.05) if(data(48).gt..01*agix) rate=rate*(1+.06) else if(data(48).lt..01*agix) rate=rate*(1+.03) if(data(48).gt..01*agix) rate=rate*(1+.04) endif endif if(palm.gt.0.and.pira.gt.0) rate=reic if(palm.gt.0.and.punemp.gt.0.and.agi.gt.0.) rate=1.5*ralm c taxsoi is the SOI definition of Total Tax, it does not include the c refundable portion of the EITC eitc = earncr if (tax.lt.eitc) then if (tax.gt.0.) eitc = tax if (tax.le.0.) eitc = 0. endif taxsoi = taxaft - eitc taxnoa = taxbc - crdnoa - earncr tax = tax - earncr pretax = max(regtax,altax,almtax,avrtax,(tax+eitc+credit)) if(palm.gt.0) ralm = ralm - rgrate return end c ****************************************************************************** c ****************************************************************************** c Tax years 1986-2023, includes changes in the Tax Reform Acts of c 1986 and 97. (updated 01/08/18) c ****************************************************************************** c ****************************************************************************** c subroutine law87(data,lawyr) implicit double precision (A-H,O-Z) common /xndxac/ xndxa(1981:2023) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) common /alm/ almsp,almr1,almr2 common /ssmaxa/ ssmax(1960:2025) common /user/ zbrack(3,1987:2018),exem(1987:2018), & crmax(1987:2018,0:3,1:2),ymax(1987:2023,0:3,1:2), 1 rtbase(1987:2023,0:3), rtless(1987:2023,0:3), 2 chmax(1998:2023),ealim(2001:2023),cphas(7) common /newshr/ &tax,agi,zbr,divall,fullcg, capgn,capded,schede,coeff,retlim, 1iralim,ira,kghlim,keogh,ltg, dislim,adjust,drugs,hins,edical, 2cash,asset,char,deduc,polcon, cded,taxy,regtax,taxinc,deducp, 3dedint,twoded,almpay,dedphs,exded, pref,earny,psinc,exphs,exclnt, 4eacc,eti,etax,avrinc,acgtax, acgsav,avrtax,calt,excl,altax, 5gencr,taxbc,chcr,elder,exagi, edcred,candid,credit,earncr,taxsoi, 6eitc,offset,addmin,addtax,ti, rgrate,yad,exemps,alminy,almtax, 7addprf,rate,chr,statax,fica,c76,pretax,untax,ssagi,excess, 8chcred,disab,amex,ssa,tax2, telcr,capinc,tamt1,tamt2,bp, 9dagidw,hoperf,chcr1,wpaycr,dyeic,tenpct,misc,alminc,almrat,regrat, &pded,rded,pexem,rexem,pssa,rssa,pira,rira,pdical,rdical, &pchar,rchar,pcht,rcht,pchild,rchild,peic,reic,palm,ralm, &prent,rrent,pmisc,rmisc,pcasu,rcasu,pdisab,rdisab,psave,rsave, &pxmp,rxmp,c133,c134,pold,rold,taxbca,xl38,xl39,xl40, &amtnon,oldcr,paddcr,raddcr,pedu,redu,xitamt,hope,life,c150, &rent,ymod,taxng,taxaft,taxnoa,taxnon,sch10,sch20,sch25,pdedy, &bppamt,bppeic,crdlost,pwpay,rwpay,pmcare,rmcare,xl46,xl47,amtr5, &amtr15,amtr25,dicare,tax3,setax,chcrbc,zbrst,comadd(78) c 09.07.2016 please do not change the name c150 in law87 dimension data(255),dy(1996:2018),eapct(2001:2023), & exclds(1990:2018) dimension bbrack(3,1987:2018),almsep(1990:2018),amtsep(1990:2018) dimension pinta(1987:1991),dstded(1987:2018),almspf(2013:2018) dimension phas(1991:2012),zbrmin(1987:2018),pease(2013:2018) dimension edphls(1998:2018),edphhs(1998:2018),hopelm(1998:2018) dimension edphlm(1998:2018),edphhm(1998:2018) double precision iramax,iralim,ira,keogh,kghmax,kghlim,misc,ltg double precision life,hope,newcr,modagi integer datayr,sepret,amtage(1990:2018) logical in c c *************************************************************************** c EITC Earned Income Tax Credit Parameters c crmax : maximum eitc (adjusted for inflation) c ymax : beginning of eitc phaseout (2001 levels are 2000 levels c rtbase: phasein rate = rtbase adjusted by assumed inflation c rtless: phaseout rate = rtless of 2 percent) c *************************************************************************** c (&=zero dependents, 1=one dependent, 2=two plus dependents) c dimension crmaxa(0:3,1:2), ymaxa(0:3,1:2) dimension rtb(1987:2023,0:3), rtl(1987:2023,0:3) dimension amax(1987:2018,0:3,1:2) dimension amaxa(0:3,1:2) c dimension amax01(32),amax11(32),amax21(32),amax31(32), & amax02(32),amax12(32),amax22(32),amax32(32) equivalence (amax01,amax(1987,0,1)) equivalence (amax11,amax(1987,1,1)) equivalence (amax21,amax(1987,2,1)) equivalence (amax31,amax(1987,3,1)) equivalence (amax02,amax(1987,0,2)) equivalence (amax12,amax(1987,1,2)) equivalence (amax22,amax(1987,2,2)) equivalence (amax32,amax(1987,3,2)) data amax01/ & 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, & 9000.d0, 9234.d0, 9677.d0, 9770.d0, 10030.d0,10195.d0,10300.d0, & 10710.d0,11060.d0,11233.d0,11490.d0, 11750.d0,12120.d0,12590.d0, & 12880.d0,13440.d0,13460.d0,13740.d0, 13980.d0,14340.d0,14590.d0, & 14820.d0,14880.d0,15010.d0,15310.d0 / data amax11/ 1 15432.d0,18576.d0,19340.d0,20264.d0,21250.d0,22370.d0,23050.d0, 1 23755.d0,24396.d0,25078.d0,25750.d0,26473.d0,26928.d0,27413.d0, 1 28281.d0,29201.d0,29666.d0,30338.d0,31030.d0,32001.d0,33241.d0, 1 33995.d0,35463.d0,35535.d0,36132.d0,36920.d0,37870.d0,38511.d0, 1 39131.d0,39296.d0,39617.d0,40402.d0/ data amax21/ 2 15432.d0,18576.d0,19340.d0,20264.d0,21250.d0,22370.d0,23050.d0, 2 25296.d0,26673.d0,28495.d0,29290.d0,30095.d0,30590.d0,31152.d0, 2 32121.d0,33178.d0,33692.d0,34458.d0,35263.d0,36348.d0,37783.d0, 2 38646.d0,40295.d0,40363.d0,41044.d0,41952.d0,43038.d0,43756.d0, 2 44454.d0,44648.d0,45007.d0,45898.d0/ data amax31/ 3 15432.d0,18576.d0,19340.d0,20264.d0,21250.d0,22370.d0,23050.d0, 3 25296.d0,26673.d0,28495.d0,29290.d0,30095.d0,30590.d0,31152.d0, 3 32121.d0,33178.d0,33692.d0,34458.d0,35263.d0,36348.d0,37783.d0, 3 38646.d0,43279.d0,43352.d0,43998.d0,45060.d0,46227.d0,46997.d0, 3 47747.d0,47955.d0,48340.d0,49298.d0/ data amax02/ & 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, & 9000.d0, 9234.d0, 9677.d0, 9770.d0,10030.d0,10195.d0,10300.d0, & 10710.d0,12060.d0, 12233.d0,12490.d0,13750.d0,14120.d0,14590.d0, & 15880.d0,18440.d0,2*18470.d0,19190.d0,19680.d0,20020.d0,20330.d0, & 20430.d0,20600.d0, 21000.d0/ data amax12/ 1 15432.d0,18576.d0,19340.d0,20264.d0,21250.d0,22370.d0,23050.d0, 1 23755.d0,24396.d0,25078.d0,25760.d0,26473.d0,26910.d0,27450.d0, 1 28281.d0,30201.d0,30666.d0,31338.d0,33030.d0,34001.d0,35241.d0, 1 36995.d0,40463.d0,40545.d0,41132.d0,42130.d0,43210.d0,43941.d0, 1 44651.d0,44846.d0,45207.d0,46102.d0/ data amax22/ 2 15432.d0,18576.d0,19340.d0,20264.d0,21250.d0,22370.d0,23050.d0, 2 25296.d0,26673.d0,28495.d0,29290.d0,30095.d0,30590.d0,31152.d0, 2 32121.d0,34178.d0,34692.d0,35458.d0,37263.d0,38348.d0,39783.d0, 2 41646.d0,45295.d0,45373.d0,46044.d0,47162.d0,48378.d0,49186.d0, 2 49974.d0,50198.d0,50597.d0,51598.d0/ data amax32/ 3 15432.d0,18576.d0,19340.d0,20264.d0,21250.d0,22370.d0,23050.d0, 3 25296.d0,26673.d0,28495.d0,29290.d0,30095.d0,30590.d0,31152.d0, 3 32121.d0,34178.d0,34692.d0,35458.d0,37263.d0,38348.d0,39783.d0, 3 41646.d0,48279.d0,48352.d0,48998.d0,50270.d0,51567.d0,52427.d0, 3 53267.d0,53505.d0,53930.d0,54998.d0/ data eapct/3*.10d0,20*.150d0/ c data zbrmin/4*500.0d0,550.0d0,5*600.0d0,650.0d0,3*700.0d0, & 3*750.0d0,2*800.0d0,2*850.0d0, 900.0d0,4*950.0d0,2*1000.d0, & 4*1050.d0/ c data pinta /.65,.40,.20,.10,.00/ data almspf /179500.d0,182500.d0,185400.d0,186300.d0,187800.d0, & 191500.d0/ data dstded /4*500.d0,550.d0,3*600.d0,3*650.d0,3*700.d0, & 3*750.d0,2*800.d0,3*850.d0,900.d0,3*950.d0,2*1000.d0,4*1050.d0/ c data phas /100000.,105250.,108450.,111800.,114700.,117950., & 121200.,124500.,126600.,128950.,132950.,137300., & 139500.,142700.,145950.,150500.,156400.,159950., & 2* 166800.,2*169550./ data dy /2200.d0,2250.d0,2300.d0,2350.d0,2400.d0,2450.d0,2550.d0, & 2600.d0,2650.d0,2700.d0,2800.d0,2900.d0,2950.d0,2*3100.d0, & 3150.d0,3200.d0,3300.d0,3350.d0,2*3400.d0,3450.d0,3500.d0/ data bbrack / 750.d0, 600.d0, 750.d0, 750.d0, 600.d0, 750.d0, & 750.d0, 600.d0, 750.d0, 800.d0, 650.d0, 800.d0, & 850.d0, 650.d0, 850.d0, 900.d0, 700.d0, 900.d0, & 900.d0, 700.d0, 900.d0, 950.d0, 750.d0, 950.d0, & 950.d0, 750.d0, 950.d0,1000.d0, 800.d0,1000.d0, & 1000.d0, 800.d0,1000.d0,1050.d0, 850.d0,1050.d0, & 1050.d0, 850.d0,1050.d0,1100.d0, 850.d0,1100.d0, & 1100.d0, 900.d0,1100.d0,1150.d0, 900.d0,1150.d0, & 1150.d0, 950.d0,1150.d0,1200.d0, 950.d0,1200.d0, & 1250.d0,1000.d0,1250.d0,1250.d0,1000.d0,1250.d0, & 1300.d0,1050.d0,1300.d0,1350.d0,1050.d0,1350.d0, & 1400.d0,1100.d0,1400.d0,1400.d0,1100.d0,1400.d0, & 1450.d0,1150.d0,1450.d0,1450.d0,1150.d0,1450.d0, & 1500.d0,1200.d0,1500.d0,1550.d0,1200.d0,1550.d0, & 1550.d0,1250.d0,1550.d0,1550.d0,1250.d0,1550.d0, & 1550.d0,1250.d0,1550.d0,1600.d0,1300.d0,1600.d0/ data pease/ 1.d0,1.0168d0,1.033d0,1.0376d0,1.046d0,1.0668d0/ data edphls /4*40000.d0,2*41000.d0,42000.d0,43000.d0,45000.d0, & 47000.d0, 48000.d0,2*50000.d0,51000.d0,52000.d0,53000.d0, & 54000.d0,2*55000.d0, 56000.d0,57000.d0 / data edphhs /4*50000.d0, 2*51000.d0,52000.d0,53000.d0,55000.d0, & 57000.d0, 58000.d0, 2*60000.d0,61000.d0,62000.d0,63000.d0, & 64000.d0,2*65000.d0, 66000.d0,67000.d0/ data edphlm /4*80000.d0, 82000.d0, 83000.d0, 85000.d0, & 87000.d0, 90000.d0, 94000.d0, 96000.d0,2*100000.d0, & 102000.d0, 104000.d0, 107000.d0, 108000.d0,2*110000.d0, & 112000.d0, 114000.d0/ data edphhm /4*100000.d0, 102000.d0, 103000.d0, 105000.d0, & 107000.d0, 110000.d0, 114000.d0, 116000.d0,2*120000.d0, & 122000.d0, 124000.d0, 127000.d0, 128000.d0, 130000.d0, & 131000.d0, 132000.d0, 134000.d0/ data hopelm/8*1000.d0,2*1100.d0,1200.d0,2*2500.d0,8*2000.d0/ data exclds /6*1000.d0,2*1300.d0,5000.d0,5100.d0,5200.d0,5350.d0, & 5500.d0,5600.d0, 5750.d0,5850.d0,6050.d0,6250.d0,6400.d0, & 2*6700.d0,6800.d0, 6950.d0,7150.d0,7250.d0,7400.d0,7400.d0, & 7500.d0,7650.d0/ data almsep/ & 3* 20000.d0, 8* 22500.d0, 2* 24500.d0, 3* 29000.d0, & 31275.d0, 33125.d0, 34975.d0, 35475.d0, & 36225.d0, 37225.d0, 39375.d0, 40400.d0, & 41050.d0, 41700.d0, 41900.d0, 42250.d0, & 43100.d0/ c amtsep in 2018 is subject to change to a real amount of F6251 for amtsep c $251450 is my guess data amtsep/ & 3*155000.d0, 8*165000.d0, 2*173000.d0, 3*191000.d0, & 200100.d0, 207500.d0, 214900.d0, 216900.d0, & 219900.d0, 223900.d0, 232500.d0, 238550.d0, & 242450.d0, 246250.d0, 247450.d0, 249450.d0, & 251450.d0/ data amtage /16*14,2*18,11*24/ c please change lawend to 2018 when 2018 update comes up lawend = lawyr if(lawyr.gt.2018) lawend = 2018 gencr = 0. xndx = xndxa(lawyr) datayr = int(data(103)) blind = data(09)+data(10) sepret = data(03) c Marital status c Function Filing: the format is Filing(MSTAT,V1,V2,V3,V4) c Where MSTAT is data(2) c V1 is the value of Filing if single c V2 is the value of Filing if filing jointly c V3 is the value of Filing if head of household c V4 is the value of Filing if filing separately c mstat = data(2) nfile = int(filing(mstat,1.,2.,3.,2.)) if(lawyr.le.2018) then exema = exem(lawyr) zbrmia = zbrmin(lawyr) zbr= zbrack(nfile,lawyr)/sepret+bbrack(nfile,lawyr)*blind c if you paid real estate taxes in 2008 or in 2009 if(lawyr.eq.2008.or.lawyr.eq.2009) & zbr = zbr + min(data(51),data(7)*500.) c 2009 and 2010 additional Motor Vehicle Tax paid if((lawyr.ge.2009.and.lawyr.le.2010).and.data(55).gt.0) & zbr = zbr + data(55) if(lawyr.ge.1998) hplm = hopelm(lawyr) if(lawyr.ge.1991.and.lawyr.le.2012) phasa = phas(lawyr) dstdea = dstded(lawyr) if(lawyr.ge.1996) dylim = dy(lawyr) if(lawyr.ge.1990) exds = exclds(lawyr) if(lawyr.ge.1990) almspr = almsep(lawyr) if(lawyr.ge.1990) amtsp = amtsep(lawyr) else exema = exem(2018)*xndx/xndxa(2018) zbrmia = zbrmin(2018)*xndx/xndxa(2018) zbr=(zbrack(nfile,2018)/sepret+bbrack(nfile,2018)*blind)* & xndx/xndxa(2018) hplm = hopelm(2018)*xndx/xndxa(2018) dstdea = dstded(2018)*xndx/xndxa(2018) dylim = dy(2018)*xndx/xndxa(2018) exds = exclds(2018)*xndx/xndxa(2018) almspr = almsep(2018)*xndx/xndxa(2018) amtsp = amtsep(2018)*xndx/xndxa(2018) endif c normal numbers for EITC if(lawyr.le.2018) then do 998 i=0,3 do 998 j=1,2 crmaxa(i,j) = crmax(lawyr,i,j) ymaxa (i,j) = ymax (lawyr,i,j) amaxa (i,j) = amax (lawyr,i,j) rtb(lawyr,i) = rtbase(lawyr,i) rtl(lawyr,i) = rtless(lawyr,i) 998 continue else do 999 i=0,3 do 999 j=1,2 crmaxa(i,j) = crmax(2018,i,j)*xndx/xndxa(2018) ymaxa (i,j) = ymax (lawyr,i,j) amaxa (i,j) = amax (2018,i,j)*xndx/xndxa(2018) rtb(lawyr,i) = rtbase(lawyr,i) rtl(lawyr,i) = rtless(lawyr,i) 999 continue endif capded = 0. c Income terms used in imputation modules (see taxsim.ndx) c Long Term CAPITAL GAINS c 1987-1996 gains treated as ordinary income, 28% top rate c 1997-2000 20% maximum rate after 5/3/97 (10% for 15% bracket) c Beginning 2001, 18% maximum rate (8% for 15% bracket) for assets c held 5 years or more c For 1997, 1/3 of LTG changed to short to reflect transition year c and holding period of 18 months after Jun97; ignore collectibles c gshort = data(68) glong = data(70) fullcg = gshort+glong if(lawyr.ge.1997) fullcg = fullcg + data(18) capgn = fullcg capgn = max(capgn,-3000.0d0/sepret) ltg = 0. if(lawyr.ge.1997.and.fullcg.gt.0.) then if(glong+data(18).gt.0..and.gshort.ge.0.) ltg = glong+data(18) if(glong+data(18).gt.0..and.gshort.lt.0.) ltg = fullcg endif c HDP if(data(176)+data(177).gt.0) then divall = data(12) divq = data(12) - data(177) divo = data(177) else divall = data(12) divq = .67*data(12) divo = .33*data(12) endif if(lawyr.ge.2003) then if(ltg.ge.0.0d0) then ltg = ltg + divq else ltg = divq endif endif c Schedule E is given without rent income or loss here schede = data(74)+data(75)+data(76)+data(77)+data(78)+data(79) rent = data(73) if(rent.ge.0) schede = schede+rent c extnd(86) : use data(142) instead of schede if(extnd(86).gt.0.0d0) then schede = data(142) rent = 0. endif untax = data(82) c Unemployment compensation exclusion -- ARRA 2009 if(lawyr.eq.2009.and.extnd(44).eq.0.and.untax.gt.0) & untax = max(0.0d0,untax -2400.) ti = capgn+data(11)+divall+data(14)+data(20)+ & data(22)+data(23)+data(72)+schede+data(17)+ & data(21)+data(24)+data(19)+untax c Keoughs & ira c next 2 c lines is for heritage retlim = max(0.0d0,.15*(data(17)+data(76)+data(21))) + & .15*max(data(145)-data(114),0.0d0) kghmax = 30000.*data(7) keogh = min(retlim,kghmax,data(28)) if(extnd(86).gt.0.0d0) keogh = data(28) ira = 0. iramax = 2000. if(lawyr.ge.2002.and.lawyr.le.2004) iramax = 3000. if(lawyr.ge.2005.and.lawyr.le.2007) iramax = 4000. if(lawyr.ge.2008.and.(lawyr.le.2012.or.extnd(2).eq.1)) & iramax = 5000. if(lawyr.ge.2013.and.lawyr.le.2015) iramax = 5500. if(lawyr.gt.2015) iramax = 5500*xndxa(lawyr)/xndxa(2015) c for joint returns if(mstat.eq.2) then if(lawyr.le.1996) then wife =min(data(119),data(120)) husb =max(data(119),data(120),data(11)+data(17)-wife) husmax = min(husb,iramax) wifmax = min(wife,iramax) if (wifmax.lt.250.) wifmax = 250. iramax = husmax + wifmax else iramax = data(7)*iramax endif endif ira = min(iramax,data(29)) c Other adjustments exagi = max(0.0d0,ti-15000.) dislim = 5200.-exagi if (dislim.lt.0.) dislim = 0. disab = min(data(25),dislim) pdisab =0. if(disab.lt.data(25).and.dislim.gt.0) pdisab=1. amov = 0. if(lawyr.ge.1994) amov = data(26) if(extnd(87).gt.0) setax = data(43) c Earned income earny = max(0.0d0,data(11) + data(17) + data(21)-.5*setax) if(lawyr.eq.2011.or.lawyr.eq.2012) then c 2011-2012 -- 5.65% instead of 7.65% if(setax.le..133*ssmax(lawyr)) then earny = max(0.0d0,data(11)+data(17)+data(21)-.5751*setax) else earny = max(0.0d0,data(11) + data(17) + data(21)- & .5*setax-.133*.0751*ssmax(lawyr)) endif endif earned = earny c Total adjustments adjust = disab+keogh+data(30)+data(62)+data(124)+amov+data(27) if(lawyr.ge.1990.and.lawyr.ne.2011.and.lawyr.ne.2012) & adjust = adjust+.5*setax if(lawyr.eq.2011.or.lawyr.eq.2012) then c 2011-2012 -- 5.65% instead of 7.65% if(setax.le..133*ssmax(lawyr)) then adjust = adjust + .5751*setax else adjust = adjust + .5*setax + .133*.0751*ssmax(lawyr) endif endif agi = ti-adjust c rate (such as .2 times secondary earnings) (extnd(69)) c maximum earning eligible for deduction (extnd(70)) c rate of clawback per 1000 of AGI (extnd(71)) c threshold to start clawback (extnd(72)) twoded = 0. if (mstat.eq.2) then wife = max(0.d0,min(data(85),data(86))) sed1 = max(0.d0, & extnd(69)-max(0.d0,extnd(71)*(agi-extnd(72))/1e3)) twoded = max(0.d0,sed1*min(wife,extnd(70))) endif adjust = adjust + twoded agi = agi - twoded c Passive loss limitations apply only to rental losses c Non-rental losses are considered allowable if reported by the SOI c Pensions in AGI: data(20)+data(72) Total pensions: data(139), not used c Rental loss phaseout prent=0. if(rent.lt.0) then phase1 = 100000./sepret phase2 = 150000./sepret rent = max(-25000.0d0/sepret,rent) if (agi.ge.phase2) rent = 0. if (agi.lt.phase2.and.agi.ge.phase1) then rent = rent*(phase2-agi)/(50000./sepret) prent=1 endif if(extnd(58).gt.0) prent = 0 ti = ti + rent agi = agi + rent schede = schede + rent endif c Phaseout of ira phaira = filing(mstat,25000.,40000.,25000.,20000.)*xndx if(lawyr.eq.1997) phaira=filing(mstat,35000.,50000.,35000.,35000.) if(lawyr.eq.1998) phaira=filing(mstat,40000.,60000.,40000.,40000.) if(lawyr.eq.1999) phaira=filing(mstat,41000.,61000.,41000.,41000.) if(lawyr.eq.2000) phaira=filing(mstat,42000.,62000.,42000.,42000.) if(lawyr.eq.2001) phaira=filing(mstat,43000.,63000.,43000.,43000.) if(lawyr.eq.2002) phaira=filing(mstat,44000.,64000.,44000.,44000.) if(lawyr.eq.2003) phaira=filing(mstat,50000.,70000.,50000.,50000.) if(lawyr.eq.2004) phaira=filing(mstat,55000.,75000.,55000.,55000.) if(lawyr.eq.2005) phaira=filing(mstat,60000.,80000.,60000.,60000.) if(lawyr.eq.2006) phaira=filing(mstat,60000.,85000.,60000.,85000.) if(lawyr.eq.2007)phaira=filing(mstat,62000.,103000.,62000.,62000.) if(lawyr.eq.2008)phaira=filing(mstat,63000.,105000.,63000.,63000.) if(lawyr.eq.2009)phaira=filing(mstat,65000.,105000.,65000.,65000.) if(lawyr.eq.2010)phaira=filing(mstat,66000.,109000.,66000.,66000.) if(lawyr.eq.2011)phaira=filing(mstat,66000.,110000.,66000.,66000.) if(lawyr.eq.2012)phaira=filing(mstat,68000.,112000.,68000.,68000.) if(lawyr.eq.2013)phaira=filing(mstat,69000.,115000.,69000.,69000.) if(lawyr.eq.2014)phaira=filing(mstat,70000.,116000.,70000.,70000.) if(lawyr.ge.2015.and.lawyr.le.2016) & phaira=filing(mstat,71000.,118000.,71000.,71000.) if(lawyr.ge.2017) then phaira=filing(mstat,71000.,118000.,71000.,71000.)*xndx/xndxa(2016) endif range = 10000. agira=agi if (agi.gt.phaira) then agira=agi ira = ira*(1.-(agi-phaira)/range) if (ira.lt.0.) ira = 0. endif if(extnd(86).gt.0.0d0) ira = data(29) agi = agi - ira adjust = adjust + ira c SSB in agi ssa = max(0.0d0,data(91)) ssagi = 0. pssa=0. if (ssa.gt.0.) then ymod = agi+data(41)+.5*ssa ssexcl = filing(mstat,25000.,32000.,25000.,0.) if(extnd(17).ne.0.0d0) ssexcl = & filing(mstat,25000.,32000.,25000.,0.)*xndxa(lawyr)/xndxa(1984) if (lawyr.le.1993) ssagi = min(ssa,max(0.0d0,ymod-ssexcl))*.5 if (lawyr.ge.1994) then xlin9 = max(0.0d0,ymod-ssexcl) xlin11 = max(0.0d0,xlin9 - & filing(mstat,9000.,12000.,9000.,0.)) xlin13 = .5 * & min(xlin9,filing(mstat,9000.,12000.,9000.,0.)) xlin14 = min(xlin13, .5*ssa) ssagi = min(.85*ssa, xlin14 + .85*xlin11) c Next formulas have economics sense c ssexcl1 = ssexcl+filing(mstat,9000.,12000.,9000.,0.) c if(ymod.ge.ssexcl.and.ymod.le.ssexcl1) then c ssagi = .5*(ymod-ssexcl,ssa) c else if(ymod.gt.ssexcl1) then c ssagi = min(.85*(ymod-ssexcl1)+.5(ssexcl1-ssexcl),.85*ssa) c endif endif if(extnd(86).gt.0.0d0.and.data(3).eq.2.0d0) ssagi = data(92) agi = agi+ssagi if(lawyr.ge.1994) then if(ssagi.gt.0.and..85*ssa.gt.xlin14 + .85*xlin11) pssa = 1 else if(ssa.gt.ymod-ssexcl.and.ymod.gt.ssexcl) pssa=1 endif endif pssa1=0. pssa2=0. if(pssa.eq.1.and.lawyr.ge.1994) then if(xlin9.gt.filing(mstat,9000.,12000.,9000.,0.))then pssa1=1 else if(xlin9.lt.filing(mstat,9000.,12000.,9000.,0.).and. & xlin13.lt..5*ssa) then pssa2=1. endif endif if(lawyr.le.1993) pssa2=pssa agix = max(0.0d0,agi) dagidw = 1. + pssa1*.85 + pssa2*.5 + pdisab &+ prent*abs(max(data(73),-25000.0d0/sepret))/(50000.0d0/sepret) c Itemized Deductions c Charitable contributions pchar=0. pchar1=0. pchar2=0. cash = data(58) asset = data(59)+data(60) alim50 = .5*agix unchar = 0. if (agi.lt.0.) then cash = 0. asset = 0. else if (cash.gt.alim50) then cash = alim50 asset = 0. pchar1=1 else unchar = alim50 - cash if(asset.gt..3*agi.and.unchar.gt..3*agi) pchar2=1 if(unchar.lt.asset.and.unchar.lt..3*agi) pchar1=1 c asset = min(asset,.3*agi,unchar) c asset = max(0.0d0,asset) endif endif asset = min(.3*agix,asset) char = min(alim50,cash+asset) char = max(0.0d0,char) pchar=pchar1+pchar2 c Miscelleneous deduction misc = data(63) misc = max(0.0d0,misc-.02*agix) pmisc=0 if(misc.gt.0) pmisc=1 c Medical Deduction edical = data(47)+data(48)+data(49) if(lawyr.ge.2013.and.data(9).lt.1) then edical = max(0.0d0,edical-.1*agix) else edical = max(0.0d0,edical-.075*agix) endif c Casuaty or Theft Losses casu = max(0.0d0,data(61)-100.) casu = max(0.0d0,casu-.1*agix) if(lawyr.eq.2009) casu = max(0.0d0,data(61)-max(500.0d0,.1*agix)) c Interest deduction persin = min(data(57),2000.0d0) if (datayr.ge.1987) persin=data(121) if (lawyr.ge.1987.and.lawyr.lt.1991) then persin = pinta(lawyr)*persin else persin = 0. endif busint = max(0.0d0,data(57)-persin) xid = max(0.0d0,divall+data(14)+capgn) dedint = min(xid,busint) xmov = data(26) if (lawyr.ge.1994) xmov = 0 sttax = data(50) if(lawyr.ge.2004.and.lawyr.le.2013) sttax = max(sttax,data(52)) deduc1 = char+sttax+data(51)+data(54)+data(56)+misc+busint+ & persin+data(66)+xmov c Motor Vehicle tax is a part of itemized deductions if(lawyr.eq.2009.or.lawyr.eq.2010) deduc1 = deduc1+data(55) dedint = data(56)+busint+persin deduc2 = casu+edical+data(53) c deducp - total amount of item. deductions before phaseout. c Needed for state tax calculator deducp = deduc1+deduc2 c Deductions phase-out indicator pded = 0. dedphs = 0. dlim1 = 0. dlim2 = 0. if (lawyr.ge.1991) then c Pease Limitations if(lawyr.le.2012) then phase = phasa/sepret else if (lawyr.eq.2013) then phase = filing(mstat,250000.,300000.,275000.,150000.) else if (lawyr.eq.2014) then phase = filing(mstat,254200.,305050.,279650.,152525.) else if (lawyr.eq.2015) then phase = filing(mstat,258250.,309900.,284050.,154950.) else if (lawyr.eq.2016) then phase = filing(mstat,259400.,311300.,285350.,155650.) else if (lawyr.eq.2017) then phase = filing(mstat,261500.,313800.,287650.,156900.) else if(lawyr.ge.2018) then phase = & filing(mstat,250000.,300000.,275000.,150000.)* & pease(lawend)*xndxa(lawyr)/xndxa(lawend) endif dlim1 = .03*max(0.0d0,agi-phase) dlim2 = .8*max(0.0d0,deduc1-data(57)-data(168)) if(lawyr.eq.2006.or.lawyr.eq.2007)then dlim1 = 2*dlim1/3 dlim2 = 2*dlim2/3 endif if(lawyr.eq.2008.or.lawyr.eq.2009) then dlim1 = dlim1/3 dlim2 = dlim2/3 endif if(lawyr.ge.2010.and.lawyr.le.2012) then dlim1 = 0. dlim2 = 0. endif dedphs = min(dlim1,dlim2) deduc1 = deduc1 - dedphs if(dedphs.gt.0.and.dedphs.lt.dlim2) pded = 1 if(dedphs.gt.0.and.dedphs.lt.dlim2) pdedy = 1 if((pchar.eq.1.or.pmisc.eq.1).and.dedphs.eq.dlim2. & and.dedphs.gt.0) pded=1 endif deduc = max(0.0d0,deduc1+deduc2) c MSF wants a limit for itemized deductions if(extnd(61).gt.0) deduc = min(deduc,extnd(61)) if(lawyr.le.2018) then c141 = zbrack(1,lawyr) if(gjtrra.ne.0.0d0.and.(mstat.eq.2.or.data(3).eq.2)) then if(lawyr.eq.2003) zbr= 7950./sepret+bbrack(nfile,lawyr)*blind if(lawyr.eq.2004) zbr= 8100./sepret+bbrack(nfile,lawyr)*blind endif c else c141 = zbrack(1,2018) *xndx/xndxa(2018) c if(nfile.eq.2.and.data(3).eq.1) then c if(extnd(4).eq.1.and.lawyr.gt.2014) then c zbr0=zbrack(1,2014)*2+bbrack(nfile,2014)*blind c elseif(lawyr.gt.2014.and.extnd(4).ne.1) then c zbr0=zbrack(1,2014)*1.67+bbrack(nfile,2014)*blind c endif c else c zbr0=zbrack(nfile,2015)/sepret+bbrack(nfile,2015)*blind c endif endif c Zero bracket amount, includes calculations for dependent returns earnkd = data(11)+max(0.0d0,data(17)-data(124)) if(lawyr.ge.1998.and.lawyr.le.2005) earnkd = earnkd+250. if(lawyr.ge.2006.and.lawyr.le.2012) earnkd = earnkd+300. if(lawyr.ge.2013) earnkd = earnkd+350. if (data(105).gt.0.)zbr = min(zbr,max(zbrmia,earnkd)) if(extnd(39).gt.0.) then if(mstat.eq.1.or.mstat.eq.3.or.mstat.eq.6)zbr = zbr + extnd(39) if(mstat.eq.2.or.mstat.eq.5) zbr = zbr + 2*extnd(39) if(mstat.eq.4.or.mstat.eq.7) zbr = zbr + 1.5*extnd(39) endif if(extnd(42).gt.0.and.extnd(43)-extnd(42).gt.0) zbr = & zbr*(1-twn((agi-extnd(42)/extnd(43)-extnd(42)),0.0d0,1.0d0)) c zbrst for state purposes zbrst = zbr c Itemized Deductions cded = 0. yad = agi excess = 0. if(data(4).eq.-1.or.data(4).eq.3) zbr = 0. if(data(4).eq.-2.or.data(4).eq.3) deduc = 0. if(data(4).eq.1.and.data(3).eq.2) zbr = 0. if(data(4).eq.2.and.data(3).eq.2) then deduc = 0. deducp = 0 endif zbr = max(0.0d0,zbr+extnd(75)) if ((deduc.gt.zbr.and.data(4).ge.0).or.data(4).eq.-1) then cded = 1. yad = yad-deduc+zbr excess = deduc-zbr else if(data(4).eq.-3) then c Always take deductions as max(item,zbr) if data(4)=3 ded = max(deduc,zbr) if(ded.ne.zbr) then cded = 1 else cded = 0 endif yad = agi - ded + zbr else c edical = 0. deduc = 0. endif exemps = data(7)+data(8) c No exemption for dependent returns xmp = 1 + data(08) c extnd(74) -- no exemption for a spouse if(mstat.eq.2) xmp = xmp + (1-extnd(74)) c xmp = data(07)+data(08) amex = exema*xmp if(extnd(85).gt.0) then amex = max(0.0d0,amex - data(7)*exema) exemps = exemps - data(7) endif c Exemption phaseout ratio = 0. exmphl = 0. if (in(lawyr,1991,1996)) then exmphl = & filing(mstat,100000.,150000.,125000.,75000.)*xndx/1.143 if (agi.gt.exmphl) then ratio = 0.02*max(0.0d0,(agi-exmphl)/(2500./sepret)) amex = max(amex*(1.-ratio),0.0d0) endif elseif (lawyr.ge.1997)then if (lawyr.le.1998) &exmphl = filing(mstat,124500.,186800.,155650.,93400.) if (lawyr.eq.1999) &exmphl = filing(mstat,126600.,189950.,158300.,94975.) if (lawyr.eq.2000) &exmphl = filing(mstat,128950.,193400.,161150.,96700.) if (lawyr.eq.2001) &exmphl = filing(mstat,132950.,199450.,166200.,99725.) if (lawyr.eq.2002) &exmphl = filing(mstat,137300.,206000.,171650.,103000.) if (lawyr.eq.2003) &exmphl = filing(mstat,139500.,209250.,174400.,104625.) if (lawyr.eq.2004) &exmphl = filing(mstat,142700.,214050.,178350.,107025.) if (lawyr.eq.2005) &exmphl = filing(mstat,145950.,218950.,182450.,109475.) if (lawyr.eq.2006) &exmphl = filing(mstat,150500.,225750.,188150.,112875.) if(lawyr.eq.2007) &exmphl = filing(mstat,156400.,234600.,195500.,117300.) if(lawyr.eq.2008) &exmphl = filing(mstat,159950.,239950.,199950.,119975.) if(lawyr.eq.2009.or.lawyr.eq.2010) &exmphl = filing(mstat,166800.,250200.,208500.,125000.) if(lawyr.eq.2011.or.lawyr.eq.2012) &exmphl = filing(mstat,169550.,254350.,211950.,127300.) if(lawyr.eq.2013) &exmphl = filing(mstat,250000.,300000.,275000.,150000.) if(lawyr.eq.2014) &exmphl = filing(mstat,254200.,305050.,279650.,152525.) if(lawyr.eq.2015) &exmphl = filing(mstat,258250.,309900.,284050.,154950.) if(lawyr.eq.2016) &exmphl = filing(mstat,259400.,311300.,285350.,155650.) if(lawyr.eq.2017) &exmphl = filing(mstat,261500.,313800.,287650.,156900.) if(lawyr.eq.2018) &exmphl = filing(mstat,266700.,320000.,293400.,160000.) if(lawyr.gt.2018) &exmphl = filing(mstat,266700.,320000.,293400.,160000.)* & xndx/xndxa(2018) if (agi.gt.exmphl) then if(lawyr.ge.2010.and.lawyr.le.2012) then ratio=0. else ratio = min(1.0d0,.02*max(0.0d0,agi-exmphl)/(2500/sepret)) endif amphs = ratio * amex if(lawyr.le.2005.or.lawyr.ge.2011) then amphs = ratio * amex else if(lawyr.eq.2006.or.lawyr.eq.2007) then amphs = ratio * amex * 2/3 else if(lawyr.eq.2008.or.lawyr.eq.2009) then amphs = ratio * amex * 1/3 endif c a flag to turn off the personal exemptions phaseout if(extnd(14).eq.2.0d0) amphs = 0. amex = amex - amphs endif endif if (data(105).gt.0.) then amex = 0.d0 exemps = 0.d0 endif exphs=exema*xmp-amex c a flag to turn off the personal exemption if(extnd(14).eq.1.0d0) amex = 0. pexem = 0. if(amex.gt.0.and.exphs.gt.0.and.agi-exmphl.le.122500/sepret) & pexem=1. c taxable income if (data(105).eq.0.) then taxin1 = yad-amex-zbr else if (lawyr.le.1997) then taxin1 = agi-max(deduc,min(zbr,max(dstdea,earned))) elseif (in(lawyr,1998,2000)) then taxin1 = agi-max(deduc,min(zbr,max(dstdea,earned+250.))) elseif (in(lawyr,2001,2005)) then depstd = dstdea taxin1 = agi-max(deduc,min(zbr,max(depstd,earned+250.))) elseif (in(lawyr,2006,2012)) then depstd = dstdea taxin1 = agi-max(deduc,min(zbr,max(depstd,earned+300.))) else depstd = dstdea taxin1 = agi-max(deduc,min(zbr,max(depstd,earned+350.))) endif endif taxinc = max(0.0d0,taxin1) c Don't itemize unless this is a benefit if((cded.gt.0.and.taxinc.eq.0.and.agi-amex-zbr.lt.0).or. & data(4).eq.-2)then cded = 0. deduc= 0. edical = 0. endif c surtax on 15% rate savings, only for 1988-90 c difference4 rsave = 0. psave = 0. tax2 = 0. saving = 0. if (in(lawyr,1988,1990)) then phase = filing(mstat,43150.,71900.,61650.,35950.)*xndx if (taxinc.gt.phase) then saving = filing(mstat,2320.5,3867.5,3107.0,3867.5)*xndx tax2 = .05*(taxinc-phase) rsave = .05*dagidw if (tax2.gt.saving) then tax2 = saving rsave = 0. endif endif if(rsave.gt.0) psave = 1. endif c c Exemption surtax, only for 1988-1996 c c difference5 tax3 = 0. rxmp = 0. pxmp = 0. if (in(lawyr,1988,1996)) then phase = filing(mstat,89560.,149250.,123790.,113300.)*xndx if (taxinc.gt.phase) then tax3 = .05*(taxinc-phase) rxmp = .05*dagidw if (tax3.ge.amex*.28) then rxmp = 0. if(pexem.eq.1) & rxmp=-.28*.02*exema*xmp/(2500./sepret)*dagidw endif if (tax3.gt.amex*.28) tax3 = amex*.28 endif if(rxmp.ne.0) pxmp = 1. endif c c Regular tax. Use taxin3 to avoid changing the value of taxinc c during tax table calculations. c brac15=0. surtax = 0. taxin3 = taxinc tax11=0. if (lawyr.eq.1987) then call tax87(taxin3,sepret,nfile,regrat,tax11,data) regtax=tax11 elseif (in(lawyr,1988,1990)) then call tax88(taxin3,sepret,nfile,regrat,tax11) regtax=tax11 elseif (in(lawyr,1991,1992)) then call tax91(taxin3,sepret,nfile,regrat,tax11,data,regtax) elseif(lawyr.eq.1993) then data68=data(68) data70=data(70) data(68)=0. data(70)=0. call tax93 &(taxin3,sepret,nfile,regrat,tax11,data,tax36,surtax,short,regtax) data(68)=data68 data(70)=data70 call tax93 &(taxin3,sepret,nfile,regrat,tax11,data,tax36,surtax,short,regtax) elseif(in(lawyr,1994,1996)) then call tax94 & (taxin3,sepret,nfile,regrat,tax11,data,tax36,surtax,short,lawyr, & regtax) elseif(in(lawyr,1997,2000)) then call tax97 & (taxin3,sepret,nfile,regrat,tax11,data,lawyr,brac15, & regtax,taxng,taxltg,ltg) elseif(lawyr.ge.2001) then if(egtrra.eq.1.0d0) then call tax01 & (lawyr,taxin3,sepret,nfile,regrat,tax11,data,brac15, & regtax,taxng,taxltg,ltg,sch10,sch20,sch25,addtax) else call tax97 & (taxin3,sepret,nfile,regrat,tax11,data,lawyr,brac15, & regtax,taxng,taxltg,ltg) endif endif c taxbc = max(0.0d0,tax11+tax2+tax3) if(lawyr.ge.2000) taxbc = taxbc + data(46) if(taxin1.lt.0) regrat=0. rgrate = regrat*100 c rexem- additional rate because of exemptions phaseout rexem= 0. if(pexem.eq.1.) rexem = & dagidw*rgrate*.02*exema*xmp/(2500./sepret) c write(0,*) 'rexem dagidw rgrate .02*exema*xmp/(2500./sepret)', c &rexem, dagidw, rgrate, .02*exema*xmp/(2500./sepret) c rded- additional rate because of itemized deduction phaseout rded = 0. pded1=0 pded2=0 if(pded.eq.1.and.cded.gt.0) rded = .03*rgrate if(pded.eq.1.and.cded.gt.0.and.dedphs.eq.dlim2.and.pchar2.eq.1) & then rded=.3*.8*rgrate pded1=1 endif if(pded.eq.1.and.cded.gt.0.and.dedphs.eq.dlim2.and.pchar1.eq.1) & then rded=.5*.8*rgrate pded2=1 endif if(lawyr.eq.2006.or.lawyr.eq.2007) then rded = .66*rded rexem = .66*rexem else if(lawyr.eq.2008.or.lawyr.eq.2009) then rded = .33*rded rexem = .33*rexem else if(lawyr.eq.2010) then rded = 0. rexem = 0. endif c rcasu -additional rate because of casualty and theft losses rcasu = 0. pcasu = 0. if(data(61)-100.gt..1*agix.and.cded.gt.0) pcasu = 1 if(pcasu.eq.1) rcasu = .1*rgrate*dagidw c rdical -additional rate because of medical expenses amount rdical = 0. pdical = 0. if(data(47)+data(48)+data(49).gt.0.075*agix.and.cded.gt.0) then pdical = 1 rdical = .075*rgrate*dagidw endif c rchar - additional rate because of charitable contributions rchar = 0. if(cded.gt.0) then if(pchar1.eq.1) then rchar=.5*rgrate*dagidw elseif(pchar2.eq.1) then rchar=.3*rgrate*dagidw endif endif c rmisc -additional rate because of miscelleneous deductions rmisc=0 if(cded.gt.0.and.pmisc.eq.1) rmisc=.02*rgrate*dagidw c Marginal rate for disability rdisab =0. if(pdisab.eq.1) rdisab=rgrate ddeddw=0 if(cded.gt.0) &ddeddw=(pdical*.075+.1*pcasu+.02*pmisc-.5*pchar1-.3*pchar2+ &.03*pded+.3*.8*pded1+.5*.8*pded2)*dagidw c c Alternative Minimum Tax c TRA2001 provides for an additional $2000 in pers against the AMT c which we add to excl c c no regular tax, only amt if(extnd(16).gt.0.and.lawyr.ge.2000) taxbc = 0. amtpi2=amtpi**(lawyr-2001.0d0) almtax = 0. if(lawyr.gt.2018) then excl = filing(mstat,55400.,86200.,55400.,43100.)* & xndx/xndxa(2018) else if(lawyr.eq.2018) then excl = filing(mstat,55400.,86200.,54400.,43100.) else if(lawyr.eq.2017) then excl = filing(mstat,54300.,84500.,54300.,42250.) else if(lawyr.eq.2016) then excl = filing(mstat,53900.,83800.,53900.,41900.) else if(lawyr.eq.2015) then excl = filing(mstat,53600.,83400.,53600.,41700.) else if(lawyr.eq.2014) then excl = filing(mstat,52800.,82100.,52800.,41050.) else if(lawyr.eq.2013) then excl = filing(mstat,51900.,80800.,51900.,40400.) else if(lawyr.eq.2012) then excl = filing(mstat,50600.,78750.,50600.,39375.) else if(lawyr.eq.2011) then excl = filing(mstat,48450.,74450.,48450.,37225.) else if(lawyr.eq.2010) then excl = filing(mstat,47450.,72450.,47450.,36225.) else if(lawyr.eq.2009) then excl = filing(mstat,46700.,70950.,46700.,35475.) else if(lawyr.eq.2008) then excl = filing(mstat,46200.,69950.,46200.,34975.) else if(lawyr.eq.2007) then excl = filing(mstat,44350.,66250.,44350.,33125.) else if(lawyr.eq.2006) then excl = filing(mstat,42500.,62550.,42500.,31275.) else if(lawyr.ge.2003.and.lawyr.le.2005) then excl = filing(mstat,40250.,58000.,40250.,29000.) else if(lawyr.ge.2001.and.lawyr.le.2002) then excl = filing(mstat,35750.,49000.,35750.,24500.) else if(lawyr.ge.1993.and.lawyr.le.2000) then excl = filing(mstat,33750.,45000.,33750.,22500.) else excl = filing(mstat,30000.,40000.,30000.,20000.) endif if(gjtrra.ne.0.0d0.and.(lawyr.eq.2003.or.lawyr.eq.2004)) & excl = filing(mstat,35750.,49000.,35750.,24500.) c AMT Exclusion Base Phaseout phase = filing(mstat,112500.,150000.,112500.,75000.) if(lawyr.eq.2013) & phase = filing(mstat,115400.,153900.,115400.,76950.) if(lawyr.eq.2014) & phase = filing(mstat,117300.,156500.,117300.,78250.) if(lawyr.eq.2015) & phase = filing(mstat,119200.,158900.,119200.,79450.) if(lawyr.eq.2016) & phase = filing(mstat,119800.,159700.,119800.,79850.) if(lawyr.eq.2017) & phase = filing(mstat,120700.,160900.,120700.,80450.) if(lawyr.eq.2018) & phase = filing(mstat,123100.,164100.,123100.,82050.) if(lawyr.gt.2018) & phase = filing(mstat,123100.,164100.,123100.,82050.) & *xndxa(lawyr)/xndxa(2018) xitamt = deducp - & (data(50)+data(51)+misc+min(.025*agix,edical)+data(54)) if(cded.gt.0) then if(lawyr.lt.1990) then addprf = data(50) + data(51) + misc + edical + data(54) & - data(22) + data(81) + amex c xitamt = deducp - c & (data(50) + data(51) + misc + edical + data(54)) if(lawyr.le.1987) addprf = addprf + .4*data(121) alminy = max(0.0d0,agi - deduc - amex + data(116) + addprf) else addprf = data(50)+data(51)+misc+data(54)-data(22)+data(81) if(lawyr.le.2012.or.(lawyr.ge.2013.and.data(9).gt.0)) & addprf = addprf+min(.025*agix,edical) c if(lawyr.gt.2005) addprf = addprf - misc if(lawyr.ge.1991.and.lawyr.le.1992) addprf = addprf + dedphs alminy = max(0.0d0,agi - deducp +data(116)+ addprf) if(data(4).eq.-1.d0.and.deducp.eq.0.d0) & alminy = max(0.0d0,agi-data(153)+data(116)+ addprf) endif if(almst.eq.1.0d0) alminy = alminy - data(50) else if(lawyr.le.1990) then if(data(4).ne.3) then addprf = zbr + amex + data(81) - data(22) alminy = max(0.0d0,agi - zbr - amex + data(116) + addprf) else addprf = data(81) + amex alminy = max(0.0d0, & agi - data(153) - deducp - amex + data(116) + addprf) endif else if(data(4).eq.3.0d0.or.data(4).eq.-1.0d0) then addprf = data(81) c alminy = max(0.0d0,agi -deducp -data(153)+data(116) +addprf) alminy = max(0.0d0,agi - data(153) + data(116) + addprf) else if(almzbr.eq.1) then addprf = - data(22)+data(81) else addprf = zbr - data(22)+data(81) endif alminy = max(0.0d0,agi + data(116)+ addprf) if (data(4).eq.1.and.taxinc.eq.0.and.xitamt.gt.0) & alminy = max(0.0d0,agi-xitamt-data(22)+data(81)+data(116)) endif endif endif c Alternative tax net operating loss deduction if(data(116).gt.0) then if(lawyr.le.1993.and.lawyr.ne.1989.and.lawyr.ne.1988) then alminy = alminy - min(.9*alminy,data(116)) else if (lawyr.eq.1989.or.lawyr.eq.1988) then alminy = max(0.0d0,alminy - data(166)) endif endif c Separate return: additional income 1990 + if(lawyr.ge.1990) then if(sepret.eq.2) & alminy = alminy + min(almspr,.25*max(0.0d0,alminy-amtsp)) endif if(almnpx.eq.1.0d0) alminy=max(0.0d0,alminy-amex) if(extnd(68).ne.0) alminy = max(0.0d0,alminy + extnd(68)) pref = max(0.0d0,addprf-zbr) c Exclusion Phase-out phaout = .25*max(0.0d0,alminy-phase) exclnt = max(0.0d0,excl-phaout) if(lawyr.ge.1990) then if(lawyr.le.2018) then nagep = amtage(lawyr) else nagep = amtage(2018) endif n205 = data(205) if(n205.gt.0) then c reported older taxpayer age if(n205.lt.nagep) & exclnt = max(0.0d0,min(exclnt,exds+earned)) else c not reported primary taxpayer age but is a dependent if(data(105).gt.0.0d0) & exclnt = max(0.0d0,min(exclnt,exds+earned)) endif endif alminc = max(0.0d0,alminy-exclnt) if(lawyr.ge.2013.and.lawyr.le.2018) then almsp = almspf(lawyr) elseif (lawyr.gt.2018) then almsp = almspf(2018)*xndx/xndxa(2018) endif if (lawyr.ge.1997) then c g1250 = 0. c if(data(115).gt.0) g1250 = data(115) c cglong = max(0.0d0,ltg - g1250) cglong = & max(0.0d0,ltg-data(138)-data(115)-max(0.0d0,data(117))) if(alminc-cglong.gt.almsp/sepret) then almrat = almr2 almbak = (almr2-almr1)*almsp/sepret if(lawyr.ge.2001) then almrat = almr2*amtmul almbak = (almr2-almr1)*almsp*amtmul/sepret endif else almrat = almr1 if(lawyr.ge.2001) almrat = almr1*amtmul almbak = 0. endif else if(lawyr.ge.1993.and.lawyr.le.1996) then if(alminc.gt.almsp/sepret) then almrat = almr2 almbak = (almr2-almr1)*almsp/sepret else almrat = almr1 almbak = 0. endif elseif(lawyr.eq.1991.or.lawyr.eq.1992) then almrat=.24d0 almbak = 0. else almrat=.21d0 almbak = 0. endif almrat = almrat*(1+extnd(77)/100) c c Starting in 1997, tax capital gains for purposes of the minimum tax c at no more than 20%. We ignore the 10% rate due to complexity and c low probability that anyone will benefit from this rate c if (lawyr.le.1996) then tamt = almrat*alminc-almbak elseif (lawyr.ge.1997) then if(ltg.gt.1) then xl37 = max(0.0d0,data(176)-data(138))+ ltg - data(176) - & min(data(115)+data(117),ltg - data(176)) xl38 = data(115) xl39 = min(xl37+xl38, & max(0.0d0,data(176)-data(138))+ ltg - data(176)) c xl37 = max(0.0d0,ltg-data(138)-data(115)) c xl37 = ltg - max(0.0d0,min(data(115),capgn)) c xl38 = data(198)+data(115) c xl39 = min(xl37+xl38,ltg) xl40 = min(alminc,xl39) xl41 = alminc - xl40 amtnon = xl41 if(lawyr.le.2000) then c line-by-line 2000Form6251 xl20d = ltg xl21d = data(138) xl22d = max(0.0d0,xl20d - xl21d) xl23d = max(0.0d0,data(68) + data(117)) xl24d = max(0.0d0,min(data(117),xl23d)) xl25d = data(115) xl26d = xl24d + xl25d xl27d = max(0.0d0,xl22d - xl26d) xl28d = max(0.0d0,taxinc - xl27d) xl29d = min(brac15,taxinc) xl30d = min(xl28d,xl29d) xl31d = max(0.0d0,taxinc - xl22d) xl32d = max(xl30d,xl31d) xl34d = xl29d xl35d = xl30d xl36d = xl34d - xl35d xl29 = alminc xl30 = xl27d xl31 = xl25d xl32 = xl30 + xl31 xl33 = xl22d xl34 = min(xl32,xl33) if(data(18).gt.0.0d0) then amtnon = max(0.0d0,alminc - data(18)) else amtnon = max(0.0d0,alminc - xl34) endif endif if(amtnon.le.almsp/sepret) then tamt1 = almr1*amtnon else tamt1 = almr2*amtnon - almbak endif c rates on capital gains in amt taxable income cgrat1 = .1*amtmul cgrate = .2*amtmul c the Tax Increase Prevention and Reconciliation Act of 2005 if(lawyr.ge.2003) then cgrat1 = .05*amtmul if(lawyr.ge.2008) cgrat1 = 0. cgrate = .15*amtmul endif xl43 = brac15 c line14 from sch D worksheet if(data(138).gt.1.0d0) then xl2d = data(176) xl3d = data(138) c xl4 = max(0.0d0,data(176)-data(138))+ c & max(0.0d0,min(data(70),data(70)+data(68))-data(185)) xl4d = 0 xl5d = max(0.0d0,xl3d - xl4d) xl6d = max(0.0d0,xl2d - xl5d) xl7d = min(data(70),data(70)+data(68))+data(18) xl8d = min(xl3d,xl4d) xl9d = max(0.0d0,xl7d-xl8d) xl10d = xl6d + xl9d else xl6d = data(176) xl9d = ltg - xl6d xl10d = ltg endif xl11d = max(0.0d0,data(115)) xl12d = min(xl11d,xl9d) xl13d = xl10d - xl12d xl14d = max(0.0d0,taxinc - xl13d) xl44 = xl14d xl45 = max(0.0d0,xl43 - xl44) xl46 = min(xl37,alminc) xl47 = min(xl45,xl46) amtr5 = cgrat1*xl47 amtr15 = cgrate*(xl46 - min(xl45,xl46)) c amtr25 = .25*(min(ltg,alminc) - xl46) amtr25 = .25*(alminc-amtnon-xl47-(xl46 - min(xl45,xl46))) if(lawyr.le.2000) then xl37 = xl36d xl38 = min(alminc,xl30,xl37) amtr5 = cgrat1*xl38 xl40 = min(alminc,xl30) xl41 = xl38 xl42 = xl40 - xl41 amtr15 = cgrate*xl42 xl44 = alminc xl45 = amtnon +xl38 + xl42 xl46 = max(0.0d0,xl44 - xl45) amtr25 = .25*xl46 endif if(taxinc.le.0.0d0) amtr25 = 0. tamt2 = amtr5 + amtr15 + amtr25 if(lawyr.ge.2013) tamt2 = tamt2 + addtax c if(lawyr.ge.2013) then c if(nfile.eq.1) then c topbrk = 400000*xndx/xndxa(2013) c else if(nfile.eq.3) then c topbrk = 425000*xndx/xndxa(2013) c else c topbrk = 450000*xndx/xndxa(2013)/sepret c endif c addamt = 0. c cglong = max(0.0d0,ltg-data(138)-data(115)) c if(taxinc-cglong.gt.topbrk) then c addamt = .05*ltg c else if (taxinc.gt.topbrk) then c addamt = .05*min(taxinc-topbrk,ltg) c endif c tamt2 = tamt2 + addamt c endif tamt = tamt1 + tamt2 else if(alminc.le.almsp/sepret) then tamt1 = almr1*alminc else tamt1 = almr2*alminc - almbak endif tamt2 = 0. tamt = tamt1 + tamt2 endif endif if(lawyr.le.1993) then amtftc = data(34) else amtftc = data(163) endif almtax = max(0.0d0,tamt - amtftc - max(taxbc-data(34),0.0d0)) if(extnd(50).gt.0) almtax = 0. almpay = 0. if (almtax.gt.0.) almpay = 1. if(lawyr.le.1999)taxbca = taxbc if(lawyr.ge.2000)taxbca = taxbc + almtax bpamt = 0. if(almtax.gt.0) then if(alminc.le.almsp) then bpamt = alminc else bpamt = alminc - almsp endif endif bppamt = taxinc - (alminc - bpamt) c Credits c Child care credit ncccr = 0 if(data(207).gt.0) then ncccr = min(data(207),2.0d0) else ncccr = min(data(8),2.0d0) endif if(lawyr.le.2002) then child = min(data(64),2400.0d0*ncccr) else child = min(data(64),3000.0d0*ncccr) endif if(mstat.eq.2) &child = max(0.0d0,min(child,data(85),data(86))) chr = 0. c if(lawyr.le.2002.or.lawyr.ge.2015) then if(lawyr.le.2002) then chr = .01*max(20.0d0,30.-max((agi-10000.)/2000.,0.0d0)) else chr = .01*max(20.0d0,35.-max((agi-15000.)/2000.,0.0d0)) endif chcr = chr*child c Indicator for Child Care Credit Phaseout! pchild = 0. rchild=0. if(chr.gt..2.and.chr.lt..3.and.chcr.gt.0.and. & (lawyr.le.2002.or.lawyr.ge.2013)) pchild = 1. if(chr.gt..2.and.chr.lt..35.and.chcr.gt.0.and. & (lawyr.gt.2002.and.lawyr.lt.2013)) pchild = 1. if(pchild.eq.1) rchild = 100*.01*dagidw*child/2000. chcr = max(0.0d0,1 - extnd(57))*chcr refchcr = 0 if(extnd(73).gt.0) then refchcr = chcr chcr = 0 endif if(child.gt.0.and.chcr.gt.0) then if(extnd(57).gt.0.and.extnd(57).lt.1) then pchild = 1 rchild = 100*(1 - extnd(57))*dagidw else if(extnd(57).eq.1) then pchild = 0 rchild = 0 endif endif c Elder credit c elder = data(32) elder = 0. pold=0. rold=0. if(data(9).gt.0) then exagi = max(0.0d0,agi-10000/sepret) eldlim = 7500/sepret if(data(9).eq.1.0d0.and.data(3).ne.2.0d0) then exagi = max(0.0d0,agi-7500) eldlim = 5000. endif elder = .15*max(0.0d0,eldlim-(.5*exagi+data(91)-ssagi)) endif c EARNED INCOME TAX CREDIT c crmaxa = credit max ymaxa = beginning of phaseout range c rtbase = credit rate rtless = phaseout rate c ieic = 0, 1, or 2 dependents. c after 1999, income limits are indexed by 3% but rates are left unchanged c data106 is children at home, data107 is children away from home c AGI and EARNED are limited by amax for eligibility of EIC earncr = 0. nearn=0 c Indicator for EIC Phase-out peic = 0. reic = 0 am = 0. ym = 0. dep = 2. if(lawyr.ge.2009) dep = 3. ieic = int(max(0.0d0, & min(data(8)-data(209),data(8)-data(107)-data(108),dep))) if(lawyr.ge.1994.and.data(203).gt.0) ieic = min(dep,data(203)) if (data(7).eq.1.and.data(3).eq.1) nearn=1 if (mstat.eq.2) nearn=2 modagi = agi if(capgn.lt.0.and.lawyr.le.2002) modagi = modagi - capgn if(schede.lt.0.and.lawyr.le.2002) modagi = modagi - schede if(lawyr.eq.1997.and.data(17).lt.0) modagi = modagi - .5*data(17) if(lawyr.gt.1997.and.data(17).lt.0.and.lawyr.le.2002) & modagi = modagi - .75*data(17) if (nearn.gt.0) then c EITC parameters rtbs = rtb(lawyr,ieic) rtlw = rtl(lawyr,ieic) ym = ymaxa(ieic,nearn) crm = crmaxa(ieic,nearn) am = amaxa(ieic,nearn) c Earned Income for EITC purposes is earny if(extnd(88).gt.0) earny = data(98) earncr=min(rtbs*earny,crm) if(earncr.lt.crm.and.max(modagi,earny).lt.ym) then peic = 1. reic = -rtbs*dagidw endif if (modagi.gt.ym.or.earny.gt.ym) then eicpo = rtlw*max(0.0d0,max(modagi,earny)- ym) earncr= min(earncr,max(0.0d0,crm - eicpo)) if(earncr.gt.0) then peic = 1. reic = rtlw*dagidw endif endif reic=reic*100 if (lawyr.le.1993.and.ieic.eq.0) then earncr = 0. else if (modagi.gt.ym+crm/rtlw.or.earny.gt.ym+crm/rtlw)earncr=0. endif if ((modagi.gt.am+20.or.earny.gt.am+20).and.earncr.gt.10) then c stop 144 endif if(earncr.le.0) earncr = 0. if(lawyr.lt.1994.and.data(8).eq.0) earncr = 0. if(data(202).lt.0.or.data(197).lt.0.) earncr = 0. if(data(105).gt.0.and.lawyr.ge.1991) earncr = 0. c Separate returns are not eligible for EIC if(sepret.eq.2) earncr = 0. c Disqualified Income for years 1997+ if(lawyr.ge.1996) then disqy = max(0.0d0,capgn)+divall+data(14)+ & max(0.0d0,data(73))+max(0.0d0,data(74))+max(0.0d0,data(75))+ & max(0.0d0,data(76))+max(0.0d0,data(77))+max(0.0d0,data(78))+ & max(0.0d0,data(79))+max(0.0d0,data(19)) dyeic = 0. if(disqy.gt.dylim) then c extnd(56) turns off the smoothing of the EIC with respect to property income if(extnd(56).gt.0) then earncr = 0. else earncr = max(0.0d0,earncr-(disqy-dylim)) endif dyeic = 1. endif endif c Childless people over 65 y.o. are not eligible for the EITC c (if joint -- both should be aged ) if(data(9).ge.data(7).and.ieic.eq.0) earncr = 0. c extnd(13) is in use for webcalc to turn off the EITC if(extnd(13).ne.0.0d0) earncr = 0. c if agep is reported c Childless people younger than 25 y.o. are not eligible for the EITC c n205 -- the age of the older taxpayer c n206 -- the age of the younger taxpayer n205 = data(205) n206 = data(206) if(((n205.lt.25.and.n205.gt.0).or. & (n205.gt.65.and.n206.lt.25.and.n206.gt.0)) & .and.lawyr.ge.1994.and.ieic.eq.0) earncr = 0 c if(data(93).eq.0.and.earny.gt.0) then c data93 is EIC claimed by the taxpayer c earncr = 0. c reic = 0. c peic = 0. c endif endif bpeic = max(0.0d0,earny-am) if(earncr.gt.0) then if(earny.gt.0.and.earny.le.crm/rtbs) then bpeic = earny else if(earny.gt.crm/rtbs.and.earny.le.ym) then bpeic = earny - crm/rtbs else if(earny.gt.ym.and.earny.le.am) then bpeic = earny - ym endif endif bppeic = taxinc - (earny - bpeic) c New credits from TRA97 c Child Tax Credit, Additional Child Tax Credit, and Education Credits c Child Tax Credit is $400 per child in 1998, $500 per child in 1999 c children under 17 are imputed based on figures from the SOI and c and the Statistical Abstract of the US c chpute = under 17 year old dependents c Education credit c educred incorporates non-refundability and stacking rules c (older credits applied first, child tax & education credits last) c Nonrefundability limits are apportioned evenly between Child and c Education credits whenever stacking becomes an issue. chcred = 0. edcred = 0. c Phase-out indicator for Child Tax Credit pcht = 0. rcht = 0. chcr1 = 0. ctcred = 0. paddcr = 0. life = 0. hope = 0. precrd = 0. if (lawyr.ge.1998) then xlin10 = max(0.0d0,taxbca-chcr-elder) ideps=data(208) if(egtrra.eq.0) then precrd = 500*ideps else c Accelerated Increase in Child Tax Credit chcmax=chmax(lawyr) c maximum child tax credit is $800 for each kid after 2010 if(extnd(7).eq.1.and.lawyr.ge.2010) chcmax = 800. if(gjtrra.ne.0.0d0) then if(lawyr.eq.2003.or.lawyr.eq.2004) chcmax = 600. endif precrd = chcmax*ideps endif cphase = cphas(mstat) if (agi.gt.cphase) then excess = agi-cphase reduc = (excess/1000.)*50. precrd = max(0.0d0,precrd-reduc) if(precrd.gt.0.and.precrd.lt.xlin10) then pcht = 1. rcht = 100*50/1000. endif endif ctcred = min(precrd,xlin10) c Additional Child Tax Credit cssmax = ssmax(lawyr) ssmtax = .0765*min(cssmax,max(0.0d0,earned)) if(lawyr.eq.2011.or.lawyr.eq.2012) & ssmtax = .0565*min(cssmax,max(0.0d0,earned)) if (ideps.gt.2.) then if(lawyr.ge.1998.and.lawyr.le.2000) then xline5 = max(0.0d0,ssmtax-earncr) xline8 = max(0.0d0,precrd-ctcred) chcr1 = min(xline5,xline8) endif endif if(chcr1.gt.0) then if(chcr1.eq.xline8) raddcr = rgrate endif chcred = ctcred chcred = (1-extnd(15))*chcred c Education Crd if(lawyr.eq.1998) then edcred = data(143)+.2*data(144) else if(lawyr.ge.1999) then xlim = 10000. if(lawyr.le.2002) xlim = 5000. life = .2*min(data(144),xlim) c if(data(110).gt.0.and. c & (lawyr.le.2008.or.lawyr.gt.2018)) then c if(data(143)/data(110).le.hplm) then c hope = data(143) c else c colc = min(2*hplm*data(110),data(143)) c cold = min(hplm*data(110),colc) c hope = .5*(colc + cold) c endif c endif c ARRA 2009 - American Opportunity Credit c if(lawyr.ge.2009.and.lawyr.le.2018) hope = data(143) hope = data(143) if(sepret.eq.2) then c You cannot claim edcred if filing status is married filing separately hope = 0. life = 0. endif hoperf = 0. if(lawyr.ge.2009.and.data(158).gt.0.0d0) hoperf = .4*hope hope = hope - hoperf edcred = hope + life if(life.eq.0.0d0) hope = edcred if(hope.eq.0.0d0) life = edcred endif phase1 = edphls(lawend)*xndxa(lawyr)/xndxa(lawend) phase2 = edphhs(lawend)*xndxa(lawyr)/xndxa(lawend) if(mstat.eq.2) then phase1 = edphlm(lawend)*xndxa(lawyr)/xndxa(lawend) phase2 = edphhm(lawend)*xndxa(lawyr)/xndxa(lawend) endif pedu = 0. redu = 0. if(lawyr.le.2008) then if (agi.ge.phase2) edcred = 0. if (agi.gt.phase1.and.agi.lt.phase2.and.edcred.gt.0) then pedu = 1. redu = 100*edcred/(10000.*data(07)) edcred = edcred*(phase2-agi)/(10000.*data(07)) endif else c ARRA 2009+ phaseouts only for American Opportunity Credit(refundable) c reflects lines from 2009 form 8863 hoptot = hope + hoperf phaseh = 90000. if(mstat.eq.2) phaseh = 180000. delta = 10000*data(7) phaseh1 = phaseh - delta excess = phaseh - agi if(excess.le.0.0d0) then hope = 0 hoperf = 0 life = 0 edcred = 0 else if(excess.ge.delta) then pcnt = 1. else pcnt = excess/delta endif hope = hoptot*pcnt if (agi.gt.phaseh1.and.agi.lt.phaseh.and.hope.gt.0) then pedu = 1. redu = 100*hope/delta endif if(data(158).gt.0.0d0) hoperf = .4*hope hope = hope - hoperf endif c Phaseouts for the Lifetime Learning Credit (non-refundable) 2009+ excess = phase2 - agi if(excess.le.0.0d0) then life = 0 else if(excess.ge.delta) then pcnt = 1. else pcnt = excess/delta endif life = life*pcnt if (agi.gt.phase1.and.agi.lt.phase2.and.life.gt.0) then pedu = 1. redu = 100*life/delta endif endif edcred = hope+life endif c Stacking Credits: old credits first, child and education credits last c oldcr = c & chcr+elder+data(33)+data(35)+data(37)+data(38)+data(40) oldcr = chcr+elder+data(35)+data(38)+data(40)+data(37) newcr = edcred+chcred totcr = newcr+oldcr if (taxbca.ge.oldcr.and.taxbca.lt.totcr) then c tax after old ref + child + life credits taxtmp = max(0.0d0,taxbca-totcr) c edcred = taxbca - taxtmp endif endif c total non-refundable credits chcrbc = chcr avail = taxbc if(lawyr.ge.2000) avail = avail + almtax chcr = min(chcr,avail) avail = max(0.0d0,avail - chcr - elder - data(34)) if(lawyr.ge.1998) then edcred = min(avail,edcred) avail = avail - edcred endif avail = max(0.0d0,avail - data(38) - data(35) - data(40)) if(lawyr.ge.1998) then chcred = min(avail,chcred) avail = avail - chcred endif credit = oldcr+chcred+edcred if(lawyr.ge.2000) then crdlost = max(0.0d0,credit - taxbc - almtax) else crdlost = max(0.0d0,chcr + elder + precrd - taxbc) endif c Phase-out Indicator for SS Benefits rssa=0. if(pssa.eq.1) then if(lawyr.ge.1994) then if(reic.ne.rtb(lawyr,ieic).and.peic.eq.1) then if(pssa1.eq.1) then rssa= .85*rgrate else if(pssa2.eq.1) then rssa=.5*rgrate endif else if(pssa1.eq.1) then rssa= .85*(rgrate-reic)+reic else if(pssa2.eq.1) then rssa=.5*(rgrate-reic)+reic endif endif else rssa=.5*rgrate endif endif c Phase out indicator for elderly credit if(exagi.gt.0.and.elder.gt.0) then pold=1. rold=max(0.0d0,.15*dagidw*(50-rssa)) endif c Phase-out Indicator for Rental Loss rrent=0. if(prent.eq.1.) & rrent= abs(max(data(73),-25000.0d0/sepret))/(50000.0d0/sepret)* & (rgrate-reic)+reic c Phase-out Indicator for ira pira = 0 rira=0. if(agira.gt.phaira.and.data(29).gt.0.and.ira.gt.0) then pira = 1 if(reic.ne.rtb(lawyr,ieic)) then rira= min(iramax,data(29))/range*rgrate else rira = min(iramax,data(29))/range*(rgrate-reic)+reic endif endif if(extnd(58).gt.0) then pira = 0 rira = 0. endif c rrate = rssa+rira+rrent+rchild+rold+rdisab &+rgrate+rdical+(rsave+rxmp)*100+rded+rexem &-rchar+rcasu+rmisc+redu rate = rrate + reic + rcht c Phase-out indicator for Almtax palm = 0. ralm = 0. if(almtax.gt.0.and.data(105).ne.1) then coeff=1. if(exclnt.gt.0.and.phaout.gt.0) coeff=1.25 if(lawyr.ge.1997.and.alminc.lt.ltg) almrat = 0. ralm=coeff*almrat*100*dagidw if(cded.gt.0) then ralm=coeff*100*almrat*(dagidw+ddeddw-.02*pmisc*dagidw) if(lawyr.gt.1993.or.lawyr.lt.1989) & ralm=coeff*100*almrat*(dagidw+ddeddw-.02*pmisc*dagidw- & (.03*pded+.3*.8*pded1+.5*.8*pded2)*dagidw) if(pdical.eq.1) then if(.025*agix.lt.edical) then ralm=ralm+coeff*.025*dagidw*100*almrat else ralm=ralm-coeff*.075*dagidw*100*almrat endif endif endif if(taxbca.lt.credit) ralm=ralm- & rgrate*(dagidw-.5*pchar1-.3*pchar2)-rded-rmisc-rexem if(lawyr.ge.1997.and.ltg.gt.alminc+100.) then if(amtr25.gt.0) then ralm = .25*coeff*100*dagidw else if(amtr15.gt.0.and.amtr25.eq.0) then ralm = cgrate*coeff*100*dagidw else if(amtr5.gt.0.and.amtr15.eq.0.and.amtr25.eq.0) then ralm = cgrat1*coeff*100*dagidw endif endif if(lawyr.ge.1998.and.tamt.eq.0) ralm= rcht + rchild + rold if(pchar1.eq.1.and.rgrate.eq.0) ralm=ralm*(1-pchar1*.5) ralm = ralm - rrate if(ralm.gt.0) palm = 1. rate = ralm + reic + rcht + rrate endif c Starting in 2001, the Child Tax Credit is refundable to the extent c of 10 percent of earned income in excess of $10,000 earnch = max(0.0d0,earned) if (lawyr.ge.2001) then earlim = ealim(lawyr) tenpct = eapct(lawyr)*max(0.0d0,earnch - earlim) chcr1 = min(precrd-chcred,tenpct) if(ideps.gt.2.and.tenpct.lt.precrd-chcred) & chcr1 = min(precrd-chcred,max(tenpct,max(0.0d0,ssmtax-earncr))) raddcr = 0. chcr1 = (1 - extnd(15))*chcr1 if(chcr1.gt.0) then if(chcr1.eq.precrd-chcred.and.chcred.gt.0) then raddcr = rgrate if(lawyr.ge.2000.and.almtax.gt.0.and.ralm.gt.0) raddcr = ralm if(chcred.eq.xlin10) raddcr = raddcr + rchild if(pcht.eq.1.or.(precrd.lt.ideps*chcmax.and.agi.gt.cphase)) & raddcr = raddcr + 5. else if(chcr1.lt.precrd-chcred) then raddcr = - eapct(lawyr)*100 else if(chcr1.eq.ssmtax-earncr) then raddcr = -7.65 - reic if(lawyr.eq.2011.or.lawyr.eq.2012) raddcr = -5.65 - reic endif paddcr = 1 rate=rate+raddcr endif endif c 2009-2010 Making Work Pay and Government Retiree Credits c(refundable line 63 of 2009 Form 1040) wpaycr = 0 pwpay = 0 rwpay = 0 if((lawyr.eq.2009.or.lawyr.eq.2010).and. &data(105).lt.1.and.earny.gt.0.and.agi.lt.95000*data(7)) then crwpay = 400. wpaycr = max(0.0d0,min(crwpay*data(7),.062*earny) - & .02*max(0.0d0,agi-data(7)*75000)) if(wpaycr.gt.0.and.agi.gt.data(7)*75000) then rwpay = 2. pwpay = 1 rate = rate + rwpay endif c if(data(91).gt.0.and.earnch.eq.0.) if(data(91).gt.0) & wpaycr = max(0.0d0,wpaycr - min(data(91),data(7)*250)) endif credit = credit+data(34) c Credit if no AMT crdnoa =credit if(taxbc.le.crdnoa) crdnoa = taxbc c if(extnd(15).ne.0.0d0) chcr1 = 0. taxnoa = taxbc-crdnoa-earncr-chcr1-hoperf-wpaycr-refchcr pmcare = 0 rmcare = 0 if(lawyr.ge.2000) then dicare = 0. c 2013 Additional Medicare tax on "unearned" Investment Income if(lawyr.ge.2013) then thres = 200000. if(mstat.eq.2.or.data(3).eq.2) & thres = 250000/data(3) if(agi.gt.thres) then dinc = max(0.0d0,data(14)+data(12)+capgn+schede) c The NIIT allows state and local income taxes attributable to c the investment income to be deducted expnse = data(50)*min(1.d0,dinc/agi) dinc = max(0.0d0,dinc - expnse) dicare = .038*min(dinc,agi-thres) if(agi-thres.lt.dinc) then pmcare = 1 rmcare = 3.8 endif rate = rate + rmcare endif taxnoa = taxnoa + dicare endif taxaft = max(0.0d0,taxbc+almtax+dicare-credit) else taxaft = max(0.0d0,taxbc-credit) endif if(crdlost.gt.0.or. & (lawyr.le.1999.and.precrd.gt.0.and. & precrd+chcr+elder+edcred+data(34).ge.taxbc).or. & (lawyr.ge.2000.and.precrd.gt.0.and. & precrd+chcr+elder+edcred+data(34).ge.taxbca)) then if(lawyr.ge.2000) credit = taxbca if(lawyr.lt.2000) credit = taxbc if(dagidw.ne.0.and.reic.gt.0) reic = reic/dagidw if(lawyr.ge.2000) rate = reic + raddcr + rdical if(lawyr.lt.2000) rate = reic + raddcr + ralm endif c data(182) - first time home buyer credit tax = taxaft - earncr - chcr1 - hoperf - wpaycr - refchcr & - data(182) c 2006 Refundable Credit for Federal Telephone Excise Tax Paid telcr = 0. if(lawyr.eq.2006.and.exemps.gt.0)telcr = 10*(min(exemps,4.0d0)+2.) tax = tax - telcr c taxsoi is the SOI definition of Total Tax, it does not include the c refundable portion of the EITC c data46 is computed other taxes, a residual c (earncr-eitc) refundable part of Earned Income Credit eitc = earncr if (taxaft.le.eitc) eitc = taxaft taxsoi = taxaft - eitc c taxsoi = taxaft - eitc + rrcred pretax = max(regtax,almtax,(tax+credit+eitc+chcr1)) crdnon=credit taxnon=max(0.0d0,taxbc+almtax-crdnon) if(extnd(53).eq.data(100).and.data(100).ne.0) call printdc(data) return end subroutine printdc(d) implicit double precision(a-h,o-z) dimension d(255) common/newshr/c(255) common/calc/st(12) save krec data krec/0/ krec = krec + 1 91231 write(15,200) (i,i=1,10) do 10 i=0,18 write(15,100) i,(int(d(i*10+j)),j=1,10),i*10 10 continue 91232 write(15,'(////)') 91233 write(15,200) (i,i=1,10) do 20 i=0,18 91234 write(15,100)i,(int(c(i*10+j)),j=1,10),i*10 20 continue 91235 write(15,300) (int(st(i)),i=1,12) c if(krec.ge.10) stop 10 100 format(i4,10i8,i4,'-') 200 format(4x,10i8/) 300 format(' st',12i8,31(/)) return end c c **************************************************************************** c TAX TABLE COMPUTATIONS and XYZ TAX TABLES 1960 to 2001 c **************************************************************************** c c Calculate regular taxes 1960-63 c subroutine tax62(tax,rate,nfile,taxinc) implicit double precision (A-H,O-Z) common /tab62/ toptab(77),tmrtab(77),acctab(78),ibeg(3) itab=ibeg(nfile) faster=taxinc 10 itab=itab+1 if(faster.le.toptab(itab)) go to 100 go to 10 100 continue rate = tmrtab(itab) tax = acctab(itab)+(faster-toptab(itab-1))*rate if(tax.le.0) rate=0. return end c c Calculate regular taxes 1964 c subroutine tax64(tax,rate,nfile,taxinc) implicit double precision (A-H,O-Z) common /tab64/ toptab(91),tmrtab(91),acctab(92),ibeg(3) itab=ibeg(nfile) faster=taxinc 10 itab=itab+1 if(faster.le.toptab(itab)) go to 100 go to 10 100 continue rate=tmrtab(itab) tax=acctab(itab)+(faster-toptab(itab-1))*rate if(tax.le.0) rate=0. return end c c Calculate regular taxes 1965-1970 c subroutine tax70(tax,rate,nfile,taxinc) implicit double precision (A-H,O-Z) common /tab70/ toptab(86),tmrtab(86),acctab(87),ibeg(3) itab=ibeg(nfile) faster=taxinc 10 itab=itab+1 if(faster.le.toptab(itab)) go to 100 go to 10 100 continue rate=tmrtab(itab) tax=acctab(itab)+(faster-toptab(itab-1))*rate if(tax.le.0) rate=0. return end c c Calculate regular taxes 1971-1976 c subroutine tax74(tax,rate,nfile,sepret,taxinc) implicit double precision (A-H,O-Z) common /tab74/ toptab(86),tmrtab(86),acctab(87),ibeg(3) integer sepret itab=ibeg(nfile) faster=taxinc*sepret 10 itab=itab+1 if(faster.le.toptab(itab)) go to 100 go to 10 100 continue rate=tmrtab(itab) tax=(acctab(itab)+(faster-toptab(itab-1))*rate)/sepret if(tax.le.0) rate=0. return end c c Calculate regular taxes 1977-78 c subroutine rtax77(tax,rate,nfile,sepret,taxinc) implicit double precision (A-H,O-Z) common /l6077/ toptab(89),tmrtab(89),acctab(90),ibeg(3) integer sepret itab=ibeg(nfile) faster=taxinc*sepret 10 itab=itab+1 if(faster.le.toptab(itab)) go to 100 go to 10 100 continue rate=tmrtab(itab) tax=(acctab(itab)+(faster-toptab(itab-1))*rate)/sepret if(tax.le.0) rate=0. return end c c Calculate regular taxes 1979 c subroutine rtax79(tax,rate,nfile,sepret,taxinc) implicit double precision (A-H,O-Z) common /l6079/ toptab(52),tmrtab(52),acctab(53),ibeg(3) integer sepret itab=ibeg(nfile) faster=taxinc*sepret 10 itab=itab+1 if(faster.le.toptab(itab)) go to 100 go to 10 100 continue rate=tmrtab(itab) tax=(acctab(itab)+(faster-toptab(itab-1))*rate)/sepret if(tax.le.0) rate=0. return end c c Second set of Tax table lookup for 1977 and 1978 c subroutine tax77 (taxinc,sepret,nfile,rate,tax) implicit double precision (A-H,O-Z) common /tab77/ ibeg(3),iend(3),toptab(83),tmrtab(83), & acctab(83) integer sepret ttax = 0. atab = 0. btab = 0. faster = taxinc*sepret itab = ibeg(nfile) - 1 10 itab = itab+1 atab = toptab(itab) if (faster.le.atab) goto 200 trate = tmrtab(itab) ttax = ttax+trate*(atab-btab) btab = atab goto 10 200 continue rate = tmrtab(itab) tax = (ttax+rate*(faster-btab))/sepret if(tax.le.0) rate=0. return end c c Tax table lookup for 1979-1981 c subroutine tax79(taxinc,sepret,nfile,rate,tax) implicit double precision (A-H,O-Z) common /tab79/ toptab(52),tmrtab(52),acctab(53),ibeg(3) integer sepret faster = taxinc*sepret itab = ibeg(nfile) 10 itab = itab+1 if (faster.le.toptab(itab)) goto 200 goto 10 200 continue rate = tmrtab(itab) tax = (acctab(itab)+rate*(faster-toptab(itab-1)))/sepret if(tax.le.0) rate=0. return end c c Tax table lookup for 1982 c subroutine tax82(taxinc,sepret,nfile,rate,tax) implicit double precision (A-H,O-Z) common /tab82/ toptab(43),tmrtab(43),acctab(44),ibeg(3) integer sepret faster = taxinc*sepret itab = ibeg(nfile) 10 itab = itab+1 if (faster.le.toptab(itab)) goto 200 goto 10 200 continue rate = tmrtab(itab) tax = (acctab(itab)+rate*(faster-toptab(itab-1)))/sepret if(tax.le.0) rate=0. return end c c Tax table lookup for 1983 c subroutine tax83(taxinc,sepret,nfile,rate,tax) implicit double precision (A-H,O-Z) common /tab83/ toptab(46),tmrtab(46),acctab(47),ibeg(3) integer sepret faster = taxinc*sepret itab = ibeg(nfile) 10 itab = itab+1 if (faster.le.toptab(itab)) goto 200 goto 10 200 continue rate = tmrtab(itab) tax = (acctab(itab)+rate*(faster-toptab(itab-1)))/sepret if(tax.le.0) rate=0. return end c c Tax table lookup for 1984-1986 c subroutine tax84(taxinc,sepret,nfile,rate,tax) implicit double precision (A-H,O-Z) common /tab84/ toptab(49),tmrtab(49),acctab(50),ibeg(3) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) integer sepret faster = taxinc*sepret itab = ibeg(nfile) 10 itab = itab+1 if (faster.le.xndx*toptab(itab)) goto 200 goto 10 200 continue rate = tmrtab(itab) tax = (xndx*acctab(itab)+rate*(faster-xndx*toptab(itab-1)))/ & sepret if(tax.le.0) rate=0. return end c c Tax table lookup for 1987 incorporates 28% max rate on gains. c subroutine tax87(taxinc,sepret,nfile,rate,tax,data) implicit double precision (A-H,O-Z) dimension data(255) common /tab87/ toptab(18),tmrtab(18),acctab(19),ibeg(3) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) double precision cgflag integer sepret itab = ibeg(nfile) ttab = toptab(itab+3)/sepret cglong = min(data(70),data(68)+data(70)) cglong = max(cglong,0.0d0) c if (taxinc.ge.ttab.and.taxinc-cglong.le.ttab) then c c Tax on income up to 28% bracket plus 28% of excess. c rate = tmrtab(itab) t28 = (taxinc-ttab) tax = acctab(itab+4)/sepret+.28*t28 if(t28.gt.0.and.rate.eq.0) rate=.28 else c c Tax on non-cg income plus 28% of cg income. c if (taxinc.lt.ttab) then faster = taxinc*sepret cgflag = 0. else faster = (taxinc-cglong)*sepret cgflag = 1. endif 10 itab = itab+1 if (faster .le. toptab(itab)) goto 200 goto 10 200 continue rate = tmrtab(itab) tax = (acctab(itab)+rate*(faster-toptab(itab-1)))/ & sepret if (tax.le.0.) rate = 0. tax = tax+.28*cglong*cgflag if(cglong.gt.0.and.rate.eq.0) rate=.28 endif return end c c Tax table lookup for 1988 to 1990 c subroutine tax88(taxinc,sepret,nfile,rate,tax) implicit double precision (A-H,O-Z) common /tab88/ toptab(9),tmrtab(9),acctab(10),ibeg(3) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) integer sepret faster = taxinc*sepret itab = ibeg(nfile) 10 itab = itab+1 if (faster.le.xndx*toptab(itab)) goto 200 goto 10 200 continue rate = tmrtab(itab) tax = (xndx*acctab(itab)+rate*(faster-xndx*toptab(itab-1)))/ & sepret if (tax.le.0.) rate = 0. return end c c Tax table lookup for 1991 incorporates 28% max rate on gains. c subroutine tax91(taxinc,sepret,nfile,rate,tax,data,regtax) implicit double precision (A-H,O-Z) dimension data(255) common /tab91/ toptab(12),tmrtab(12),acctab(13),ibeg(3) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) common /xndxac/ xndxa(1981:2023) common /newshr/ comnew(255) integer sepret itab = ibeg(nfile) bot28 = toptab(itab+1)/sepret top28 = toptab(itab+2)/sepret acc = 0 c c index to 1991 levels c pcglg=0 c blowup = xndx/1.124 blowup = xndx/xndxa(1991) cglong = min(data(70),data(68)+data(70))/blowup taxin2 = taxinc/blowup taxin3 = taxin2 faster = taxin3*sepret 101 itab = itab+1 if (faster .le. toptab(itab)) goto 100 acc = acc+tmrtab(itab)*(toptab(itab)-toptab(itab-1)) goto 101 100 continue rate = tmrtab(itab) regtax = (acc+rate*(faster-toptab(itab-1)))/sepret regtax = regtax*blowup if (regtax.le.0.) rate = 0. acc=0. itab = ibeg(nfile) if(data(70).gt.0..and.cglong.gt.0.. & and.taxin2.gt.top28) then taxin3 = max(taxin2-cglong,bot28) faster = taxin3*sepret pcglg=1 10 itab = itab+1 if (faster .le. toptab(itab)) goto 200 acc = acc+tmrtab(itab)*(toptab(itab)-toptab(itab-1)) goto 10 200 continue rate = tmrtab(itab) tax = (acc+rate*(faster-toptab(itab-1)))/sepret excess = taxin2 - taxin3 tax = tax+.28*excess if(excess.gt.0.and.pcglg.gt.0.and.taxin2-cglong.lt.bot28) & rate=.28 tax = tax*blowup if (tax.le.0.) rate = 0. else tax=regtax endif return end c c **************************************************************************** c Clinton tax increases for tax year 1993 c **************************************************************************** c subroutine tax93 &(taxinc,sepret,nfile,regrat,tax,data,tax36,surtax,short,regtax) implicit double precision (A-H,O-Z) dimension data(255) common /tab93/ toptab(18),tmrtab(18),acctab(19),ibeg(3) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) common /newshr/ comnew(255) integer sepret acc = 0. cglong = min(data(70),data(68)+data(70)) itab = ibeg(nfile) bot28 = toptab(itab+1) top28 = toptab(itab+2) taxin2=taxinc pcglg=0. taxin3 = taxin2 faster = taxin3*sepret 101 itab = itab+1 if (faster .le. toptab(itab)) goto 100 rate=tmrtab(itab) acc=acc+rate*(toptab(itab)-toptab(itab-1)) goto 101 100 continue regrat = tmrtab(itab) regtax = (acc+regrat*(faster-toptab(itab-1)))/sepret c acc=0. itab = ibeg(nfile) if(data(70).gt.0..and.cglong.gt.0..and. & taxin2*sepret.gt.top28) then taxin3 = max(taxin2-cglong,bot28) faster = (taxin3)*sepret pcglg=1. 10 itab = itab+1 if (faster .le. toptab(itab)) goto 200 rate=tmrtab(itab) acc=acc+rate*(toptab(itab)-toptab(itab-1)) goto 10 200 continue rate = tmrtab(itab) taxncg = (acc+rate*(faster-toptab(itab-1)))/sepret excess = taxin2 - taxin3 tax = taxncg+.28*excess if(excess.gt.0.and.pcglg.gt.0.and.taxin2-cglong.lt.bot28) & rate=.28 if (tax.le.0.) rate = 0. else tax=regtax endif tax36 = 0. surtax = 0. itab = ibeg(nfile) itab = itab+1 taxnbk = (faster-toptab(itab-1))/sepret if(mod(itab,6).eq.4.or.mod(itab,6).eq.5) then short = (toptab(itab)-faster)/sepret else short = 0. endif along=toptab(itab)-faster if(data(70).gt.0..and.cglong.gt.0..and.taxin2.gt.top28) then if(along.eq.0) along=34000 endif tax36=0. surtax=0. if(mod(itab,6).eq.5) then tax36 = .05*taxnbk surtax = 0. elseif(mod(itab,6).eq.0) then tax36 = .05*(faster-toptab(itab-2))/sepret surtax = .036*taxnbk else tax36=0. surtax=0. endif if (tax.le.0.) rate = 0. return end c c **************************************************************************** c Clinton tax increases for years beginning in 1994 c **************************************************************************** c subroutine tax94 &(taxinc,sepret,nfile,rate,tax,data,tax36,surtax,short,lawyr, & regtax) implicit double precision (A-H,O-Z) dimension data(255), ibeg(3),toptab(18),tmrtab(18) common /tab94/ top94(18),tmr94(18),ibeg94(3) common /tab95/ top95(18),tmr95(18),ibeg95(3) common /tab96/ top96(18),tmr96(18),ibeg96(3) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) common /newshr/ comnew(255) integer sepret acc = 0. cglong = 0. if (data(70).gt.0.) & cglong = max(0.0d0,min(data(70),data(68)+data(70))) c if (lawyr.eq.1994) then do 11 i=1,3 11 ibeg(i) = ibeg94(i) do 12 i=1,18 toptab(i) = top94(i) 12 tmrtab(i) = tmr94(i) elseif (lawyr.eq.1995) then do 21 i=1,3 21 ibeg(i) = ibeg95(i) do 22 i=1,18 toptab(i) = top95(i) 22 tmrtab(i) = tmr95(i) elseif (lawyr.eq.1996) then do 31 i=1,3 31 ibeg(i) = ibeg96(i) do 32 i=1,18 toptab(i) = top96(i) 32 tmrtab(i) = tmr96(i) endif c itab = ibeg(nfile) bot28 = toptab(itab+1) top28 = toptab(itab+2) taxin3 = 0 excess = 0. faster =taxinc*sepret 10 itab = itab+1 if (faster.le.toptab(itab)) goto 200 rate=tmrtab(itab) acc=acc+rate*(toptab(itab)-toptab(itab-1)) goto 10 200 continue rate = tmrtab(itab) regtax = (acc+rate*(faster-toptab(itab-1)))/sepret regrat = rate tax = regtax acc = 0. if(cglong.gt.0) then itab = ibeg(nfile) bot28 = toptab(itab+1) top28 = toptab(itab+2) taxin3 =max(bot28/sepret,taxinc-cglong) faster = taxin3*sepret excess=max(0.0d0,taxinc - taxin3) 101 itab = itab+1 if (faster.le.toptab(itab)) goto 2001 rate=tmrtab(itab) acc=acc+rate*(toptab(itab)-toptab(itab-1)) goto 101 2001 continue rate = tmrtab(itab) if((acc+rate*(faster-toptab(itab-1)))/sepret+.28*excess.lt. & regtax) then tax=(acc+rate*(faster-toptab(itab-1)))/sepret+.28*excess if(bot28/sepret.gt.taxinc-cglong) rate=0.28 endif endif tax36 = 0. surtax = 0. short = 0. taxnbk = (faster-toptab(itab-1))/sepret if(mod(itab,6).eq.4.or.mod(itab,6).eq.5) then short = (toptab(itab)-faster)/sepret endif along=toptab(itab)-faster if(data(70).gt.0.and.cglong.gt.0.and.taxinc*sepret.gt.top28) then if(along.eq.0) along=34000 endif if(mod(itab,6).eq.5) then tax36 = .05*taxnbk surtax = 0. elseif(mod(itab,6).eq.0) then tax36 = .05*(faster-toptab(itab-2))/sepret surtax = .0360*taxnbk endif c if (tax.le.0.) rate = 0. return end c c **************************************************************************** c TRA97 c **************************************************************************** c subroutine tax97 (taxinc,sepret,nfile,rate,tax,data,lawyr,brac15, & regtax,taxng,taxltg,ltg) implicit double precision (A-H,O-Z) double precision ltg dimension data(255), ibeg(3),toptab(18),tmrtab(18) common /tab97/ top97(18),tmr97(18),ibeg97(3) common /tab98/ top98(18),tmr98(18),ibeg98(3) common /tab99/ top99(18),tmr99(18),ibeg99(3) common /tab00/ top00(18),tmr00(18),ibeg00(3) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) common/newshr/comnew(255) common /xndxac/ xndxa(1981:2023) integer sepret acc = 0. cglong = max(0.0d0,ltg-data(115)-data(138)) taxin9 = max(0.0d0,taxinc-cglong) c if (lawyr.eq.1997) then do 11 i=1,3 11 ibeg(i) = ibeg97(i) do 12 i=1,18 toptab(i) = top97(i) 12 tmrtab(i) = tmr97(i) elseif (lawyr.eq.1998) then do 21 i=1,3 21 ibeg(i) = ibeg98(i) do 22 i=1,18 toptab(i) = top98(i) 22 tmrtab(i) = tmr98(i) elseif (lawyr.eq.1999) then do 31 i=1,3 31 ibeg(i) = ibeg99(i) do 32 i=1,18 toptab(i) = top99(i) 32 tmrtab(i) = tmr99(i) elseif (lawyr.eq.2000.or.egtrra.ne.1) then do 41 i=1,3 41 ibeg(i) = ibeg00(i) do 42 i=1,18 toptab(i) = top00(i)*xndxa(lawyr)/xndxa(2000) 42 tmrtab(i) = tmr00(i) endif mstat = data(2) if(mstat.eq.1) then brac15=toptab(14) else if(mstat.eq.4.or.mstat.eq.7) then brac15=toptab(8) else brac15=toptab(2)/sepret endif itab = ibeg(nfile) faster = taxinc*sepret 101 itab = itab+1 if (faster.le.toptab(itab)) goto 100 rate = tmrtab(itab) acc = acc+rate*(toptab(itab)-toptab(itab-1)) goto 101 100 continue regrat = tmrtab(itab) regtax = (acc+regrat*(faster-toptab(itab-1)))/sepret bp = toptab(itab-1) if(regtax.le.0) regrat=0. c acc = 0. itab = ibeg(nfile) faster = taxin9*sepret 10 itab = itab+1 if (faster.le.toptab(itab)) goto 200 rate = tmrtab(itab) acc = acc+rate*(toptab(itab)-toptab(itab-1)) goto 10 200 continue rate = tmrtab(itab) taxng = (acc+rate*(faster-toptab(itab-1)))/sepret if(taxng.le.0) rate=0. bpng = toptab(itab-1) c c if rate eq .15, then taxin9 is below the 15% bracket c taxltg = 0. if(cglong.gt.0) then taxltg=.1*(max(0.0d0,min(taxinc,brac15/sepret)-taxin9))+ & .2*(min(taxinc,cglong)-max(0.0d0,min(taxinc,brac15/sepret) &-taxin9))+.25*data(115) endif c calculations line-by-line Schedule D for the year 1999 if(ltg.gt.0) then c data18 is non-schedule D capital gains in agi xlin20 = ltg xlin21 = data(138) xlin22 = max(0.0d0,xlin20-xlin21) xlin23 = max(0.0d0,data(68)+data(117)) xlin24 = max(0.0d0,min(data(117),xlin23)) xlin25 = data(115) xlin26 = xlin25 + xlin24 xlin27 = max(0.0d0,xlin22-xlin26) xlin28 = max(0.0d0,taxinc-xlin27) xlin29 = min(brac15,taxinc) xlin30 = min(xlin28,xlin29) xlin31 = max(0.0d0,taxinc-xlin22) xlin32 = max(xlin30,xlin31) if(ltg.eq.data(18).and.data(18).gt.0) then c Capital gain tax worksheet w3 = max(0.0d0,taxinc - data(18)) xlin32 = w3 endif acc = 0. itab = ibeg(nfile) faster = xlin32*sepret 1000 itab = itab+1 if (faster.le.toptab(itab)) goto 2000 rate = tmrtab(itab) acc = acc+rate*(toptab(itab)-toptab(itab-1)) goto 1000 2000 continue rate = tmrtab(itab) taxng = (acc+rate*(faster-toptab(itab-1)))/sepret if(taxng.le.0) rate=0. bpng = toptab(itab-1) xlin36 = max(0.0d0,xlin29-xlin28) if(ltg.eq.data(18).and.data(18).gt.0) then c Capital gain tax worksheet (page 33 2000 form 1040 instructions) w5 = min(brac15,taxinc) if(w3.ge.w5) then w7 = 0. else w6 = w3 w7 = max(0.0d0,w5 - w6) endif xlin37 = w7 endif schd10 = .1*xlin36 xlin38 = min(taxinc,xlin27) xlin40 = xlin38 - xlin36 if(ltg.eq.data(18).and.data(18).gt.0) then c Capital gain tax worksheet (page 33 2000 form 1040 instructions) if(data(18).eq.w7) then w11 = 0. else w9 = min(taxinc,data(18)) w11 = max(0.0d0,w9 - w7) endif xlin40 = w11 endif schd20 = .2*xlin40 xlin42 = min(xlin22,xlin25) xlin43 = xlin22 + xlin32 xlin45 = max(0.0d0,xlin43-taxinc) xlin46 = max(0.0d0,xlin42-xlin45) schd25 = .25*xlin46 xlin49 = xlin32+xlin36+xlin40+xlin46 xlin50 = taxinc-xlin49 schd28 = .28*xlin50 if(ltg.eq.data(18).and.data(18).gt.0) then c Capital gain tax worksheet (page 33 2000 form 1040 instructions) schd28 = 0 endif taxltg = schd10 + schd20 + schd25 + schd28 endif if(regtax.lt.taxng+taxltg) then tax = regtax else tax = taxng+taxltg bp = bpng endif c comnew(96) =regtax-tax comnew(90) = bp c return end c c c **************************************************************************** c TRA2001 c **************************************************************************** c subroutine tax01 (lawyr,taxinc,sepret,nfile,rate,tax,data,brac15, & regtax,taxng,taxltg,ltg,sch10,sch20,sch25, & addtax) implicit double precision (A-H,O-Z) double precision ltg dimension data(255) common /tab01/ top01(21),tmr01(21),ibeg01(3) common /tab02/ top02(21),tmr02(21),ibeg02(3) common /tab03/ top03(21),tmr03(21),ibeg03(3) common /tab04/ top04(21),tmr04(21),ibeg04(3) common /tab05/ top05(21),tmr05(21),ibeg05(3) common /tab06/ top06(21),tmr06(21),ibeg06(3) common /tab07/ top07(21),tmr07(21),ibeg07(3) common /tab08/ top08(21),tmr08(21),ibeg08(3) common /tab09/ top09(21),tmr09(21),ibeg09(3) common /tab10/ top10(21),tmr10(21),ibeg10(3) common /tab11/ top11(21),tmr11(21),ibeg11(3) common /tab12/ top12(21),tmr12(21),ibeg12(3) common /tab13/ top13(24),tmr13(24),ibeg13(3) common /tab14/ top14(24),tmr14(24),ibeg14(3) common /tab15/ top15(24),tmr15(24),ibeg15(3) common /tab16/ top16(24),tmr16(24),ibeg16(3) common /tab17/ top17(24),tmr17(24),ibeg17(3) common /tab18/ top18(24),tmr18(24),ibeg18(3) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) common /newshr/comnew(255) common /cgrt/ cgrat1,cgrate common /xndxac/ xndxa(1981:2023) dimension ibeg(3),toptab(24),tmrtab(24) integer sepret at28 = 0. x2012 = 1.973 x2013 = 2.0223 nmax = 21 if(lawyr.ge.2013) nmax = 24 if(lawyr.eq.2001) then do 11 i=1,3 11 ibeg(i) = ibeg01(i) do 12 i=1,21 toptab(i) = top01(i) tmrtab(i) = tmr01(i) 12 continue else if(lawyr.eq.2002) then do 21 i=1,3 21 ibeg(i) = ibeg02(i) do 22 i=1,21 toptab(i) = top02(i) 22 tmrtab(i) = tmr02(i) else if(lawyr.eq.2003) then do 31 i=1,3 31 ibeg(i) = ibeg03(i) do 32 i=1,21 toptab(i) = top03(i) 32 tmrtab(i) = tmr03(i) elseif(lawyr.eq.2004) then do 41 i=1,3 41 ibeg(i) = ibeg04(i) do 42 i=1,21 toptab(i) = top04(i) tmrtab(i) = tmr04(i) 42 continue elseif(lawyr.eq.2005) then do 51 i=1,3 51 ibeg(i) = ibeg05(i) do 52 i=1,21 toptab(i) = top05(i) tmrtab(i) = tmr05(i) 52 continue elseif(lawyr.eq.2006) then do 61 i=1,3 61 ibeg(i) = ibeg06(i) do 62 i=1,21 toptab(i) = top06(i) 62 tmrtab(i) = tmr06(i) elseif(lawyr.eq.2007) then do 71 i=1,3 71 ibeg(i) = ibeg07(i) do 72 i=1,21 toptab(i) = top07(i) 72 tmrtab(i) = tmr07(i) elseif(lawyr.eq.2008) then do 81 i=1,3 81 ibeg(i) = ibeg08(i) do 82 i=1,21 toptab(i) = top08(i) 82 tmrtab(i) = tmr08(i) elseif(lawyr.eq.2009) then do 83 i=1,3 83 ibeg(i) = ibeg09(i) do 84 i=1,21 toptab(i) = top09(i) 84 tmrtab(i) = tmr09(i) elseif(lawyr.eq.2010) then do 85 i=1,3 85 ibeg(i) = ibeg10(i) do 86 i=1,21 toptab(i) = top10(i) 86 tmrtab(i) = tmr10(i) elseif(lawyr.eq.2011) then do 91 i=1,3 91 ibeg(i) = ibeg11(i) do 92 i=1,21 toptab(i) = top11(i) 92 tmrtab(i) = tmr11(i) elseif(lawyr.eq.2012) then do 95 i=1,3 95 ibeg(i) = ibeg12(i) do 96 i=1,21 toptab(i) = top12(i) 96 tmrtab(i) = tmr12(i) elseif(lawyr.eq.2013) then do 901 i=1,3 901 ibeg(i) = ibeg13(i) do 902 i=1,24 toptab(i) = top13(i) 902 tmrtab(i) = tmr13(i) elseif(lawyr.eq.2014) then c Federal Individual Income Tax Rates for 2014 do 911 i=1,3 911 ibeg(i) = ibeg14(i) do 912 i=1,24 toptab(i) = top14(i) 912 tmrtab(i) = tmr14(i)*(1+extnd(76)/100) elseif(lawyr.eq.2015) then c Federal Individual Income Tax Rates for 2015 do 921 i=1,3 921 ibeg(i) = ibeg15(i) do 922 i=1,24 toptab(i) = top15(i) 922 tmrtab(i) = tmr15(i) elseif(lawyr.eq.2016) then do 931 i=1,3 931 ibeg(i) = ibeg16(i) do 932 i=1,24 toptab(i) = top16(i) 932 tmrtab(i) = tmr16(i) elseif(lawyr.eq.2017) then c Federal Individual Income Tax Rates for 2017 do 941 i=1,3 941 ibeg(i) = ibeg17(i) do 942 i=1,24 toptab(i) = top17(i) 942 tmrtab(i) = tmr17(i) elseif(lawyr.ge.2018) then c Federal Individual Income Tax Rates for 2018+ do 951 i=1,3 951 ibeg(i) = ibeg18(i) do 952 i=1,24 toptab(i) = top18(i)*xndxa(lawyr)/xndxa(2018) 952 tmrtab(i) = tmr18(i)*(1+extnd(76)/100) do 971 j = 0,2 tmrtab(6+8*j) = tmrtab(6+8*j) + extnd(63) tmrtab(7+8*j) = tmrtab(7+8*j) + extnd(64) 971 tmrtab(8+8*j) = tmrtab(8+8*j) + extnd(65) c extnd(45) - the top rate is extnd(45) if(extnd(45).gt.0) then do 934 j= 1,nmax 934 tmrtab(j) = min(extnd(45),tmrtab(j)) endif endif if(extnd(46).gt.0) then if(lawyr.ge.2013) then c extnd(46) adds a little to the 3 top bracket rates 2013+ do 905 j= 0,2 tmrtab(6+8*j) = tmrtab(6+8*j) + extnd(46) tmrtab(7+8*j) = tmrtab(7+8*j) + extnd(46) 905 tmrtab(8+8*j) = tmrtab(8+8*j) + extnd(46) else c extnd(46) adds a little to the 2 top bracket rates 2001-2012 do 906 j= 0,2 tmrtab(6+7*j) = tmrtab(6+7*j) + extnd(46) 906 tmrtab(7+7*j) = tmrtab(7+7*j) + extnd(46) endif endif c 15% rate bracket for joint returns as percentage of 15% for singles c added 10/01/2007 last1 = ibeg(1) + ibeg(3) - ibeg(2) - 1 last2 = last1 - 1 tmrtab(last1) = tmrtab(last1) + extnd(18) tmrtab(last2) = tmrtab(last2) + extnd(19) tmrtab(ibeg(1)-1) = tmrtab(ibeg(1)-1) + extnd(18) tmrtab(ibeg(1)-2) = tmrtab(ibeg(1)-2) + extnd(19) tmrtab(ibeg(3)-1) = tmrtab(ibeg(3)-1) + extnd(18) tmrtab(ibeg(3)-2) = tmrtab(ibeg(3)-2) + extnd(19) c extnd(59) - Marty wants to simulate the effect of a 20% reduction in the bracket c rates(No change in capital gains or AMT) do 359 i = 1,nmax tmrtab(i) = (1-extnd(59))*tmrtab(i) 359 continue c extnd(60) - Marty wants to subtract a fixed number of c percentage points from the tax rate do 360 i = 1,nmax tmrtab(i) = max(0.0d0,tmrtab(i) - extnd(60)) 360 continue if(extnd(48).gt.0.and.lawyr.eq.2005) then c extnd48 changes the top rate a little for the year 2005 do 999 j= 0,2 999 tmrtab(7+7*j) = tmrtab(7+7*j) + extnd(48) endif c cglong = max(0.0d0,ltg-data(138)-data(115)) cglong = max(0.0d0,ltg-data(115)) taxin9 = max(0.0d0,taxinc-cglong) c !!! it is important to have cglong formula for 2013+ and high taxinc !!! taxltg = 0. sch10 = 0 sch20 = 0 sch25 = 0 sch28 = 0 r10 = 0. r20 = 0. c Regular Tax calculation acc = 0. itab = ibeg(nfile) itab0 = itab+1 faster = taxinc*sepret 101 itab = itab+1 if (faster.le.toptab(itab)) goto 100 rate = tmrtab(itab)*ratmul acc = acc+rate*(toptab(itab)-toptab(itab-1)) goto 101 100 continue regrat = tmrtab(itab)*ratmul regtax = (acc+regrat*(faster-toptab(itab-1)))/sepret bp = toptab(itab-1) if(taxinc.eq.0.0d0) regrat = tmrtab(itab0)*ratmul if(regtax.le.0.0d0) regtax = 0. comnew(153) = regrat*100 tax = regtax c brac15 definition if(nfile.eq.1) then brac15 = toptab(17) if(lawyr.ge.2013) brac15 = toptab(19) else if(nfile.eq.3) then brac15 = toptab(10) if(lawyr.ge.2013) brac15 = toptab(11) else brac15 = toptab(3)/sepret endif c Capital Gain rates definition cgrat1 = .1*cgmul cgrate = .2*cgmul c Tax Increase Prevention and reconciliation Act of 2005 if(lawyr.ge.2003) then cgrat1 = .05*cgmul if(lawyr.ge.2008) cgrat1 = 0. cgrate = .15*cgmul endif c 2001 and 2002 tax special tax calculation if(lawyr.le.2002) then xl4 = max(0.0d0,ltg - data(138)) xl5 = max(0.0d0,data(68)+data(117)) xl6 = max(0.0d0,min(xl5,data(117))) xl9 = max(0.0d0,xl4-xl6-data(115)) xl10 = max(0.0d0,taxinc - xl9) xl12 = min(xl10,brac15) xl13 = max(0.0d0,taxinc - xl4) taxin9 = max(xl12,xl13) c taxng calculation acc = 0. itab = ibeg(nfile) faster = taxin9*sepret 10 itab = itab+1 if (faster.le.toptab(itab)) goto 200 rate = tmrtab(itab)*ratmul if(rate.ge..27.and.rate.le..29) & at28 = (faster-toptab(itab-1))/sepret acc = acc+rate*(toptab(itab)-toptab(itab-1)) goto 10 200 continue rate = tmrtab(itab)*ratmul taxng = (acc+rate*(faster-toptab(itab-1)))/sepret bpng = toptab(itab-1) if(taxin9.le.0) rate = 0. if(taxng.le.0) taxng = 0. c if rate eq .15, then taxin9 is below the 15% bracket xl16 = max(0.0d0,brac15-xl12) sch10 = cgrat1*xl16 xl22 = min(taxinc,xl9) xl24 = max(0.0d0,xl22 - xl16) sch20 = cgrate*xl24 xl26 = min(xl4,data(115)) xl27 = xl4+taxin9 xl29 = max(0.0d0,xl27-taxinc) xl30 = max(0.0d0,xl26-xl29) sch25 = .25*xl30 xl33 = taxinc-(taxin9+xl16+xl24+xl30) sch28 = .28*max(0.0d0,xl33) taxltg=sch10+sch20+sch25+sch28 endif if(lawyr.eq.2003) then c line-by-line 2003 sch D calculations xl1 = taxinc xl6 = data(176) xl9 = max(0.0d0,comnew(6)) xl10 = ltg xl11 = max(0.0d0,data(115)+data(117)) xl12 = min(xl9,xl11) xl13 = xl10 - xl12 xl14 = max(0.0d0,xl1 - xl13) xl15 = min(taxinc,brac15) xl16 = min(xl14,xl15) xl17 = max(0.0d0,xl1 - xl10) xl18 = max(xl16,xl17) xl19 = xl15 - xl16 xl20 = xl6 xl21 = min(xl19,xl20) sch5 = .05*xl21 xl23 = xl19 - xl21 sch10 = .1*xl23 xl29 = min(xl1,xl13) xl31 = max(0.0d0,xl29 - xl19) xl32 = data(176) xl34 = xl32 - xl21 xl35 = min(xl31,xl34) sch15 = .15*xl35 xl37 = xl31 - xl35 sch20 = .2*xl37 xl39 = min(xl9,max(0.0d0,data(115))) xl40 = xl10 + xl18 xl41 = xl1 xl42 = max(0.0d0,xl40 - xl41) xl43 = max(0.0d0,xl39 - xl42) sch25 = .25*xl43 xl46 = xl1 - xl18 - xl19 - xl31 - xl43 sch28 = .28*xl46 taxltg = sch5+sch10+sch15+sch20+sch25+sch28 c non-gain taxable income for 2003 faster = xl18*sepret acc = 0. itab = ibeg(nfile) 2003 itab = itab+1 if (faster.le.toptab(itab)) goto 203 rate = tmrtab(itab)*ratmul acc = acc+rate*(toptab(itab)-toptab(itab-1)) goto 2003 203 continue rate = tmrtab(itab)*ratmul taxng = (acc+rate*(faster-toptab(itab-1)))/sepret bpng = toptab(itab-1) if(faster.le.0) rate = 0. if(taxng.le.0) taxng = 0. endif if(lawyr.ge.2004) then c line-by-line calculations for the year 2004 if(data(138).gt.1.0d0) then xl2 = data(176) xl3 = data(138) c xl4 = max(0.0d0,data(176)-data(138))+ c & max(0.0d0,min(data(70),data(70)+data(68))-data(185)) xl4 = 0 xl5 = max(0.0d0,xl3 - xl4) xl6 = max(0.0d0,xl2 - xl5) xl7 = min(data(70),data(70)+data(68))+data(18) xl8 = min(xl3,xl4) xl9 = max(0.0d0,xl7-xl8) c xl10 = xl6 + xl9 else xl6 = data(176) xl9 = max(0.0d0,ltg - xl6) c xl10 = ltg endif xl10 = xl6 + xl9 xl11 = max(0.0d0,data(115)+data(117)) xl12 = min(xl11,xl9) xl13 = xl10 - xl12 xl14 = max(0.0d0,taxinc - xl13) xl15 = brac15 xl16 = min(xl15,taxinc) xl17 = min(xl14,xl16) xl18 = max(0.0d0,taxinc-xl10) xl19 = max(xl18,xl17) xl20 = xl16 - xl17 sch10 = cgrat1*xl20 xl21 = min(taxinc,xl13) xl22 = xl20 xl23 = max(0.0d0,xl21 - xl22) sch20 = cgrate*xl23 xl25 = min(xl9,data(115)) xl26 = xl10 + xl19 xl27 = taxinc xl28 = max(0.0d0,xl26 - xl27) xl29 = max(0.0d0,xl25 - xl28) sch25 = .25*xl29 xl31 = xl19 + xl20 + xl23 + xl29 xl32 = taxinc - xl31 sch28 = .28*xl32 taxltg = sch10 + sch20 +sch25 + sch28 faster = xl19*sepret acc = 0. itab = ibeg(nfile) c non-gain taxable income for 2004 1000 itab = itab+1 if (faster.le.toptab(itab)) goto 201 rate = tmrtab(itab)*ratmul acc = acc+rate*(toptab(itab)-toptab(itab-1)) goto 1000 201 continue rate = tmrtab(itab)*ratmul taxng = (acc+rate*(faster-toptab(itab-1)))/sepret bpng = toptab(itab-1) if(faster.le.0) rate = 0. if(taxng.le.0) taxng = 0. endif if (min(taxinc,brac15).gt.taxin9) then if(taxinc.lt.brac15.and.taxin9.lt.1.) r10 = .1 if(taxinc.gt.brac15.and.taxin9.gt.0.) r10 = -.1 endif if (min(taxinc,cglong).gt.max(0.0d0, & min(taxinc,brac15)-taxin9)) then if(min(taxinc,brac15) - taxin9.le.0.) then if(taxinc.lt.cglong) r20 = cgrate else if(taxinc.gt.cglong) then if(taxinc.gt.brac15.and.taxin9.gt.0.) r20=cgrate if(taxinc.lt.brac15.and.taxin9.le.0.) r20=-cgrate else if(taxinc.gt.brac15.and.taxin9.gt.0.) r20=2*cgrate if(taxinc.gt.brac15.and.taxin9.lt.1.) r20=cgrate if(taxinc.lt.brac15.and.taxin9.gt.0.) r20=cgrate endif endif endif rate = max(rate,max(r10,r20)) addtax = 0. if(lawyr.ge.2013.and.cglong.gt.0) then if(nfile.eq.1) then topbrk = toptab(23) else if(nfile.eq.3) then topbrk = toptab(15) else topbrk = toptab(7)/sepret endif if(taxin9.gt.topbrk) then addtax = .05*cglong else if (taxinc.gt.topbrk) then addtax = .05*min(taxinc-topbrk,cglong) endif taxltg = taxltg + addtax if(addtax.gt.0) rate = rate + .05 endif if(regtax.le.taxng+taxltg) then tax = regtax else tax = taxng+taxltg bp = bpng endif if(extnd(66).gt.0) then tax = regtax rate = regrat endif comnew(96) = regtax-tax comnew(90) = bp comnew(152) = at28 return end c c **************************************************************************** c Estate Tax Imputation = comnew(201) c **************************************************************************** c combined estate and gift taxes imputed to capital income over c $30,000 only for those 65 and over c 1985=6.422, 1986=6.658, 1987=7.493, 1988=7.594, 1989=8.745 c 1990=11.500, 1991=11.138, 1992=11.143, 1993=12.577, 1994=15.225 c NOTE this module is calibrated only for actual year data 1985-94 c subroutine estate(data,lawyr) implicit double precision (A-H,O-Z) common /newshr/ comnew(255) dimension data(255),factor(1985:1994) double precision muni,inter data factor /0.18778,0.14226,0.20178,0.19880,0.19890, * 0.12190,0.11285,0.12272,0.13201,0.15536/ c if (lawyr.lt.1985.or.lawyr.gt.1994) then comnew(201) = 0. return endif inter = data(14) rent = data(73) royal = data(74) div = data(12) muni = data(41) gains = data(68)+data(70)+data(18)+data(19) trust = data(77) part = data(75) scorp = data(79) capinc = div+muni+gains+trust+part+scorp+inter+rent+royal egtax = 0. if (capinc.ge.30000.) egtax = factor(lawyr)*(capinc-30000.) if (data(9).lt.1.) egtax = 0. comnew(201) = egtax return end c c ******************************************************************* c Corporate Tax Imputation (comnew202 is the imputed CIT) c ******************************************************************* c c based on the Feldstein/Jung algorithm c AT THIS TIME, tested only 1985 and 1991 c x1 to x4 have been recalculated by Dan Feenberg from 1985-1994 c x1 (not used) reduction in dividends caused by CIT, per $ of dvds c x2 (not used) reduction in retained earnings per dollar of dvds c x3 additional corporate tax liability per $ of double precision int inc c x4 additional corporate tax liability per $ of dividends and ren c expect (not used) is the avrg inflation rate over the prior 5 yrs c Actual CIT in billions, Fiscal year c 1985=61.33, 1986=63.14, 1987=83.93, 1988=94.51, 1989=103.3 c 1990=93.51, 1991=98.09, 1992=100.3, 1993=117.5, 1994=140.4 c subroutine cit(data,lawyr) implicit double precision (A-H,O-Z) common /newshr/ comnew(255) common /misc/ inreal,x1,x2 dimension data(255),x(4,1985:1994) dimension expect(1985:1994),rint(1985:1994),pint(1985:1994) double precision inreal,intnet c c x1,x2,x3,x4 for 1985 to 1994 c data x / 0.491, 0.226, 0.127, 0.605, 6 0.449, 0.206, 0.150, 0.601, 7 0.573, 0.394, 0.171, 0.804, 8 0.571, 0.393, 0.167, 0.830, 9 0.466, 0.321, 0.149, 0.640, * 0.411, 0.283, 0.146, 0.602, 1 0.350, 0.240, 0.602, 0.338, 2 0.343, 0.236, 0.117, 0.386, 3 0.339, 0.233, 0.121, 0.397, 4 0.397, 0.273, 0.130, 0.436/ data expect / 5.48, 3.81, 3.32, 3.50, 3.60, * 3.97, 4.44, 4.31, 4.08, 3.63/ data rint / 6.22, 5.72, 5.89, 6.08, 6.18, * 6.24, 5.97, 5.64, 5.34, 5.86/ data pint /12.57,13.34,13.28,13.30,13.42, * 13.32,13.17,12.92,12.79,12.77/ c if (lawyr.lt.1985.or.lawyr.gt.1994) then comnew(202) = 0. return endif recrat = (rint(lawyr)-expect(lawyr))/rint(lawyr) payrat = (pint(lawyr)-expect(lawyr))/pint(lawyr) recint = data(14)+data(41) payint = data(56)+data(57) intnet = recint-payint c c net real interest calculation ala Jun/Feldstein c recvd = recrat*recint/(.82) payed = payrat*payint/(.82) inreal = recvd-payed c div = data(12) x1 = x(1,lawyr) x2 = x(2,lawyr) x3 = x(3,lawyr) x4 = x(4,lawyr) c c Retax is picked up from the CEX (data160) for non-itemizers c retax = data(51) deduc = data(48)+data(49)+data(50)+data(51)+data(52)+ * data(53)+data(54)+data(55)+data(56)+data(57)+ * data(58)+data(59)+data(60)+data(61)+data(63)+ * data(65)+data(66) if (deduc.lt.2000..and.data(51).lt.1.) retax = data(160) tax3 = x3*div tax4 = x4*(intnet+0.8407*retax) citax = tax3+tax4 comnew(202) = citax c return end c c **************************************************************************** c Functions c **************************************************************************** c c twn returns upper bound, lower bound or actual value ("a") c if actual value falls between the two bounds c double precision function twn(a,amin,amax) implicit double precision(A-H,O-Z) common /dindiv/ data(255) if (amin.gt.amax) then 91234 write(6,100) a,amin,amax,data(100),data(6) continue endif 100 format(' Error in TWN',5G12.5) twn = max(amin,min(amax,a)) return end c c this function rounds down to next lowest $50 c double precision function trunc(value,modder) implicit double precision(A-H,O-Z) double precision value,modder trunc = value-mod(value,modder) return end c c This function returns appropriate values based on marital status. c First variable is MARITAL STATUS [data(02] c Second variable is value for filing as a SINGLE c Third variable is value for filing JOINTLY c Fourth variable is value for filing as HEAD of HOUSEHOLD c Fifth variable is value for filing MARRIED but SEPARATELY c double precision function filing(mstat,single,joint,hoh,separ) implicit double precision (A-H,O-Z) real single,joint,hoh,separ integer mstat filing = single if (mstat.eq.2.or.mstat.eq.5) filing = joint if (mstat.eq.4.or.mstat.eq.7) filing = hoh if (mstat.eq.3.or.mstat.eq.6) filing = separ return end c c In(lawyr,year1,year2) returns a value of .true. if the year c Contained in LAWYR is between year1 and year2, INCLUSIVE. c Year1 must be smaller than year2. c logical function in(lawyr,year1,year2) integer year1,year2,lawyr in = .false. if (lawyr.ge.year1.and.lawyr.le.year2) in = .true. return end c c **************************************************************************** c Miscellaneous Subroutines c **************************************************************************** c c This subroutine is necessary since V94, the table generator, uses c it to call nlaw, the federal law routine. c subroutine newtax(data,lawyr) implicit double precision (A-H,O-Z) dimension data(255) double precision data call nlaw(data,lawyr) return end c c These subroutines prevent error messages in some earlier programs c subroutine behave return end subroutine setup return end subroutine setage return end subroutine lawus return end c c Tax table lookups for 1993 and 1994 are done in the main subroutine c Block data containing tax table information c Check second block77 and block79 c block data bl62 implicit double precision (A-H,O-Z) common /tab62/ toptab(77),tmrtab(77),acctab(78),ibeg(3) data ibeg /1,26,51/ data toptab /0.,2000.,4000.,6000.,8000.,10000., & 12000.,14000.,16000.,18000.,20000., & 22000.,26000.,32000.,38000., & 44000.,50000.,60000.,70000.,80000., & 90000.,100000.,150000.,200000.,1.e29, & 0.,4000.,8000.,12000.,16000.,20000.,24000., & 28000.,32000.,36000., & 40000.,44000.,52000.,64000.,76000.,88000., & 100000.,120000.,140000.,160000.,180000.,200000., & 300000.,400000.,1.e29, & 0.,2000.,4000.,6000.,8000.,10000.,12000., & 14000.,16000.,18000.,20000.,22000.,24000., & 28000.,32000.,38000.,44000.,50000., & 60000.,70000.,80000.,90000., & 100000.,150000.,200000., & 300000.,1.e29/ data tmrtab / 0.,.2,.22,.26,.3, & .34,.38,.43,.47,.5 ,.53, & .56,.59,.62,.65,.69,.72,.75, & .78,.81,.84,.87,.89,.9 ,.91, & 0.,.2 ,.22,.26,.3 ,.34, & .38,.43,.47,.5 ,.53,.56, & .59,.62,.65,.69,.72,.75, & .78,.81,.84,.87,.89,.9 ,.91, & 0.,.2 ,.21,.24,.26,.3 , & .32,.36,.39,.42,.43,.47, & .49,.52,.54,.58, & .62,.66,.68,.71,.74,.76, & .8 ,.83,.87,.9 ,.91/ data acctab /0.0, & 0.,400., 840.,1360.,1960.,2640., & 3400.,4260.,5200.,6200.,7260., & 8380.,10740.,14460.,18360.,22500., & 26820.,34320.,42120.,50220.,58620.,67320., & 111820.,156820,1.e29, & 0.,800.,1680.,2720.,3920.,5280.,6800., & 8520.,10400.,12400., & 14520.,16760.,21480.,28920.,36720.,45000., & 53640.,68640.,84240.,100440.,117240.,134640., & 223640.,313640.,1.e29, & 0.,400.,820. ,1300.,1820.,2420.,3060., & 3780.,4560 .,5400.,6260.,7200.,8180., & 10260.,12420.,15900.,19620.,23580., & 30380.,37480.,44880.,52480., & 60480.,101980.,145480., & 235480.,1.e29/ end c block data bl64 implicit double precision (A-H,O-Z) common /tab64/ toptab(91),tmrtab(91),acctab(92),ibeg(3) data ibeg /1,28,55/ data toptab /0.,500.,1000.,1500.,2000.,4000., & 6000.,8000.,10000.,12000.,14000., & 16000.,18000.,20000.,22000.,26000.,32000., & 38000.,44000.,50000.,60000.,70000.,80000., & 90000.,100000.,200000.,1.e29, & 0.,1000.,2000.,3000.,4000.,8000.,12000., & 16000.,20000.,24000.,28000.,32000.,36000., & 40000.,44000.,52000.,64000.,76000.,88000., & 100000.,120000.,140000.,160000.,180000.,200000., & 400000.,1.e29, & 0.,1000.,2000.,4000.,6000.,8000.,10000.,12000., & 14000.,16000.,18000.,20000.,22000.,24000.,26000., & 28000.,32000.,36000.,38000.,40000.,44000.,50000., & 52000.,60000.,64000.,70000.,76000.,80000.,88000., & 90000.,100000.,120000.,140000.,160000.,180000., & 200000.,1.e29/ data tmrtab /0.,.16,.165,.175,.18,.2,.235,.27,.305, & .34,.375,.41, .445,.475,.505, & .535,.56,.585,.61,.635,.66,.685,.71, & .735,.75,.765,.77, & 0.,.16,.165,.175,.18,.2,.235,.27,.305,.34, & .375,.41,.445,.475,.505,.535,.56, & .585,.61,.635,.66,.685,.71,.735,.75, & .765,.77, & 0.,.16,.175,.19,.22,.23,.27,.29, & .32,.34,.375,.39,.425,.435,.455,.47, & .485,.515,.53,.54,.56,.585,.595, & .61,.62,.635,.65,.66,.67,.69,.695, & .71,.725,.74,.75,.755,.77/ data acctab /0.0, & 0.,80., 162.5,250.,340.,740., & 1210.,1750.,2360.,3040.,3790., & 4610.,5500.,6450.,7460.,9600., & 12960.,16470.,20130.,23940.,30540.,37390., & 44490.,51840,59340.,135840.,1.e29, & 0.,160.,325.,500.,680.,1480.,2420., & 3500.,4720.,6080.,7580.,9220., & 11000.,12900.,14920.,19200.,25920.,32940., & 40260.,47880.,61080.,74780.,88980.,103680., & 118680.,271680.,1.e29, & 0.,160.,335.,715.,1155.,1615.,2155., & 2735.,3375.,4055.,4805.,5585.,6435., & 7305.,8215.,9155.,11095.,13155.,14215., & 15295.,17535.,21045.,22235., & 27115.,29595.,33405.,37305.,39945.,45305., & 46685.,53635.,67835.,82335.,97135.,112135., & 127235.,1.e29/ end c block data bl70 implicit double precision (A-H,O-Z) common /tab70/ toptab(86),tmrtab(86),acctab(87),ibeg(3) data ibeg /1,27,53/ data toptab /0.,500.,1000.,1500.,2000., & 4000.,6000.,8000.,10000.,12000.,14000.,16000., & 18000.,20000.,22000., & 26000.,32000.,38000.,44000.,50000., & 60000.,70000.,80000.,90000.,100000.,1.e29, & 0.,1000.,2000.,3000.,4000.,8000.,12000.,16000.,20000., & 24000.,28000.,32000.,36000.,40000.,44000.,52000., & 64000.,76000.,88000.,100000.,120000.,140000., & 160000.,180000.,200000.,1.e29, & 0.,1000.,2000.,4000.,6000.,8000.,10000.,12000.,14000., & 16000.,18000.,20000.,22000.,24000.,26000., & 28000.,32000.,36000.,38000.,40000.,44000., & 50000.,52000.,64000.,70000.,76000.,80000., & 88000.,100000.,120000.,140000.,160000.,180000., & 1.e29/ data tmrtab /0.,.14,.15,.16,.17,.19,.22,.25,.28,.32, & .36,.39,.42,.45,.48,.5,.53,.55, & .58,.6,.62,.64,.66,.68,.69,.7, & 0.,.14,.15,.16,.17,.19,.22,.25,.28,.32,.36, & .39,.42,.45,.48,.5,.53,.55,.58,.6, & .62,.64,.66,.68,.69,.7, & 0.,.14,.16,.18,.2,.22,.25,.27, & .31,.32,.35,.36,.4,.41,.43,.45, & .46,.48,.5,.52,.53,.55,.56,.58,.59,.61, & .62,.63,.64,.66,.67,.68,.69,.7/ data acctab /0.0, & 0.,70., 145.,225.,310.,690., & 1130.,1630.,2190.,2830.,3550., & 4330.,5170.,6070.,7030.,9030., & 12210.,15510.,18990.,22590.,28790.,35190., & 41790.,48590.,55490.,1.e29, & 0.,140.,290.,450.,620.,1380.,2260., & 3260.,4380.,5660.,7100.,8660., & 10340.,12140.,14060.,18060.,24420.,31020., & 37980.,45180.,57580.,70380.,83580.,97180., & 110980.,1.e29, & 0.,140.,300.,660.,1060.,1500.,2000., & 2540.,3160.,3800.,4500.,5220.,6020., & 6840.,7700.,8600.,10440.,12360.,13360., & 14400.,16520.,19820.,20940., & 27900.,31440.,35100.,37580.,42620.,50300., & 63500.,76900.,90500.,104300., & 1.e29/ end c block data bl74 implicit double precision (A-H,O-Z) common /tab74/ toptab(86),tmrtab(86),acctab(87),ibeg(3) data ibeg /1,27,53/ data toptab /0.,500.,1000.,1500.,2000., & 4000.,6000.,8000.,10000.,12000.,14000.,16000., & 18000.,20000.,22000., & 26000.,32000.,38000.,44000.,50000., & 60000.,70000.,80000.,90000.,100000.,1.e29, & 0.,1000.,2000.,3000.,4000.,8000.,12000.,16000.,20000., & 24000.,28000.,32000.,36000.,40000.,44000.,52000., & 64000.,76000.,88000.,100000.,120000.,140000., & 160000.,180000.,200000.,1.e29, & 0.,1000.,2000.,4000.,6000.,8000.,10000.,12000.,14000., & 16000.,18000.,20000.,22000.,24000.,26000., & 28000.,32000.,36000.,38000.,40000.,44000., & 50000.,52000.,64000.,70000.,76000.,80000., & 88000.,100000.,120000.,140000.,160000.,180000., & 1.e29/ data tmrtab /0.,.14,.15,.16,.17,.19,.21,.24,.25,.27, & .29,.31,.34,.36,.38,.4,.45,.5, & .55,.6,.62,.64,.66,.68,.69,.7, & 0.,.14,.15,.16,.17,.19,.22,.25,.28,.32,.36, & .39,.42,.45,.48,.5,.53,.55,.58,.6, & .62,.64,.66,.68,.69,.7, & 0.,.14,.16,.18,.19,.22,.23,.25,.27,.28, & .31,.32,.35,.36,.38,.41,.42,.45,.48, & .51,.52,.55,.56,.58,.59,.61,.62,.63,.64, & .66,.67,.68,.69,.7/ data acctab /0.0, & 0.,70., 145.,225.,310.,690., & 1110.,1590.,2090.,2630.,3210., & 3830.,4510.,5230.,5990.,7590., & 10290.,13290.,16590.,20190.,26390.,32790., & 39390.,46190.,53090.,1.e29, & 0.,140.,290.,450.,620.,1380.,2260., & 3260.,4380.,5660.,7100.,8660., & 10340.,12140.,14060.,18060.,24420.,31020., & 37980.,45180.,57580.,70380.,83580.,97180., & 110980.,1.e29, & 0.,140.,300.,660.,1040.,1480.,1940., & 2440.,2980.,3540.,4160.,4800.,5500., & 6220.,6980.,7800.,9480.,11280.,12240., & 13260.,15340.,18640.,19760., & 26720.,30260.,33920.,36400.,41440.,49120., & 62320.,75720.,89320.,103120., & 1.e29/ c end c block data bloc77 implicit double precision (A-H,O-Z) common /tab77/ ibeg(3),iend(3),toptab(83),tmrtab(83),acctab(83) data ibeg /1,26,51/ data iend /25,50,83/ data toptab /500.,1000.,1500.,2000.,4000.,6000.,8000., & 10000.,12000.,14000.,16000.,18000.,20000., & 22000.,26000.,32000.,38000.,44000.,50000., & 60000.,70000.,80000.,90000.,100000.,1.e29, & 1000.,2000.,3000.,4000.,8000.,12000.,16000., & 20000.,24000.,28000.,32000.,36000.,40000., & 44000.,52000.,64000.,76000.,88000.,100000., & 120000.,140000.,160000.,180000.,200000., & 1.e29,1000.,2000.,4000.,6000.,8000.,10000., & 12000.,14000.,16000.,18000.,20000.,22000., & 24000.,26000.,28000.,32000.,36000.,38000., & 40000.,44000.,50000.,52000.,64000.,70000., & 76000.,80000.,88000.,100000.,120000., & 140000.,160000.,180000.,1.e29/ data tmrtab/0.14,0.15,0.16,0.17,0.19,0.21,0.24,0.25,0.27,0.29, *0.31,0.34,0.36,0.38,0.40,0.45,0.50,0.55,0.60,0.62,0.64,0.66,0.68, *0.69,0.70, *0.14,0.15,0.16,0.17,0.19,0.22,0.25,0.28,0.32,0.36,0.39,0.42,0.45, *0.48,0.50,0.53,0.55,0.58,0.60,0.62,0.64,0.66,0.68,0.69,0.70, *0.14,0.16,0.18,0.19,0.22,0.23,0.25,0.27,0.28,0.31,0.32,0.35,0.36, *0.38,0.41,0.42,0.45,0.48,0.51,0.52,0.55,0.56,0.58,0.59,0.61,0.62, *0.63,0.64,0.66,0.67,0.68,0.69,0.70/ data acctab/0.,70.,145.,225.,310.,690.,1110.,1590.,2090.,2630., *3210.,3830.,4510.,5230.,5990.,7590.,10290.,13290.,16590.,20190., *26390.,32790.,39390.,46190.,53090., *0.,140.,290.,450.,620.,1380.,2260.,3260.,4380.,5660.,7100.,8660., *10340.,12140.,14060.,18060.,24420.,31020.,37980.,45180.,57580., *70380.,83580.,97180.,110980., *0.,140.,300.,660.,1040.,1480.,1940.,2440.,2980.,3540.,4160.,4800., *5500.,6220.,6980.,7800.,9480.,11280.,12240.,13260.,15340.,18640., *19760.,26720.,30260.,33920.,36400.,41440.,49120.,62320.,75720., *89320.,103120./ c end c block data bloc79 implicit double precision (A-H,O-Z) common /tab79/ toptab(52),tmrtab(52),acctab(53),ibeg(3) data ibeg /35,1,18/ data toptab / 1 .0,3400.,5500.,7600.,11900.,16000.,20200.,24600.,29900.,35200., 2 45800.,60000.,85600.,109400.,162400.,215400.,1.e29, 3 .0,2300.,4400.,6500.,8700.,11800.,15000.,18200.,23500., 4 28800.,34100.,44700.,60600.,81800.,108300.,161300.,1.e29, 5 .0,2300.,3400.,4400.,6500.,8500.,10800.,12900.,15000.,18200., 6 23500.,28800.,34100.,41500.,55300.,81800.,108300.,1.e29/ data tmrtab / 1 2*0.,.14,.16,.18,.21,.24,.28,.32,.37,.43,.49,.54,.59,.64,.68,.7, 2 2*.0,.14,.16,.18,.22,.24,.26,.31,.36,.42,.46,.54,.59,.63,.68,.70, 3 2*0.,.14,.16,.18,.19,.21,.24,.26,.30,.34,.39,.44,.49,.55,.63, 4 .68,.70/ data acctab /0.0, 1 2*0.,294.,630.,1404.,2265.,3273.,4505.,6201.,8162.,12720., 2 19678.,33502.,47544.,81464.,117504.,999.e29, 3 2*0.,294.,630.,1026.,1708.,2476.,3308.,4951.,6859.,9085.,13961., 4 22547.,35055.,51750.,87790.,999.e29 , 5 2*0.,154.,314.,692.,1072.,1555.,2059.,2605.,3565.,5367., 6 7434.,9766.,13392.,20982.,37677.,55697.,999.e29/ c end c block data bl77 implicit double precision (A-H,O-Z) common /l6077/ toptab(89),tmrtab(89),acctab(90),ibeg(3) data ibeg /1,28,55/ data toptab /0.,2200.,2700.,3200.,3700., & 4200.,6200.,8200.,10200.,12200.,14200.,16200., & 18200.,20200.,22200., & 24200.,28200.,34200.,40200.,46200., & 52200.,62200.,72200.,82200.,92200., & 102200,1.e29, & 0.,3200.,4200.,5200.,6200.,7200.,11200.,15200.,19200., & 23200.,27200.,31200.,35200.,39200.,43200.,47200., & 55200.,67200.,79200.,91200.,103200.,123200., & 143200.,163200.,183200.,203200.,1.e29, & 0.,2200.,3200.,4200.,6200.,8200.,10200.,12200.,14200., & 16200.,18200.,20200.,22200.,24200.,26200., & 28200.,30200.,34200.,38200.,40200., & 42200.,46200.,52200.,54200.,66200.,72200., & 78200.,82200.,90200.,102200.,122200.,142200., & 162200.,182200.,1.e29/ data tmrtab /2*0.,.14,.15,.16,.17,.19,.21,.24,.25,.27, & .29,.31,.34,.36,.38,.4,.45,.5, & .55,.6,.62,.64,.66,.68,.69,.7, & 2*0.,.14,.15,.16,.17,.19,.22,.25,.28,.32,.36, & .39,.42,.45,.48,.5,.53,.55,.58,.6, & .62,.64,.66,.68,.69,.7, & 2*0.,.14,.16,.18,.19,.22,.23,.25,.27,.28, & .31,.32,.35,.36,.38,.41,.42,.45,.48, & .51,.52,.55,.56,.58,.59,.61,.62,.63,.64, & .66,.67,.68,.69,.7/ data acctab /0.0, & 2*0.,70., 145.,225.,310.,690., & 1110.,1590.,2090.,2630.,3210., & 3830.,4510.,5230.,5990.,7590., & 10290.,13290.,16590.,20190.,26390.,32790., & 39390.,46190.,53090.,1.e29, & 2*0.,140.,290.,450.,620.,1380.,2260., & 3260.,4380.,5660.,7100.,8660., & 10340.,12140.,14060.,18060.,24420.,31020., & 37980.,45180.,57580.,70380.,83580.,97180., & 110980.,1.e29, & 2*0.,140.,300.,660.,1040.,1480.,1940., & 2440.,2980.,3540.,4160.,4800.,5500., & 6220.,6980.,7800.,9480.,11280.,12240., & 13260.,15340.,18640.,19760., & 26720.,30260.,33920.,36400.,41440.,49120., & 62320.,75720.,89320.,103120., & 1.e29/ c end c block data bl79 implicit double precision (A-H,O-Z) common /l6079/ toptab(52),tmrtab(52),acctab(53),ibeg(3) data ibeg /1,19,36/ data toptab /0.,2300.,3400.,4400.,6500.,8500., & 10800.,12900.,15000.,18200.,23500., & 28800.,34100.,41500.,55300.,81800.,108300., & 1.e29, & 0.,3400.,5500.,7600.,11900.,16000.,20200., & 24600.,29900.,35200.,45800.,60000.,85600., & 109400.,162400.,215400.,1.e29, & 0.,2300.,4400.,6500.,8700.,11800.,15000.,18200., & 23500.,28800.,34100.,44700., & 60600.,81800.,108300.,161300.,1.e29/ data tmrtab /2*0.,.14,.16,.18,.19,.21,.24,.26, & .30,.34,.39,.44,.49,.55, & .63,.68,.7, & 2*0.,.14,.16,.18,.21,.24,.28,.32,.37, & .43,.49,.54,.59,.64,.68,.7, & 2*0.,.14,.16,.18,.22,.24,.26, & .31,.36,.42,.46, .54,.59,.63,.68,.7/ data acctab /0.0, & 2*0.,154., 314.,692.,1072.,1555., & 2059.,2605.,3565.,5367.,7434., & 9766.,13392.,20982.,37677.,55697., 1.e29, & 2*0.,294.,630.,1404.,2265.,3273.,4505., & 6201.,8162.,12720.,19678.,33502., & 47544.,81464.,117504., 1.e29, & 2*0.,294.,630.,1026.,1708.,2476.,3308., & 4951.,6859.,9085.,13961.,22547.,35055., & 51750.,87790., 1.e29/ c end c block data bloc82 implicit double precision (A-H,O-Z) common /tab82/ toptab(43),tmrtab(43),acctab(44),ibeg(3) data ibeg /29,1,15/ data toptab / 1 .0,3400.,5500.,7600.,11900.,16000.,20200.,24600.,29900.,35200., 2 45800.,60000.,85600.,1.e29, 3 .0,2300.,4400.,6500.,8700.,11800.,15000.,18200.,23500., 4 28800.,34100.,44700.,60600.,1.e29, 5 .0,2300.,3400.,4400.,6500.,8500.,10800.,12900.,15000.,18200., 6 23500.,28800.,34100.,41500.,1.e29/ data tmrtab / 1 2*0.,.12,.14,.16,.19,.22,.25,.29,.33,.39,.44,.49,.50, 2 2*0.,.12,.14,.16,.20,.22,.23,.28,.32,.38,.41,.49,.50, 3 2*0.,.12,.14,.16,.17,.19,.22,.23,.27,.31,.35,.40,.44,.50/ data acctab /0.0, 1 2*0.,252.,546.,1234.,2013.,2937.,4037.,5574.,7323.,11457.,17705., 2 30249.,999.e29, 3 2*0.,252.,546.,898.,1518.,2222.,2958.,4442.,6138.,8152.,12498., 4 20289.,999.e29, 5 2*0.,132.,272.,608.,948.,1385.,1847.,2330.,3194.,4837.,6692., 6 8812.,12068.,999.e29/ c end c block data bloc83 implicit double precision (A-H,O-Z) common /tab83/ toptab(46),tmrtab(46),acctab(47),ibeg(3) data ibeg /31,1,16/ data toptab / 1 .0,3400.,5500.,7600.,11900.,16000.,20200.,24600.,29900.,35200., 2 45800.,60000.,85600.,109400.,.999e29, 3 .0,2300.,4400.,6500.,8700.,11800.,15000.,18200.,23500., 4 28800.,34100.,44700.,60600.,81800.,999.e29, 5 .0,2300.,3400.,4400.,6500.,8500.,10800.,12900.,15000.,18200., 6 23500.,28800.,34100.,41500.,55300.,999.e29/ data tmrtab / 1 2*0.,.11,.13,.15,.17,.19,.23,.26,.30,.35,.40,.44,.48,.5, 2 2*0.,.11,.13,.15,.18,.19,.21,.25,.29,.34,.37,.44,.48,.50, 3 2*0.,.11,.13,.15,.15,.17,.19,.21,.24,.28,.32,.36,.40,.45,.50/ data acctab /0.0, 1 2*0.,231.,504.,1149.,1846.,2644.,3656.,5034.,6624.,10334.,16014., 2 27278.,38702.,999.e29, 3 2*0.,231.,504.,834.,1392.,2000.,2672.,3997.,5534.,7336.,11258., 4 18254.,28430.,999.e29, 5 2*0.,121.,251.,566.,866.,1257.,1656.,2097.,2865.,4349.,6045., 6 7953.,10913.,17123.,999.e29/ c end c block data bloc84 implicit double precision (A-H,O-Z) common /tab84/ toptab(49),tmrtab(49),acctab(50),ibeg(3) data ibeg /33,1,17/ data toptab / 1 .0,3400.,5500.,7600.,11900.,16000.,20200.,24600.,29900.,35200., 2 45800.,60000.,85600.,109400.,162400.,1.e29, 3 .0,2300.,4400.,6500.,8700.,11800.,15000.,18200.,23500., 4 28800.,34100.,44700.,60600.,81800.,108300.,1.e29, 5 .0,2300.,3400.,4400.,6500.,8500.,10800.,12900.,15000.,18200., 6 23500.,28800.,34100.,41500.,55300.,81800.,1.e29/ data tmrtab / 1 2*0.d0,.11d0,.12d0,.14d0,.16d0,.18,.22,.25,.28,.33,.38,.42,.45, $ 0.49,0.50, 2 2*0.,.11,.12,.14,.17,.18,.20,.24,.28,.32,.35,.42,.45, $ 0.48,0.50, 3 2*0.,.11,.12,.14,.15,.16,.18,.20,.23,.26,.30,.34,.38,.42, $ 0.48,0.50/ data acctab /0.0, 1 2*0.,231.,483.,1085.,1741.,2497.,3465.,4790.,6274.,9772.,15168., 2 25920.,36630.,62600.,1.e29, 3 2*0.,231.,483.,791.,1318.,1894.,2534.,3806.,5290.,6986.,10696., 4 17374.,26914.,39634.,1.e29, 5 2*0.,121.,241.,535.,835.,1203.,1581.,2001.,2737.,4115.,5705., 6 7507.,10319.,16115.,28835.,1.e29/ c end c block data bloc87 implicit double precision (A-H,O-Z) common /tab87/ toptab(18),tmrtab(18),acctab(19),ibeg(3) data ibeg /13,1,7/ data toptab / 1 0.,3000.,28000.,45000.,90000.,1.e29, 3 0.,2500.,23000.,38000.,80000.,1.e29, 5 0.,1800.,16800.,27000.,54000.,1.e29/ data tmrtab / 1 0.d0,.11d0,.15d0,.28d0,.35d0,.385d0, 2 0.d0,.11d0,.15d0,.28d0,.35d0,.385d0, 3 0.d0,.11d0,.15d0,.28d0,.35d0,.385d0/ data acctab /0.0, 1 0.,330,4080.,8840.,24590.,1.e29, 3 0.,275,3350.,7550.,22250.,1.e29, 5 0.,198,2448.,5304.,14754.,1.e29/ c end c block data bloc88 implicit double precision (A-H,O-Z) common /tab88/ toptab(9),tmrtab(9),acctab(10),ibeg(3) data ibeg /7,1,4/ data toptab / 1 0.,29750.,1.e29, 3 0.,23900.,1.e29, 5 0.,17850.,1.e29/ data tmrtab / 1 0.d0,.15d0,.28d0, 2 0.d0,.15d0,.28d0, 3 0.d0,.15d0,.28d0/ data acctab /0.0, 1 0.,4462.5,1.e29, 3 0.,3585.,1.e29, 5 0.,2677.5,1.e29/ c end c block data bloc91 implicit double precision (A-H,O-Z) common /tab91/ toptab(12),tmrtab(12),acctab(13),ibeg(3) data ibeg /9,1,5/ data toptab / 1 0.,34000.,82150.,1.e29, 2 0.,27300.,70450.,1.e29, 3 0.,20350.,49300.,1.e29/ data tmrtab / 1 0.,.15d0,.28d0,.31d0, 2 0.,.15d0,.28d0,.31d0, 3 0.,.15d0,.28d0,.31d0/ data acctab /0.0, 1 0.,5100,18582,1.e29, 2 0.,4095.,16177,1.e29, 3 0.,3052.5,11158.5,1.e29/ c end c c Tax table lookup Clinton 17 Feb 1993 plan c This table is used only for 1993, because some brackets are c indexed and some are not. c block data bloc93 implicit double precision (A-H,O-Z) common /tab93/ toptab(18),tmrtab(18),acctab(19),ibeg(3) data ibeg /13,1,7/ data toptab / 1 0.,36900.,89150.,140000.,250000.,1.e29, 2 0.,29600.,76400.,127500.,250000.,1.e29, 3 0.,22100.,53500.,115000.,250000.,1.e29/ data tmrtab / 1 0.,.15d0,.28d0,.31d0,.36d0,.396d0, 2 0.,.15d0,.28d0,.31d0,.36d0,.396d0, 3 0.,.15d0,.28d0,.31d0,.36d0,.396d0/ data acctab /0.0, 1 0.,5100.,18582.,32775.,68962.,1.e29, 2 0.,4095.,16177.,26914.,71326.,1.e29, 3 0.,3052.5,11158.5,19670.,74280.,1.e29/ c end c block data bloc94 implicit double precision (A-H,O-Z) common /tab94/ toptab(18),tmrtab(18),ibeg(3) data ibeg /13,1,7/ data toptab / 1 0.,38000.,91850.,140000.,250000.,1.e29, 2 0.,30500.,78700.,127500.,250000.,1.e29, 3 0.,22750.,55100.,115000.,250000.,1.e29/ data tmrtab / 1 0.,.15d0,.28d0,.31d0,.36d0,.396d0, 2 0.,.15d0,.28d0,.31d0,.36d0,.396d0, 3 0.,.15d0,.28d0,.31d0,.36d0,.396d0/ end c block data bloc95 implicit double precision (A-H,O-Z) common /tab95/ toptab(18),tmrtab(18),ibeg(3) data ibeg /13,1,7/ data toptab / 1 0.,39000.,94250.,143600.,256500.,1.e29, 2 0.,31250.,80750.,130800.,256500.,1.e29, 3 0.,23350.,56550.,117950.,256500.,1.e29/ data tmrtab / 1 0.,.15d0,.28d0,.31d0,.36d0,.396d0, 2 0.,.15d0,.28d0,.31d0,.36d0,.396d0, 3 0.,.15d0,.28d0,.31d0,.36d0,.396d0/ end c block data bloc96 implicit double precision (A-H,O-Z) common /tab96/ toptab(18),tmrtab(18),ibeg(3) data ibeg /13,1,7/ data toptab / 1 0.,40100.,96900.,147700.,263750.,1.e29, 2 0.,32150.,83050.,134500.,263750.,1.e29, 3 0.,24000.,58150.,121300.,263750.,1.e29/ data tmrtab / 1 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0, 2 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0, 3 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0/ end c c tax brackets for 1997 c block data bloc97 implicit double precision (A-H,O-Z) common /tab97/ toptab(18),tmrtab(18),ibeg(3) data ibeg /13,1,7/ data toptab / 1 0.,41200.,99600.,151750.,271050.,1.e29, 2 0.,33050.,85350.,138200.,271050.,1.e29, 3 0.,24650.,59750.,124650.,271050.,1.e29/ data tmrtab / 1 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0, 2 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0, 3 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0/ c end c c tax brackets for 1998 c block data bloc98 implicit double precision (A-H,O-Z) common /tab98/ toptab(18),tmrtab(18),ibeg(3) data ibeg /13,1,7/ data toptab / 1 0.,42350.,102300.,155950.,278450.,1.e29, 2 0.,33950., 87700.,142000.,278450.,1.e29, 3 0.,25350., 61400.,128100.,278450.,1.e29/ data tmrtab / 1 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0, 2 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0, 3 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0/ c end c c tax brackets for 1999 c block data bloc99 implicit double precision (A-H,O-Z) common /tab99/ toptab(18),tmrtab(18),ibeg(3) data ibeg /13,1,7/ data toptab / 1 0.,43050.,104050.,158550.,283150.,1.e29, 2 0.,34550., 89150.,144400.,283150.,1.e29, 3 0.,25750., 62450.,130250.,283150.,1.e29/ data tmrtab / 1 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0, 2 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0, 3 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0/ c end c c tax brackets for 2000 c block data bloc00 implicit double precision (A-H,O-Z) common /tab00/ toptab(18),tmrtab(18),ibeg(3) data ibeg /13,1,7/ data toptab / 1 0.,43850.,105950.,161450.,288350.,1.e29, 2 0.,35150., 90800.,147050.,288350.,1.e29, 3 0.,26250., 63550.,132600.,288350.,1.e29/ data tmrtab / 1 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0, 2 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0, 3 0.d0,.15d0,.28d0,.31d0,.36d0,.396d0/ c end c c tax brackets 2001 c block data bloc01 implicit double precision (A-H,O-Z) common /tab01/ toptab(21),tmrtab(21),ibeg(3) data ibeg /15,1,8/ data toptab / 1 0.,12000.,45200.,109250.,166500.,297350.,1.e29, 2 0.,10000.,36250., 93650.,151650.,297350.,1.e29, 3 0., 6000.,27050., 65550.,136750.,297350.,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.275d0,.305d0,.355d0,.391d0, 2 0.d0,.10d0,.15d0,.275d0,.305d0,.355d0,.391d0, 3 0.d0,.10d0,.15d0,.275d0,.305d0,.355d0,.391d0/ c end c c tax brackets 2002 c block data bloc02 implicit double precision (A-H,O-Z) common /tab02/ toptab(21),tmrtab(21),ibeg(3) data ibeg /15,1,8/ data toptab / 1 0.d0,12000.d0,46700.d0,112850.d0,171950.d0,307050.d0,1.e29, 2 0.d0,10000.d0,37450.d0, 96700.d0,156600.d0,307050.d0,1.e29, 3 0.d0, 6000.d0,27950.d0, 67700.d0,141250.d0,307050.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.27d0,.30d0,.35d0,.386d0, 2 0.d0,.10d0,.15d0,.27d0,.30d0,.35d0,.386d0, 3 0.d0,.10d0,.15d0,.27d0,.30d0,.35d0,.386d0/ c end c c tax brackets 2003 c block data bloc03 implicit double precision (A-H,O-Z) common /tab03/ toptab(21),tmrtab(21),ibeg(3) data ibeg /15,1,8/ data toptab / 1 0.d0,14000.d0,56800.d0,114650.d0,174700.d0,311950.d0,1.e29, 2 0.d0,10000.d0,38050.d0, 98250.d0,159100.d0,311950.d0,1.e29, 3 0.d0, 7000.d0,28400.d0, 68800.d0,143500.d0,311950.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0/ c end c c tax brackets 2004 c block data bloc04 implicit double precision (A-H,O-Z) common /tab04/ toptab(21),tmrtab(21),ibeg(3) data ibeg /15,1,8/ data toptab / 1 0.d0,14300.d0,58100.d0,117250.d0,178650.d0,319100.d0,1.e29, 2 0.d0,10200.d0,38900.d0,100500.d0,162700.d0,319100.d0,1.e29, 3 0.d0, 7150.d0,29050.d0, 70350.d0,146750.d0,319100.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0/ c end c c tax brackets 2005 c block data bloc05 implicit double precision (A-H,O-Z) common /tab05/ toptab(21),tmrtab(21),ibeg(3) data ibeg /15,1,8/ data toptab / 1 0.d0,14600.d0,59400.d0,119950.d0,182800.d0,326450.d0,1.e29, 2 0.d0,10450.d0,39800.d0,102800.d0,166450.d0,326450.d0,1.e29, 3 0.d0, 7300.d0,29700.d0, 71950.d0,150150.d0,326450.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0/ c end c c tax brackets 2006 c block data bloc06 implicit double precision (A-H,O-Z) common /tab06/ toptab(21),tmrtab(21),ibeg(3) data ibeg /15,1,8/ data toptab / 1 0.,15100.d0,61300.d0,123700.d0,188450.d0,336550.d0,1.e29, 2 0.,10750.d0,41050.d0,106000.d0,171650.d0,336550.d0,1.e29, 3 0., 7550.d0,30650.d0, 74200.d0,154800.d0,336550.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0/ c end c c tax brackets 2007 c block data bloc07 implicit double precision (A-H,O-Z) common /tab07/ toptab(21),tmrtab(21),ibeg(3) data ibeg /15,1,8/ data toptab / 1 0.,15650.d0,63700.d0,128500.d0,195850.d0,349700.d0,1.e29, 2 0.,11200.d0,42650.d0,110100.d0,178350.d0,349700.d0,1.e29, 3 0., 7825.d0,31850.d0, 77100.d0,160850.d0,349700.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0/ c end c c tax brackets 2008 c block data bloc08 implicit double precision (A-H,O-Z) common /tab08/ toptab(21),tmrtab(21),ibeg(3) data ibeg /15,1,8/ data toptab / 1 0.,16050.d0,65100.d0,131450.d0,200300.d0,357700.d0,1.e29, 2 0.,11450.d0,43650.d0,112650.d0,182400.d0,357700.d0,1.e29, 3 0., 8025.d0,32550.d0, 78850.d0,164550.d0,357700.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0/ c end c c c tax brackets 2009 c block data bloc09 implicit double precision (A-H,O-Z) common /tab09/ toptab(21),tmrtab(21),ibeg(3) data ibeg /15,1,8/ data toptab / 1 0.d0,16700.d0,67900.d0,137050.d0,208850.d0,372950.d0,1.e29, 2 0.d0,11950.d0,45500.d0,117450.d0,190200.d0,372950.d0,1.e29, 3 0.d0, 8350.d0,33950.d0, 82250.d0,171550.d0,372950.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0/ c end c c c c tax brackets 2010 c block data bloc10 implicit double precision (A-H,O-Z) common /tab10/ toptab(21),tmrtab(21),ibeg(3) data ibeg /15,1,8/ data toptab / 1 0.d0,16750.d0,68000.d0,137300.d0,209250.d0,373650.d0,1.e29, 2 0.d0,11950.d0,45550.d0,117650.d0,190550.d0,373650.d0,1.e29, 3 0.d0, 8375.d0,34000.d0, 82400.d0,171850.d0,373650.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0/ c end c c tax brackets 2011 c block data bloc11 implicit double precision (A-H,O-Z) common /tab11/ toptab(21),tmrtab(21),ibeg(3) data ibeg /15,1,8/ data toptab / 1 0.d0,17000.d0,69000.d0,139350.d0,212300.d0,379150.d0,1.e29, 2 0.d0,12150.d0,46250.d0,119400.d0,193350.d0,379150.d0,1.e29, 3 0.d0, 8500.d0,34500.d0, 83600.d0,174400.d0,379150.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0/ c end c c tax brackets 2012 c block data bloc12 implicit double precision (A-H,O-Z) common /tab12/ toptab(21),tmrtab(21),ibeg(3) data ibeg /15,1,8/ data toptab / 1 0.d0,17400.d0,70700.d0,142700.d0,217450.d0,388350.d0,1.e29, 2 0.d0,12400.d0,47350.d0,122300.d0,198050.d0,388350.d0,1.e29, 3 0.d0, 8700.d0,35350.d0, 85650.d0,178650.d0,388350.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0/ c end c c tax brackets 2013 c block data bloc13 implicit double precision (A-H,O-Z) common /tab13/ toptab(24),tmrtab(24),ibeg(3) data ibeg /17,1,9/ data toptab / 1 0.d0,17850.d0,72500.d0,146400.d0,223050.d0,398350.d0, 1 450000.d0,1.e29, 2 0.d0,12750.d0,48600.d0,125450.d0,203150.d0,398350.d0, 2 425000.d0,1.e29, 3 0.d0, 8925.d0,36250.d0, 87850.d0,183250.d0,398350.d0, 3 400000.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0/ c end c c tax brackets 2014 c block data bloc14 implicit double precision (A-H,O-Z) common /tab14/ toptab(24),tmrtab(24),ibeg(3) data ibeg /17,1,9/ data toptab / 1 0.d0,18150.d0,73800.d0,148850.d0,226850.d0,405100.d0, 1 457600.d0,1.e29, 2 0.d0,12950.d0,49400.d0,127550.d0,206600.d0,405100.d0, 2 432200.d0,1.e29, 3 0.d0, 9075.d0,36900.d0, 89350.d0,186350.d0,405100.d0, 3 406750.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0/ c end c c tax brackets 2015 c block data bloc15 implicit double precision (A-H,O-Z) common /tab15/ toptab(24),tmrtab(24),ibeg(3) data ibeg /17,1,9/ data toptab / 1 0.d0,18450.d0,74900.d0,151200.d0,230450.d0,411500.d0, 1 464850.d0,1.e29, 2 0.d0,13150.d0,50200.d0,129600.d0,209850.d0,411500.d0, 2 439000.d0,1.e29, 3 0.d0, 9225.d0,37450.d0, 90750.d0,189300.d0,411500.d0, 3 413200.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0/ c end c c tax brackets 2016 c block data bloc16 implicit double precision (A-H,O-Z) common /tab16/ toptab(24),tmrtab(24),ibeg(3) data ibeg /17,1,9/ data toptab / 1 0.d0,18550.d0,75300.d0,151900.d0,231450.d0,413350.d0, 1 466950.d0,1.e29, 2 0.d0,13250.d0,50400.d0,130150.d0,210800.d0,413350.d0, 2 441000.d0,1.e29, 3 0.d0, 9275.d0,37650.d0, 91150.d0,190150.d0,413350.d0, 3 415050.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0/ c end c c tax brackets 2017 c block data bloc17 implicit double precision (A-H,O-Z) common /tab17/ toptab(24),tmrtab(24),ibeg(3) data ibeg /17,1,9/ data toptab / 1 0.d0,18650.d0,75900.d0,153100.d0,233350.d0,416700.d0, 1 470700.d0,1.e29, 2 0.d0,13350.d0,50800.d0,131200.d0,212500.d0,416700.d0, 2 444500.d0,1.e29, 3 0.d0, 9325.d0,37950.d0, 91900.d0,191650.d0,416700.d0, 3 418400.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0/ c end c c tax brackets 2018 c block data bloc18 implicit double precision (A-H,O-Z) common /tab18/ toptab(24),tmrtab(24),ibeg(3) data ibeg /17,1,9/ data toptab / 1 0.d0,19050.d0,77400.d0,156150.d0,237950.d0,424950.d0, 1 480050.d0,1.e29, 2 0.d0,13600.d0,51850.d0,133850.d0,216700.d0,424950.d0, 2 453350.d0,1.e29, 3 0.d0, 9525.d0,38700.d0, 93700.d0,195450.d0,424950.d0, 3 426700.d0,1.e29/ data tmrtab / 1 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0, 2 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0, 3 0.d0,.10d0,.15d0,.25d0,.28d0,.33d0,.35d0,.396d0/ c end c c initialization comnew c block data comout implicit double precision (A-H,O-Z) common /newshr/ comnew(255) data comnew/255*1.0d0/ c end c c c initialization xndxa c block data xndx implicit double precision (A-H,O-Z) common /xndxac/ xndxa(1981:2023) c c Inflation Indexing Parameters: estimates based on ratio of bracket c amounts. data xndxa / .768d0, .815d0, .842d0, .879d0, .910d0, .927d0, & 2*1.d0,1.041d0,1.091d0,1.144d0,1.204d0,1.241d0,1.279d0, & 1.312d0,1.347d0,1.360d0,1.397d0,1.420d0,1.446d0,1.504d0, & 1.554d0,1.579d0,1.620d0,1.660d0,1.702d0,1.744d0,1.788d0, & 1.832d0,1.878d0,1.925d0,1.954d0,1.979d0,2.046d0,2.120d0, & 2.196d0,2.276d0,2.357d0,2.409d0,2.462d0,2.517d0,2.572d0, & 2.629d0/ end c c c initialization ssmax c block data ssm implicit double precision (A-H,O-Z) common /ssmaxa/ ssmax(1960:2025) data ssmax/ 6 4800.d0, 4800.d0, 4800.d0, 4800.d0, 4800.d0, 6 4800.d0, 6600.d0, 6600.d0, 7800.d0, 7800.d0, 7 7800.d0, 7800.d0, 9000.d0, 10800.d0, 13200.d0, 7 14100.d0, 15300.d0, 16500.d0, 17700.d0, 22900.d0, 8 25900.d0, 29700.d0, 32400.d0, 35700.d0, 37800.d0, 8 39600.d0, 42000.d0, 43800.d0, 45000.d0, 48000.d0, 9 51300.d0, 53400.d0, 55500.d0, 57600.d0, 60600.d0, 9 61200.d0, 62700.d0, 65400.d0, 68400.d0, 72600.d0, & 76200.d0, 80400.d0, 84900.d0, 87000.d0, 87900.d0, & 90000.d0, 94200.d0, 97500.d0, 102000.d0, 106800.d0, & 106800.d0, 106800.d0, 110100.d0, 113700.d0, 117000.d0, & 118500.d0, 118500.d0, 127200.d0, 128700.d0, 135900.d0, & 142500.d0, 148800.d0, 155100.d0, 161700.d0, 168300.d0, & 175200.d0/ end c c c initialization amtpi c block data amptpi implicit double precision (A-H,O-Z) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) data xndx/0.0d0/ data amtpi/1.0d0/ data almnpx/0.0d0/ data egtrra/1.0d0/ data almzbr/1.0d0/ data almst/0.0d0/ c initialization The President Tax Cut 2003 c enders - continue gjtrra data enders/0.0d0/ data gjtrra/0.0d0/ data ratmul/1.0d0/ data cgmul/1.0d0/ data amtmul/1.0d0/ data tipra/1.0d0/ c wilhlc for Mark Wilhelm data wilhlc/0.0d0/ data extnd /101*0.0d0/ end c c parameter initialization for AMT c block data almdat implicit double precision (A-H,O-Z) common /alm/ almsp,almr1,almr2 data almsp/175000.0d0/ c almr1 - lower rate data almr1/.260d0/ c almr2 - higher rate data almr2/.280d0/ c end c block data userbloc implicit double precision(A-H,O-Z) common /user/ zbrack(3,1987:2018),exem(1987:2018), &crmax(1987:2018,0:3,1:2),ymax(1987:2023,0:3,1:2), 1rtbase(1987:2023,0:3), rtless(1987:2023,0:3), 2chmax(1998:2023),ealim(2001:2023),cphas(7) data zbrack/ 2540.d0, 3760.d0, 2540.d0, 3000.d0, 5000.d0, 4400.d0, 9 3100.d0, 5200.d0, 4550.d0, 3250.d0, 5450.d0, 4750.d0, 1 3400.d0, 5700.d0, 5000.d0, 3600.d0, 6000.d0, 5250.d0, 3 3700.d0, 6200.d0, 5450.d0, 3800.d0, 6350.d0, 5600.d0, 5 3900.d0, 6550.d0, 5750.d0, 4000.d0, 6700.d0, 5900.d0, 7 4150.d0, 6900.d0, 6050.d0, 4250.d0, 7100.d0, 6250.d0, 9 4300.d0, 7200.d0, 6350.d0, 4400.d0, 7350.d0, 6450.d0, 1 4550.d0, 7600.d0, 6650.d0, 4700.d0, 7850.d0, 6900.d0, 3 4750.d0, 9500.d0, 7000.d0, 4850.d0, 9700.d0, 7150.d0, 5 5000.d0,10000.d0, 7300.d0, 5150.d0,10300.d0, 7550.d0, 7 5350.d0,10700.d0, 7850.d0, 5450.d0,10900.d0, 8000.d0, 9 5700.d0,11400.d0, 8350.d0, 5700.d0,11400.d0, 8400.d0, 1 5800.d0,11600.d0, 8500.d0, 5950.d0,11900.d0, 8700.d0, 3 6100.d0,12200.d0, 8950.d0, 6200.d0,12400.d0, 9100.d0, 5 6300.d0,12600.d0, 9250.d0, 6300.d0,12600.d0, 9300.d0, 7 6350.d0,12700.d0, 9350.d0, 6500.d0,13000.d0, 9550.d0/ data exem / & 1900.d0,1950.d0,2000.d0,2050.d0,2150.d0,2300.d0,2350.d0,2450.d0, & 2500.d0,2550.d0,2650.d0,2700.d0,2750.d0,2800.d0,2900.d0,3000.d0, & 3050.d0,3100.d0,3200.d0,3300.d0,3400.d0,3500.d0,2*3650.d0, & 3700.d0,3800.d0,3900.d0,3950.d0,4000.d0,2*4050.d0,4150.d0/ data crmax/ & 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 306.d0, & 314.d0, 323.d0, 332.d0, 341.d0, 347.d0, 353.d0, 364.d0, 376.d0, & 382.d0, 390.d0, 399.d0, 412.d0, 428.d0, 438.d0,2*457.d0, & 464.d0, 475.d0, 487.d0, 496.d0, 503.d0, 506.d0, 510.d0,520.d0, 1 851.d0, 874.d0, 910.d0, 953.d0,1192.d0,1324.d0,1434.d0,2038.d0, 1 2094.d0,2152.d0,2210.d0,2271.d0,2312.d0,2353.d0,2428.d0,2506.d0, 1 2547.d0,2604.d0,2662.d0,2747.d0,2853.d0,2917.d0,3043.d0,3050.d0, 1 3094.d0,3169.d0,3250.d0,3305.d0,3359.d0,3373.d0,3400.d0,3468.d0, 2 851.d0, 874.d0, 910.d0, 953.d0,1235.d0,1384.d0,1511.d0,2528.d0, 2 3110.d0,3556.d0,3656.d0,3756.d0,3816.d0,3888.d0,4008.d0,4140.d0, 2 4204.d0,4300.d0,4400.d0,4536.d0,4716.d0,4824.d0,5028.d0,5036.d0, 2 5112.d0,5236.d0,5372.d0,5460.d0,5548.d0,5572.d0,5616.d0,5728.d0, 3 851.d0, 874.d0, 910.d0, 953.d0,1235.d0,1384.d0,1511.d0,2528.d0, 3 3110.d0,3556.d0,3656.d0,3756.d0,3816.d0,3888.d0,4008.d0,4140.d0, 3 4204.d0,4300.d0,4400.d0,4536.d0,4716.d0,4824.d0,5657.d0,5666.d0, 3 5751.d0,5891.d0,6044.d0,6143.d0,6242.d0,6269.d0,6318.d0,6444.d0, & 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 306.d0, & 314.d0, 323.d0, 332.d0, 341.d0, 347.d0, 353.d0, 364.d0, 376.d0, & 382.d0, 390.d0, 399.d0, 412.d0, 428.d0, 438.d0,2*457.d0, & 464.d0, 475.d0, 487.d0, 496.d0, 503.d0, 506.d0, 510.d0,520.d0, 1 851.d0, 874.d0, 910.d0, 953.d0,1192.d0,1324.d0,1434.d0,2038.d0, 1 2094.d0,2152.d0,2210.d0,2271.d0,2312.d0,2353.d0,2428.d0,2506.d0, 1 2547.d0,2604.d0,2662.d0,2747.d0,2853.d0,2917.d0,3043.d0,3050.d0, 1 3094.d0,3169.d0,3250.d0,3305.d0,3359.d0,3373.d0,3400.d0,3468.d0, 2 851.d0, 874.d0, 910.d0, 953.d0,1235.d0,1384.d0,1511.d0,2528.d0, 2 3110.d0,3556.d0,3656.d0,3756.d0,3816.d0,3888.d0,4008.d0,4140.d0, 2 4204.d0,4300.d0,4400.d0,4536.d0,4716.d0,4824.d0,5028.d0,5036.d0, 2 5112.d0,5236.d0,5372.d0,5460.d0,5548.d0,5572.d0,5616.d0,5728.d0, 3 851.d0, 874.d0, 910.d0, 953.d0,1235.d0,1384.d0,1511.d0,2528.d0, 3 3110.d0,3556.d0,3656.d0,3756.d0,3816.d0,3888.d0,4008.d0,4140.d0, 3 4204.d0,4300.d0,4400.d0,4536.d0,4716.d0,4824.d0,5657.d0,5666.d0, 3 5751.d0,5891.d0,6044.d0,6143.d0,6242.d0,6269.d0,6318.d0,6444.d0/ data ymax/ 7*0.d0, 5000.d0, 5150.d0, 5300.d0, 5450.d0, 5600.d0, & 5700.d0, 5800.d0, 5950.d0, 6050.d0, 6240.d0, 6390.d0, 6550.d0, & 6740.d0, 7000.d0, 7160.d0, 7470.d0, 7480.d0, 7590.d0, 7750.d0, & 7970d0, 8110.d0, 8250.d0, 8270.d0, 8340.d0,6*8510.d0, 1 6920.d0, 9840.d0,10240.d0,10730.d0,11250.d0,11840.d0,12200.d0, 1 11000.d0,11290.d0,11610.d0,11930.d0,12260.d0,12460.d0,12690.d0, 1 13090.d0,13520.d0,13730.d0,14040.d0,14370.d0,14810.d0,15390.d0, 1 15740.d0,16420.d0,16460.d0,16690.d0,17100.d0, 1 17530.d0,17830.d0,18150.d0,18190.d0,18340.d0,6*18700.d0, 2 6920.d0, 9840.d0,10240.d0,10730.d0,11250.d0,11840.d0,12200.d0, 2 11000.d0,11290.d0,11610.d0,11930.d0,12260.d0,12460.d0,12690.d0, 2 13090.d0,13520.d0,13730.d0,14040.d0,14370.d0,14810.d0,15390.d0, 2 15740.d0,16420.d0,16460.d0,16690.d0,17100.d0, 2 17530.d0,17830.d0,18150.d0,18190.d0,18340.d0,6*18700.d0, 3 6920.d0, 9840.d0,10240.d0,10730.d0,11250.d0,11840.d0,12200.d0, 3 11000.d0,11290.d0,11610.d0,11930.d0,12260.d0,12460.d0,12690.d0, 3 13090.d0,13520.d0,13730.d0,14040.d0,14370.d0,14810.d0,15390.d0, 3 15740.d0,16420.d0,16460.d0,16690.d0,17100.d0, 3 17530.d0,17830.d0,18150.d0,18190.d0,18340.d0,6*18700.d0, & 7*0.d0, 5000.d0, 5150.d0, 5300.d0, 5450.d0, 5600.d0, 5700.d0, & 5800.d0, 5950.d0, 7050.d0, 7240.d0, 7390.d0, 8550.d0, 8750.d0, & 9000.d0,10160.d0,12470.d0,12490.d0,12590.d0,13000.d0,13310.d0, &13540.0d0,13750.d0,13820.d0,13930.d0,14200.d0,5*8310.d0, 1 6920.d0, 9840.d0,10240.d0,10730.d0,11250.d0,11840.d0,12200.d0, 111000.d0,11300.d0,11650.d0,11950.d0,12300.d0,12500.d0,12700.d0, 113090.d0,14520.d0,14730.d0,15040.d0,16400.d0,16850.d0,17390.d0, 118740.d0,21420.d0,21460.d0,21690.d0,22300.d0,22870.d0,23260.d0, 123650.d0,23740.d0,23930.d0,24400.d0,5*17870.d0, 2 6920.d0, 9840.d0,10240.d0,10730.d0,11250.d0,11840.d0,12200.d0, 211000.d0,11300.d0,11650.d0,11950.d0,12300.d0,12500.d0,12700.d0, 213090.d0,14520.d0,14730.d0,15040.d0,16370.d0,16810.d0,17390.d0, 218740.d0,21420.d0,21460.d0,21690.d0,22300.d0,22870.d0,23260.d0, 223650.d0,23740.d0,23930.d0,24400.d0,5*17870.d0, 3 6920.d0, 9840.d0,10240.d0,10730.d0,11250.d0,11840.d0,12200.d0, 311000.d0,11300.d0,11650.d0,11950.d0,12300.d0,12500.d0,12700.d0, 313090.d0,14520.d0,14730.d0,15040.d0,16370.d0,16810.d0,17390.d0, 318740.d0,21420.d0,21460.d0,21790.d0,22300.d0,22870.d0,23260.d0, 323650.d0,23740.d0,23930.d0,24400.d0,5*17870.d0/ c 1 2 3 4 5 6 7 8 data rtbase/ c 1 2 3 4 5 6 7 8 9 10 &.00d0,.00d0,.00d0,.00d0,.00d0,.00d0,.00d0,.0765d0,.0765d0,.0765d0, &.0765d0,.0765d0,.0765d0,.0765d0,23*.0765d0, 1.14d0,.14d0,.14d0,.14d0,.167d0,.176d0,.185d0,.26d0,.34d0,.34d0, 1.34d0,.34d0,.34d0,.34d0,23*.34d0, 2.14d0,.14d0,.14d0,.14d0,.1703d0,.184d0,.195d0,.3d0,.36d0,.4d0, 2.4d0,.4d0,.4d0,.4d0,23*.4d0, 3.14d0,.14d0,.14d0,.14d0,.1703d0,.184d0,.195d0,.3d0,.36d0,.4d0, 3.4d0,.4d0,.4d0,.4d0,8*.4d0,9*.45d0,6*.4d0 / data rtless/ c 1 2 3 4 5 6 7 8 9 10 & .0d0,.0d0,.0d0,.0d0,.0d0,.0d0,.0d0,.0765d0,.0765d0,.0765d0, & .0765d0,.0765d0,.0765d0,.0765d0,23*.0765d0, 1 .1d0,.1d0,.1d0,.1d0,.1193d0,.1257d0,.1321d0,.1598d0,.1598d0, 1 .1598d0,.1598d0,.1598d0,.1598d0,.1598d0,23*.1598d0, 2 .1d0,.1d0,.1d0,.1d0,.1236d0,.1314d0,.1393d0,.1768d0,.2022d0, 2 .2106d0,.2106d0,.2106d0,.2106d0,.2106d0,23*.2106d0, 3 .1d0,.1d0,.1d0,.1d0,.1236d0,.1314d0,.1393d0,.1768d0,.2022d0, 3 .2106d0,.2106d0,.2106d0,.2106d0,.2106d0,23*.2106d0/ data chmax /400.d0,2*500.d0,2*600.d0,21*1000.d0/ data ealim/10000.d0,10350.d0,10500.d0,10750.d0,11000.d0,11300.d0, & 11750.d0,8500.d0,15*3000.d0/ data cphas / &75000.d0,110000.d0,55000.d0,75000.d0,110000.d0,55000.d0,75000.d0/ end function saletx(data,lawyr) c from http://www.nber.org/~taxsim/salestax c for years past LASTYR, use LASTYR and deflate data implicit double precision(a-h,o-z) parameter (LASTYR=2015) common/newshr/comnew(255) common/xndxac/xndxa(1981:2023) dimension data(255) dimension x(1:3,1:51,2004:LASTYR) data x/ & 1.912,.3941,.2443, 0.000,.0000,.0000, 1.698,.4311,.1692, & 2.394,.3854,.2375, 1.843,.4253,.1918, 0.847,.4440,.1828, & 1.668,.4363,.1914, 0.000,.0000,.0000, 1.520,.4482,.1931, & 1.942,.4236,.1862, 1.098,.4635,.2000, 1.901,.4079,.2418, & 2.122,.4079,.2422, 2.564,.3791,.2583, 1.733,.4404,.1933, & 1.403,.4531,.1886, 2.162,.3996,.2430, 1.569,.4464,.1952, & 1.167,.4419,.1892, 1.079,.4724,.1828, 0.763,.4960,.2126, & 1.166,.4688,.1729, 1.909,.4144,.1735, 1.704,.4444,.1766, & 2.592,.3826,.2427, 2.044,.3922,.2453, 0.000,.0000,.0000, & 1.477,.4499,.1842, 1.229,.4717,.2169, 0.000,.0000,.0000, & 1.419,.4558,.2049, 2.156,.3949,.2328, 1.036,.4596,.2181, & 1.463,.4338,.1706, 1.379,.4510,.1799, 1.698,.4407,.1721, & 2.161,.3814,.2379, 0.000,.0000,.0000, 1.038,.4845,.2021, & 1.212,.4726,.1735, 2.183,.3943,.2369, 1.369,.4418,.2713, & 2.779,.3620,.2415, 1.748,.4386,.1834, 2.086,.3945,.2463, & 0.787,.5013,.2050, 1.714,.4080,.2462, 1.970,.4191,.1698, & 2.521,.3863,.2382, 1.276,.4625,.1806, 2.063,.3946,.2445, & 0.929,.4717,.2670, 0.000,.0000,.0000, -0.457,.6164,.2063, & 0.963,.5146,.2610, -0.395,.6166,.2154, -0.640,.5619,.1993, & -0.505,.6187,.1759, 0.000,.0000,.0000, -0.696,.6228,.1946, & -0.260,.6002,.2291, -0.252,.5621,.1844, 0.600,.5149,.2637, & 1.247,.4712,.2691, -0.189,.5963,.2226, 0.334,.5440,.2118, & -0.324,.5981,.2075, 0.919,.5033,.2789, 0.231,.5519,.2032, & -0.570,.6000,.1944, -0.795,.6151,.2213, -0.447,.5993,.2145, & -0.495,.5946,.1822, -0.196,.5953,.2153, -0.403,.6106,.1952, & 1.122,.5142,.2607, 0.024,.5441,.2170, 0.000,.0000,.0000, & -0.244,.5992,.1993, -0.107,.5945,.2082, 0.000,.0000,.0000, & -0.490,.6164,.1838, -0.285,.5982,.2045, -0.603,.6033,.2097, & -0.381,.5879,.2284, -0.355,.5923,.2238, -0.063,.5852,.2085, & 0.470,.5278,.2553, 0.000,.0000,.0000, -0.379,.6032,.1980, & -0.263,.6053,.1921, 0.815,.5052,.2817, 0.549,.5159,.2663, & 0.912,.5288,.2566, -0.158,.6017,.2103, 0.775,.5083,.2696, & -1.467,.6759,.1696, 0.071,.5493,.2109, 0.015,.5893,.2130, & 0.966,.5147,.2571, -0.348,.6006,.1972, 0.572,.5112,.2693, & 0.793,.4898,.2324, 0.000,.0000,.0000, -0.543,.6345,.1111, & 0.731,.5456,.1861, -0.220,.6224,.1087, -0.738,.5783,.1347, & -0.584,.6375,.0790, 0.000,.0000,.0000, -0.871,.6481,.0852, & -0.456,.6300,.1274, -0.307,.5736,.1299, 0.405,.5441,.1804, & 0.952,.5025,.2207, 0.042,.5909,.1379, 0.298,.5553,.1507, & -0.450,.6219,.1035, 0.637,.5388,.2040, 0.148,.5666,.1467, & -0.694,.6233,.0893, -0.890,.6362,.0950, -0.388,.6061,.1125, & -0.530,.6074,.0921, -0.276,.6135,.1121, -0.429,.6291,.0826, & 0.982,.5352,.1956, -0.111,.5659,.1580, 0.000,.0000,.0000, & -0.372,.6231,.0906, -0.198,.6135,.1072, 0.000,.0000,.0000, & -0.268,.6141,.0946, -0.433,.6255,.0935, -0.838,.6247,.1026, & -0.357,.5972,.1275, -0.464,.6138,.1216, -0.320,.6171,.0978, & 0.262,.5567,.1813, 0.000,.0000,.0000, -0.340,.6097,.1078, & -0.170,.6067,.1044, 0.518,.5409,.1941, 0.341,.5450,.1900, & 0.811,.5487,.1817, -0.279,.6248,.1088, 0.511,.5418,.1984, & -1.319,.6764,.0411, 0.339,.5378,.1816, -0.161,.6180,.1045, & 0.739,.5453,.1825, -0.502,.6266,.0949, -0.164,.5804,.1510, & 0.969,.4679,.3092, 0.000,.0000,.0000, 0.126,.5648,.2314, & 1.176,.4953,.2678, 0.249,.5704,.2308, -0.605,.5587,.2386, & 0.239,.5547,.1953, 0.000,.0000,.0000, -0.021,.5631,.2097, & 0.293,.5513,.2567, -0.158,.5546,.2228, 1.006,.4822,.2827, & 1.295,.4774,.3015, 0.477,.5446,.2404, 0.510,.5347,.2342, & 0.394,.5370,.2277, 1.234,.4805,.2872, 0.376,.5420,.2305, & -0.009,.5514,.2139, -0.299,.5713,.2294, 0.063,.5598,.2255, & -0.126,.5640,.2092, 0.181,.5670,.2160, 0.041,.5760,.1996, & 1.531,.4807,.2809, 0.218,.5260,.2708, 0.000,.0000,.0000, & 0.364,.5511,.2045, 0.331,.5583,.2134, 0.000,.0000,.0000, & 0.479,.5486,.1979, 0.372,.5467,.2104, -0.093,.5500,.1977, & 0.162,.5401,.2354, 0.072,.5569,.2414, 0.280,.5556,.2047, & 0.703,.5092,.2810, 0.000,.0000,.0000, 0.029,.5714,.1965, & 0.316,.5620,.1795, 0.608,.5302,.2516, 0.959,.4823,.2830, & 1.371,.4895,.2794, 0.527,.5433,.2336, 0.640,.5190,.2471, & -0.323,.5844,.1463, 0.442,.5248,.2623, 0.523,.5508,.2144, & 1.073,.5049,.2538, 0.287,.5481,.2056, -0.021,.5499,.2247, & 0.970,.4714,.2756, 0.000,.0000,.0000, -0.010,.5798,.1826, & 0.779,.5309,.2131, 0.089,.5889,.1813, -0.639,.5654,.1930, & 0.032,.5772,.1448, 0.000,.0000,.0000, -0.305,.5887,.1646, & 0.022,.5793,.2038, -0.128,.5530,.1886, 0.934,.4941,.2344, & 1.310,.4790,.2694, 0.338,.5591,.1968, 0.618,.5362,.2000, & 0.164,.5697,.1906, 1.148,.4888,.2655, 0.399,.5404,.2005, & -0.205,.5729,.1692, -0.477,.5900,.1718, 0.121,.5726,.1678, & -0.257,.5762,.1482, 0.127,.5721,.1765, -0.145,.5965,.1474, & 1.448,.4906,.2493, -0.054,.5634,.1972, 0.000,.0000,.0000, & 0.188,.5678,.1708, 0.231,.5696,.1736, 0.000,.0000,.0000, & 0.104,.5843,.1481, 0.264,.5583,.1655, -0.403,.5809,.1502, & 0.454,.5250,.2202, -0.051,.5704,.1913, 0.107,.5720,.1680, & 0.714,.5114,.2476, 0.000,.0000,.0000, 0.012,.5722,.1629, & 0.526,.5343,.1650, 0.144,.5739,.1718, 0.823,.4985,.2475, & 1.125,.5156,.2322, 0.254,.5709,.1914, 0.598,.5235,.2214, & -0.243,.5646,.1394, 0.281,.5201,.2269, 0.270,.5728,.1760, & 0.826,.5264,.2153, 0.089,.5681,.1720, -0.299,.5788,.1741, & 0.568,.5108,.2045, 0.000,.0000,.0000, -0.278,.6095,.0996, & 0.434,.5662,.1407, -0.162,.6257,.0943, -0.936,.5996,.0975, & -0.207,.6043,.0806, 0.000,.0000,.0000, -0.757,.6386,.0673, & -0.343,.6217,.1086, -0.562,.5963,.1000, 0.724,.5176,.1736, & 0.795,.5287,.2045, 0.012,.5843,.1283, 0.402,.5645,.1195, & 0.074,.5924,.1155, 0.825,.5231,.2047, -0.243,.6061,.1184, & -0.662,.6187,.0994, -0.988,.6430,.0752, -0.221,.5996,.1120, & -0.579,.6093,.0775, -0.207,.5988,.1093, -0.322,.6201,.0836, & 1.094,.5288,.1827, -0.424,.5929,.1433, 0.000,.0000,.0000, & -0.057,.5963,.1030, -0.088,.5970,.1087, 0.000,.0000,.0000, & -0.307,.6263,.0762, -0.126,.5972,.1062, -0.799,.6228,.0717, & -0.023,.5782,.1141, -0.520,.6067,.1504, -0.181,.6034,.0931, & 0.230,.5580,.1869, 0.000,.0000,.0000, -0.339,.6089,.0808, & 0.207,.5678,.0940, 0.032,.5905,.0944, 0.552,.5281,.1836, & 0.809,.5421,.1801, 0.096,.5915,.1228, 0.162,.5682,.1583, & -0.953,.6350,.0557, -0.190,.5665,.1522, -0.141,.6152,.1085, & 0.325,.5748,.1507, -0.165,.5967,.1061, -0.726,.6224,.1007, & 1.831,.3944,.2779, 0.000,.0000,.0000, 0.804,.5145,.2235, & 1.273,.4827,.2433, 1.089,.5111,.2085, 0.587,.4580,.2023, & 0.774,.5094,.1974, 0.000,.0000,.0000, 0.313,.5340,.2138, & 0.908,.5071,.2191, 0.903,.4592,.1981, 1.501,.4426,.2700, & 0.962,.5044,.2395, 2.163,.4064,.2809, 1.580,.4492,.2147, & 1.470,.4479,.2129, 1.738,.4444,.2972, 1.319,.4605,.2094, & 0.503,.5078,.2135, 0.248,.5253,.2089, 1.255,.4624,.2006, & 1.210,.4597,.1618, 1.264,.4621,.1981, 0.806,.5153,.2084, & 1.954,.4461,.2819, 1.016,.4584,.2421, 0.000,.0000,.0000, & 0.843,.5073,.2254, 1.496,.4527,.1944, 0.000,.0000,.0000, & 0.935,.5090,.1983, 0.714,.5044,.2302, 0.421,.5071,.2071, & 1.289,.4731,.2534, 1.057,.4613,.2266, 0.872,.5021,.2097, & 1.317,.4570,.2817, 0.000,.0000,.0000, 0.788,.5024,.1965, & 1.515,.4446,.1861, 0.960,.4996,.2164, 1.339,.4511,.2907, & 2.171,.4151,.2651, 0.998,.5025,.2376, 1.201,.4694,.2633, & 1.096,.4462,.1428, 1.187,.4385,.2388, 0.929,.5118,.2360, & 1.306,.4806,.2622, 0.829,.5003,.2274, 0.459,.5093,.2190, & 1.572,.4186,.2361, 0.000,.0000,.0000, 0.606,.5387,.1454, & 1.000,.5077,.1668, 0.653,.5450,.1288, 0.316,.4831,.1429, & 0.556,.5395,.1206, 0.000,.0000,.0000, 0.261,.5423,.1028, & 0.592,.5371,.1321, 0.559,.4910,.1474, 1.175,.4739,.2031, & 1.870,.4304,.2327, 1.319,.4621,.1639, 1.349,.4729,.1524, & 0.565,.5424,.1543, 1.783,.4489,.2379, 0.867,.5032,.1434, & 0.163,.5397,.1264, 0.192,.5309,.1105, 0.602,.5265,.1501, & 0.843,.4881,.1070, 0.888,.4959,.1398, 0.369,.5571,.1195, & 1.810,.4611,.2176, 0.697,.4898,.1791, 0.000,.0000,.0000, & 0.569,.5332,.1448, 1.058,.4924,.1364, 0.000,.0000,.0000, & 0.547,.5461,.1037, 0.393,.5508,.1006, 0.072,.5401,.1097, & 1.105,.4818,.1904, 0.849,.4804,.1673, 0.562,.5317,.1282, & 1.189,.4695,.2232, 0.000,.0000,.0000, 0.502,.5283,.1082, & 1.204,.4738,.1200, 0.644,.5296,.1366, 1.154,.4695,.2243, & 1.593,.4752,.1993, 0.708,.5310,.1540, 0.998,.4898,.1900, & 0.629,.4891,.0679, 0.918,.4618,.1819, 0.547,.5480,.1402, & 1.104,.5015,.1967, 0.536,.5288,.1417, 0.127,.5418,.1270, & 1.629,.4168,.2130, 0.000,.0000,.0000, 0.908,.5175,.1088, & 1.239,.4907,.1341, 1.005,.5134,.0979, 0.322,.4842,.1315, & 1.128,.5009,.1098, 0.000,.0000,.0000, 0.525,.5206,.1007, & 0.969,.5081,.1055, 0.586,.4907,.1286, 1.590,.4404,.1904, & 1.910,.4291,.2153, 1.179,.4776,.1376, 1.382,.4720,.1405, & 1.053,.5042,.1206, 1.960,.4380,.2096, 1.041,.4891,.1301, & 0.539,.5104,.1013, 0.414,.5154,.1011, 0.889,.5040,.1195, & 1.004,.4740,.1183, 1.039,.4846,.1208, 1.010,.5043,.0972, & 2.095,.4409,.1884, 0.766,.4854,.1590, 0.000,.0000,.0000, & 0.958,.5040,.1113, 1.293,.4738,.1174, 0.000,.0000,.0000, & 1.099,.5000,.0924, 1.153,.4857,.1069, 0.575,.4964,.0979, & 1.224,.4684,.1612, 0.787,.4872,.1497, 0.963,.5009,.1025, & 1.428,.4544,.1914, 0.000,.0000,.0000, 1.047,.4801,.1085, & 1.380,.4592,.1246, 1.091,.4954,.1023, 1.441,.4490,.1953, & 1.831,.4582,.1728, 1.105,.5004,.1235, 1.291,.4687,.1604, & 1.027,.4507,.1033, 0.858,.4688,.1704, 1.044,.5082,.1134, & 1.239,.4906,.1416, 0.914,.4997,.1160, 0.570,.5069,.1006, & 1.233,.4510,.2339, 0.000,.0000,.0000, -0.351,.6169,.1507, & 0.379,.5680,.1592, 0.067,.5958,.1345, -0.085,.5182,.1586, & 0.190,.5805,.1397, 0.000,.0000,.0000, -0.618,.6186,.1187, & 0.007,.5899,.1387, 0.035,.5382,.1536, 0.171,.5630,.2236, & 1.558,.4602,.2324, 0.862,.5037,.1647, 0.934,.5108,.1597, & 0.010,.5922,.1600, 1.214,.5025,.2270, 0.539,.5312,.1586, & -0.404,.5915,.1283, -0.636,.6063,.1241, -0.105,.5865,.1543, & 0.420,.5273,.1247, 0.539,.5273,.1478, -0.166,.6062,.1179, & 1.311,.5088,.2072, 0.227,.5311,.1901, 0.000,.0000,.0000, & -0.108,.5948,.1499, 0.845,.5113,.1445, 0.000,.0000,.0000, & -0.010,.5955,.1096, -0.743,.6476,.1632, -0.530,.5928,.1094, & 0.431,.5360,.1867, 0.408,.5212,.1675, 0.029,.5813,.1287, & 0.710,.5161,.2058, 0.000,.0000,.0000, -0.119,.5807,.1237, & 0.808,.5112,.1266, 0.033,.5849,.1433, 0.679,.5160,.2122, & 0.981,.5312,.1907, 0.127,.5834,.1602, 0.466,.5395,.1842, & 0.361,.5110,.0945, 0.599,.4952,.1825, 0.106,.5885,.1462, & 0.065,.5881,.1649, 0.014,.5761,.1451, -0.361,.5868,.1299, & 1.228,.4514,.2332, 0.000,.0000,.0000, -0.357,.6174,.1505, & 0.368,.5690,.1592, 0.056,.5968,.1347, -0.082,.5180,.1578, & 0.178,.5815,.1396, 0.000,.0000,.0000, -0.626,.6194,.1180, & -0.004,.5908,.1392, 0.026,.5391,.1523, 0.161,.5639,.2237, & 1.555,.4607,.2314, 0.857,.5042,.1647, 0.928,.5114,.1589, & -0.001,.5932,.1601, 1.206,.5032,.2270, 0.534,.5318,.1577, & -0.410,.5921,.1277, -0.639,.6066,.1246, -0.109,.5870,.1539, & 0.415,.5278,.1243, 0.534,.5278,.1469, -0.171,.6067,.1174, & 1.303,.5097,.2070, 0.220,.5318,.1892, 0.000,.0000,.0000, & -0.118,.5956,.1502, 0.839,.5119,.1439, 0.000,.0000,.0000, & -0.023,.5967,.1094, -0.757,.6489,.1633, -0.542,.5938,.1097, & 0.423,.5367,.1866, 0.402,.5217,.1668, 0.020,.5822,.1289, & 0.706,.5165,.2055, 0.000,.0000,.0000, -0.130,.5818,.1233, & 0.805,.5115,.1262, 0.021,.5860,.1433, 0.666,.5172,.2122, & 0.973,.5320,.1904, 0.116,.5844,.1605, 0.460,.5401,.1839, & 0.355,.5116,.0940, 0.592,.4960,.1813, 0.096,.5895,.1459, & 0.057,.5888,.1649, 0.003,.5771,.1451, -0.368,.5874,.1301, & 1.228,.4514,.2332, 0.000,.0000,.0000, -0.357,.6174,.1505, & 0.368,.5690,.1592, 0.056,.5968,.1347, -0.082,.5180,.1578, & 0.178,.5815,.1396, 0.000,.0000,.0000, -0.626,.6194,.1180, & -0.004,.5908,.1392, 0.026,.5391,.1523, 0.161,.5639,.2237, & 1.555,.4607,.2314, 0.857,.5042,.1647, 0.928,.5114,.1589, & -0.001,.5932,.1601, 1.206,.5032,.2270, 0.534,.5318,.1577, & -0.410,.5921,.1277, -0.639,.6066,.1246, -0.109,.5870,.1539, & 0.415,.5278,.1243, 0.534,.5278,.1469, -0.171,.6067,.1174, & 1.303,.5097,.2070, 0.220,.5318,.1892, 0.000,.0000,.0000, & -0.118,.5956,.1502, 0.839,.5119,.1439, 0.000,.0000,.0000, & -0.023,.5967,.1094, -0.757,.6489,.1633, -0.542,.5938,.1097, & 0.423,.5367,.1866, 0.402,.5217,.1668, 0.020,.5822,.1289, & 0.706,.5165,.2055, 0.000,.0000,.0000, -0.130,.5818,.1233, & 0.805,.5115,.1262, 0.021,.5860,.1433, 0.666,.5172,.2122, & 0.973,.5320,.1904, 0.116,.5844,.1605, 0.460,.5401,.1839, & 0.355,.5116,.0940, 0.592,.4960,.1813, 0.096,.5895,.1459, & 0.057,.5888,.1649, 0.003,.5771,.1451, -0.368,.5874,.1301 & / saletx = 0. is = data(6) iy = lawyr if(is.gt.51) return if(is.eq.0..or.iy.lt.2004) return if(iy.gt.LASTYR) then iy = LASTYR else iy = lawyr endif hy = comnew(2)+data(91)-data(79)+data(41) dhy = (xndxa(iy)/xndxa(lawyr))*hy if(hy.gt.0.and.data(7)+data(8).gt.0.) then saletx = exp(x(1,is,iy)+x(2,is,iy)*log(dhy)+ & x(3,is,iy)*log(data(8)+data(7))) saletx = saletx*xndxa(lawyr)/xndxa(iy) else saletx = 0. endif return end c c main subroutine statax c subroutine statax(data,lawyr,comnew) implicit double precision (A-H,O-Z) parameter(lastat=2016) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common /xndxac/ xndxa(1981:2023) dimension data(255),comnew(255) dimension ds(255),coms(255) c DO NOT FORGET TO UPDATE parameter(lastat=2016) EVERY YEAR agi=0. exemp =0. stded =0. xitded=0. taxinc=0. pcred =0. chcr =0. earncr=0. credit=0. stax=0. rt=0. hy=data(159) rent=data(160) comnew(74)=0. id=abs(data(6)) if(id.lt.0.or.id.gt.51) then 91234 write(0,*) 'State ID must be in range [1..51]' return endif if(id.eq.0) return if(lawyr.lt.1977) then 91235 write(0,*) 'State Tax Calculator available for years 1977+' return endif flate = 1. law = lawyr if(extnd(21).gt.0) law = extnd(21) if(law.gt.lastat) then flate = xndxa(law)/xndxa(lastat) law = lastat endif do 100 i=1,255 ds(i) = data(i) 100 coms(i) = comnew(i) do 200 i=11,99 ds(i) = data(i)/flate ds(i+100) = data(i+100)/flate 200 continue do 300 i=1,98 if(i.ne.26.and.i.ne.65.and.i.ne.72.and.i.ne.73) & coms(i) = comnew(i)/flate 300 continue go to (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, @ 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40, @ 41,42,43,44,45,46,47,48,49,50,51),id 1 continue call altax(ds,coms,stax,law) go to 80 2 continue call aktax(ds,coms,stax,law) go to 80 3 continue call aztax(ds,coms,stax,law) go to 80 4 continue call artax(ds,coms,stax,law) go to 80 5 continue call catax(ds,coms,stax,law) go to 80 6 continue call cotax(ds,coms,stax,law) go to 80 7 continue call cttax(ds,coms,stax,law) go to 80 8 continue call detax(ds,coms,stax,law) go to 80 9 continue call dctax(ds,coms,stax,law) go to 80 10 continue go to 80 11 continue call gatax(ds,coms,stax,law) go to 80 12 continue call hitax(ds,coms,stax,law) go to 80 13 continue call idtax(ds,coms,stax,law) go to 80 14 continue call iltax(ds,coms,stax,law) go to 80 15 continue call intax(ds,coms,stax,law) go to 80 16 continue call iatax(ds,coms,stax,law) go to 80 17 continue call kstax(ds,coms,stax,law) go to 80 18 continue call kytax(ds,coms,stax,law) go to 80 19 continue call latax(ds,coms,stax,law) go to 80 20 continue call metax(ds,coms,stax,law) go to 80 21 continue call mdtax(ds,coms,stax,law) go to 80 22 continue call matax(ds,coms,stax,law) go to 80 23 continue call mitax(ds,coms,stax,law) go to 80 24 continue call mntax(ds,coms,stax,law) go to 80 25 continue call mstax(ds,coms,stax,law) go to 80 26 continue call motax(ds,coms,stax,law) go to 80 27 continue call mttax(ds,coms,stax,law) go to 80 28 continue call netax(ds,coms,stax,law) go to 80 29 continue goto 80 30 continue call nhtax(ds,coms,stax,law) go to 80 31 continue call njtax(ds,coms,stax,law) go to 80 32 continue call nmtax(ds,coms,stax,law) go to 80 33 continue call nytax(ds,coms,stax,law) go to 80 34 continue call nctax(ds,coms,stax,law) go to 80 35 continue call ndtax(ds,coms,stax,law) go to 80 36 continue call ohtax(ds,coms,stax,law) go to 80 37 continue call oktax(ds,coms,stax,law) go to 80 38 continue call ortax(ds,coms,stax,law) go to 80 39 continue call patax(ds,coms,stax,law) go to 80 40 continue call ritax(ds,coms,stax,law) go to 80 41 continue call sctax(ds,coms,stax,law) go to 80 42 continue goto 80 43 continue call tntax(ds,coms,stax,law) goto 80 44 continue go to 80 45 continue call uttax(ds,coms,stax,law) go to 80 46 continue call vttax(ds,coms,stax,law) go to 80 47 continue call vatax(ds,coms,stax,law) go to 80 48 continue goto 80 49 continue call wvtax(ds,coms,stax,law) go to 80 50 continue call witax(ds,coms,stax,law) go to 80 51 continue 80 continue comnew(74) = stax*flate return end c c Subroutines from Statutil c double precision function socsec(data,law) implicit double precision (A-H,O-Z) dimension data(255),rate(1977:2025),ceil(1977:2025) data rate * / .0585d0,.0605d0,.0613d0,.0613d0, * .0665d0,.0670d0,.0670d0,.0700d0,.0705d0, * .0715d0,.0715d0,.0751d0,.0751d0,21*.0765d0, * 2*.0565d0,13*.0765d0/ data ceil * / 16500.d0, 17700.d0, 22900.d0, 25900.d0, * 29700.d0, 32400.d0, 35700.d0, 37800.d0, 39600.d0, * 42000.d0, 43800.d0, 45000.d0, 48000.d0, 51300.d0, * 53400.d0, 55500.d0, 57600.d0, 60600.d0, 61200.d0, * 62700.d0, 65400.d0, 68400.d0, 72600.d0, 76200.d0, * 80400.d0, 84900.d0, 87000.d0, 87900.d0, 90000.d0, * 94200.d0, 97500.d0,102000.d0,106800.d0,106800.d0, * 106800.d0,110100.d0,113700.d0,117000.d0,118500.d0, * 118500.d0,127200.d0,128700.d0,135900.d0,142500.d0, * 148800.d0,155100.d0,161700.d0,168300.d0,175200.d0/ mst = data(2) if(mst.eq.2) then fica = (min(data(85),ceil(law))+min(data(86),ceil(law)))* & rate(law) else fica = min(data(11),ceil(law))*rate(law) endif socsec = fica + data(43)+data(44) return end double precision function xjobs(data,law) implicit double precision (A-H,O-Z) dimension data(100),rate1(1977:1994),rate2(1977:1994) data rate1/10*.5d0,3*.4d0,5*0.0d0/ data rate2/10*.25d0,8*0.0d0/ amt1=0. amt2=0. xjobs=0. if(law.le.1986) then amt1=data(37)*2/3 amt2=amt1/2 xjobs=min(12000.0d0,(amt1/rate1(law))+(amt2/rate2(law))) elseif(law.ge.1987.and.law.le.1989) then amt1=data(37) amt2=0. xjobs=min(6000.0d0,(amt1/rate1(law))) elseif(law.ge.1990) then xjobs=0. endif return end c subroutine look(table,y,ntab,n,statax,aif,data2,rt,data) implicit double precision (A-H,O-Z) common/times/z,p,txrate,h dimension table(2,ntab),data(255) integer d2,d209 d209 = data(209) d2 = data2 c negative data2 is signal that separate filing is allowed. h=0. c ntab=25 call look2(table,y,ntab,n,statax,aif,dabs(data2),rt,data) if(d2.eq.-2) then yh= max(data(85),data(86))+(y-data(11))/2. yw=y-yh h=2 call look2(table,yw,ntab,n,taxw,aif,1.0d0,rt,data) h=1 call look2(table,yh,ntab,n,taxh,aif,1.0d0,rt,data) if(taxw+taxh.gt.statax.and.d209.eq.2) then c91234 write(0,*) 'should not file jointly',data(6),data(100),data(101) continue endif statax=min(statax,taxw+taxh) endif return end subroutine look2(table,y,ntab,n,statax,aif,data2,rt,data) implicit double precision (A-H,O-Z) c aif=annual inflation factor if indexed,otherwise 1. common/times/z,p,txrate,h common/x/ct c data2=marital status if joint filing is allowed,otherwise 0. dimension table(2,ntab),data(255) integer d2 d2 = data2 c This line is in here to avoid unused variable errors if(d2.eq.543) then 91234 write(0,*) n,'unused var' continue endif ajnt=1. if(d2.eq.2.or.d2.eq.5)ajnt=2 y1=max(y/aif/ajnt,0.0d0) statax=0. rt=0. yleft=y1 rate=table(2,1)/100. if(y1.lt.table(1,1)) goto 99 statax=table(1,1)*table(2,1)/100. do 10 i=2,ntab if(table(1,i).lt.table(1,i-1).or.table(2,i).lt..1) then if(table(2,i).gt.0) then d101 = data(101) d100 = data(100) 91235 write(0,2)table(1,i),table(1,i-1),table(2,i),d101,data(6),d100 endif endif yleft=y1-table(1,i-1) rate=table(2,i)/100. if(y1.lt.table(1,i)) goto 99 statax=statax+(table(1,i)-table(1,i-1))*rate c1 format(1x,8f8.2) 2 format(' error in look2:',3f8.2,f6.0,f4.0,f12.0) 10 continue yleft=y1-table(1,ntab) 99 continue statax=aif*ajnt*(yleft*rate+statax) c calculating marginal tax rate rt=rate c if(ct.eq.1) then c write(*,*) c endif return end double precision function disap(y,alow,ahigh) implicit double precision (A-H,O-Z) if(ahigh.le.alow) then 91234 write(6,100) alow,ahigh continue endif 100 format(' error in disap',2g12.5) disap=1.-min(max(((y-alow)/ahigh-alow),0.0d0),1.0d0) return end double precision function xif(logic,real) implicit double precision (A-H,O-Z) logical logic xif=0. if(logic) xif=real return end double precision function tablk(table,n,y,data) implicit double precision (A-H,O-Z) dimension table(2,n),data(100) do 200 j=1,n num=j if(j+1.ge.n) goto 2 if(table(1,j+1).le.table(1,j)) then 91234 write(6,100)table(1,j),table(1,j+1),data(6) continue endif 100 format(' error in tablk',3g12.5) 2 if(y.lt.table(1,j)) go to 210 200 continue tablk=0. 210 tablk=table(2,num) return end double precision function tablki(table,n,y,data) implicit double precision (A-H,O-Z) common /psubr/ xndx,amtpi,almnpx,egtrra,almzbr,almst,enders, &gjtrra,ratmul,cgmul,amtmul,tipra,wilhlc,extnd(0:100) dimension table(2,n),data(100) do 200 j=1,n num=j if(j+1.ge.n) goto 2 if(table(1,j+1).le.table(1,j)) then 91234 write(6,100)table(1,j),table(1,j+1),data(6) continue endif 100 format(' error in tablki',3g12.5) 2 if(y.lt.table(1,j)) go to 210 200 continue 210 if(num.eq.1) then tablki = table(2,num) else if(num.lt.n) then w = (y-table(1,num-1))/(table(1,num)-table(1,num-1)) if(table(2,num).gt.table(2,num-1)) then tablki = w*table(2,num-1) + (1-w)*table(2,num) else tablki = w*table(2,num) + (1-w)*table(2,num-1) endif else if(num.eq.n) then tablki=table(2,num) endif if(extnd(88).gt.0.d0) tablki = table(2,num) return end function lastk() implicit double precision (A-H,O-Z) lastk=13 return end double precision function sorm(mart,a,b) implicit double precision (A-H,O-Z) c this soubroutine determines married or single status sorm=a if(mart.eq.2.or.mart.eq.3.or.mart.eq.6)sORM=b return end block data inpc87 implicit double precision (A-H,O-Z) common/pce96/gnpd(1973:1999) data gnpd * / 34.02d0,36.96d0, 40.37d0, 42.79d0, 45.59d0, 48.75d0, * 52.70d0,57.38d0,62.70d0, 66.51d0, 69.24d0, 71.80d0, 74.05d0, * 75.66d0,77.84d0,80.46d0, 83.56d0, 86.83d0, 89.76d0, 91.70d0, * 94.16d0,96.14d0,98.19d0,100.00d0,101.66d0,102.86d0,104.37d0/ end c double precision function keoles(data,comnew,lawyr) implicit double precision (A-H,O-Z) c adjusts keogh deductions to requested year levels dimension data(255),comnew(255) double precision keogh, kghmax,kghlim kghmax = 7500. if (lawyr.eq.1982.or.lawyr.eq.1983) kghmax = 15000. if (lawyr.ge.1984) kghmax = 30000. bus = data(17)+data(75)+data(79)-data(80) retlim = max(0.0d0,.15*bus) kghlim = min(retlim,kghmax) keogh = min(data(28),kghlim) keoles=max(0.0d0,comnew(14)-keogh) return end c double precision function irales(data,comnew,lawyr) implicit double precision (A-H,O-Z) c adjusts ira deductions tp requested year levels dimension data(255),comnew(255) double precision iramax, iralim sepret=data(3) mst = data(2) iramax = 3000./sepret if (lawyr.ge.1981) iramax = 4000./sepret if(mst.eq.1.or.mst.eq.4.or.mst.eq.7)iramax = iramax/2. bus = data(17)+data(75)+data(79)-data(80) busnet = max(0.0d0,bus-comnew(14)) iralim = min(data(11)+busnet,iramax) ira = min(data(29),iralim) irales=max(0.0d0,comnew(12)-ira) return end c double precision function divexc(data,comnew,law) implicit double precision (A-H,O-Z) c computes the amount of the federal div (int) excl dimension data(255), comnew(255) divexc=0. diff=0. if(law.ne.1981) diff= data(12) - comnew(4) if(law.eq.1981) diff= data(12) + data(14) - comnew(4) c3 format(' error in divexc, year:',i5,'divs:',f8.0,'int:',f8.0, c + 'divs net of exc (from fed prg):',f8.0) divexc=diff return end c double precision function disab(data,comnew,law) implicit double precision (A-H,O-Z) c computes amount of federal disability exclusion dimension data(255),comnew(255) disab=0. if(law.ge.1981.and.law.le.1985) then disab=data(25) else disab=max(0.0d0,data(25)-comnew(16)) endif return end c double precision function trent(foreac,diff, & starty,stamnt,sign,tabby,tmax) implicit double precision (A-H,O-Z) integer sign trent=0. over=max(0.0d0,tabby-starty) if(over.gt.0) then trent=stamnt iplus=aint(over/foreac) if(sign.eq.1)trent=trent+(iplus*diff) if(sign.eq.-1)trent=trent-(iplus*diff) trent=max(0.0d0,min(trent,tmax)) endif return end c c double precision function renter(data,comnew) implicit double precision (A-H,O-Z) c determines whether a return with no property tax is likely to c pay rent common/calc/hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr, & earncr,credit,rt dimension data(255), comnew(255) renter=0. c agi=max(0.0d0,comnew(2)) y=data(11)+data(23) y=y+comnew(84) if(data(51).lt.1.and.data(160).gt.0.) renter=1. return end c ALABAMA c State 1 c Updated through 2016 subroutine altax(data,comnew,statax,law) implicit double precision (A-H,O-Z) c common/opts/intnet common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension tab(2,4),tab82(2,3) c tab arrays hold data on tax increments and rates dimension data(255), comnew(255) data tab /1000.0d0,1.5d0,3000.0d0,3.0d0,5000.0d0,4.5d0, & 1.e20,5.0d0/ data tab82/500.0d0, 2.0d0, 3000.0d0, 4.0d0, 1.e20, 5.0d0/ rt=0. mst = data(2) ided = data(4) c AGI c no dividend exclusion c Unemployment income is exempt from state taxes c state tax refund is not taxable agi=comnew(2)+divexc(data,comnew,law)-comnew(78)-data(22) if(law.eq.2011.or.law.eq.2012) then if(data(43).le.14204.) then agi = agi + .5751*(data(43)+data(44)) else agi = agi + .5*(data(43)+data(44)) + 1067 endif else agi = agi + .5*(data(43)+data(44)) endif c The Capital Gains are treated similar to Federal Taxes, c except that all gains are taxable and all losses are deduct. in the year incurred c agi=agi+(max(0.0d0,comnew(5))-max(0.0d0,comnew(6))) if(comnew(6).lt.0) agi = agi + abs(comnew(6)) if(law.le.1981) then alimon=data(23)+data(62) agi=agi-alimon agi=agi+comnew(12)+comnew(14) endif if(law.ge.1982.and.law.le.1986) agi=agi+comnew(32) c All social security income is exempt from state taxes if(law.ge.1984)agi=agi-comnew(79) if(law.ge.1987) agi=agi-data(26) if(law.le.1981) then stded=twn(.1*agi,0.0d0,data(7)*1000.) else if(law.ge.1982.and.law.le.2006) then stded=twn(.2*agi,0.0d0,data(7)*2000.) else if(law.ge.2007) then c New Standard Deduction since 2007 stded = 2000.*data(7) if(mst.eq.1) then if(agi.ge.20500.and.agi.lt.30000.) & stded=2500-(agi-20000)*.052631578 if(agi.lt.20500) stded = 2500. else if(mst.eq.4.or.mst.eq.7) then if(agi.gt.20500.and.agi.lt.30000.) & stded=4700-(agi-20000)*.284210526 if(agi.lt.20500) stded = 4700. else if(agi.ge.20500/data(3).and.agi.lt.30000/data(3)) & stded = 7500./data(3) - (agi-20500/data(3))*.368421052 if(agi.lt.20500) stded = 7500./data(3) endif endif c XITDED ag=max(0.0d0,agi) if(law.le.1982) then xitded = data(56)+data(57)+comnew(23)+data(61) & +max(0.0d0,data(63)-.02*ag)+data(66) else xitded = data(56)+data(57)+comnew(23)+max(0.0d0,data(61)-.1*ag) & +max(0.0d0,data(63)-.02*ag)+data(66) endif if(law.le.1991) then xitded=xitded+max(0.0d0,max(0.0d0,data(48)-.01*ag)+ & data(49)+min(150.0d0,data(47))-.03*ag) else if(law.ge.1992) then xitded=xitded+max(0.0d0,data(49)-.04*ag) endif if(law.ge.1982) xitded=xitded+socsec(data,law)+data(51)+data(54) if(law.le.1981)xitded=xitded-max(0.0d0,comnew(23)-ag*.15) c accounts for deduction of fed inc tax c tax based on withholding; don't count for credits c if(law.le.1999)fedtax=max(comnew(52)-comnew(58),0.0d0) if(law.le.1999)fedtax=max(comnew(1),0.0d0) if(law.ge.2000.and.law.le.2008)fedtax = & max(comnew(52)+comnew(70)-comnew(58),0.0d0) c 2009+ Federal Income Tax deduction worksheet if(law.ge.2009) fedtax = &max(0.0d0,comnew(154)-comnew(94)-comnew(59)-comnew(93)-comnew(92)) deduc=max(stded,xitded)+fedtax c EXEMPTIONS if(mst.eq.4.or.mst.eq.7.or.mst.eq.2) then exemp=3000. else exemp=1500. endif c Dependent Exemptions if(law.le.2006) exemp=exemp+300*data(8) if(law.ge.2007) then if(agi.le.20000) exemp=exemp+1000*data(8) if(agi.gt.20000.and.agi.le.100000) exemp=exemp+500*data(8) if(agi.gt.100000) exemp=exemp+300*data(8) endif taxinc=max(0.0d0,agi-deduc-exemp) if(law.le.1981) then call look(tab, taxinc,4,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1982) then taxy = taxinc/data(7) call look(tab82,taxy,3,n,stat,1.0d00, 0.0d0,rt,data) statax = stat*data(7) endif c deduction for solar energy credit; non-refundable solcrd=0. if(law.ge.1981.and.law.le.1986)solcrd=data(38) statax=max(0.0d0,statax-solcrd) credit = solcrd return end c ALASKA c State 2 c c c c EAC revised Summer 1994 c c tax abolished for 1979 on c maximum tax on earned income not included c alternative tax on captial gains not included c aktab (x,1) for single people c aktab (x,2) for married filing jointly, surviving spouses c aktab (x,3) for heads of household c subroutine aktax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255) dimension aktab1(2,25),aktab2(2,25),aktab3(2,25),cred(1977:1988) data aktab1 / 2000.0d0, 3.0d0, 4000.0d0, 3.5d0, & 6000.0d0, 4.0d0, 8000.0d0, 5.0d0, 10000.0d0, 2.5d0, & 12000.0d0, 6.0d0, 14000.0d0, 7.0d0, 16000.0d0, 7.5d0, & 18000.0d0, 8.0d0, 20000.0d0, 8.5d0, 22000.0d0, 9.0d0, & 26000.0d0, 9.5d0, 32000.0d0,10.0d0, 38000.0d0,10.5d0, & 44000.0d0,11.0d0, 50000.0d0,11.5d0, 60000.0d0,12.0d0, & 70000.0d0,12.5d0, 80000.0d0,13.0d0, 90000.0d0,13.5d0, &100000.0d0,14.0d0,150000.0d0,14.0d0, 1.e20, 14.5d0, & 0.0d0, 0.0d0, 0.0d0, 0.0d0 / data aktab2/ & 4000.0d0, 3.0d0, 8000.0d0, 3.5d0, 12000.0d0, 4.0d0, & 16000.0d0, 5.0d0, 20000.0d0, 5.5d0, 24000.0d0, 6.0d0, & 28000.0d0, 7.0d0, 32000.0d0, 7.5d0, 36000.0d0, 8.0d0, & 40000.0d0, 8.5d0, 44000.0d0, 9.0d0, 52000.0d0, 9.5d0, & 64000.0d0,10.0d0, 76000.0d0,10.5d0, 88000.0d0,11.0d0, & 100000.0d0,11.5d0,120000.0d0,12.0d0,140000.0d0,12.5d0, & 160000.0d0,13.0d0,180000.0d0,13.5d0,200000.0d0,14.0d0, & 300000.0d0,14.0d0,1.e20, 14.5d0,0.0d0,0.0d0,0.0d0,0.0d0 / data aktab3 / & 2000.0d0, 3.0d0, 4000.0d0, 3.5d0, 6000.0d0, 4.0d0, & 8000.0d0, 4.5d0, 10000.0d0, 5.0d0, 12000.0d0, 5.5d0, & 14000.0d0, 6.0d0, 16000.0d0, 6.5d0, 18000.0d0, 7.0d0, & 20000.0d0, 7.0d0, 22000.0d0, 7.5d0, 24000.0d0, 8.0d0, & 28000.0d0, 8.5d0, 32000.0d0, 9.0d0, 38000.0d0, 9.5d0, & 44000.0d0, 10.0d0, 50000.0d0,10.5d0, 60000.0d0,11.0d0, & 70000.0d0, 11.5d0, 80000.0d0,12.0d0, 90000.0d0,12.5d0, & 100000.0d0, 13.0d0,150000.0d0,13.5d0,200000.0d0,14.0d0, & 1.e20, 14.5d0 / data cred/0.0d0,100.0d0,200.0d0,300.0d0,8*0.0d0/ statax=0. rt=0. mst = data(2) c Personal income tax repealed in 1980 after the oil boom. if(law.gt.1979)return agi = comnew (2) c 1978 0 bracket used instead of 1974 stded=2200. m = 1 if(mst.eq.2.or.mst.eq.5) then stded=3200. m = 2 endif if(mst.eq.3.or.mst.eq.6) stded=1600. if(mst.eq.7.or.mst.eq.4) m = 3 deduc=stded taxinc = agi - deduc if (m.eq.1) &call look(aktab1,taxinc, 23,n, statax,1.0d00,0.0d0,rt,data) if (m.eq.2) &call look(aktab2,taxinc, 23,n, statax,1.0d00,0.0d0,rt,data) if (m.eq.3) &call look(aktab3,taxinc, 25,n, statax,1.0d00,0.0d0,rt,data) c minimum tax statax=statax+.16*.15*data(81) txcred=cred(law) if(mst.eq.2) txcred=txcred*2. credit=min(50.0d0,data(35)) statax=max(0.0d0,statax-credit-txcred) c1 format(1x,10f8.0) return end c ARIZONA c State 3 c Updated through 2016 subroutine aztax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255),tab(2,7),proptb(2,22),pr90tb(2,22) dimension t9093s(2,5) , t9093h(2,5) dimension tab94s(2,5) , tab94h(2,5) dimension tab95s(2,5) , tab95h(2,5) dimension tab97s(2,5) , tab97h(2,5) dimension tab98s(2,5) , tab98h(2,5) dimension tab99s(2,5) , tab99h(2,5) dimension tab06s(2,5) , tab06h(2,5) dimension tab07s(2,5) , tab07h(2,5) dimension ex(1995:2016),fag98m(4),fag98h(5) dimension aif(1977:2016),rtab(1977:1994),rfrac(1977:1994) dimension brkif(1977:1994), ptab(2,22),std(1990:2016) dimension aif92(1992:2012),aif13(2013:2017),aif15(2015:2016) data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ data aif15/1.0163d0,1.01785d0/ data aif92/ & 1.0525d0, 1.0845d0, 1.118d0 , 1.147d0 , 1.1795d0, 1.212d0, & 1.245d0 , 1.266d0 , 1.2895d0, 1.3295d0, 1.373d0 , 1.395d0, & 1.427d0 , 1.4595d0, 1.505d0 , 1.564d0 , 1.5995d0, 1.668d0, &2*1.6955d0, 1.7365d0/ data proptb / 1750.0d0, 225.0d0, 1850.0d0, 215.0d0, 1950.0d0, & 206.0d0, 2050.0d0, 250.0d0, 2150.0d0, 185.0d0, 2250.0d0, & 175.0d0, 2350.0d0, 165.0d0, 2450.0d0, 155.0d0, 2550.0d0, & 145.0d0, 2650.0d0, 135.0d0, 2750.0d0, 125.0d0, 2850.0d0, & 115.0d0, 2950.0d0, 105.0d0, 3050.0d0, 95.0d0, 3150.0d0, & 86.0d0, 3250.0d0, 75.0d0, 3350.0d0, 65.0d0, 3450.0d0, & 55.0d0, 3550.0d0, 45.0d0, 3650.0d0, 35.0d0, 3750.0d0, & 25.0d0, 1.e20, 0.0d0/ data pr90tb / &0.d0,502.d0,0.d0,479.d0,0.d0,457.d0,0.d0,435.d0,0.d0,412.d0, &0.d0,390.d0,0.d0,368.d0,0.d0,345.d0,0.d0,323.d0,0.d0,301.d0, &0.d0,279.d0,0.d0,256.d0,0.d0,234.d0,0.d0,212.d0,0.d0,189.d0, &0.d0,167.d0,0.d0,145.d0,0.d0,123.d0,0.d0,100.d0,0.d0, 78.d0, &0.d0, 56.d0,0.d0, 0.d0/ data ptab/ &1750.d0,0.d0,1850.d0,0.d0,1950.d0,0.d0,2050.d0,0.d0,2150.d0,0.d0, &2250.d0,0.d0,2350.d0,0.d0,2450.d0,0.d0,2550.d0,0.d0,2650.d0,0.d0, &2750.d0,0.d0,2850.d0,0.d0,2950.d0,0.d0,3050.d0,0.d0,3150.d0,0.d0, &3250.d0,0.d0,3350.d0,0.d0,3450.d0,0.d0,3550.d0,0.d0,3650.d0,0.d0, &3750.d0,0.d0, 1.e20,0.d0/ data tab/ 1000.0d0, 2.0d0, 2000.0d0, 3.0d0, 3000.0d0, 4.0d0, & 4000.0d0, 5.0d0, 5000.0d0, 6.0d0, 6000.0d0, 7.0d0, & 1.e20, 8.0d0/ data t9093s/ 10000.0d0, 3.8d0, 25000.0d0, 4.40d0, & 50000.0d0, 5.250d0,150000.0d0, 6.50d0, & 1.e20, 7.0d0/ data t9093h/ 20000.0d0, 3.80d0, 50000.0d0, 4.40d0, & 100000.0d0, 5.250d0, 300000.0d0, 6.50d0, 1.e20,7.0d0/ data tab94s/ 10000.0d0, 3.250d0, 25000.0d0, 4.0d0, & 50000.0d0, 5.050d0,150000.0d0, 6.40d0, 1.e20, 6.90d0/ data tab94h/ 20000.0d0, 3.250d0, 50000.0d0, 4.0d0, & 100000.0d0, 5.050d0, 300000.0d0, 6.40d0, 1.e20, 6.90d0/ data tab95s/ 10000.0d0, 3.0d0, 25000.0d0, 3.50d0, & 50000.0d0, 4.20d0, 150000.0d0, 5.20d0, 1.e20, 5.60d0/ data tab95h/ 20000.0d0, 3.0d0, 50000.0d0, 3.50d0, & 100000.0d0, 4.20d0, 300000.0d0, 5.20d0, 1.e20, 5.60d0/ data tab97s/ 10000.0d0, 2.90d0, 25000.0d0, 3.30d0, & 50000.0d0, 3.90d0, 150000.0d0, 4.80d0, 1.e20, 5.170d0/ data tab97h/ 20000.0d0, 2.90d0, 50000.0d0, 3.30d0, & 100000.0d0, 3.90d0,300000.0d0, 4.80d0, 1.e20, 5.170d0/ data tab98s/ 10000.0d0, 2.880d0, 25000.0d0, 3.240d0, & 50000.0d0, 3.820d0,150000.0d0, 4.740d0, 1.e20, 5.10d0/ data tab98h/ 20000.0d0, 2.880d0, 50000.0d0, 3.240d0, & 100000.0d0, 3.820d0,300000.0d0, 4.740d0, 1.e20, 5.10d0/ data tab99s/ 10000.0d0, 2.870d0, 25000.0d0, 3.20d0, & 50000.0d0, 3.740d0,150000.0d0, 4.720d0, 1.e20, 5.040d0/ data tab99h/ 20000.0d0, 2.870d0, 50000.0d0, 3.20d0, & 100000.0d0, 3.740d0, 300000.0d0, 4.720d0, 1.e20, 5.040d0/ data tab06s/ 10000.0d0, 2.730d0, 25000.0d0, 3.040d0, & 50000.0d0, 3.550d0,150000.0d0, 4.480d0, 1.e20, 4.790d0/ data tab06h/ 20000.0d0, 2.730d0, 50000.0d0, 3.040d0, & 100000.0d0, 3.550d0, 300000.0d0, 4.480d0, 1.e20, 4.790d0/ data tab07s/ 10000.0d0, 2.590d0, 25000.0d0, 2.880d0, & 50000.0d0, 3.360d0, 150000.0d0, 4.240d0, 1.e20, 4.540d0/ data tab07h/ 20000.0d0, 2.590d0, 50000.0d0, 2.880d0, & 100000.0d0, 3.360d0,300000.0d0, 4.240d0, 1.e20, 4.540d0/ data fag98m/ 20000.0d0, 23600.0d0, 27300.0d0, 31000.0d0/ data fag98h/ 20000.0d0, 20135.0d0, 23800.0d0, 25200.0d0, & 26575.0d0/ data rtab/50.0d0,83.0d0,92.0d0,107.0d0,120.0d0,130.0d0,132.0d0, & 4*100.0d0,85.0d0,6*70.0d0/ data aif/1.00d0, 1.1010d0, 1.2260d0, 1.4220d0, 1.5890d0, & 1.7290d0, 1.7590d0, 1.8340d0,1.9410d0, 1.9960d0, 2.0450d0, &2.1250d0, 2.2290d0, 27*1.0d0/ data rfrac/7*.10d0,11*.050d0/ data brkif/6*1.0d0, 1.10170d0, 1.0610d0, 1.1230d0, 1.1550d0, & 1.1830d0, 1.2290d0, 1.290d0, 5*1.0d0/ data ex/ 3*30.0d0,19*40.0d0/ data std/5*3500.d0,6*3600.d0,4*4050.d0,4125.d0,4247.d0, & 4373.d0,4521.d0,2*4677.d0,4703.d0,4833.d0,4945.d0,5009.d0, & 5091.d0,5099.d0/ c Tax Law is the same for 1995 and 1996 c indexing covers everything. mst = data(2) rt=0. credit = 0. phas92=100000./data(3) if(law.ge.1992.and.law.le.2012)phas92=100000.*aif92(law)/data(3) if(law.ge.2013) &phas92 = filing(mst,250000.,300000.,275000.,150000.)*aif13(law) c AGI agi=comnew(2) if(law.le.1980)agi=agi+divexc(data,comnew,law) if(law.ge.1982.and.law.le.1986) agi=agi+comnew(32) if(law.ge.1984)agi=agi-comnew(79) c federal tax deduction is only for withholding and estimated c tax payments; don't include credits for this reason c fedtax=max(0.,comnew(1)-comnew(64)+comnew(59)+comnew(58)) fedtax=max(0.0d0,comnew(1)+comnew(59)+comnew(58)) if(law.le.1989)agi=agi-fedtax c EXEMP txp=data(7) if(mst.eq.4.or.mst.eq.7)txp=txp+1. if(law.le.1989)then exemp=(((txp+data(9))*1000.)+(data(8)*600.)+(data(10)*500.))* & aif(law) endif if(law.le.1978)exemp=exemp-xif(mst.eq.4.or.mst.eq.7, & min(data(8),1.0d0)*600.*aif(law)) if(law.ge.1990)exemp=((txp+data(8))*2000.)+ & ((data(9)+data(10))*1500.) if(law.ge.1992)exemp=((txp+data(8))*2100.)+ & (data(9)*1750.)+(data(10)*1500.) if(law.ge.1993.and.law.le.1996) exemp=((txp+data(9))*2100.)+ & (data(8)*2300.)+(data(10)*1500.) if(law.ge.1997) then txpex = txp if(data(8).gt.0.and.mst.eq.2) txpex=txpex+1 exemp=txpex*2100. exemp = exemp + data(9)*2100 + data(10)*1500+data(8)*2300 endif c DEDUCTIONS if(law.le.1983) then fctr=nint(aif(law)*10.)/10. else if(law.eq.1984.or.law.eq.1985) then fctr=nint(aif(law)*100.)/100. else if(law.ge.1986) then fctr=aif(law) endif if(law.le.1989) then stded=twn(.1*fctr*agi,0.0d0,txp*500.*aif(law)) else stded = txp * std(law) if(mst.eq.4.or.mst.eq.7) stded = 2 * std(law) endif ag=max(0.0d0,comnew(2)) c what is the difference here between this & medical expenses--see 1992? health = data(47)+data(48)+data(49) if(law.le.1989) then xitded = comnew(30)+health-data(50)-comnew(20) & +min(data(63),.02*ag)+data(54)+data(55) if(law.ge.1980)xitded = xitded+min(100.*data(7),data(65)) c Child Care Deduction-- if(data(159).lt.6000./data(3)) & xitded = xitded+min(data(64),1200.0d0) c ---------------------- if(law.le.1979)xitded = xitded-data(60) char = data(58)+data(59)+data(60) if(law.le.1981)xitded = xitded-max(char-(.2*ag),0.0d0) c itemized deduction=federal itemized deduct else xitded=comnew(30) if(agi.gt.phas92.and.law.ge.1991) then if(law.le.2005) & reduce = min(.8*xitded,.03*(agi-phas92)) if(law.eq.2006.or.law.eq.2007) & reduce = 2*min(.8*xitded,.03*(agi-phas92))/3. if(law.eq.2008.or.law.eq.2009) & reduce = min(.8*xitded,.03*(agi-phas92))/3. if(law.ge.2010.and.law.le.2012) & reduce = 0 xitded = xitded-reduce endif if(law.eq.1992)xitded = xitded+ & max(0.0d0,health -.06*comnew(2)-comnew(20)) if(law.eq.1993)xitded = xitded+ & max(0.0d0,health -.04*comnew(2)-comnew(20)) if(law.eq.1994)xitded = xitded+ & max(0.0d0,health -.02*comnew(2)-comnew(20)) if(law.ge.1994)xitded = xitded+max(0.0d0,-comnew(20)+health) endif c state income tax is an allowable deduction after 1980 aiflk=1. if(law.ge.2015) aiflk = aif15(law) deduc=max(stded,xitded) taxinc=max(agi - deduc - exemp,0.0d0) if(law.le.1989) then call look(tab,taxinc,7,n,statax,brkif(law),0.d0,rt,data) else if(law.ge.1990.and.law.le.1993)then if(mst.eq.4.or.mst.eq.7.or.mst.eq.2) then call look(t9093h,taxinc,5,n,statax,brkif(law),0.d0,rt,data) else call look(t9093s,taxinc,5,n,statax,brkif(law),0.d0,rt,data) endif else if(law.eq.1994) then if(mst.eq.4.or.mst.eq.7.or.mst.eq.2) then call look(tab94h,taxinc,5,n,statax,aiflk,0.d0,rt,data) else call look(tab94s,taxinc,5,n,statax,aiflk,0.d0,rt,data) endif else if(law.eq.1995.or.law.eq.1996) then if(mst.eq.4.or.mst.eq.7.or.mst.eq.2) then call look(tab95h,taxinc,5,n,statax,aiflk,0.d0,rt,data) else call look(tab95s,taxinc,5,n,statax,aiflk,0.d0,rt,data) endif else if(law.eq.1997) then if(mst.eq.4.or.mst.eq.7.or.mst.eq.2) then call look(tab97h,taxinc,5,n,statax,aiflk,0.d0,rt,data) else call look(tab97s,taxinc,5,n,statax,aiflk,0.d0,rt,data) endif else if(law.eq.1998) then if(mst.eq.4.or.mst.eq.7.or.mst.eq.2) then call look(tab98h,taxinc,5,n,statax,aiflk,0.d0,rt,data) else call look(tab98s,taxinc,5,n,statax,aiflk,0.d0,rt,data) endif else if(law.ge.1999.and.law.le.2005) then if(mst.eq.4.or.mst.eq.7.or.mst.eq.2) then call look(tab99h,taxinc,5,n,statax,aiflk,0.d0,rt,data) else call look(tab99s,taxinc,5,n,statax,aiflk,0.d0,rt,data) endif else if(law.eq.2006) then if(mst.eq.4.or.mst.eq.7.or.mst.eq.2) then call look(tab06h,taxinc,5,n,statax,aiflk,0.d0,rt,data) else call look(tab06s,taxinc,5,n,statax,aiflk,0.d0,rt,data) endif else if(law.ge.2007) then if(mst.eq.4.or.mst.eq.7.or.mst.eq.2) then call look(tab07h,taxinc,5,n,statax,aiflk,0.d0,rt,data) else call look(tab07s,taxinc,5,n,statax,aiflk,0.d0,rt,data) endif endif c res energy credit; non-refundable; appears to follow approx fed % solcrd=min(data(38),1000.0d0) statax=max(0.0d0,statax-solcrd) c refundable property tax credit c after 1989 no longer indexes pcred=0. rcred=0. more=0 pens=data(72)+data(20)+data(91) if(mst.ne.1.or.data(8).gt.0.)more=1 if(data(9).gt.0.and.pens.gt.0) then do 20 i=1,21 ptab(1,i)=proptb(1,i) + (750.*more) if(law.le.1989) then ptab(2,i)=proptb(2,i)*aif(law) else ptab(2,i)=pr90tb(2,i) endif 20 continue pcred=tablki(ptab,22,data(159),data) endif c renters credit; changes after 1989 if(law.le.1989)rcred=twn(rfrac(law)*data(160),0.0d0,rtab(law)) if(law.ge.1990.and.law.le.1991.and.agi.le.25000.) & rcred=min(twn(rfrac(law)*data(160),0.0d0,rtab(law)),55.0d0) credit=max(pcred,rcred) c Family income Credit since 1995 famcr=0. if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then fagi = 10000. famlim = 60. if(law.ge.1998) famlim = 120. else fagi = 20000. famlim = 120. if(law.ge.1998) famlim = 240. endif if(mst.eq.2.and.law.ge.1998) then if(data(8).le.1) fagi = fag98m(1) if(data(8).eq.2) fagi = fag98m(2) if(data(8).eq.3) fagi = fag98m(3) if(data(8).ge.4) fagi = fag98m(4) else if((mst.eq.4.or.mst.eq.7).and.law.ge.1998) then if(data(8).le.1) fagi = fag98h(1) if(data(8).eq.2) fagi = fag98h(2) if(data(8).eq.3) fagi = fag98h(3) if(data(8).eq.4) fagi = fag98h(4) if(data(8).ge.5) fagi = fag98h(5) endif if(law.ge.1995.and.agi.le.fagi) & famcr=min(famlim,(data(8)+data(7))*ex(law)) statax = max(0.0d0,statax-famcr) c Credit For Increased Excise Taxes 2001+ excise = 0. if(law.ge.2001) then numb = data(7) if(mst.eq.4.or.mst.eq.7) numb = 2 if(comnew(2).le.12500*numb) & excise = min(25.0d0*(data(7)+data(8)),100.0d0) endif credit = credit + excise statax = statax-credit credit = credit + famcr return end c ARKANSAS c State 4 c Updated through 2016 subroutine artax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255) dimension tab(2,6),tab99(5),tab00(5),tab01(5),tab02(5), &tab03(5),tab04(5),tab05(5),tab06(5),tab07(5),tab08(5), &tab09(5),tab10(5),tab11(5),tab12(5),tab13(5),tab14(5) dimension tabst1(2,10),tabst2(2,12),std(1998:2016), & aif13(2013:2017) real aif92(1992:2016),pcr(1987:2016),pcrcg(1999:2016) integer sep data pcrcg/16*.7d0,.55d0,.5d0/ data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ data std/17*2000.0d0,2*2200.0d0/ c aif92 is real variable data aif92/ & 1.0525, 1.0845, 1.1180, 1.1470, 1.1795, 1.2120, & 1.2450, 1.2660, 1.2895, 1.3295, 1.3730, 1.3950, & 1.4270, 1.4595, 1.5050, 1.5640, 1.5995, 1.6680, &2*1.6955, 1.7365, 1. , 1.0168, 1.033d0 , 1.0376/ data tab / 3000.0d0, 1.0d0, 6000.0d0, 2.50d0, 9000.0d0, 3.50d0, & 15000.0d0, 4.50d0, 25000.0d0, 6.0d0, 1.e20, 7.0d0 / data tab99 /3100.0d0,6100.0d0, 9200.0d0,15300.0d0,25400.0d0/ data tab00 /3100.0d0,6200.0d0, 9300.0d0,15500.0d0,25900.0d0/ data tab01 /3200.0d0,6400.0d0, 9600.0d0,16000.0d0,26700.0d0/ data tab02 /3300.0d0,6600.0d0, 9900.0d0,16500.0d0,27500.0d0/ data tab03 /3300.0d0,6700.0d0,10000.0d0,16700.0d0,27900.0d0/ data tab04 /3400.0d0,6800.0d0,10300.0d0,17100.0d0,28500.0d0/ data tab05 /3500.0d0,7000.0d0,10500.0d0,17500.0d0,29200.0d0/ data tab06 /3600.0d0,7200.0d0,10800.0d0,18000.0d0,30100.0d0/ data tab07 /3700.0d0,7400.0d0,11100.0d0,18600.0d0,31000.0d0/ data tab08 /3800.0d0,7600.0d0,11400.0d0,18900.0d0,31700.0d0/ data tab09 /3900.0d0,7800.0d0,11700.0d0,19600.0d0,32600.0d0/ data tab10 /3900.0d0,7800.0d0,11800.0d0,19600.0d0,32700.0d0/ data tab11 /4000.0d0,8000.0d0,11900.0d0,19900.0d0,33200.0d0/ data tab12 /4100.0d0,8200.0d0,12200.0d0,20400.0d0,34000.0d0/ data tab13 /4200.0d0,8300.0d0,12400.0d0,20700.0d0,34600.0d0/ data tab14 /4300.0d0,8400.0d0,12600.0d0,21000.0d0,35100.0d0/ data tabst1 / 3000.0d0, .90d0, 4000.0d0, 1.70d0, & 5000.0d0, 2.20d0 , 6000.0d0, 2.30d0, 7000.0d0, 2.50d0, &10000.0d0, 3.150d0,16000.0d0, 4.50d0,17000.0d0, 5.90d0, &25000.0d0, 6.0d0 , 1.e20, 7.0d0/ data tabst2 / 3000.0d0,.90d0 , 4000.0d0,1.70d0, 5000.0d0,2.20d0, & 6000.0d0, 2.50d0, 7000.0d0, 3.0d0 , 9000.0d0,3.50d0, &10000.0d0, 3.90d0,15000.0d0, 4.50d0,16000.0d0,5.20d0, &24000.0d0, 6.0d0 ,25000.0d0, 6.50d0, 1.e20, 7.0d0/ c Personal Credit (data for years 1987-2006) -- real variable data pcr/18*20.,21.,22.,6*23.,4*26./ rt=0. mst = data(2) sep = data(3) ided = data(4) phas92=100000./data(3) if(law.ge.1992.and.law.le.2012) phas92=100000.*aif92(law)/data(3) if(law.ge.2013) &phas92 = filing(mst,250000.,300000.,275000.,150000.)*aif13(law) c AGI if(law.le.1998) then capgn = comnew(6) if(law.le.1990.and.capgn.lt.0) capgn = comnew(5) else if(law.ge.1999) then if(comnew(6).gt.0) then if(data(68).lt.0) then capgn = pcrcg(law)*(data(70) + data(68)) else capgn = pcrcg(law)*data(70) + data(68) c 2015 has 50% on Jan. and 55% on Feb.- Dec. I take 55% c 2016 has 55% for a half-year and 50% for another half. I take 50% endif else capgn = comnew(6) endif if(law.ge.2014) capgn = min(capgn,10000000.0d0) endif divs=data(12)-comnew(4) intinc=min(xif(law.le.1986,150.*data(7)),data(14)) alimon=data(62)-data(23) pnsion=data(20)+data(72) pendis=pnsion+comnew(82) c agi=comnew(2)-comnew(6)+capgn+divs-intinc-data(22)+data(26)- c & comnew(78)-comnew(79)+.5*(data(43)+data(44)) agi = data(11)+data(12)+data(14)+data(23)+data(17)+capgn &+comnew(8)+data(21)-data(26)-data(124)-comnew(14)-data(62) &+data(20)+data(72)+data(24)+data(19) if(law.eq.1982) then agi=agi+max((comnew(12)-1500.-xif(mst.eq.2,875.0d0)),0.0d0) agi=agi+max((comnew(14)-7500.),0.0d0) endif if(law.lt.1983) agi=agi+alimon if(law.ge.1989) agi=agi-data(26) if(law.eq.1983)agi=agi-min(1000.0d0,pnsion) if(law.eq.1984)agi=agi-min(2000.*data(7),pnsion) if(law.ge.1985.and.law.le.1989)agi=agi-min(6000.*data(7),pendis) if(law.ge.1990)then penexc = min(pendis,data(7)*6000.) agi = agi - penexc c agi=agi+xif(pendis.ge.6000.,pendis-6000.) endif c Act 817 of 1999 extended the $6,000 exemption from income tax for benefits c paid from an employer sponsored retirement plan to distributions from an IRA. c This exemption will be available to calendar year 2000 State of Arkansas c Individual Income Tax returns. The aggregate exclusion may not exceed $6,000 c for all retirement plans for each taxpayer. The taxpayer must be 59 ? years of c age at the time of the distribution unless the distribution is because of c disability or death of the taxpayer. c DEDUCTIONS if (law.ge.1998) then stded=std(law)*data(7) else if (law.ge.1987.and.law.le.1997) then stded=twn(.1*agi,0.0d0,2000.*data(7)/data(3)) else stded=twn(.1*agi,0.0d0,4000.*data(7)/data(3)) endif c non-itemizer charitable contribution if(law.ge.1983.and.law.le.1986)stded=stded+comnew(81) xitded = max(0.0d0,comnew(30)-data(50)) if(agi.gt.phas92.and.law.ge.1991) then if(law.le.2008) then reduce = min(.8*xitded,.03*(agi-phas92)) c AR doesn't have 1/3 and 2/3 decreasing of "reduce" in 2006-2008 else if(law.eq.2009) then reduce = min(.8*xitded,.01*(agi-phas92)) else if(law.ge.2010.and.law.le.2012) then reduce = 0. endif xitded = xitded-reduce endif if(ided.eq.-2) xitded=0 deduc = max(stded,xitded) c if(law.le.1997.and.stded.gt.xitded) deduc = 0. taxinc=max(0.0d0,agi-deduc) if(mst.eq.2.and.agi.gt.0) then agih = max(data(85),data(86))+.5*(agi - data(11)) agiw = agi-agih xitdh = xitded*agih/agi xitdw = xitded-xitdh dedh = max(.5*stded,xitdh) dedw = max(.5*stded,xitdw) c stdh = stded*agih/agi c stdw = stded - stded*agih/agi c dedh = max(stdh,xitdh) c dedw = max(stdw,xitdw) taxinh=max(0.0d0,agih-dedh) taxinw=max(0.0d0,agiw-dedw) endif if(law.le.1997) then if(stded.ge.xitded.and.ided.ne.-1) then c For taxpayers who take standard deductions before 1998 if(sep.eq.1) then call look(tabst1,agi,10,n,statax,1.0d00,-data(2),rt,data) else call look(tabst2,agi,12,n,statax,1.0d00,-data(2),rt,data) endif else c For taxpayers who take itemized deductions before 1998 call look(tab,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) if(mst.eq.2.and.agi.gt.0) then call look(tab,taxinh,6,n,stath,1.0d0,0.0d0,rt,data) call look(tab,taxinw,6,n,statw,1.0d0,0.0d0,rt,data) statax = min(statax,stath+statw) endif endif else if(law.ge.1998.and.law.le.2014) then if(law.eq.1999) then do 1999 i=1,5 1999 tab(1,i) = tab99(i) else if(law.eq.2000) then do 2000 i=1,5 2000 tab(1,i) = tab00(i) else if(law.eq.2001) then do 2001 i=1,5 2001 tab(1,i) = tab01(i) else if(law.eq.2002) then do 2002 i=1,5 2002 tab(1,i) = tab02(i) else if(law.eq.2003) then do 2003 i=1,5 2003 tab(1,i) = tab03(i) else if(law.eq.2002) then do 2004 i=1,5 2004 tab(1,i) = tab04(i) else if(law.eq.2005) then do 2005 i=1,5 2005 tab(1,i) = tab05(i) else if(law.eq.2006) then do 2006 i=1,5 2006 tab(1,i) = tab06(i) else if(law.eq.2007) then do 2007 i=1,5 2007 tab(1,i) = tab07(i) else if(law.eq.2008) then do 2008 i=1,5 2008 tab(1,i) = tab08(i) else if(law.eq.2009) then do 2009 i=1,5 2009 tab(1,i) = tab09(i) else if(law.eq.2010) then do 2010 i=1,5 2010 tab(1,i) = tab10(i) else if(law.eq.2011) then do 2011 i=1,5 2011 tab(1,i) = tab11(i) else if(law.eq.2012) then do 2012 i=1,5 2012 tab(1,i) = tab12(i) else if(law.eq.2013) then do 2013 i=1,5 2013 tab(1,i) = tab13(i) else if(law.eq.2014) then do 2014 i=1,5 2014 tab(1,i) = tab14(i) endif if(law.eq.2014) tab(2,1) = .9d0 call look(tab,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) if(mst.eq.2.and.agi.gt.0) then call look(tab,taxinh,6,n,stath,1.0d0,0.0d0,rt,data) call look(tab,taxinw,6,n,statw,1.0d0,0.0d0,rt,data) statax = min(statax,stath+statw) endif else if(law.eq.2015) then if(taxinc.ge.0.and.taxinc.lt.4300) then statax = taxinc * .009 else if (taxinc.ge.4300.and.taxinc.lt.8400) then statax = taxinc * .024 - 64.49 else if (taxinc.ge.8400.and.taxinc.lt.12700) then statax = taxinc * .034 - 148.48 else if (taxinc.ge.12700.and.taxinc.lt.21100) then statax = taxinc * .044 - 275.47 else if (taxinc.ge.21100.and.taxinc.lt.35300) then statax = taxinc * .06 - 596.25 else if (taxinc.ge.35300) then statax = taxinc * .07 - 949.24 endif if(mst.eq.2) then if(taxinh.ge.0.and.taxinh.lt.4300) then stath = taxinh * .009 else if (taxinh.ge.4300.and.taxinh.lt.8400) then stath = taxinh * .024 - 64.49 else if (taxinh.ge.8400.and.taxinh.lt.12700) then stath = taxinh * .034 - 148.48 else if (taxinh.ge.12700.and.taxinh.lt.21100) then stath = taxinh * .044 - 275.47 else if (taxinc.ge.21100.and.taxinh.lt.35300) then stath = taxinh * .06 - 596.25 else if (taxinh.ge.35300) then stath = taxinh * .07 - 949.24 endif if(taxinw.ge.0.and.taxinw.lt.4300) then statw = taxinw * .009 else if (taxinw.ge.4300.and.taxinw.lt.8400) then statw = taxinw * .024 - 64.49 else if (taxinw.ge.8400.and.taxinw.lt.12700) then statw = taxinw * .034 - 148.48 else if (taxinw.ge.12700.and.taxinw.lt.21100) then statw = taxinw * .044 - 275.47 else if (taxinw.ge.21100.and.taxinw.lt.35300) then statw = taxinw * .06 - 596.25 else if (taxinw.ge.35300) then statw = taxinw * .07 - 949.24 endif statax = min(statax,stath+statw) endif else if(law.eq.2016) then if(taxinc.ge.0.and.taxinc.lt.4300) then statax = taxinc * .009 else if (taxinc.ge.4300.and.taxinc.lt.8400) then statax = taxinc * .024 - 64.49 else if (taxinc.ge.8400.and.taxinc.lt.12700) then statax = taxinc * .034 - 149.48 else if (taxinc.ge.12700.and.taxinc.lt.21200) then statax = taxinc * .044 - 276.47 else if (taxinc.ge.21200.and.taxinc.lt.35100) then statax = taxinc * .05 - 383.76 else if (taxinc.ge.35100.and.taxinc.lt.75000) then statax = taxinc * .06 - 734.75 else if (taxinc.ge.75000.and.taxinc.lt.76000) then statax = taxinc * .069 - 1349.64 else if (taxinc.ge.76000.and.taxinc.lt.77000) then statax = taxinc * .069 - 1249.64 else if (taxinc.ge.77000.and.taxinc.lt.78000) then statax = taxinc * .069 - 1149.64 else if (taxinc.ge.78000.and.taxinc.lt.79000) then statax = taxinc * .069 - 1049.64 else if (taxinc.ge.79000.and.taxinc.lt.80000) then statax = taxinc * .069 - 949.64 else if (taxinc.ge.80000) then statax = taxinc * .069 - 909.64 endif if(mst.eq.2) then if(taxinh.ge.0.and.taxinh.lt.4300) then stath = taxinh * .009 else if (taxinh.ge.4300.and.taxinh.lt.8400) then stath = taxinh * .024 - 64.49 else if (taxinh.ge.8400.and.taxinh.lt.12700) then stath = taxinh * .034 - 149.48 else if (taxinh.ge.12700.and.taxinh.lt.21200) then stath = taxinh * .044 - 276.47 else if (taxinh.ge.21200.and.taxinh.lt.35100) then stath = taxinh * .05 - 383.76 else if (taxinh.ge.35100.and.taxinh.lt.75000) then stath = taxinh * .06 - 734.75 else if (taxinh.ge.75000.and.taxinh.lt.76000) then stath = taxinh * .069 - 1349.64 else if (taxinh.ge.76000.and.taxinh.lt.77000) then stath = taxinh * .069 - 1249.64 else if (taxinh.ge.77000.and.taxinh.lt.78000) then stath = taxinh * .069 - 1149.64 else if (taxinh.ge.78000.and.taxinh.lt.79000) then stath = taxinh * .069 - 1049.64 else if (taxinh.ge.79000.and.taxinh.lt.80000) then stath = taxinh * .069 - 949.64 else if (taxinh.ge.80000) then stath = taxinh * .069 - 909.64 endif if(taxinw.ge.0.and.taxinw.lt.4300) then statw = taxinw * .009 else if (taxinw.ge.4300.and.taxinw.lt.8400) then statw = taxinw * .024 - 64.49 else if (taxinw.ge.8400.and.taxinw.lt.12700) then statw = taxinw * .034 - 149.48 else if (taxinw.ge.12700.and.taxinw.lt.21200) then statw = taxinw * .044 - 276.47 else if (taxinw.ge.21200.and.taxinw.lt.35100) then statw = taxinw * .05 - 383.76 else if (taxinw.ge.35100.and.taxinw.lt.75000) then statw = taxinw * .06 - 734.75 else if (taxinw.ge.75000.and.taxinw.lt.76000) then statw = taxinw * .069 - 1349.64 else if (taxinw.ge.76000.and.taxinw.lt.77000) then statw = taxinw * .069 - 1249.64 else if (taxinw.ge.77000.and.taxinw.lt.78000) then statw = taxinw * .069 - 1149.64 else if (taxinw.ge.78000.and.taxinw.lt.79000) then statw = taxinw * .069 - 1049.64 else if (taxinw.ge.79000.and.taxinw.lt.80000) then statw = taxinw * .069 - 949.64 else if (taxinw.ge.80000) then statw = taxinw * .069 - 909.64 endif statax = min(statax,stath+statw) endif endif c For tax years 2003-2004, the act imposes a 3% income tax surcharge if(law.ge.2003.and.law.le.2004) statax = 1.03*statax c 1998 - 2002 Working Taxpayer Credit work = 0. work86 = 0. work85 = 0. if(law.ge.1998.and.law.le.2002) then if(data(85).gt.0.and.data(86).gt.0) then winc85 = max(data(85),data(86))+data(21)+data(17) winc86 = min(data(85),data(86)) if(winc85.gt.400.) work85 = min(50.0d0,.00125*winc85) if(winc86.gt.400.) work86 = min(50.0d0,.00125*winc86) work = work85+work86 else winc = data(11)+data(21)+data(17) if(winc.gt.400.) work = min(50.0d0,.00125*winc) endif endif statax=max(statax-work,0.0d0) c LOW INCOME TAX TABLE c Taxpayers who use the Low Income Table do not qualify for c the Working Taxpayer Credit c low income tax table before 1991 if(law.le.1990)then if(mst.eq.1.and.agi.le.3100.) then statax=aint((agi-2990.)/10) if(agi.lt.3010.)statax=0. else if(mst.eq.2.and.data(8).lt.1.and.agi.le.4100.) then statax=aint(((agi-3990.)/10))*1.2 if(agi.lt.4008.)statax=0. else if(mst.eq.2.or.mst.eq.4.or.mst.eq.7) then if(data(8).le.1.and.agi.le.4600.) then statax=aint(((agi-4490.)/10))*1.7 if(agi.lt.4505.)statax=0. endif if(data(8).ge.2.and.agi.le.5100.) then statax=aint(((agi-4990.)/10))*1.1 if(agi.lt.5004.)statax=0. endif endif endif c low income tax table after 1991:numbers approximate w/in $10 c for years 1998-2002 NOTE: The standard deduction and c the working taxpayer credit are incorporated into c the low income tax table. if(sep.eq.1.and.law.ge.1991)then if(mst.eq.1) then c 1997 and before single if(law.le.1997) then if(agi.le.5500) statax=0. if(agi.gt.5500.and.agi.le.8400)statax = 26 + (agi-5500)*.01 if(agi.gt.8400.and.agi.lt.11400)statax = 106 + (agi-8400)*.02 c 1998 - 2006 single else if(law.ge.1998.and.law.le.2006) then if(agi.le.7800) statax = 0. if(agi.gt.7800.and.agi.le.11400)statax = 21. + (agi-7800)*.034 c 2007 single else if(law.eq.2007) then if(agi.le.10200) statax = 0. if(agi.gt.10200.and.agi.le.13500)statax = 29.+ & (agi-10200)*.073939394 c 2008 single else if(law.eq.2008) then if(agi.le.10506) statax = 0. if(agi.gt.10506.and.agi.le.13900)statax = 33. + & (agi-10506)*.07424867 c 2009 single else if(law.eq.2009) then if(agi.le.10526) statax = 0. if(agi.gt.10526.and.agi.le.13800)statax = 32. + & (agi-10526)*.068 c 2010 single else if(law.eq.2010) then if(agi.le.10681) statax = 0. if(agi.gt.10681.and.agi.le.14000)statax = 33. + & (agi-10681)*.075 c 2011 single else if(law.eq.2011) then if(agi.le.10940) statax = 0. if(agi.gt.10940.and.agi.le.14400)statax = 35. + & (agi-10940)*.075 c 2012 single else if(law.eq.2012) then if(agi.le.11220) statax = 0. if(agi.gt.11220.and.agi.le.14800)statax = 36. + & (agi-11220)*.075 c 2013 single else if(law.eq.2013) then if(agi.le.11410) statax = 0. if(agi.gt.11410.and.agi.le.15100)statax = 37. + & (agi-11410)*.075 c 2014 single else if(law.eq.2014) then if(agi.le.11591) statax = 0. if(agi.gt.11591.and.agi.le.15200)statax = 36. + & (agi-11591)*.076 c 2015 single else if(law.eq.2015) then if(agi.le.11643) statax = 0. if(agi.gt.11643.and.agi.le.15100)statax = 35. + & (agi-11643)*.073 c 2016 single else if(law.eq.2016) then if(agi.le.11736) statax = 0. if(agi.gt.11736.and.agi.le.15200)statax = 35. + & (agi-11736)*.073 endif else if(mst.eq.2.or.mst.eq.5) then c 1997 and before married if(law.le.1997) then if(agi.le.10000) statax = 0. if(agi.gt.10000.and.agi.le.13000)statax = 71. + & (agi-10000)*.01467 if(agi.gt.13000.and.agi.le.16200)statax = 230. + & (agi-13000)*.03 c 1998 - 2006 married else if(law.ge.1998.and.law.le.2006) then if(agi.le.15500) then statax = 0. else if(agi.le.16000..and.agi.gt.15500) then statax = 78.5+(agi-15500)*.015 else if(agi.le.16200..and.agi.gt.16000) then statax = 114.+(agi-16000)*.02 endif c 2007 married else if(law.eq.2007) then if(data(8).le.1) then if(agi.le.17200) then statax = 0. else if(agi.gt.17200.and.agi.le.21400) then statax = 66. + (agi-17200.)*.1121412857 endif else if(data(8).ge.2) then if(agi.le.20700.) then statax = 0. else if(agi.gt.20700..and.agi.le.26700) then statax = 97. + (agi-20700)*.123333 endif endif c 2008 married else if(law.eq.2008) then if(data(8).le.1) then if(agi.le.17716.) then statax = 0. else if(agi.gt.17716.and.agi.le.22000) then statax = 74. + (agi-17716)*.112745098 endif else if(data(8).ge.2) then if(agi.le.21321.) then statax = 0. else if(agi.gt.21321..and.agi.le.27400) then statax = 107. + (agi-21321)*.124198 endif endif c 2009 married else if(law.eq.2009) then if(data(8).le.1) then if(agi.le.17749.) then statax = 0. else if(agi.gt.17749..and.agi.le.21900) then statax = 73. + (agi-17749.)*.113 endif else if(data(8).ge.2) then if(agi.le.21362.) then statax = 0. else if(agi.gt.21362..and.agi.le.27400) then statax = 107. + (agi-21362.)*.1235 endif endif c 2010 married else if(law.eq.2010) then if(data(8).le.1) then if(agi.le.18011.) then statax = 0. else if(agi.gt.18011..and.agi.le.22400) then statax = 76. + (agi-18011.)*.11255 endif else if(data(8).ge.2) then if(agi.le.21676.) then statax = 0. else if(agi.gt.21676.and.agi.le.27800) then statax = 108. + (agi-21676)*.124755 endif endif c 2011 married else if(law.eq.2011) then if(data(8).le.1) then if(agi.le.18448.) then statax = 0. else if(agi.gt.18448.and.agi.le.22400) then statax = 78. + (agi-18448.)*.1137 endif else if(data(8).ge.2) then if(agi.le.22202) then statax = 0. else if(agi.gt.22202.and.agi.le.27800) then statax = 112. + (agi-22202)*.1243 endif endif c 2012 married else if(law.eq.2012) then if(data(8).le.1) then if(agi.le.18992.) then statax = 0. else if(agi.gt.18922.and.agi.le.23600) then statax = 81. + (agi-18922.)*.113 endif else if(data(8).ge.2) then if(agi.le.22773) then statax = 0. else if(agi.gt.22773.and.agi.le.29400) then statax = 116. + (agi-22773)*.1257 endif endif c 2013 married else if(law.eq.2013) then if(data(8).le.1) then if(agi.le.19242.) then statax = 0. else if(agi.gt.19243.and.agi.le.24000) then statax = 83. + (agi-19243.)*.115 endif else if(data(8).ge.2) then if(agi.le.23159) then statax = 0. else if(agi.gt.23159.and.agi.le.29900) then statax = 118. + (agi-23159)*.115 endif endif c 2014 married else if(law.eq.2014) then if(data(8).le.1) then if(agi.le.19547.) then statax = 0. else if(agi.gt.19547.and.agi.le.24400) then statax = 84. + (agi-19547.)*.114 endif else if(data(8).ge.2) then if(agi.le.23525) then statax = 0. else if(agi.gt.23525.and.agi.le.30400) then statax = 120. + (agi-23525.)*.125 endif endif c 2015 married else if(law.eq.2015) then if(data(8).le.1) then if(agi.le.19635.) then statax = 0. else if(agi.gt.19635.and.agi.le.24200) then statax = 79. + (agi-19635.)*.112 endif else if(data(8).ge.2) then if(agi.le.23631) then statax = 0. else if(agi.gt.23631.and.agi.le.30200) then statax = 114. + (agi-23631.)*.1267 endif endif c 2016 married else if(law.eq.2016) then if(data(8).le.1) then if(agi.le.19793.) then statax = 0. else if(agi.gt.19793.and.agi.le.24300) then statax = 80. + (agi-19793.)*.1138 endif else if(data(8).ge.2) then if(agi.le.23821) then statax = 0. else if(agi.gt.23821.and.agi.le.30500) then statax = 116. + (agi-23821.)*.12 endif endif endif else if(mst.eq.4.or.mst.eq.7) then c 1997 and before hoh if(law.le.1997) then if(agi.le.7200.) then statax=0. else if(agi.le.11600..and.agi.gt.7200) then statax=42.+max(0.0d0,agi-7400)*.0119 else if(agi.le.16200..and.agi.gt.11600) then statax=189.+(agi-11600)*.03 endif c 1998-2006 hoh else if (law.ge.1998.and.law.le.2006) then if(agi.le.12100.) then statax = 0. else if(agi.le.13000..and.agi.gt.12100) then statax = 41.+(agi-12100)*.01 else if(agi.le.15200.and.agi.gt.13000) then statax = 82.5+(agi-13000)*.015 else if(agi.le.16100.and.agi.gt.15200) then statax = 200.5+(agi-15200)*.025 endif c 2007 hoh else if (law.eq.2007) then if(agi.le.14500.) then statax = 0. else if(agi.gt.14500..and.agi.le.19000) then statax = 59. + (agi-14500.)*.102666 endif c 2008 hoh else if (law.eq.2008) then if(agi.le.14935.) then statax = 0. else if(agi.gt.14935..and.agi.le.19400) then statax = 67. + (agi-14935.)*.103471 endif c 2009 hoh else if (law.eq.2009) then if(agi.le.14963.) then statax = 0. else if(agi.gt.14963..and.agi.le.19300) then statax = 66. + (agi-14963.)*.104 endif c 2010 hoh else if (law.eq.2010) then if(agi.le.15184) then statax = 0. else if(agi.gt.15184..and.agi.le.19600) then statax = 67. + (agi-15184)*.1046 endif c 2011 hoh else if (law.eq.2011) then if(data(8).le.1) then if(agi.le.15552) then statax = 0. else if(agi.gt.15552.and.agi.le.20200) then statax = 70. + (agi-15552)*.104 endif else if(agi.le.18539.) then statax = 0. else if(agi.gt.18539..and.agi.le.22900) then statax = 97. + (agi-18540)*.1365 endif endif c 2012 hoh else if (law.eq.2012) then if(data(8).le.1) then if(agi.le.15952.) then statax = 0. else if(agi.gt.15952.and.agi.le.20800) then statax = 72. + (agi-15952)*.104 endif else if(agi.le.19016) then statax = 0. else if(agi.gt.19016.and.agi.le.23500) then statax = 100. + (agi-19016)*.136 endif endif c 2013 hoh else if (law.eq.2013) then if(data(8).le.1) then if(agi.le.16223.) then statax = 0. else if(agi.gt.16223.and.agi.le.21200) then statax = 74. + (agi-16223)*.105 endif else if(agi.le.19338) then statax = 0. else if(agi.gt.19338.and.agi.le.23900) then statax = 102. + (agi-19338)*.135 endif endif c 2014 hoh else if (law.eq.2014) then if(data(8).le.1) then if(agi.le.16479.) then statax = 0. else if(agi.gt.16479.and.agi.le.21400) then statax = 74. + (agi-16479)*.104 endif else if(agi.le.19644) then statax = 0. else if(agi.gt.19644.and.agi.le.24200) then statax = 103. + (agi-19644)*.137 endif endif c 2015 hoh else if (law.eq.2015) then if(data(8).le.1) then if(agi.le.16553.) then statax = 0. else if(agi.gt.16553.and.agi.le.21300) then statax = 71. + (agi-16553)*.103 endif else if(agi.le.19733) then statax = 0. else if(agi.gt.19733.and.agi.le.24200) then statax = 99. + (agi-19733)*.139 endif endif c 2016 hoh else if (law.eq.2016) then if(data(8).le.1) then if(agi.le.16686.) then statax = 0. else if(agi.gt.16686.and.agi.le.21400) then statax = 72. + (agi-16686)*.105 endif else if(agi.le.19891) then statax = 0. else if(agi.gt.19891.and.agi.le.24300) then statax = 100. + (agi-19891)*.139 endif endif endif endif endif c Arkansas Capital Gains and Losses Adjustment AR1000DGW if(law.le.1998.and.law.ge.1991.and.taxinc.gt.25000) statax = & statax - .01*min(taxinc-25000,15000.0d0,max(0.0d0,comnew(6))) c Total Personal Credits if(law.le.1986) then gcred=17.50*(data(7)+data(9)+data(10))+6.*data(8) else gcred= pcr(law)*(data(7)+data(9)+data(10)+data(8)) if(mst.eq.4.or.mst.eq.7) gcred=gcred+pcr(law) endif c Child Care Credit dep = min(data(8),2.0d0) child = min(comnew(53),max(0.0d0,comnew(52)-data(34))) if(law.ge.1998) then chcr = max(0.0d0,.2*child) else chcr = max(0.0d0,.1*child) endif if(law.eq.1982)chcr=min(chcr,40.*dep) credit=chcr+gcred statax=max(statax-credit,0.0d0) credit=credit+work return end c CALIFORNIA c State 5 c c Updated to 2016 subroutine catax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255),aif(1977:2016) dimension tab77s(2,11),tab77h(2,11),tab87s(2,6),tab87h(2,6) dimension tab82s(2,12),tab82h(2,12),tab3s(2,12),tab3h(2,12) dimension tab1s(2,11), tab1h(2,11), tab2s(2,6), tab2h(2,6) dimension rtabm(1977:1992),rtabs(1977:1992), xmpaif(1977:2016) dimension xmpdep(1998:2016),aiftab(1977:2012),aifrent(1998:2016) double precision lowtab(2,6), ltab2(2,6) dimension amtaxh(2,12), amtaxs(2,12), aiflow(1977:1994), & aifren(1991:1992),aif1(1994:1998), & aif2(1991:1998),ak(1994:1998),aifded(1991:2016),aif12(2012:2016) dimension tab91h(2,8), tab91s(2,8), tab4h(2,8), tab4s(2,8) dimension tab96h(2,6), tab96s(2,6), tab5h(2,6), tab5s(2,6), &tab9h(2,6), tab9s(2,6),tab11h(2,6), tab11s(2,6), &tab12(2,9),ts12(8),th12(8) double precision ira,iralim,iramax,iratax,keogh,kghlim,kghmax, &lowcr,noncr dimension dylim(2015:2016),crmax(2015:2016,0:3), &amax(2015:2016,0:3) integer sep,hoh data dylim / 3400.0d0, 3471.0d0/ data crmax/ 214.d0, 217.d0, 1 1428.d0,1452.d0, 2 2358.d0,2406.d0, 3 2653.d0,2706.d0/ data amax / 6580.d0, 6718.d0, 1 9880.d0, 10088.d0, 2 13870.d0, 14162.d0, 3 13870.d0, 14162.d0/ data aif12 / 1.0d0, 1.017d0, 1.0394d0, 1.0529d0, 1.075d0/ data aifrent/ 1.0d0 , 1.026d0 , 1.063960d0, 1.120360d0, &1.137160d0, 1.162160d0, 1.19820d0, 1.231760d0, 1.290880d0, &1.330880d0, 1.357440d0, 1.37648d0, 1.388880d0,2*1.426360d0, &1.478200d0, 1.510720d0, 1.53036d0, 1.562480d0/ data aifded/ 1.0d0 , 1.0360d0 , 1.06190d0 , 1.074640d0, &1.099360d0, 1.116950d0, 1.141520d0, 1.167770d0, 1.198130d0, &1.242460d0, 1.308310d0, 1.327930d0, 1.357140d0, 1.399210d0, &1.438390d0, 1.507430d0, 1.554160d0, 1.631870d0, 1.607390d0, &1.621850d0, 1.665650d0, 1.69730d0 , 1.726150d0, 1.764130d0, &1.787060d0, 1.824590d0/ c need to multiply tax brackets by infl. adj. factor data tab77s/2000.0d0, 1.0d0, 3500.0d0, 2.0d0,5000.0d0,3.0d0, & 6500.0d0, 4.0d0, 8000.0d0, 5.0d0, 9500.0d0, 6.0d0, &11000.0d0, 7.0d0,12500.0d0, 8.0d0, 14000.0d0, 9.0d0, &15500.0d0, 10.0d0, 1.e20, 11.0d0/ data tab77h/4000.0d0, 1.0d0, 6000.0d0, 2.0d0,7500.0d0,3.0d0, & 9000.0d0, 4.0d0,10500.0d0, 5.0d0, 12000.0d0,6.0d0, 13500.0d0, &7.0d0, 15000.0d0, 8.0d0, 16500.0d0, 9.0d0, 18000.0d0, 10.0d0, &1.e20, 11.0d0/ data tab82s/1580.0d0, 0.0d0, 4680.0d0, 1.0d0, 7080.0d0, 2.0d0, & 9380.0d0, 3.0d0, 11680.0d0, 4.0d0, 14080.0d0,5.0d0,16480.0d0, & 6.0d0, 18680.0d0, 7.0d0, 21180.0d0, 8.0d0,23380.0d0, 9.0d0, &25780.0d0, 10.0d0, 1.e20, 11.0d0/ data tab82h/3070.0d0, 0.0d0, 9270.0d0,1.0d0,12270.0d0,2.0d0, & 14670.0d0, 3.0d0, 16970.0d0,4.0d0,19270.0d0,5.0d0,21570.0d0, &6.0d0, 23970.0d0, 7.0d0, 26170.0d0, 8.0d0,28570.0d0, 9.0d0, &30870.0d0, 10.0d0, 1.e20, 11.0d0/ data tab87s/3650.0d0,1.0d0,8650.0d0,2.0d0,13650.0d0,4.0d0, & 18950.0d0,6.0d0,24050.0d0,8.0d0,1.e20, 9.30d0/ data tab87h/7300.0d0,1.0d0,17300.0d0,2.0d0,22300.0d0,4.0d0, & 27600.0d0,6.0d0,32599.0d0,8.0d0,1.e20,9.30d0/ data tab91s/4394.0d0,1.0d0,10414.0d0,2.0d0,16435.0d0,4.0d0, & 22816.0d0,6.0d0,28835.0d0, 8.0d0, 100000.0d0, 9.30d0, &200000.0d0, 10.0d0, 1.e20, 11.0d0/ data tab91h/8789.0d0, 1.0d0, 20829.0d0, 2.0d0, 26848.0d0, 4.0d0, & 33229.0d0, 6.0d0,39249.0d0, 8.0d0, 136115.0d0, 9.30d0, &272230.0d0,10.0d0, 1.e20, 11.0d0/ data tab96s/4908.0d0, 1.0d0, 11632.0d0, 2.0d0, 18357.0d0, 4.0d0, & 25484.0d0, 6.0d0, 32207.0d0, 8.0d0, 1.e20, 9.30d0/ data tab96h/9817.0d0, 1.0d0, 23264.0d0, 2.0d0, 29988.0d0, 4.0d0, & 37114.0d0, 6.0d0, 43839.0d0, 8.0d0, 1.e20, 9.30d0/ data lowtab/10900.0d0,1.0d0,12600.0d0,.80d0,14300.0d0,.60d0, & 16000.0d0,.40d0,17700.0d0,.20d0, 1.e20, 0.0d0/ data ltab2/0.0d0, 1.0d0,0.0d0, .80d0,0.0d0, .60d0,0.0d0, .40d0, & 0.0d0, .20d0, 1.e20, 0.0d0/ data tab1s/0.0d0, 1.0d0,0.0d0, 2.0d0,0.0d0, 3.0d0,0.0d0, 4.0d0, & 0.0d0, 5.0d0, 0.0d0, 6.0d0, 0.0d0,7.0d0, 0.0d0, 8.0d0, 0.0d0, & 9.0d0, 0.0d0,10.0d0, 1.e20,11.0d0/ data tab1h/0.0d0, 1.0d0, 0.0d0, 2.0d0, 0.0d0, 3.0d0, 0.0d0, 4.0d0, & 0.0d0, 5.0d0, 0.0d0, 6.0d0, 0.0d0, 7.0d0, & 0.0d0, 8.0d0, 0.0d0, 9.0d0, 0.0d0,10., 1.e20,11.0d0/ data tab3s/0.0d0, 0.0d0, 0.0d0, 1.0d0, 0.0d0, 2.0d0, 0.0d0, 3.0d0, & 0.0d0, 4.0d0, 0.0d0, 5.0d0, 0.0d0,6.0d0,0.0d0,7.0d0,0.0d0, 8.0d0, & 0.0d0,9.0d0, 0.0d0, 10.0d0, 1.e20, 11.0d0/ data tab3h/0.0d0, 0.0d0, 0.0d0, 1.0d0, 0.0d0, 2.0d0, 0.0d0, 3.0d0, & 0.0d0, 4.0d0, 0.0d0, 5.0d0, 0.0d0,6.0d0, 0.0d0, 7.0d0, 0.0d0, & 8.0d0, 0.0d0, 9.0d0, 0.0d0, 10.0d0, 1.e20, 11.0d0/ data tab2s/0.0d0, 1.0d0, 0.0d0, 2.0d0, 0.0d0, 4.0d0, 0.0d0, & 6.0d0, 0.0d0, 8.0d0, 1.e20, 9.30d0/ data tab2h/0.0d0, 1.0d0, 0.0d0,2.0d0, 0.0d0, 4.0d0, 0.0d0, 6.0d0, & 0.0d0, 8.0d0, 1.e20, 9.30d0/ data tab4s/0.0d0, 1.0d0, 0.0d0, 2.0d0, 0.0d0, 4.0d0, 0.0d0, 6.0d0, & 0.0d0, 8.0d0, 0.0d0, 9.30d0, 0.0d0,10.0d0,1.e20,11.0d0/ data tab4h/ & 0.d0,1.d0,0.d0,2.d0,0.d0,4.d0,0.d0,6.d0,0.d0,8.d0,0.d0,9.3d0, & 0.d0,10.d0,1.e20,11.d0/ data tab5s/ & 0.d0,1.d0,0.d0,2.d0,0.d0,4.d0,0.d0,6.d0,0.d0,8.d0,1.e20,9.3d0/ data tab5h/ & 0.d0,1.d0,0.d0,2.d0,0.d0,4.d0,0.d0,6.d0,0.d0,8.d0,1.e20,9.3d0/ data tab9s/ & 0.d0,1.25d0,0.d0,2.25d0,0.d0,4.25d0,0.d0,6.25d0,0.d0,8.25d0, & 1.e20,9.55d0/ data tab9h/ & 0.d0,1.25d0,0.d0,2.25d0,0.d0,4.25d0,0.d0,6.25d0,0.d0,8.25d0, & 1.e20,9.55d0/ data tab11s/ & 0.d0,1.d0,0.d0,2.d0,0.d0,4.d0,0.d0,6.d0,0.d0,8.d0,1.e20,9.3d0/ data tab11h/ & 0.d0,1.d0,0.d0,2.d0,0.d0,4.d0,0.d0,6.d0,0.d0,8.d0,1.e20,9.3d0/ c 2012 CA tax rate schedule -- 9 bracket rates data tab12/ & 0.d0, 1.d0 , 0.d0, 2.d0 , 0.d0, 4.d0, & 0.d0, 6.d0 , 0.d0, 8.d0 , 0.d0, 9.3d0, & 0.d0,10.3d0, 0.d0,11.3d0, 1.e20,12.3d0/ data ts12/ 7455.0d0, 17676.0d0, 27897.0d0, 38726.0d0, 48942.0d0, & 250000.0d0,300000.0d0,500000.0d0/ data th12/ 14920.0d0, 35351.0d0, 45571.0d0, 56400.0d0, 66618.0d0, & 340000.0d0,408000.0d0,680000.0d0/ c data rtabm/2*37.d0,11*137.d0,3*120.d0/ data rtabs/2*37.d0,14* 60.d0/ data xmpdep/253.d0,227.d0,235.d0,247.d0,251.d0,257.d0, & 265.d0,272.d0,285.d0,294.d0,309.d0,98.0d0,99.d0,315.d0, & 321.d0,326.d0,333.d0,337.d0,344.d0/ data xmpaif/10*0.0d0, 1.020d0, 1.040d0, 1.10d0, 1.160d0, 1.20d0, & 1.240d0, 1.280d0, 1.30d0, 1.320d0,1.340d0,1.360d0,1.40d0,1.440d0, & 1.50d0,1.580d0,1.60d0,1.640d0,1.70d0,1.740d0,1.820d0,1.880d0, & 1.98d0,1.960d0,1.980d0,2.040d0,2.08d0,2.12d0,2.160d0,2.180d0, & 2.22d0/ c in order to get correct revenue estimates, must take account of c the fact that the inflation factors vary slightly data aif/1.0d0, 1.0520d0, 1.10d0, 1.290d0, 1.40d0, 1.530d0, & 1.510d0, 1.580d0, 1.650d0,1.710d0, 1.880d0, 1.9960d0, 2.070d0, & 2.1690d0, 2.262d0, 2.3430d0, 2.4020d0, 2.4310d0, & 2.4870d0, 2.527d0, 2.5830d0, 2.6420d0, 2.7110d0, & 2.8110d0, 2.960d0, 3.0040d0, 3.0700d0, 3.1650d0, & 3.2540d0, 3.410d0, 3.5160d0, 3.6920d0, 3.6370d0, & 3.670d0, 3.769d0, 3.8410d0, 3.9060d0, 3.9920d0, & 4.044d0, 4.129d0/ data aiftab/ 1.0d0, 1.0520d0, 1.10d0, 1.3190d0, 1.430d0, 1.0d0, & .9870d0, 1.0320d0, 1.08570d0, 1.1250d0, 1.0d0,1.0480d0, &1.10140d0,1.1530d0, 1.0d0,1.0360d0,1.0620d0, 1.0750d0, &1.09945380d0,1.0d0, 1.02180d0,1.04540d0,1.0720d0,1.1120d0, &1.1710d0,1.18867150d0,1.2150d0,1.2530d0,1.28740d0,1.3490d0, &1.39120d0,1.460470d0,1.4390d0,1.45150d0,1.4910d0,1.520d0/ data aiflow/8*0.0d0, 1.0d0, 1.0350d0, 1.0720d0, 1.120d0, & 6*1.180d0/ data aif1/3*1.0d0, 1.1250d0,1.43150d0/ data ak/2*.0850d0,3*.070d0/ data aif2/0.90d0,5*1.0d0, 1.14520d0,1.16780d0/ data amtaxh/8000.0d0, 0.0d0, 10000.0d0, & 0.50d0, 11500.0d0, 1.00d0, 13000.0d0, 1.50d0, & 14500.0d0, 2.0d0, 16000.0d0, 2.50d0, 17500.0d0, 3.0d0, & 19000.0d0, 3.50d0,20500.0d0, 4.0d0, 22000.0d0, 4.50d0, & 23500.0d0, 5.00d0, 1.e20, 5.50d0/ data amtaxs/4000.0d0, 0.0d0, 5500.0d0, 0.50d0, 7000.0d0, 1.0d0, & 8500.0d0, 1.50d0,10000.0d0, 2.0d0, 11500.0d0, 2.50d0, 13000.0d0, & 3.0d0, 14500.0d0, 3.50d0,16000.0d0, 4.0d0, 17500.0d0, 4.50d0, &19000.0d0, 5.0d0, 1.e20, 5.50d0/ data aifren/1.0d0, 1.0360d0/ c c standard deduction, exemptions and tax barackets are indexed c rt=0. mst = data(2) dep=data(8) nfile = int(filing(mst,1.,2.,3.,2.)) txp=data(7) ided = data(4) if(mst.eq.4.or.mst.eq.5.or.mst.eq.7)txp=2. sep=data(3) if(law.le.1978) then stded=1000.*txp else stded=1000.*aif(law)*txp if(law.ge.1988.and.data(105).gt.0.) & stded = min(stded, max(comnew(37),500. & +xif(law.ge.1991,50.0d0)+xif(law.ge.1992,50.0d0) & +xif(law.ge.1995,50.0d0)+xif(law.ge.1998,50.0d0) & +xif(law.ge.2001,50.0d0)+xif(law.ge.2004,50.0d0) & +xif(law.ge.2006,50.0d0)+xif(law.ge.2008,50.0d0) & +xif(law.ge.2009,50.0d0)+xif(law.ge.2013,50.0d0) & +xif(law.ge.2015,50.0d0))) endif if(law.le.1986) then c AGI totinc=data(11)+data(14)+data(12)+data(73)+data(74)+data(75)+ & data(77)-data(78)+data(21)+data(20)+data(23)+data(24)+data(19)+ & xif(law.le.1982,data(71))+data(79)-data(80)+data(17) kghmax=2500. einc=data(17)+data(75)+data(79)-data(80)+data(24)+data(21)+ & data(11) kghlim=min(.1*einc,kghmax) if(law.le.1978) then iralim=min(.1*einc,2500.0d0) else if(law.le.1981) then iralim=min(.15*einc,2500.0d0) else iramax=(1500.+xif(nfile.eq.2,250.0d0))/sep iralim=min(.15*einc,iramax) endif ira=min(data(29),iralim) keogh=min(data(28),kghlim) adj=data(25)+data(26)+data(27)+data(30)+data(62)+ira+keogh+ & xif(law.ge.1979,data(22)+comnew(78)) cg=data(68)+.65*(data(70)+xif(law.ge.1983,data(71)))-data(67)- & data(69) if(cg.lt.0.) then taxy=totinc-adj-deduc-1510.*txp cg=-1.*min(abs(cg),taxy,1000.0d0/sep) endif if(law.eq.1985.or.law.eq.1986) then oldex = max(1000.*data(9)-.5*max(totinc-adj-25000.*data(9)/ & sep,0.0d0),0.0d0) adj = adj+oldex endif totinc = totinc + cg agi = max(totinc - adj,0.0d0) c Deductions c xitded=max(comnew(3),comnew(30))-data(50) xitded = 0. if(comnew(24).gt.0.and.comnew(30).gt.0) & xitded = comnew(24) - data(50)*comnew(24)/comnew(30) deduc=max(stded,xitded) if(stded.gt.xitded) then char = data(58) + data(59) + data(60) charni = 0. if(law.eq.1986) then charni = min(char,.2d0*agi) else if(law.eq.1985) then charni = min(.5*char,.2d0*agi) else if(law.eq.1984) then charni = .25*min(300.0d0/data(3),char) else if(law.eq.1982.or.law.eq.1983) then charni = .25*min(100.0d0/data(3),char) endif deduc = stded + charni endif deduc = deduc - xif(law.ge.1982,stded) c Taxable Income taxinc = max(agi - deduc,0.0d0) else agi = comnew(2) addit = 0 c Social Security Benefits are not taxable in California subtra = data(22)+comnew(78)+comnew(79) if(law.eq.2011.or.law.eq.2012) then c Effective Jan 1,2011, federal law increased the amount of adj. c CA does not confirm. c 2011-2012 -- 5.65% instead of 7.65% if(data(43).le.14204) then subtra = subtra - (.5751-.5)*data(43) else subtra = subtra - 1067 endif endif c cg = data(68)+data(70)-data(67)-data(69) c if(cg.lt.0.) then c cacg = -1*min(abs(cg),3000./sep) c else c cacg = cg c endif c adjcg = max(0.0d0,comnew(6))-cacg c if(adjcg.gt.0.) then c subtra = subtra+adjcg c else c addit = addit+adjcg c endif agi = agi+addit-subtra xitded= max(0.d0,comnew(30)-data(50)+data(27)) if(mst.eq.1.or.sep.eq.2) then phaded=100000. if(law.ge.1992) phaded=100000.*aifded(law) else if(mst.eq.4.or.mst.eq.7) then phaded=100000.*1.5 if(law.ge.1992) phaded=100000.*aifded(law)*1.5 else if(mst.eq.2.or.mst.eq.5) then phaded=100000.*2. if(law.ge.1992) phaded=100000.*aifded(law)*2. endif if(law.ge.1991.and.comnew(2).gt.phaded) then reduce = min(.8*xitded,.06*(comnew(2)-phaded)) xitded = xitded-reduce endif if(ided.eq.-2.and.law.eq.1999) xitded=0 deduc=max(stded,xitded) taxinc=max(0.0d0,agi-deduc) endif ajnt=1. if(mst.eq.2.or.mst.eq.5)ajnt=2. hoh = 0 if(mst.eq.4.or.mst.eq.7) hoh = 1 if(law.le.1981) then do 20 i=1,10 tab1s(1,i)=nint(tab77s(1,i)*aiftab(law)/10)*10.*ajnt tab1h(1,i)=nint(tab77h(1,i)*aiftab(law)/10)*10. 20 continue else if(law.le.1986.and.law.ge.1982) then do 25 i=1,11 tab3s(1,i)=tab82s(1,i)*aiftab(law)*ajnt tab3h(1,i)=tab82h(1,i)*aiftab(law) 25 continue else if(law.ge.1987.and.law.le.1990) then do 30 i=1,5 tab2s(1,i)=tab87s(1,i)*aiftab(law)*ajnt tab2h(1,i)=tab87h(1,i)*aiftab(law) 30 continue else if(law.ge.1991.and.law.le.1995) then do 35 i=1,7 tab4s(1,i)=tab91s(1,i)*aiftab(law)*ajnt tab4h(1,i)=tab91h(1,i)*aiftab(law) 35 continue else if(law.ge.1996.and.law.le.2008) then do 40 i=1,5 tab5s(1,i)=tab96s(1,i)*aiftab(law)*ajnt tab5h(1,i)=tab96h(1,i)*aiftab(law) 40 continue else if(law.ge.2009.and.law.le.2010) then do 45 i=1,5 tab9s(1,i)=tab96s(1,i)*aiftab(law)*ajnt tab9h(1,i)=tab96h(1,i)*aiftab(law) 45 continue else if(law.eq.2011) then do 50 i=1,5 tab11s(1,i)=tab96s(1,i)*aiftab(law)*ajnt tab11h(1,i)=tab96h(1,i)*aiftab(law) 50 continue else if(law.ge.2012) then do 55 i=1,8 if(hoh.ne.1) then tab12(1,i) = aif12(law)*ts12(i)*ajnt else tab12(1,i) = aif12(law)*th12(i) endif 55 continue endif if(law.le.1981) then if(hoh.ne.1) & call look(tab1s,taxinc,11,n,statax,1.0d0,0.0d0,rt,data) if(hoh.eq.1) & call look(tab1h,taxinc,11,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.1982.and.law.le.1986) then if(hoh.ne.1) & call look(tab3s,taxinc,12,n,statax,1.0d0,0.0d0,rt,data) if(hoh.eq.1) & call look(tab3h,taxinc,12,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.1987.and.law.le.1990) then if(hoh.ne.1) & call look(tab2s,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) if(hoh.eq.1) & call look(tab2h,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.1991.and.law.le.1995) then if(hoh.ne.1)then call look(tab4s,taxinc,8,n,statax,1.0d0,0.0d0,rt,data) else call look(tab4h,taxinc,8,n,statax,1.0d0,0.0d0,rt,data) endif else if(law.ge.1996.and.law.le.2008) then if(hoh.ne.1)then call look(tab5s,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else call look(tab5h,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) endif else if(law.ge.2009.and.law.le.2010) then if(hoh.ne.1)then call look(tab9s,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else call look(tab9h,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) endif else if(law.eq.2011) then if(hoh.ne.1)then call look(tab11s,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else call look(tab11h,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) endif else if(law.ge.2012) then call look(tab12,taxinc,9,n,statax,1.0d0,0.0d0,rt,data) endif if(law.le.1986) then if(mst.eq.4.or.mst.eq.7.or.mst.eq.5)dep=max(0.0d0,dep-1.) blnd=data(10) exemp=(nint(25.*aif(law))*txp) exemp=exemp + (nint(8.*aif(law))*(dep+blnd)) if(law.eq.1978)exemp=(100*txp) + (8*(dep+blnd)) else if(law.ge.1987.and.law.le.1997) then exemp=50.*xmpaif(law)*(data(7)+data(9)+data(10)+dep) else c In 1998:$253;1999:$227;2000:$235;2001:$247;2004:$265 for each dependent exemp=50.*xmpaif(law)*(data(7)+data(9)+data(10))+ & dep*xmpdep(law) endif if(law.ge.1991) then c limiting the exemption credit by federal AGI if(comnew(2).gt.phaded) then if(law.lt.1998) then if((comnew(2)-phaded).gt.25000.*aif2(law)/sep) then exemp = 0. else exemp=max(0.0d0,exemp - (dep + txp + data(9) + data(10)) & *6.*(comnew(2)-phaded)/2500./sep) endif else num = int(1 + (comnew(2)-phaded)/(2500./sep)) exemp = max(0.0d0,exemp - (dep+txp+data(9)+data(10))*6*num) endif else c since 1994 there are two limitations on exemption credits : c a federal AGI limitation and a California limitation computed c on Schedule P(540)in 1994 or California tentative min tax later. if(law.ge.1994.and.law.le.1998) then if(mst.eq.4.or.mst.eq.7.or.mst.eq.1) then exc =30000.*aif1(law) else exc =20000.*aif1(law)*sep endif if(mst.eq.4.or.mst.eq.7) then excess = 150000.*aif2(law) else excess = 100000.*aif2(law)*sep endif if(agi.gt.phaded) then if(agi.lt.excess) then if(stded.gt.xitded.and.ided.ne.-1) then exemp=min(statax-ak(law)*min(0.0d0,agi-exc),exemp) else exemp= min(statax -ak(law)*(min(.025*comnew(2), & data(49))+ data(54) +data(56) +data(66) + taxinc -exc),exemp) endif endif endif endif endif endif c low income credit; starts out as an amnt, later a % of tax c the credits for taxpayers with income under $22,841, military income c and for the elderly and disabled have expired and may no longer be claimed c since 1992 lowcr=0. if(law.le.1983) then if(data(159).le.(10000*txp).and.data(81).lt.1) then lowcr=40.*xif(law.ge.1979,aif(law)) lowcr=nint(max(0.0d0,lowcr-((agi-5000.)*.5))) endif else if(law.ge.1985.and.law.le.1991) then div=1. if(mst.eq.1.or.mst.eq.3.or.mst.eq.6)div=2. do 450 i=1,5 ltab2(1,i)=(lowtab(1,i)*aiflow(law))/div 450 continue lowcr=statax*tablki(ltab2,6,agi,data) endif c child care credit c the credit for child and dependent care expenses has expired c and may no longer be claimed for 1993 - 1999 c New in 2000 : Child and dependent care expenses credit chcr=0. fagi=comnew(2) c comnew(176) = total amount of the federal cccr before avail if(law.le.1984) then chmax=min(2000.*data(8),4000.0d0) chwage=max(0.0d0,data(11)+data(17)) chcr=.03*min(chmax,chwage,data(64)) else if(law.eq.1985.or.law.eq.1986) then chcr=.1*comnew(53) if(agi.ge.20000)chcr=.05*comnew(53) else if(law.ge.1987.and.law.le.1990) then chcr=.3*comnew(53) else if(law.ge.1991.and.law.le.1992) then if(fagi.le.40000.)chcr=.3*comnew(53) if(fagi.gt.40000..and.fagi.le.70000.)chcr=comnew(53)/4 if(fagi.gt.70000..and.fagi.le.100000.)chcr=comnew(53)/5 if(fagi.gt.100000.)chcr=.15*comnew(53) else if(law.ge.2000.and.law.le.2002) then if(fagi.le.40000.) chcr = .63*comnew(176) if(fagi.gt.40000.and.fagi.le.70000.) chcr = .53*comnew(176) if(fagi.gt.70000.and.fagi.le.100000.) chcr = .42*comnew(176) else if(law.ge.2003) then if(fagi.le.40000.) chcr = .50*comnew(176) if(fagi.gt.40000.and.fagi.le.70000.) chcr = .43*comnew(176) if(fagi.gt.70000.and.fagi.le.100000.) chcr = .34*comnew(176) endif c credit for elderly eld=0. if(law.ge.1978.and.law.le.1983) then eld=min(data(32),comnew(54)) else if(law.ge.1984.and.law.le.1991) then eld=.5*min(data(32),comnew(54)) endif polcr=0. if(law.ge.1987)polcr=min(.25*data(65),25.*txp) c energy credit; not related to federal credit, but d38 was best c estimate encred=data(38) noncr=exemp+lowcr+eld+polcr+encred c none of these credits are refundable statax=max(0.0d0,statax-noncr) iratax = data(42)/4 c alternative minimum tax amt=0. prefs=max(0.0d0,data(81)+min(data(17),0.0d0)+data(80)+data(116)) pref2=prefs/ajnt if(hoh.eq.1)call look(amtaxh,prefs,12,n,amt,1.0d0,0.0d0,art, &data) if(hoh.eq.0)call look(amtaxs,pref2,12,n,amt,1.0d0,0.0d0,art, &data) amt=amt*ajnt amt=max(0.0d0,amt-statax) statax=statax+iratax+amt c rent cred independent of income or rent paid c Due to a tax law change, renter's credit was eliminated in 1993. c 1998 -- a credit is back rcred = 0. if(law.ge.1977.and.law.le.1978) then rcred = rtabs(law)*renter(data,comnew) else if(law.ge.1979.and.law.le.1990) then if (mst.eq.1) then rcred = rtabs(law) * renter(data,comnew) else rcred = rtabm(law) * renter(data,comnew)/sep endif else if(law.ge.1991.and.law.le.1992) then if(mst.eq.1.or.sep.eq.2) then if(agi.le.20500.*aifren(law).and.agi.gt.20000.*aifren(law)) & rcred = .5 * rtabs(law) * renter(data,comnew) if(agi.le.20000.*aifren(law)) & rcred = rtabs(law) * renter(data,comnew) else if(agi.le.41000.*aifren(law).and.agi.gt.40000.*aifren(law)) & rcred = .5 * rtabm(law) * renter(data,comnew) if(agi.le.40000.*aifren(law)) & rcred = rtabm(law) * renter(data,comnew) endif else if(law.ge.1998) then jrent = 2 if(data(2).eq.1.or.data(3).eq.2) jrent = 1 if(agi.le.25000*data(7)*aifrent(law)) & rcred = jrent*60.*renter(data,comnew) endif statax = max(0.0d0,statax-rcred) c 2011+ the child and dependent care expense credit is nonrefundable. if(law.le.2010) then statax = statax - chcr else if (law.ge.2011) then statax = max(0.d0,statax - chcr) endif credit = noncr + rcred + chcr c 2005+ Additional Mental Health Services Tax for taxinc>1.e6 if(law.ge.2005) statax = statax + .01*max(0.0d0,taxinc-1000000) c 2015+ refundable California Earned Income Tax Credit(EITC) earncr = 0 if(law.ge.2015) then c California does not allow the credit for self-employment income earned = data(11) ieic = int(max(0.0d0, & min(data(8)-data(209),data(8)-data(107)-data(108),3.0d0))) if(data(203).gt.0) ieic = min(3.0d0,data(203)) disqy = max(0.0d0,comnew(6))+comnew(4)+data(14)+ & max(0.0d0,data(73))+max(0.0d0,data(74))+max(0.0d0,data(75))+ & max(0.0d0,data(76))+max(0.0d0,data(77))+max(0.0d0,data(78))+ & max(0.0d0,data(79))+max(0.0d0,data(19)) am = amax(law,ieic) cr = crmax(law,ieic) if(disqy.le.dylim(law).and.earned.le.am)then if(earned.lt..5*am) base = earned if(earned.ge..5*am) base = max(0.0d0,am - earned) earncr = base*cr/(.5*am) endif posagi = max(0.0d0,comnew(2)) if(posagi.ge..5*am) then base = max(0.0d0,am - posagi) earncr = min(earncr,base*cr/(.5*am)) endif c no CA eitc for separate returns if(sep.eq.2) earncr = 0. endif statax = statax - earncr credit = credit + earncr return end c COLORADO c State 6 c c Updated through 2016 subroutine cotax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt double precision foodcr,foody,fuelcr,minex,itc integer ym,dm dimension data(255), comnew(255), crtab(2,3) dimension pmax(1977:1997,4),ylim(1977:1997,2),fmax(1977:1997,4), & pnsion(1977:2016) dimension tab77(2,11),aif(1977:1986),tab79(2,11),tab84(2,11) dimension surtax(1977:1986),subtr(2000:2001),xmar(2000:2002) data subtr/ 1200.0d0,1500.0d0/ data xmar/ 8800.0d0,9100.0d0,9400.0d0/ data tab77/ 1000.0d0, 2.50d0, 2000.0d0, 3.0d0, & 3000.0d0, 3.50d0, 4000.0d0, 4.00d0, 5000.0d0, 4.50d0, & 6000.0d0, 5.0d0, 7000.0d0, 5.50d0, 8000.0d0, 6.0d0, & 9000.0d0, 6.50d0,10000.0d0,7.0d0, 1.e20, 7.50d0/ data tab79/ 1000.0d0, 2.50d0, 2000.0d0, 3.0d0, & 3000.0d0, 3.50d0, 4000.0d0, 4.0d0, 5000.0d0, 4.50d0, & 6000.0d0, 5.0d0, 6500.0d0, 5.50d0, 8000.0d0, 6.0d0, & 9000.0d0, 6.50d0,10000.0d0,7.50d0, 1.e20, 8.0d0/ data tab84/ 1000.0d0, 3.0d0, 2000.0d0, 3.50d0, 3000.0d0, 4.0d0, & 4000.0d0, 4.50d0,5000.0d0, 5.0d0, 6000.0d0, 5.50d0, 6500.0d0, & 6.0d0, 8000.0d0, 6.50d0, 9000.0d0, 7.0d0, 10000.0d0,7.50d0, &1.e20, 8.0d0/ data surtax/2*1.0d0,.90d0,.80d0,.840d0,5*1.0d0/ data aif/1.0d0,1.060d0,1.13420d0,1.2362780d0,1.335180d0, &4*1.4152910d0,1.420d0/ c pmax,fmax,ylim,aif,pnsion, and surtax not used after 1986 c pmax contains variables used in computing the property tax credit: c max credit, income exemption for married & single, rent percent data pmax/3*410.0d0,18*500.0d0, 4300.0d0,2*6700.0d0,18*8700.0d0, & 3000.0d0,2*3300.0d0, 18*5000.0d0, 3*.10d0,18*.20d0/ c fmax contains the same for fuel tax credit data fmax/21*160.0d0, 4300.0d0,2*6700.0d0,18*8700.0d0,3000.0d0, & 2*3300.0d0,18*5000.0d0, .04d0,20*.064d0/ c ylim contains income limits for the property tax & fuel credit data ylim/8300.0d0,2*10800.0d0,18*11200.0d0,3*7300.0d0, & 18*7500.0d0/ data crtab / 3000.0d0, 16.0d0, 4000.0d0, 11.0d0, 1.e20, 7.0d0 / data pnsion/3000.0d0,4000.0d0,3*5000.0d0,18*20000.0d0, & 17*24000.0d0/ mst = data(2) txp = data(7) if(law.le.1986) then c indexing from 1978 to 1982. legislative discretion. rt=0. c AGI agi=comnew(2)-data(22) c alimony if(law.le.1979)agi=agi-(6.65*data(38)) c res energy c if(law.ge.1978)agi=agi-comnew(76) if(law.ge.1979.and.law.le.1983)agi=agi-xjobs(data,law) if(law.ge.1982.and.law.le.1986)agi=agi+comnew(32) c interest and dividend income exclusions if(law.ge.1980) then agi=agi+divexc(data,comnew,law) agi=agi-twn(data(14),0.0d0,200.*data(7)) agi=agi-twn(data(12),0.0d0,200.*data(7)) endif c pnsion exclusions if(data(9).gt.0) agi=agi- & twn(data(20)+data(72)+comnew(79),0.0d0,data(2)*pnsion(law)) fedded=max(comnew(52) - comnew(58) - comnew(59),0.0d0) taxmax=fedded if(agi.gt.0.and.comnew(2).gt.0) then fedded=twn(fedded*(agi/comnew(2)),0.0d0,taxmax) endif c Standard Deduction ag=max(0.0d0,agi) if(law.le.1979) then if(mst.ne.3.and.mst.ne.6) then minex=(1000.0d0*aif(law))/data(3) stded=min(.1*ag,(1000.0d0*aif(law))/data(3)) sub=(comnew(68)*100.0d0) sub=sub+.5*max(0.0d0,(ag-(1000.0d0+comnew(68)*750.0d0))) sub=max(0.0d0, 800.0d0-sub) allow = 200.0d0 +(100.0d0*comnew(68))+sub allow=min(1000.0d0*aif(law),allow) stded=max(stded,allow) elseif(mst.eq.3.or.mst.eq.6) then allow=aif(law)*min(500.0d0,100.0d0+(comnew(68)*100.0d0)) minex=500.0d0*aif(law) stded = min(500.0d0*aif(law),.1d0*ag) stded=max(stded,allow) endif elseif(law.ge.1980) then stded=(1000.0d0*aif(law))/data(3) minex=stded endif c state and loc var left out on purpose xitded = 0.d0 if(comnew(26).gt.0) & xitded = comnew(24)-data(50)*comnew(24)/comnew(30) c gasoline tax: arbitary distance assumed xitded=xitded+(49*data(7))+(26*data(8)) deduc=max(xitded,stded) c Exemptions if(law.eq.1977) then exemp = 750.0d0*comnew(68) else exemp = 850.0d0*aif(law)*comnew(68) endif minex=minex+exemp taxinc = max(0.0d0,agi - deduc - exemp - fedded) if(law.le.1978)call look(tab77,taxinc,11,n,statax,aif(law), & 0.0d0,rt,data) if(law.gt.1978.and.law.le.1983) call look(tab79,taxinc,11,n, & statax,aif(law),0.0d0,rt,data) if(law.ge.1984.and.law.le.1986) call look(tab84,taxinc,11,n, & statax,aif(law),0.0d0,rt,data) c surtax statax=statax*surtax(law) if(law.le.1978) then statax=statax+.02*max(data(12)+data(14)-5000.0d0*data(7),0.0d0) elseif(law.ge.1979) then statax=statax+.02*max(data(12)+data(14)-15000.0d0*data(7),0.0d0) endif else if(law.ge.1987) then agi = comnew(2) taxinc = max(0.0d0,comnew(29)-data(22)) c additions to federal taxable income: state income tax claimed as c a deduction on Schedule A , federal form 1040 c (if a person did itemized deductions on his federal return, he must add back c to income on your Colorado return any state income tax included in his total c federal itemized deduction.) if(comnew(26).gt.0.and.law.ge.1992) then taxinc= taxinc + min(data(50),comnew(24)-comnew(3)) endif c subractions to federal taxable income: pnsion exclusions penexc=twn(data(20)+data(72)+comnew(79),0.0d0,pnsion(law)*txp) if(data(9).gt.0) taxinc=max(0.0d0,taxinc-penexc) c 2000-2001 interest, dividend and capital gain subtraction if(law.ge.2000.and.law.le.2001) & taxinc=max(0.0d0,taxinc-min(subtr(law)*data(7), & data(12)+data(14)+max(0.0d0,comnew(06)))) c 2000-2002 Marrige Penalty Subtraction if(mst.eq.2.and.law.ge.2000.and.law.le.2002) then if(comnew(26).lt.1.) taxinc = & max(0.0d0,taxinc-(xmar(law)-comnew(3))) if(comnew(26).gt.0..and.comnew(24).gt.comnew(3)) taxinc = & max(0.0d0,taxinc-max(0.0d0,(xmar(law)-comnew(24)))) if(law.ge.2001.and.data(9)+data(10).gt.0) taxinc = & max(0.0d0,taxinc-900*(data(9)+data(10))) endif c 2001+ Qualifying Charitable Contributions if(law.gt.2001.and.comnew(26).lt.1..and.comnew(23).gt.0) & taxinc = max(0.0d0,taxinc-max(0.0d0,comnew(23)-500)) if(law.le.1998) then statax = taxinc*.05 else if(law.eq.1999) then c The income tax rate was reduced from 5% to 4.75% in 1999 statax = taxinc*.0475 else if(law.ge.2000) then c The income tax rate was reduced from 4.75% to 4.63% in 2000 statax = taxinc*.0463 endif if(law.le.1999) then altax=.0375*max(0.0d0,comnew(69)-comnew(40)) else altax=.0347*max(0.0d0,comnew(69)-comnew(40)) endif statax=statax + max(altax-statax,0.0d0) endif c Credits credit=0. fuelcr=0. foodcr=0. foody=0. propcr=0. encr=0. itc=0. cr=0. if(law.le.1986) then ag=max(0.0d0,agi) foody=(ag/(data(7)+data(8))) mst=data(2) if(law.le.1979) then foodcr=(data(7)+data(8))*nint(tablki(crtab,3,foody,data)* & aif(law)) if(law.ge.1978) then if(mst.eq.3.or.mst.eq.6)foodcr=crtab(2,3)*(data(7)+data(8)) endif endif if(law.ge.1980.and.law.le.1986)encr=min(data(38),3400.0d0) itc=.1*data(33) if(law.le.1978) then itc=0. else if(law.eq.1979) then itc=min(itc,5000./data(3)) else if(law.eq.1980.or.law.eq.1981) then if(law.eq.1981)itc=.15*data(33) itc=min(itc,37000./data(3)) else if(law.ge.1982.and.law.le.1986) then itc=min(itc,10000./data(3)) endif ym=0 dm=0 if(mst.eq.1.or.mst.eq.4.or.mst.eq.7.or.mst.eq.5) then dm= 3 ym=2 else if(mst.eq.2.or.mst.eq.3.or.mst.eq.6) then dm=2 ym=1 endif c income for property credit purposes is larger than agi if(data(9).gt.0.or.data(10).gt.0.or.mst.eq.5) then hhy = data(159) if(mst.eq.3.or.mst.eq.6) hhy=hhy*2. if(hhy.le.ylim(law,ym)) then propcr=max(pmax(law,1)-max(0.0d0,(hhy-pmax(law,dm)))* & pmax(law,4),0.0d0) propcr=min(propcr,(data(51)+.2*data(160))) if(law.eq.1977)propcr=propcr+.1*(data(51)+.15*data(160)) c rent used as proxy for heat expense. if(law.ge.1979.and.law.le.1986)then fuelcr=max(fmax(law,1)-(hhy-fmax(law,dm))* & fmax(law,4),0.0d0) fuelcr=min(fuelcr,(.1*data(160))) endif endif endif endif c 1997-2001 and 2005, 2015 State Sales Tax Refund c Modified CO AGI includes Gross SSB coagi = comnew(2) - comnew(79) + data(91) if(law.eq.1997) then if(coagi.lt.15001) cr=37. if(coagi.ge.15001.and.coagi.lt.100001.) cr=60. if(coagi.ge.100001) cr=80. else if(law.eq.1998) then if(coagi.lt.20001) cr=142. if(coagi.ge.20001.and.coagi.lt.50001) cr=195. if(coagi.ge.50001.and.coagi.lt.95001) cr=276. if(coagi.ge.95001) cr=384. else if(law.eq.1999) then if(coagi.lt.25001) cr=159. if(coagi.ge.25001.and.coagi.lt.50001) cr=212. if(coagi.ge.50001.and.coagi.lt.75001) cr=244. if(coagi.ge.75001.and.coagi.lt.100001) cr=290. if(coagi.ge.100001.and.coagi.lt.125001) cr=312. if(coagi.ge.125001)cr=502. else if(law.eq.2000) then if(coagi.lt.26001) cr=182. if(coagi.ge.26001.and.coagi.lt.53001) cr=245. if(coagi.ge.53001.and.coagi.lt.78001) cr=288. if(coagi.ge.78001.and.coagi.lt.103001) cr=325. if(coagi.ge.103001.and.coagi.lt.126001) cr=363. if(coagi.ge.126001) cr=574. else if(law.eq.2001) then if(coagi.lt.27001) cr=144. if(coagi.ge.27001.and.coagi.lt.56001) cr=187. if(coagi.ge.56001.and.coagi.lt.83001) cr=220. if(coagi.ge.83001.and.coagi.lt.110001) cr=252. if(coagi.ge.110001.and.coagi.lt.135001) cr=283. if(coagi.ge.135001) cr=451. else if(law.eq.2005) then cr = 15. else if(law.eq.2015) then if(coagi.lt.36001) cr=13. if(coagi.ge.36001.and.coagi.lt.77001) cr=18. if(coagi.ge.77001.and.coagi.lt.120001) cr=21. if(coagi.ge.120001.and.coagi.lt.163001) cr=23. if(coagi.ge.163001.and.coagi.lt.204001) cr=24. if(coagi.ge.204001) cr=41. endif cr = cr * data(07) c Colorado Child Care Credit since 1996 refundable chcr = 0. chcare = min(comnew(53),max(0.0d0,comnew(52)-data(34))) if(law.eq.1996.or.law.eq.1997) then if(comnew(2).le.25000.) chcr = .5*chcare if(comnew(2).gt.25000.and.comnew(2).le.35000.) & chcr = .3*chcare if(comnew(2).gt.35000.and.comnew(2).le.60000.) & chcr = .1*chcare elseif(law.eq.1998) then chcr = .5*chcare elseif(law.eq.1999) then if(comnew(2).le.60000) chcr = .5*chcare elseif(law.ge.2000.and.law.le.2001) then if(comnew(2).le.64000)chcr=max(0.0d0,.7*chcare-300*data(8)) elseif(law.ge.2002) then if(comnew(2).le.25000) then chcr = .5*chcare else if(comnew(2).gt.25000.and.comnew(2).le.35000) then chcr = .3*chcare else if(comnew(2).gt.35000.and.comnew(2).le.60000) then chcr = .1*chcare endif endif c 1999-2001 Colorado Child Tax Credit child = 0. c child credit only for children under age 5 c we assume that children are older than 5 y.o. c if(law.eq.1999.and.comnew(2).le.60000.and.comnew(1).gt.0) c & child = 200.*data(8) c if(law.eq.2000.and.comnew(2).le.64000.and.comnew(1).gt.0) c & child = 300.*data(8) c if(law.eq.2001.and.comnew(2).le.64000. c & and.comnew(81)+comnew(93).gt.0) c & child = min(comnew(81)+comnew(93),300.*data(8)) c --------------------------------------------------------- c Earned Income Credit 1999-2001 earncr = 0. if(law.eq.1999) then earncr = .085*comnew(59) else if((law.ge.2000.and.law.le.2001).or.law.ge.2015) then earncr = .1*comnew(59) endif c --------------------------------------------------------- credit = propcr+fuelcr+foodcr+itc+encr statax=max(0.0d0,statax-credit)-cr-earncr-chcr-child credit = credit + cr + earncr + chcr + child c1 format(6(1x,f8.0)) c2 format(6(1x,a8)) return end c CONNECTICUT c State 7 c Updated through 2016 c until 1991 Connecticut just had tax on cap gains,interest & dividends. c In 1991 Connecticut enacted a flat rate income tax subroutine cttax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension tab(2,10),tab84(2,6),tab85(2,13),tab86(2,12), & tab89(2,14), tab91(2,14),reic(2011:2016), & tab96s(2,2),tab96h(2,2),tab96m(2,2), & tab97s(2,2),tab97h(2,2),tab97m(2,2), & tab98s(2,2),tab98h(2,2),tab98m(2,2), & tab99s(2,2),tab99h(2,2),tab99m(2,2), & tab03s(2,2),tab03h(2,2),tab03m(2,2), & tab09s(2,3),tab09h(2,3),tab09m(2,3), & tab11s(2,6),tab11h(2,6),tab11m(2,6), & tab15s(2,7),tab15h(2,7),tab15m(2,7) c Tax Recapture dimension rmaxh(2011:2016),rmaxs(2011:2016), & ragih(2011:2016),ragis(2011:2016), & rateh(2011:2016),rates(2011:2016) dimension aifpc(1995:2016),xmps(2008:2016), & phses(1997:2016),phseh(1997:2016),phsej(1997:2016),prop2(2,8) &,prop(1996:2016) dimension Bsin(2,6),Bhead(2,6),Bjoin(2,6) dimension B95sin(2,29),B00sin(2,29),B95hed(2,29),B95joi(2,29) dimension data(255),comnew(255) double precision inctax integer sep data prop2 / & 0.0d0, .00d0, 0.0d0, .15d0, 0.0d0,.30d0, 0.0d0, .45d0, & 0.0d0, .60d0, 0.0d0, .75d0, 0.0d0,.90d0, 1.e20,1.00d0/ data phses /3*52500.d0,53500.d0,3*54500.d0,3*55000.d0, 55500.d0, & 5*56500.d0,60500.d0, 62500.d0, 47500.d0,49500.0d0/ data phseh /19* 78500.d0,54500.0d0/ data phsej /19*100500.d0,70500.0d0/ data xmps /4*13000.d0,13500.d0,14000.d0,2*14500.d0,15000.d0/ data rmaxs/4*2250.d0,2*3150.d0/ data rmaxh/4*3600.d0,2*4920.d0/ data ragis/6*200000.d0/ data ragih/6*320000.d0/ data rateh/4*.015d0,2*.0175d0/ data rates/4*.015d0,2*.0180d0/ c inflation factor for personal credits (singles) data aifpc/5*1.0d0,1.02d0,3*1.042d0,3*1.052d0,1.0625d0,4*1.083d0, & 1.125d0,1.167d0,1.207d0,1.208333d0,1.2129032/ c arrays for Tax Table B through 1994 :Personal Tax Credit Percentages data Bsin/12001.0d0,1.0d0, 15001.0d0,.75d0,20001.0d0,.35d0, & 25001.0d0,.15d0, 48001.0d0,.10d0,1.e20,.0d0/ data Bhead/19001.0d0,1.0d0,24001.0d0,.75d0,34001.0d0,.35d0, & 44001.0d0,.15d0,74001.0d0,.10d0,1.e20,.0d0/ data Bjoin/24001.0d0,1.0d0, 30001.0d0,.75d0,40001.0d0,.35d0, & 50001.0d0,.15d0, 96001.0d0,.10d0,1.e20,.0d0/ c arrays for Tax Table B since 1995 :Personal Tax Credit Percentages data B95sin/12001.0d0,1.0d0, & 15001.0d0,.75d0,15501.0d0,.7d0 ,16001.0d0,.65d0,16501.0d0,.6d0 , & 17001.0d0,.55d0,17501.0d0,.5d0 ,18001.0d0,.45d0,18501.0d0,.4d0 , & 20001.0d0,.35d0,20501.0d0,.3d0 ,21001.0d0,.25d0,21501.0d0,.2d0 , & 25001.0d0,.15d0,25501.0d0,.14d0,26001.0d0,.13d0,26501.0d0,.12d0, & 27001.0d0,.11d0,48001.0d0,.1d0 ,48501.0d0,.09d0,49001.0d0,.08d0, & 49501.0d0,.07d0,50001.0d0,.06d0,50501.0d0,.05d0,51001.0d0,.04d0, & 51501.0d0,.03d0,52001.0d0,.02d0,52501.0d0,.01d0,1.e20,.0d0 / data B95hed/19001.0d0,1.0d0, & 24001.0d0,.75d0,24501.0d0,.7d0 ,25001.0d0,.65d0,25501.0d0,.6d0, & 26001.0d0,.55d0,26501.0d0,.5d0 ,27001.0d0,.45d0,27501.0d0,.4d0, & 34001.0d0,.35d0,34501.0d0,.3d0 ,35001.0d0,.25d0,35501.0d0,.2d0, & 44001.0d0,.15d0,44501.0d0,.14d0,45001.0d0,.13d0,45501.0d0,.12d0, & 46001.0d0,.11d0,74001.0d0,.1d0 ,74501.0d0,.09d0,75001.0d0,.08d0, & 75501.0d0,.07d0,76001.0d0,.06d0,76501.0d0,.05d0,77001.0d0,.04d0, & 77501.0d0,.03d0,78001.0d0,.02d0,78501.0d0,.01d0,1.e20,.0d0 / data B95joi/24001.0d0,1.0d0, & 30001.0d0,.75d0,30501.0d0,.7d0,31001.d0,.65d0,31501.d0,.6d0, & 32001.0d0,.55d0,32501.0d0,.5d0,33001.d0,.45d0,33501.d0,.4d0, & 40001.0d0,.35d0,40501.0d0,.3d0,41001.d0,.25d0,41501.d0,.2d0, & 50001.0d0,.15d0,50501.0d0,.14d0,51001.d0,.13d0,51501.d0,.12d0, & 52001.0d0,.11d0,96001.0d0,.1d0,96501.d0,.09d0,97001.d0,.08d0, & 97501.0d0,.07d0,98001.0d0,.06d0,98501.d0,.05d0,99001.d0,.04d0, & 99501.0d0,.03d0,100001.0d0,.02d0,100501.d0,.01d0,1.e20,.0d0 / c for 1996 year data tab96s/2250.0d0,3.0d0,1.e20,4.50d0/ data tab96h/3500.0d0,3.0d0,1.e20,4.50d0/ data tab96m/4500.0d0,3.0d0,1.e20,4.50d0/ c for 1997 year data tab97s/ 6250.0d0,3.0d0,1.e20,4.50d0/ data tab97h/10000.0d0,3.0d0,1.e20,4.50d0/ data tab97m/12500.0d0,3.0d0,1.e20,4.50d0/ c for 1998 year data tab98s/ 7500.0d0,3.0d0,1.e20,4.50d0/ data tab98h/12000.0d0,3.0d0,1.e20,4.50d0/ data tab98m/15000.0d0,3.0d0,1.e20,4.50d0/ c for 1999 year data tab99s/10000.0d0,3.0d0,1.e20,4.50d0/ data tab99h/16000.0d0,3.0d0,1.e20,4.50d0/ data tab99m/20000.0d0,3.0d0,1.e20,4.50d0/ c for 2003-2008 year data tab03s/10000.0d0,3.0d0,1.e20,5.0d0/ data tab03h/16000.0d0,3.0d0,1.e20,5.0d0/ data tab03m/20000.0d0,3.0d0,1.e20,5.0d0/ c for 2009-2010 year data tab09s/10000.0d0,3.0d0, 500000.0d0,5.0d0,1.e20,6.50d0/ data tab09h/16000.0d0,3.0d0, 800000.0d0,5.0d0,1.e20,6.50d0/ data tab09m/20000.0d0,3.0d0,1000000.0d0,5.0d0,1.e20,6.50d0/ c for 2011-2014 year data tab11s/10000.0d0,3.0d0, 50000.0d0,5.0d0,100000.0d0,5.50d0, & 200000.0d0,6.0d0,250000.0d0,6.5d0,1.e20,6.7d0 / data tab11h/16000.0d0,3.0d0, 80000.0d0,5.0d0,160000.0d0,5.50d0, & 320000.0d0,6.0d0,400000.0d0,6.5d0,1.e20,6.7d0 / data tab11m/20000.0d0,3.0d0,100000.0d0,5.0d0,200000.0d0,5.5d0, & 400000.0d0,6.0d0,500000.0d0,6.5d0,1.e20,6.7d0 / c for 2015+ year data tab15s/10000.0d0,3.0d0, 50000.0d0,5.0d0,100000.0d0,5.50d0, & 200000.0d0,6.0d0,250000.0d0,6.5d0,500000.0d0,6.90d0, & 1.e20,6.99d0 / data tab15h/16000.0d0,3.0d0, 80000.0d0,5.0d0,160000.0d0,5.50d0, & 320000.0d0,6.0d0,400000.0d0,6.5d0,800000.0d0,6.90d0, & 1.e20,6.99d0 / data tab15m/20000.0d0,3.0d0,100000.0d0,5.0d0, 200000.0d0,5.5d0, & 400000.0d0,6.0d0,500000.0d0,6.5d0,1000000.0d0,6.9d0, & 1.e20,6.99d0 / c maximum property tax credit allowed data prop/100.0d0, 215.0d0,350.0d0,425.0d0,3*500.0d0,3*350.0d0, & 5*500.0d0,5*300.0d0,200.0d0/ c arrays for conn cap gains,interest,& dividends data tab/ 19999.0d0, 0.0d0, 21999.0d0, .01d0 , & 23999.0d0, .02d0, 27999.0d0, .03d0 , & 29999.0d0, .04d0, 34999.0d0, .05d0 , & 39999.0d0, .06d0, 49999.0d0, .075d0, & 99999.0d0, .08d0, 1.e20 , .09d0 / data tab84/49999.0d0, 0.0d0, 59999.0d0, .06d0 , & 69999.0d0, .08d0, 79999.0d0, .1d0 , & 99999.0d0, .12d0, 1.e20, .13d0 / data tab85/49999.0d0, 0.0d0, 53999.0d0, .01d0, & 57999.0d0, .02d0, 61999.0d0, .03d0, & 65999.0d0, .04d0, 69999.0d0, .05d0, & 73999.0d0, .06d0, 77999.0d0, .07d0, & 81999.0d0, .08d0, 85999.0d0, .09d0, & 89999.0d0, .10d0, 99999.0d0, .12d0, & 1.e20 , .13d0/ data tab86/53999.0d0, 0.0d0, 57999.0d0, .01d0, & 61999.0d0, .02d0, 65999.0d0, .03d0, & 69999.0d0, .04d0, 73999.0d0, .05d0, & 77999.0d0, .06d0, 81999.0d0, .07d0, & 85999.0d0, .08d0, 89999.0d0, .09d0, & 99999.0d0, .11d0, 1.e20 , .12d0/ data tab89/53999.0d0, 0.0d0, 55999.0d0, .01d0, & 57999.0d0, .02d0, 59999.0d0, .03d0, & 61999.0d0, .04d0, 65999.0d0, .05d0, & 69999.0d0, .06d0, 73999.0d0, .07d0, & 77999.0d0, .08d0, 81999.0d0, .09d0, & 85999.0d0, .10d0, 89999.0d0, .11d0, & 99999.0d0, .13d0, 1.e20 , .14d0/ data tab91/53999.0d0, 0.0d0 , 55999.0d0, .0075d0, & 57999.0d0, .015d0 , 59999.0d0, .020d0 , & 61999.0d0, .0275d0, 65999.0d0, .035d0 , & 69999.0d0, .04d0 , 73999.0d0, .0475d0, & 77999.0d0, .055d0 , 81999.0d0, .06d0 , & 85999.0d0, .0675d0, 89999.0d0, .075d0 , & 99999.0d0, .0875d0, 1.e20 , .095d0/ data reic/2*.3d0,.25d0,3*.275d0/ rt = 0. mst = data(2) sep = data(3) c AGI subrac=data(22)+xif(law.le.1993,data(26)) agi=comnew(2) if(law.ge.1991)agi=agi-subrac c Social Security Benefits are not taxable for c mst = 2,5,4,7 and comnew(2)< $60K; for mst=1,3,6 and comnew(2)< $50K c if comnew(2) is above , ssb are phased out. c if(law.ge.1985.and.comnew(79).gt.0) then if ((agi.lt.60000.and.(mst.eq.2.or.mst.eq.4.or.mst.eq.7)).or. & (agi.lt.50000.and.(mst.eq.1.or.mst.eq.3.or.mst.eq.6))) then agi=agi-comnew(79) else if(mst.eq.1.or.mst.eq.4.or.mst.eq.7.or.mst.eq.5) then excl = 25000. elseif(mst.eq.2) then excl = 32000. elseif(mst.eq.3.or.mst.eq.6) then excl = 0. endif if(law.le.1999) then agi = agi - max(0.0d0,comnew(79) - 0.5* & min(0.5*max(0.0d0,data(159)-.5*data(91)- & comnew(17)- excl),.5*data(91))) else if(excl.gt.0) then agi = agi - (comnew(79) - .25 * min(data(91),excl)) endif endif endif endif c Exemptions if(law.le.1990)exemp=(data(7)+data(9)+data(10))*100. c exemptions after 1991 based on agi and marital status c single exemption 1991 if(law.ge.1991) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6)then if(law.le.1999) then exemp=twn(12000-(agi-24000),0.0d0,12000.0d0) else if(law.eq.2000.and.mst.eq.1) then exemp=twn(12250-(agi-24500),0.0d0,12250.0d0) else if(law.eq.2001.and.mst.eq.1) then exemp=twn(12750-(agi-25500),0.0d0,12750.0d0) else if(law.eq.2002.and.mst.eq.1) then exemp=twn(12500-(agi-25000),0.0d0,12500.0d0) else if(law.ge.2003.and.law.le.2006.and.mst.eq.1) then exemp=twn(12625-(agi-25250),0.0d0,12625.0d0) else if(law.eq.2007.and.mst.eq.1) then exemp=twn(12750-(agi-25500),0.0d0,12750.0d0) c Singles 2008+ else if(law.ge.2008.and.mst.eq.1) then xmp = xmps(law) exemp = twn(xmp-(agi-2*xmp),0.0d0,xmp) else if(law.ge.2000.and.sep.eq.2) then exemp=twn(12000-(agi-24000),0.0d0,12000.0d0) endif c head of household exemption 1991 elseif(mst.eq.4.or.mst.eq.7)then exemp=twn(19000-(agi-38000),0.0d0,19000.0d0) c married filing jointly or widower exemption 1991 else exemp=twn(24000-(agi-48000),0.0d0,24000.0d0) endif endif c The scheduled increases will resume beginning with the 2012 taxable year c (for Personal Exemptions and Credits) c c Cap Gains, Dividends, and Interest Liability gain = max(comnew(6),0.0d0) c 1987-1988 Long-Term Capital Gains are reported at 100% in Federal tax returns, c a 60% deduction is allowed at CT tax returns if(law.eq.1987.or.law.eq.1988) then if(data(68).le.0.and.gain.gt.0)gain=gain-.6*(data(70)+data(68)) if(data(68).gt.0.and.data(70).gt.0) gain = gain - .6*data(70) endif gain = gain +data(18) if(law.le.1990) then cgtax=max(0.0d0,(gain-exemp)*.07) else if(law.eq.1991) then cgtax=max(0.0d0,min(.034*agi, & (gain-100.*(data(7)+data(9)+data(10)))*.0475)) endif divint=data(12)+data(14) c Calculation of Tax if(law.lt.1983) then call cttab(tab ,10,agi,data(12),divtax,rt) taxinc = gain + divint statax=cgtax+divtax else if(law.eq.1983) then call cttab(tab ,10,agi,divint,divtax,rt) taxinc = gain + divint statax=cgtax+divtax else if(law.eq.1984) then call cttab(tab84,6,agi,divint,divtax,rt) taxinc = gain + divint statax=cgtax+divtax else if(law.eq.1985) then call cttab(tab85,13,agi,divint,divtax,rt) taxinc = gain + divint statax=cgtax+divtax else if(law.ge.1986.and.law.le.1988) then call cttab(tab86,12,agi,divint,divtax,rt) taxinc = gain + divint statax=cgtax+divtax else if(law.ge.1989.and.law.le.1990) then call cttab(tab89,14,agi,divint,divtax,rt) taxinc = gain + divint statax=cgtax+divtax else taxinc= max(0.0d0,agi - exemp) if(law.ge.1991.and.law.le.1995)then rt=0.045 if(law.eq.1991) then call cttab(tab91,14,agi,divint,divtax,rt) rt=0.015 endif xtax = taxinc * rt elseif(law.eq.1996) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) & call look(tab96s,taxinc,2,n,xtax,1.0d00,0.0d0,rt, &data) if(mst.eq.4.or.mst.eq.7) & call look(tab96h,taxinc,2,n,xtax,1.0d00,0.0d0,rt, &data) if(mst.eq.5.or.mst.eq.2) & call look(tab96m,taxinc,2,n,xtax,1.0d00,0.0d0,rt, &data) elseif(law.eq.1997) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) & call look(tab97s,taxinc,2,n,xtax,1.0d00,0.0d0,rt, &data) if(mst.eq.4.or.mst.eq.7) & call look(tab97h,taxinc,2,n,xtax,1.0d00,0.0d0,rt, &data) if(mst.eq.5.or.mst.eq.2) & call look(tab97m,taxinc,2,n,xtax,1.0d00,0.0d0,rt, &data) elseif(law.eq.1998) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) & call look(tab98s,taxinc,2,n,xtax,1.0d00,0.0d0,rt, &data) if(mst.eq.4.or.mst.eq.7) & call look(tab98h,taxinc,2,n,xtax,1.0d00,0.0d0,rt,data) if(mst.eq.5.or.mst.eq.2) & call look(tab98m,taxinc,2,n,xtax,1.0d00,0.0d0,rt,data) elseif(law.ge.1999.and.law.le.2002) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) & call look(tab99s,taxinc,2,n,xtax,1.0d00,0.0d0,rt,data) if(mst.eq.4.or.mst.eq.7) & call look(tab99h,taxinc,2,n,xtax,1.0d00,0.0d0,rt,data) if(mst.eq.5.or.mst.eq.2) & call look(tab99m,taxinc,2,n,xtax,1.0d00,0.0d0,rt,data) elseif(law.ge.2003.and.law.le.2008) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) & call look(tab03s,taxinc,2,n,xtax,1.0d00,0.0d0,rt,data) if(mst.eq.4.or.mst.eq.7) & call look(tab03h,taxinc,2,n,xtax,1.0d00,0.0d0,rt,data) if(mst.eq.5.or.mst.eq.2) & call look(tab03m,taxinc,2,n,xtax,1.0d00,0.0d0,rt,data) elseif(law.ge.2009.and.law.le.2010) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) & call look(tab09s,taxinc,3,n,xtax,1.0d00,0.0d0,rt,data) if(mst.eq.4.or.mst.eq.7) & call look(tab09h,taxinc,3,n,xtax,1.0d00,0.0d0,rt,data) if(mst.eq.5.or.mst.eq.2) & call look(tab09m,taxinc,3,n,xtax,1.0d00,0.0d0,rt,data) elseif(law.ge.2011) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then if(law.le.2014) then call look(tab11s,taxinc,6,n,xtax,1.0d00,0.0d0,rt,data) else call look(tab15s,taxinc,7,n,xtax,1.0d00,0.0d0,rt,data) endif c 2011 3% tax rate phase out add-back - stax if(mst.eq.1) then stax = min(200.0d0,.03*1000*max(0.0d0,agi - 56500)/5000) else stax = min(200.0d0,.03*1000*max(0.0d0,agi - 50250)/2500) endif c 2011 Tax Recapture for Taxpayers with Higher AGI - rtax rtax = min(rates(law)*max(0.d0,agi-ragis(law)),rmaxs(law)) endif if(mst.eq.4.or.mst.eq.7) then if(law.le.2014) then call look(tab11h,taxinc,6,n,xtax,1.0d00,0.0d0,rt,data) else call look(tab15h,taxinc,7,n,xtax,1.0d00,0.0d0,rt,data) endif c 2011 3% tax rate phase out add-back - stax stax = min(320.d0,.03*1600*max(0.0d0,agi - 78500)/4000) c 2011 Tax Recapture for Taxpayers with Higher AGI - rtax rtax = min(rateh(law)*max(0.d0,agi-ragih(law)),rmaxh(law)) endif if(mst.eq.5.or.mst.eq.2) then if(law.le.2014) then call look(tab11m,taxinc,6,n,xtax,1.0d00,0.0d0,rt,data) else call look(tab15m,taxinc,7,n,xtax,1.0d00,0.0d0,rt,data) endif c 2011 3% tax rate phase out add-back - stax stax = min(400.0d0,.03*2000*max(0.0d0,agi - 100500)/5000) c 2011 Tax Recapture for Taxpayers with Higher AGI - rtax rtax = min(rates(law)*max(0.0d0,agi-2*ragis(law)), & 2*rmaxs(law)) endif xtax = xtax + stax + rtax endif endif c Personal Tax Credits c credp - percentage rate--- if(law.ge.1991) then if(law.ge.1991.and.law.le.1994) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) & credp=tablki(Bsin,6,agi,data) if(mst.eq.4.or.mst.eq.7) credp=tablki(Bhead,6,agi,data) if(mst.eq.2.or.mst.eq.5) credp=tablki(Bjoin,6,agi,data) elseif(law.ge.1995) then if(mst.eq.1) then credp=tablki(B95sin,29,agi/aifpc(law),data) else if(mst.eq.4.or.mst.eq.7) then credp=tablki(B95hed,29,agi,data) else credp=tablki(B95joi,29,agi*sep,data) endif endif ytax=xtax*credp inctax=xtax-ytax statax=inctax endif if(law.eq.1991) statax = statax + cgtax + divtax c--------------------------- sep=data(3) amcred =0. if(law.ge.1993.and.data(81).gt.0.) then xprefs=comnew(69)-subrac if(mst.eq.3.or.mst.eq.6.and.xprefs.gt.165000.) then if(xprefs.gt.255000.)then xprefs=xprefs+22500. else xprefs=xprefs+.25*(xprefs-165000.) endif endif xemp=sorm(mst,33750.0d0,45000.0d0/sep) xln9=max(0.0d0,xprefs-sorm(mst,112500.0d0,150000.0d0/sep))*.25 xemp=max(0.0d0,xemp-xln9) xln11=max(0.0d0,xprefs-xemp) if(xln11.gt.0.) then if(xln11.gt.(175000./sep)) then xln12=(45500./sep)+(xln11-175000.)*.28-xif(law.ge.1994, & 3500.0d0/sep) else xln12=xln11*.26 endif if(law.le.1993) then amt=max((xln12*.23)-statax,0.0d0) else if(law.ge.1994) then amt = max(min(xln12*.19,xprefs*.05)-inctax,0.0d0) c amcred - Adjusted Net Connecticut Minimum Tax Credit since 1994 c line 7 Form CT-1040 in 1994 amcred = min(xln12*.19,max((-amt),0.0d0)) endif else amt=0. endif statax = max(statax - amcred,0.0d0) statax= max(statax + amt ,0.0d0) endif c Credit for property taxes paid on your primary residence and/or c motor vehicle : since 1996 year and not more than $100 c $500 in 2000, $425 in 1999, $350 in 1998, $215 in 1997 pcred=0. if(law.ge.1996) then pcred=min(prop(law),data(51)) c Credit for property taxes paid is subject to limitations since 1997 if(law.ge.1997) then if(mst.eq.1) then phse = phses(law) else if(mst.eq.4.or.mst.eq.7) then phse = phseh(law) else phse = phsej(law)/data(3) endif agix = max(0.0d0,agi) do 1001 i = 1,7 prop2(1,i) = phse + (i-1)*10000 1001 continue pct = tablki(prop2,8,agix,data) c Property Tax Credit Limitation pcred = pcred - pct*pcred endif endif statax=max(0.0d0,statax-pcred) c New in 2011 - Connecticut EITC earncr = 0. if(law.ge.2011.and.law.le.2016) earncr = reic(law)*comnew(59) statax = statax - earncr credit = pcred + amcred + earncr return end c subroutine cttab(tab,n,agi,div,statax,rate) implicit double precision (A-H,O-Z) dimension tab(2,n) statax=0. do 10 i=1,n rt=tab(2,i) if(rt.ge..15) then 91234 write(0,*)'TAX RATE ERROR IN CTTAX' continue endif if(agi .le. tab(1,i)) goto 20 10 continue i=n 20 continue statax=statax+(rt*div) rate=rt return end c c DELAWARE c State 8 c c Updated through 2016 subroutine detax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt c dimension tab99(8,2),tab00(7,2),tab98(7,2) dimension tab99(7,2),tab00(6,2),tab98(6,2),tab09(7,2),tab12(7,2) dimension tab(2,17),tab77(17),tab79(17),tab80(17),tab14(7,2) dimension tab85(17),tab86(17),tab87(17),tab88(17),tab96(17) dimension data(255),comnew(255),xmp(1977:2016,3),ded(1977:1986), & xcoef(1991:1997),aif92(1992:2012),chlim(1999:2016),pns(1977:2016) &,aif13(2013:2017) data pns/22*3000.0d0,5000.0d0,17*12500.0d0/ data chlim/4*720.0d0,14*1050.0d0/ data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ data aif92/ & 1.0525d0, 1.0845d0, 1.118d0 , 1.147d0 , 1.1795d0, 1.2120d0, & 1.2450d0, 1.2660d0, 1.2895d0, 1.3295d0, 1.3730d0, 1.3950d0, & 1.4270d0, 1.4595d0, 1.5050d0, 1.5640d0, 1.5995d0, 1.6680d0, &2*1.6955d0, 1.7365d0/ data xcoef/1.,1.05250d0,1.08450d0,1.1180d0,1.1470d0,1.17950d0, & 1.2120d0/ c Rates change, brackets don't. Later these rates will be substituted c into the "tab" array(up to 1998). data tab / 1000.0d0, 0.0d0, 2000.0d0, 0.0d0, 3000.0d0, 0.0d0, & 4000.0d0, 0.0d0, 5000.0d0, 0.0d0, 6000.0d0, 0.0d0, & 8000.0d0, 0.0d0, 10000.0d0, 0.0d0,15000.0d0, 0.0d0, & 20000.0d0, 0.0d0, 25000.0d0, 0.0d0,30000.0d0, 0.0d0, & 40000.0d0, 0.0d0, 50000.0d0, 0.0d0,75000.0d0, 0.0d0, & 100000.0d0, 0.0d0, 1.e20, 0.0d0/ c data tab98 / 2000., 0., 5000., 3.1, 10000., 4.86, c & 20000., 5.8, 25000., 6.2,30000., 6.44, c & 1.e20, 6.9/ c data tab99 / 2000., 0., 3000., 2.5, 5000., 2.6, c & 10000., 4.3, 20000., 5.2, 25000., 5.6, 60000., 5.95, c & 1.e20, 6.4/ c data tab00 / 2000., 0., 5000., 2.2, c & 10000., 3.9, 20000., 4.8, 25000., 5.2, 60000., 5.55, c & 1.e20, 5.95/ c 1977 data tab77/1.6d0,2.2d0,3.3d0, 4.4d0, 5.5d0, 6.6d0, 7.7d0, & 3*8.8d0,9.3d0,9.9d0,12.1d0,13.2d0,15.4d0,16.5d0, 19.8d0/ c 1979 data tab79/1.5d0 , 2.1d0, 3.15d0, 4.3d0, 5.35d0, 6.4d0 , & 7.45d0, 8.4d0, 8.5d0 , 8.6d0, 9.05d0, 9.65d0, & 11.55d0,12.8d0,14.45d0,15.5d0,16.65d0/ c 1980 data tab80/1.4d0, 2.0d0,3.0d0,4.2d0,5.2d0, 6.2d0, 7.2d0, & 8.0d0, 8.2d0,8.4d0,8.8d0,9.4d0,11.0d0,12.2d0, & 3*13.5d0/ c 1985 c data tab85/1.3d0,1.8d0,2.6d0,3.8d0,4.7d0,5.6d0, 6.5d0, c & 7.2d0,7.4d0,7.6d0,7.9d0,8.5d0,9.9d0,11.0d0, c & 3*12.2d0/ c 1985 data tab85/1.3d0,1.8d0,2.6d0,3.8d0,4.7d0,5.6d0, 6.5d0, & 7.2d0,7.4d0,7.6d0,7.9d0,8.5d0,9.9d0, & 4*10.7d0/ c 1986 data tab86/1.2d0,1.6d0,2.4d0,3.5d0,4.3d0,5.1d0, 5.9d0, & 6.6d0,6.7d0,6.9d0,7.2d0,7.7d0,9.0d0,4*9.7d0/ c 1987 data tab87/1.0d0,1.4d0,2.2d0,3.2d0,3.9d0,4.6d0, 5.4d0, & 6.0d0,6.1d0,6.3d0,6.5d0,7.0d0,8.2d0,4*8.8d0/ c 1988 data tab88/2*0.0d0,3.1d0,2*3.2d0,3*5.0d0,2*6.0d0, & 6.6d0,7.0d0, 7.6d0,4*7.7d0/ c 1996 data tab96/0.0d0,0.0d0 , 3.1d0,2*3.2d0,3*5.0d0,2*6.0d0, & 6.4d0,6.66d0, 7.1d0,4*7.1d0/ c 1998 data tab98 / 3000.0d0, 3.10d0, 8000.0d0, 4.860d0, & 18000.0d0, 5.80d0, 23000.0d0, 6.20d0,28000.0d0, 6.440d0, & 1.e20, 6.90d0/ c 1999 data tab99 / 1000.0d0, 2.50d0, 3000.0d0, 2.60d0, 8000.0d0, & 4.30d0, 18000.0d0, 5.20d0, 23000.0d0, 5.60d0, 58000.0d0, & 5.950d0,1.e20, 6.40d0/ c 2000 data tab00 / 3000.0d0, 2.20d0, 8000.0d0, 3.90d0,18000.0d0, & 4.80d0, 23000.0d0, 5.20d0, 58000.0d0, 5.550d0, 1.e20, 5.950d0/ c 2009-2011 data tab09 / 2000.0d0, 0.0d0, 5000.0d0, 2.20d0,10000.0d0, & 3.90d0, 20000.0d0, 4.80d0, 25000.0d0, 5.20d0,60000.0d0, & 5.550d0,1.e20, 6.950d0/ c 2012-2013 data tab12 / 2000.0d0, 0.0d0, 5000.0d0, 2.20d0,10000.0d0, & 3.90d0, 20000.0d0, 4.80d0, 25000.0d0, 5.20d0,60000.0d0, & 5.550d0,1.e20, 6.750d0/ c 2014+ data tab14 / 2000.0d0, 0.0d0, 5000.0d0, 2.20d0,10000.0d0, & 3.90d0, 20000.0d0, 4.80d0, 25000.0d0, 5.20d0,60000.0d0, & 5.550d0,1.e20, 6.60d0/ data xmp/8*600.0d0,800.0d0,2*1000.0d0,8*1250.0d0,21*0.0d0, & 11*1.0d0,29*0.0d0, & 10*0.0d0,2*.250d0,28*.50d0/ data ded/10*.20d0/ do 20 i=1,17 if(law.eq.1977.or.law.eq.1978) tab(2,i)=tab77(i) if(law.eq.1979) tab(2,i)=tab79(i) if(law.ge.1980.and.law.le.1984) tab(2,i)=tab80(i) if(law.eq.1985) tab(2,i)=tab85(i) if(law.eq.1986) tab(2,i)=tab86(i) if(law.eq.1987) tab(2,i)=tab87(i) if(law.ge.1988.and.law.le.1995) tab(2,i)=tab88(i) if(law.eq.1996) tab(2,i)=tab96(i) 20 continue rt=0. mst = data(2) phas92=100000./data(3) if(law.ge.1992.and.law.le.2012)phas92=100000.*aif92(law)/data(3) if(law.ge.2013) & phas92 = aif13(law)*250000*filing(mst,1.,1.2,1.1,.6) c AGI c can't add fed tax refund or subtract interest on US obligations c adjustment for poor and elderly/can't calculate for disabled agi=comnew(2) c Social Security Benefits and State Tax refund are not taxable agi=agi-comnew(79)-data(22) texp=data(7) bexp=data(9)+data(10) penson=data(20)+data(72) penexc = 0. if(data(9).lt.1.) then c under 60 pnsion exclusion (line 34 in 2006) penexc = min(data(7)*2000.0d0,penson) else if(data(9).eq.1) then penexc = min(pns(law),penson+.5*(data(14)+data(12)+ & max(0.0d0,comnew(6))+ & max(0.0d0,data(73)))) c 60 or over pension exclusion (line 34 in 2006) else penexc = min(2*pns(law),penson+data(14)+data(12)+ & max(0.0d0,comnew(6))+ max(0.0d0,data(73))) endif penexc = max(0.0d0,penexc) agi = agi - penexc c exclusion for those 60 and over (line 39 in 2006) if(law.ge.1984.and.data(9).gt.0.and.comnew(37).lt.2500*data(9) &.and.agi.le.10000*data(9)) agi= agi - 2000.*data(9) c DEDUCTIONS c when 1987 data is in use; after 1988 separate filers are allowed c different passive real estate losses than fed mst=data(2) if(law.le.1987) then stded=min(data(7)*1000./data(3),.1*max(0.0d0,agi)) else if(law.ge.1988.and.law.le.1998) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.5.or.mst.eq.7) then stded=1300. else stded=(1600./data(3)) endif else if(law.eq.1999) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.5.or.mst.eq.7) then stded=3250. else stded=(4000./data(3)) endif else if(law.ge.2000) then stded = 3250. * data(7) endif c additional standard deduction for old people or blind if(law.ge.1987.and.law.le.1998) then stded=stded+(bexp*1000.) elseif (law.ge.1999) then stded=stded+(bexp*2500.) endif c Itemized deductions xitded = max(0.0d0,comnew(30)-data(50)) if(law.ge.1981) xitded = xitded+data(34) if(law.le.1986) then ylimi = ded(law) char = data(58)+data(59)+data(60) xitded = xitded-max(char-ylimi*max(0.0d0,agi),0.0d0) endif if(law.eq.1987) xitded = xitded * 1.12 if(agi.gt.phas92.and.law.ge.1991) then reduce = min(.8*xitded,.03*(agi-phas92)) if(law.eq.2006.or.law.eq.2007) reduce = 2*reduce/3 if(law.eq.2008.or.law.eq.2009) reduce = reduce/3 if(law.ge.2010.and.law.le.2012) reduce = 0 xitded = xitded-reduce endif ided = data(4) if(ided.eq.-2.and.law.eq.1999) xitded=0 deduc = max(stded,xitded) c A taxpayer can elect to use the standard deduction even he uses c itemized deductions in the Federal law. c EXEMPTIONS num=comnew(68) if(law.eq.1989)num=num+data(9) exemp = 0. if(law.le.1987) then exemp=(num*xmp(law,1))+twn(comnew(1),0.0d0,300.*texp) c since 1996 only personal exemption credit exists, no exemptions else if(law.ge.1988.and.law.le.1995) then exemp=(num*xmp(law,1)) endif taxinc = max(0.0d0,agi - deduc - exemp) c According to the Tax Table, taxes for taxable income 0-$2000 are 0 c for all income levels if(law.ge.1997.and.law.le.2008) taxinc = max(0.0d0,taxinc - 2000) if(mst.eq.2.and.agi.gt.0) then agih = max(data(85),data(86))+.5*(agi - data(11)) agiw = agi-agih c xitdh = xitded*agih/agi c xitdw = xitded-xitdh c dedh = max(.5*stded,xitdh) c dedw = max(.5*stded,xitdw) dedh = deduc*agih/agi dedw = deduc - dedh taxinh=max(0.0d0,agih-dedh-.5*exemp) taxinw=max(0.0d0,agiw-dedw-.5*exemp) if(law.ge.1997.and.law.le.2008) then taxinh=max(0.0d0,taxinh- 2000.) taxinw=max(0.0d0,taxinw -2000.) endif endif if(law.le.1996) then call look(tab,taxinc,17,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.2.and.agi.gt.0) then call look(tab,taxinh,17,n,stath,1.0d00,0.0d0,rt,data) call look(tab,taxinw,17,n,statw,1.0d00,0.0d0,rt,data) statax = min(statax,stath+statw) endif else if(law.eq.1997.or.law.eq.1998) then call look(tab98,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) if(mst.eq.2.and.agi.gt.0) then call look(tab98,taxinh,6,n,stath,1.0d0,0.0d0,rt,data) call look(tab98,taxinw,6,n,statw,1.0d0,0.0d0,rt,data) statax = min(statax,stath+statw) endif else if(law.eq.1999) then call look(tab99,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) if(mst.eq.2.and.agi.gt.0) then call look(tab99,taxinh,7,n,stath,1.0d0,0.0d0,rt,data) call look(tab99,taxinw,7,n,statw,1.0d0,0.0d0,rt,data) statax = min(statax,stath+statw) endif else if(law.ge.2000.and.law.le.2008) then call look(tab00,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) if(mst.eq.2.and.agi.gt.0) then call look(tab00,taxinh,6,n,stath,1.0d0,0.0d0,rt,data) call look(tab00,taxinw,6,n,statw,1.0d0,0.0d0,rt,data) statax = min(statax,stath+statw) endif else if(law.ge.2009.and.law.le.2011) then call look(tab09,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) if(mst.eq.2.and.agi.gt.0) then call look(tab09,taxinh,7,n,stath,1.0d0,0.0d0,rt,data) call look(tab09,taxinw,7,n,statw,1.0d0,0.0d0,rt,data) statax = min(statax,stath+statw) endif else if(law.ge.2012.and.law.le.2013) then call look(tab12,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) if(mst.eq.2.and.agi.gt.0) then call look(tab12,taxinh,7,n,stath,1.0d0,0.0d0,rt,data) call look(tab12,taxinw,7,n,statw,1.0d0,0.0d0,rt,data) statax = min(statax,stath+statw) endif else if(law.ge.2014) then call look(tab14,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) if(mst.eq.2.and.agi.gt.0) then call look(tab14,taxinh,7,n,stath,1.0d0,0.0d0,rt,data) call look(tab14,taxinw,7,n,statw,1.0d0,0.0d0,rt,data) statax = min(statax,stath+statw) endif endif c Child Care Credit since 1987 chcr=comnew(53)*xmp(law,3) if(law.ge.1999) chcr = min(chcr,chlim(law)) cred = 0. if(law.ge.1977)cred = min(5.*data(38),200.0d0) c- since-1996-personal exemption credit---- pecred = 0. if(law.ge.1996.and.law.le.1999) then pecred = (num + data(9))*100. else if(law.ge.2000) then pecred = (num + data(9))*110. endif c since 2006, EITC - non-refundable earncr = 0. if(law.ge.2006) earncr = .2*comnew(59) credit = chcr + cred + pecred + earncr statax=max(0.0d0,statax-credit) return end c c DISTRICT OF COLUMBIA c State 9 c Status: Updated through 2016 subroutine dctax(data,comnew, statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common/times/zitem,ptax,txrate,h dimension prop1(2,7), prop2(2,5), xtra(1987:2016) dimension ylowj(0:4,1987:2016),xmp(1977:2016) dimension ylows(0:2,1987:2016), ylowh(0:2,1987:2016) dimension data(255),comnew(255),aif92(1992:2012) dimension tab77(2,10), tab87(2,3), tab88(2,3) &,tab00(2,3),tab01(2,3),tab05(2,3),tab06(2,3),tab07(2,3),tab12(2,4) &,tab15(2,5),tab16(2,6) dimension crmax(2015:2016),amax(2015:2016),ymax(2015:2016) dimension prop(2014:2016) integer dx2 data crmax / 503.d0, 506.d0/ data amax /24040.d0,24254.d0/ data ymax /18111.d0,18292.d0/ data prop /2*40000.d0,50000.d0/ data tab77 / 1000.0d0, 2.0d0, 2000.0d0, 3.0d0, 3000.0d0, 4.0d0, & 4000.0d0, 5.0d0, & 5000.0d0, 6.0d0, 10000.0d0, 7.0d0, 13000.0d0, 8.0d0, 17000.0d0, & 9.0d0, 25000.0d0, 10.0d0, & 1.e20, 11.0d0/ data tab87/ 10000.0d0, 6.0d0, 20000.0d0, 8.0d0, 1.e20, 10.0d0/ data tab88/ 10000.0d0, 6.0d0, 20000.0d0, 8.0d0, 1.e20, 9.50d0/ data tab00/ 10000.0d0, 5.0d0, 20000.0d0, 7.5d0, 1.e20, 9.50d0/ data tab01/ 10000.0d0, 5.0d0, 30000.0d0, 7.5d0, 1.e20, 9.30d0/ data tab05/ 10000.0d0, 5.0d0, 30000.0d0, 7.5d0, 1.e20, 9.00d0/ data tab06/ 10000.0d0, 4.5d0, 40000.0d0, 7.0d0, 1.e20, 8.70d0/ data tab07/ 10000.0d0, 4.0d0, 40000.0d0, 6.0d0, 1.e20, 8.50d0/ data tab12/ 10000.0d0, 4.0d0, 40000.0d0, 6.0d0, & 350000.0d0, 8.5d0, 1.e20, 8.95d0/ data tab15/ 10000.0d0, 4.0d0, 40000.0d0, 6.0d0, 60000.0d0, 7.0d0, & 350000.0d0, 8.5d0, 1.e20, 8.95d0/ data tab16/ 10000.0d0, 4.0d0, 40000.0d0, 6.0d0, 60000.0d0, 6.5d0, & 350000.0d0, 8.5d0, 1.e6, 8.75d0, 1.e20, 8.95d0/ data aif92/ & 1.0525d0, 1.0845d0, 1.118d0 , 1.147d0 , 1.1795d0, 1.212d0, & 1.2450d0, 1.2660d0, 1.2895d0, 1.3295d0, 1.3730d0, 1.395d0, & 1.4270d0, 1.4595d0, 1.5050d0, 1.5640d0, 1.5995d0, 1.668d0, & 2*1.6955d0, 1.7365d0/ data xmp/ & 10*750.0d0, 885.0d0, 1025.0d0, 1160.0d0, 1270.0d0,15*1370.0d0, & 2*1500.0d0,6*1675.d0, 1725.0d0, 2*1775.0d0/ data prop1 / & 3000.0d0, .015d0, 5000.0d0, .02d0 , 7000.0d0, .025d0, & 10000.0d0, .030d0,15000.0d0, .035d0, 20000.0d0, .040d0, & 1.e20,1.0d0/ data prop2 / & 5000.0d0, .010d0, 10000.0d0, .015d0, 15000.0d0,.020d0, & 20000.0d0, .025d0, 1.e20,1.0d0/ c starting points for low income credit c low income credit numbers for 1998 are only guessed data ylowj/ & 227.4d0,284.7d0,267.6d0,250.5d0,233.40d0,293.0d0,266.0d0, & 242.0d0,215.0d0,191.0d0,293.0d0,260.0d0,227.0d0,194.0d0, & 158.0d0,302.0d0,263.0d0,227.0d0,191.0d0,152.0d0, & 317.0d0,272.0d0,230.0d0,188.0d0,143.0d0,353.0d0,311.0d0, & 272.0d0,233.0d0,191.0d0,371.0d0,329.0d0,290.0d0,251.0d0, & 209.0d0,392.0d0,353.0d0,317.0d0,281.0d0,242.0d0,410.0d0, & 371.0d0,335.0d0,299.0d0,260.0d0,425.0d0,389.0d0,356.0d0, & 323.0d0,287.0d0,449.0d0,413.0d0,380.0d0,347.0d0,311.0d0, & 455.0d0, 430.0d0, 397.0d0, 366.0d0, 332.0d0, & 479.0d0, 446.0d0, 415.0d0, 386.0d0, 353.0d0, & 411.0d0, 384.0d0, 359.0d0, 334.0d0, 306.0d0, & 434.0d0, 409.0d0, 386.0d0, 364.0d0, 339.0d0, & 434.0d0, 409.0d0, 386.0d0, 364.0d0, 339.0d0, & 566.0d0, 532.0d0, 502.0d0, 481.0d0, 459.0d0, & 566.0d0, 532.0d0, 502.0d0, 481.0d0, 459.0d0, & 626.0d0, 596.0d0, 569.0d0, 543.0d0, 513.0d0, & 550.0d0, 515.0d0, 480.0d0, 447.0d0, 424.0d0, & 520.0d0, 493.0d0, 466.0d0, 439.0d0, 412.0d0, & 435.0d0, 397.0d0, 373.0d0, 347.0d0, 323.0d0, & 481.0d0, 447.0d0, 412.0d0, 386.0d0, 363.0d0, & 483.0d0, 447.0d0, 414.0d0, 385.0d0, 363.0d0, & 495.0d0, 459.0d0, 426.0d0, 393.0d0, 371.0d0, & 531.0d0, 498.0d0, 468.0d0, 435.0d0, 405.0d0, & 555.0d0, 525.0d0, 498.0d0, 468.0d0, 441.0d0, & 355.0d0, 321.0d0, 301.0d0, 279.0d0, 258.0d0, & 349.0d0, 327.0d0, 307.0d0, 285.0d0, 265.0d0, & 353.0d0, 331.0d0, 311.0d0, 289.0d0, 269.0d0/ data ylows/93.30d0,112.8d0,104.70d0,116.0d0,101.0d0, 83.0d0, & 116.0d0, 92.00d0, 68.0d0, 122.0d0, 95.0d0, 65.0d0, & 131.0d0, 101.0d0, 68.0d0, 152.0d0, 125.0d0, 95.0d0, & 161.0d0, 134.0d0, 104.0d0, 173.0d0, 149.0d0, 122.0d0, & 182.0d0, 158.0d0, 131.0d0, 191.0d0, 170.0d0, 146.0d0, & 206.0d0, 185.0d0, 161.0d0, 211.0d0, 181.0d0, 164.0d0, & 221.0d0, 203.0d0, 182.0d0, 191.0d0, 179.0d0, 164.0d0, & 204.0d0, 191.0d0, 176.0d0, 204.0d0, 191.0d0, 176.0d0, & 221.0d0, 211.0d0, 199.0d0, 221.0d0, 211.0d0, 199.0d0, & 241.0d0, 236.0d0, 229.0d0, 201.0d0, 190.0d0, 179.0d0, & 183.0d0, 182.0d0, 174.0d0, 131.0d0, 119.0d0, 105.0d0, & 148.0d0, 137.0d0, 126.0d0, 147.0d0, 137.0d0, 125.0d0, & 151.0d0, 141.0d0, 129.0d0, 163.0d0, 155.0d0, 145.0d0, & 169.0d0, 163.0d0, 155.0d0, 171.0d0, 165.0d0, 157.00d0, & 133.0d0, 125.0d0, 115.0d0, 133.0d0, 127.0d0, 117.0d0/ data ylowh/40.2d0,143.7d0,135.6d0,140.0d0,122.0d0,107.0d0, & 134.0d0, 110.0d0, 86.0d0, 137.0d0, 107.0d0, 80.0d0, & 146.0d0, 113.0d0, 83.0d0, 170.0d0, 140.0d0, 113.0d0, & 185.0d0, 155.0d0,128.0d0, 200.0d0, 173.0d0, 149.0d0, & 212.0d0, 185.0d0,161.0d0, 224.0d0, 200.0d0, 179.0d0, & 239.0d0, 215.0d0,194.0d0, 248.0d0, 218.0d0, 200.0d0, & 263.0d0, 242.0d0,224.0d0, 226.0d0, 211.0d0, 199.0d0, & 241.0d0, 226.0d0,214.0d0, 241.0d0, 226.0d0, 214.0d0, & 266.0d0, 254.0d0,244.0d0, 266.0d0, 254.0d0, 244.0d0, & 289.0d0, 281.0d0,276.0d0, 242.0d0, 231.0d0, 219.0d0, & 230.0d0, 222.0d0,214.0d0, 167.0d0, 153.0d0, 141.0d0, & 187.0d0, 176.0d0,165.0d0, 189.0d0, 177.0d0, 167.0d0, & 195.0d0, 183.0d0,173.0d0, 207.0d0, 197.0d0, 189.0d0, & 217.0d0, 209.0d0,203.0d0, 219.0d0, 211.0d0, 205.0d0, & 129.0d0, 119.0d0,111.0d0, 133.0d0, 123.0d0, 115.0d0/ c ylowrt for 1989 should be 51 data xtra/ 60.9d0, 54.0d0, 51.0d0, 45.0d0, 48.0d0, 57.0d0, & 57.0d0, 63.0d0, 69.0d0, 72.0d0, 78.0d0, 85.0d0, & 86.0d0, 84.0d0, 2*77.0d0,2*85.0d0, 93.0d0, 81.0d0, & 114.0d0,2*119.0d0,2*120.0d0,126.0d0,3*109.0d0,92.0d0/ rt=0. mst = data(2) sep = data(3) C AGI if(law.le.1981) then addit=divexc(data,comnew,law)+comnew(12)+comnew(14)+data(30) subtra=comnew(78)+data(22)+data(26) agi=comnew(2)+addit-subtra else agi=comnew(2)-data(22) if(law.ge.1982.and.law.le.1986) agi = agi + comnew(32) if(law.ge.1984)agi=agi-comnew(79) c government employee pension exclusion c (TaxSim does not use this exclusion if a pension is c specifically from government) c if(law.ge.1986) agi = agi - min(3000.*data(9),data(72)+data(20)) endif c Standard Deduction if(law.le.1981) then stded = twn(.1*agi,0.0d0,1000/sep) else if(law.ge.1982.and.law.le.1986) then stded = 1000/sep else if(law.ge.1987.and.law.le.2005) then stded = 2000/sep else if(law.eq.2006.or.law.eq.2007) then stded = 2500/sep else if(law.eq.2008.or.law.eq.2009) then stded = 4000/sep + min(data(51),data(7)*500.) else if(law.ge.2010.and.law.le.2012) then stded = 4000/sep else if(law.eq.2013) then stded = 4100/sep else if(law.eq.2014) then stded = 4150/sep else if(law.ge.2015) then if(mst.eq.2.or.mst.eq.5) then stded = 8350. else if(mst.eq.4.or.mst.eq.7) then stded = 6500. else stded = 5200. endif endif c Itemized Deductions xitded = 0. if(comnew(26).gt.0..and.comnew(30).gt.0) then if(law.le.1981) then xitded=comnew(24)-max(comnew(23)-.15*max(agi,0.0d0),0.0d0) & -data(60)-data(65) else xitded=max(0.0d0,comnew(24)-data(50)*comnew(24)/comnew(30)) endif endif c Taxpayer MUST itemize deductions if he itemized on his Fed Return ided = data(4) if(ided.eq.-2.and.law.eq.1999) xitded=0 deduc = max(xitded,stded) c Exemptions c exemptions equal to exemptions of irs code with modifications amnt=xmp(law) exemp=(data(7)+data(8)+data(9)+data(10))*amnt if(mst.eq.4.or.mst.eq.7)exemp= exemp+ amnt c 2015+ Exemption phaseout if(law.ge.2015) then exmphl = 150000. ratio = min(1.0d0,.02*max(0.0d0,agi-exmphl)/(2500/sep)) amphs = ratio * exemp exemp = exemp - amphs endif c Taxable Income taxinc=max(0.0d0,agi-deduc-exemp) if(law.le.1986) then call look(tab77,taxinc,10,n,statax,1.0d0,0.0d0,rt,data) else if(law.eq.1987) then call look(tab87,taxinc,3,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.1988.and.law.le.1999) then call look(tab88,taxinc,3,n,statax,1.0d0,0.0d0,rt,data) else if(law.eq.2000) then call look(tab00,taxinc,3,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2001.and.law.le.2004) then call look(tab01,taxinc,3,n,statax,1.0d0,0.0d0,rt,data) else if(law.eq.2005) then call look(tab05,taxinc,3,n,statax,1.0d0,0.0d0,rt,data) else if(law.eq.2006) then call look(tab06,taxinc,3,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2007.and.law.le.2011) then call look(tab07,taxinc,3,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2012.and.law.le.2014) then call look(tab12,taxinc,4,n,statax,1.0d0,0.0d0,rt,data) else if(law.eq.2015) then call look(tab15,taxinc,5,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2016) then call look(tab16,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) endif if(mst.eq.2.and.agi.gt.0) then agih = max(data(85),data(86)) + (agi-data(11))/2. agiw = agi-agih exemph=exemp*agih/agi exempw=exemp-exemph stdedh=stded*agih/agi stdedw=stded - stdedh xitdh= xitded*agih/agi xitdw= xitded-xitdh call dcstax(law,agih,agiw,stdedh,stdedw,exemph,exempw,taxst,data) call dcstax(law,agih,agiw,xitdh,xitdw,exemph,exempw,taxit,data) statax = min(statax,taxit,taxst) endif c Credits credit = 0. c Credit for D.C. campaign contributions through 1988 polcr=0. if(law.le.1982) then polcr=twn(.5*comnew(25),0.0d0,25.*data(7)) elseif(law.ge.1983.and.law.le.1988) then polcr=twn(.5*comnew(25),0.0d0,50.*data(7)) endif c Credit for child care expenses 6% of employment related expenses c for years ..-1980, c 30% of the credit allowed on the Federal form for 1981-1988 c 32% of the credit allowed on the Federal form for 1989-1999 chcr = 0. c if(law.le.1981) chcr = .06*comnew(76) if(law.ge.1982.and.law.le.1988) then chcr = comnew(176)*.3 else chcr = comnew(176)*.32 endif c refund credit property tax credit pcred = 0. ptax = 0. nqu = 0 if(mst.eq.2.and.data(9)+data(10).gt.1.d0) nqu = 1 if(mst.ne.2.and.data(9)+data(10).gt.0.d0) nqu = 1 if(law.le.2013.and.hy.le.20000) then ptax=max(.15*data(160),data(51)) if(nqu.gt.0) then c pcred=max(0.0d0, c & (ptax-tablki(prop2,5,hy,data)*hy)) c to avoid notches we interpolate % of household income pcred = max(0.0d0,ptax - hy*(1 + hy/20000)/100) else if(ngu.eq.0) then c pcred=max(0.0d0, c & (ptax-tablki(prop1,7,data(159),data)*data(159))) pcred = max(0.0d0,ptax - hy*(1.5 + hy/8000)/100) if(hy.lt.3000) then pcred=.95*pcred else pcred=.75*pcred endif endif pcred = min(750.0d0,pcred) else if(law.ge.2014) then ptax=max(.2*data(160),data(51)) agix = max(0.0d0,comnew(2)) if((nqu.eq.1.and.agix.le.60000.0d0).or. & (nqu.eq.0.and.agix.lt.25000.0d0)) & pcred = max(0.0d0,ptax - .03*agix) if(nqu.eq.0.and.agix.ge.25000.0d0.and.agix.le.prop(law)) & pcred = max(0.0d0,ptax - .04*agix) pcred = min(1000.0d0,pcred) endif c low income tax credit in DC since 1987 ycr = 0. if(comnew(52).eq.0.and.law.ge.1987.and.data(105).lt.1) then allow = data(8)+data(10)+data(9) dx2 = data(9)+data(10) if(mst.ne.2) dx2 = min(data(9)+data(10),2.0d0) if(mst.eq.2.or.mst.eq.3.or.mst.eq.6) then ycr = ylowj(dx2,law)/sep ycr = ycr + xtra(law)*allow else if(mst.eq.1) then c Low Income Credit for Single Taxpayers ycr = ylows(dx2,law) + xtra(law)*allow else ycr = ylowh(dx2,law) + xtra(law)*allow endif else if(comnew(52).eq.0.and.law.ge.1987. &and.comnew(3)-stded.gt.0.and.data(105).gt.0) then if(law.eq.1987) then call look(tab87,comnew(3)-stded,3,n,ycr,1.0d00,-data(2),rt,data) else if(law.ge.1988.and.law.le.1999) then call look(tab88,comnew(3)-stded,3,n,ycr,1.0d00,-data(2),rt,data) else if(law.ge.2000) then call look(tab00,comnew(3)-stded,3,n,ycr,1.0d00,-data(2),rt,data) else if(law.ge.2001.and.law.le.2004) then call look(tab01,comnew(3)-stded,3,n,ycr,1.0d0,-data(2),rt,data) else if(law.eq.2005) then call look(tab05,comnew(3)-stded,3,n,ycr,1.0d0,-data(2),rt,data) else if(law.eq.2006) then call look(tab06,comnew(3)-stded,3,n,ycr,1.0d0,-data(2),rt,data) else if(law.ge.2007.and.law.le.2011) then call look(tab07,comnew(3)-stded,3,n,ycr,1.0d0,-data(2),rt,data) else if(law.ge.2012.and.law.le.2014) then call look(tab12,comnew(3)-stded,4,n,ycr,1.0d0,-data(2),rt,data) else if(law.eq.2015) then call look(tab15,comnew(3)-stded,5,n,ycr,1.0d0,-data(2),rt,data) else if(law.ge.2016) then call look(tab16,comnew(3)-stded,6,n,ycr,1.0d0,-data(2),rt,data) endif endif c Calculation of eligibility of the low income credit if(agi.ge.comnew(3)+comnew(83)) ycr = 0 credit = credit + chcr + polcr statax=max(0.0d0,statax-credit) stat1 =max(0.0d0,statax-ycr) c New in 2000 + earned income credit earncr = 0 earned = comnew(37) agimax = max(earned,comnew(2)) if(law.eq.2000) earncr = .1*comnew(59) if(law.ge.2001.and.law.le.2004) earncr = .25*comnew(59) if(law.ge.2005.and.law.le.2007) earncr = .35*comnew(59) if(law.ge.2008.and.law.le.2014) earncr = .4*comnew(59) if(law.ge.2015.and.data(8).gt.0.d0) earncr = .4*comnew(59) c 2015+ special rule for childless people if(law.ge.2015.and.data(8).lt.1.d0) then am = amax(law) cr = crmax(law) ym = ymax(law) if(agimax.le.am) & earncr = min(cr,.0765*earned)-.0848*max(0.0d0,agimax - ym) endif stat2 = statax - earncr c Taxpayer may not claim both the Low Income Credit and the EITC. statax = min(stat1,stat2) if(statax.eq.stat1) then credit = credit + ycr + pcred else if (statax.eq.stat2) then credit = credit + earncr + pcred endif c Property tax credit is a refund statax = statax - pcred return end subroutine dcstax(law,agih,agiw,dedh,dedw,exemph,exempw,tax,data) implicit double precision (A-H,O-Z) dimension tab77(2,10),tab87(2,3),tab88(2,3),tab08(2,3),tab12(2,4), &tab00(2,3),tab01(2,3),tab05(2,3),tab06(2,3),tab07(2,3),tab15(2,5), &data(255),tab16(2,6) data tab77 / 1000.0d0, 2.0d0, 2000.0d0, 3.0d0, 3000.0d0, 4.0d0, & 4000.0d0, 5.0d0, 5000.0d0, 6.0d0, 10000.0d0, 7.0d0, & 13000.0d0, 8.0d0, 17000.0d0, 9.0d0, 25000.0d0,10.0d0, & 1.e20,11.0d0/ data tab87/ 10000.0d0, 6.0d0, 20000.0d0, 8.0d0, 1.e20, 10.0d0/ data tab88/ 10000.0d0, 6.0d0, 20000.0d0, 8.0d0, 1.e20, 9.5d0/ data tab00/ 10000.0d0, 5.0d0, 20000.0d0, 7.5d0, 1.e20, 9.5d0/ data tab01/ 10000.0d0, 5.0d0, 30000.0d0, 7.5d0, 1.e20, 9.3d0/ data tab05/ 10000.0d0, 5.0d0, 30000.0d0, 7.5d0, 1.e20, 9.0d0/ data tab06/ 10000.0d0, 4.5d0, 40000.0d0, 7.0d0, 1.e20, 8.7d0/ data tab07/ 10000.0d0, 4.5d0, 40000.0d0, 7.0d0, 1.e20, 8.5d0/ data tab08/ 10000.0d0, 4.0d0, 40000.0d0, 6.0d0, 1.e20, 8.5d0/ data tab12/ 10000.0d0, 4.0d0, 40000.0d0, 6.0d0, & 350000.0d0, 8.5d0, 1.e20, 8.95d0/ data tab15/ 10000.0d0, 4.0d0, 40000.0d0, 6.0d0, 60000.0d0, 7.0d0, & 350000.0d0, 8.5d0, 1.e20, 8.95d0/ data tab16/ 10000.0d0, 4.0d0, 40000.0d0, 6.0d0, 60000.0d0, 6.5d0, & 350000.0d0, 8.5d0, 1.e6, 8.75d0, 1.e20, 8.95d0/ taxyh=max(0.0d0,agih-dedh-exemph) taxyw=max(0.0d0,agiw-dedw-exempw) if(law.le.1986) then call look2(tab77,taxyh,10,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab77,taxyw,10,n,taxw,1.0d0,0.0d0,rt,data) else if(law.eq.1987) then call look2(tab87,taxyh,3,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab87,taxyw,3,n,taxw,1.0d0,0.0d0,rt,data) else if(law.ge.1988.and.law.le.1999) then call look2(tab88,taxyh,3,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab88,taxyw,3,n,taxw,1.0d0,0.0d0,rt,data) else if(law.eq.2000) then call look2(tab00,taxyh,3,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab00,taxyw,3,n,taxw,1.0d0,0.0d0,rt,data) else if(law.ge.2001.and.law.le.2004) then call look2(tab01,taxyh,3,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab01,taxyw,3,n,taxw,1.0d0,0.0d0,rt,data) else if(law.eq.2005) then call look2(tab05,taxyh,3,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab05,taxyw,3,n,taxw,1.0d0,0.0d0,rt,data) else if(law.eq.2006) then call look2(tab06,taxyh,3,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab06,taxyw,3,n,taxw,1.0d0,0.0d0,rt,data) else if(law.eq.2007) then call look2(tab07,taxyh,3,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab07,taxyw,3,n,taxw,1.0d0,0.0d0,rt,data) else if(law.ge.2008.and.law.le.2011) then call look2(tab08,taxyh,3,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab08,taxyw,3,n,taxw,1.0d0,0.0d0,rt,data) else if(law.ge.2012.and.law.le.2014) then call look2(tab12,taxyh,4,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab12,taxyw,4,n,taxw,1.0d0,0.0d0,rt,data) else if(law.eq.2015) then call look2(tab15,taxyh,5,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab15,taxyw,5,n,taxw,1.0d0,0.0d0,rt,data) else if(law.ge.2016) then call look2(tab16,taxyh,6,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab16,taxyw,6,n,taxw,1.0d0,0.0d0,rt,data) endif tax=taxh+taxw return end c Georgia c State 11 c Updated through 2016 c subroutine gatax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255) dimension tabs(2,6),tabm(2,6),gmp(7),fmp(7),rtmax(1977:2016) dimension xmp(1977:2016) double precision lic(5,2) data lic/6000.0d0,8000.0d0,10000.0d0,15000.0d0,20000.0d0, & 26.0d0, 20.0d0, 14.0d0, 8.0d0, 5.0d0/ data tabs/ 750.0d0, 1.0d0, 2250.0d0, 2.0d0, 3750.0d0, & 3.0d0, 5250.0d0, 4.0d0, 7000.0d0, 5.0d0, 1.e20, 6.0d0/ data tabm/ 1000.0d0, 1.0d0, 3000.0d0, 2.0d0, 5000.0d0, & 3.0d0, 7000.0d0, 4.0d0, 10000.0d0, 5.0d0, 1.e20, 6.0d0/ c Georgia unemployment income limits data gmp/ 20000.0d0, 25000.0d0, 3*20000.0d0, 0.0d0, 20000.0d0/ c Federal unemployment income limits data fmp/ 12000.0d0, 18000.0d0, 3*20000.0d0, 0.0d0, 12000.0d0/ c Retirement exclusion data rtmax/ 5*0.0d0, 4*2000.0d0, 3*4000.0d0,4*8000.0d0, & 10000.0d0,11000.0d0,4*12000.0d0, & 13000.0d0,13500.0d0,14000.0d0,14500.0d0,3*15000.0d0,25000.0d0, & 30000.0d0,4*35000.0d0,5*65000.0d0/ c exemptions for dependents, age and blindness,& + for hohs w/ deps data xmp/10*700.0d0, 7*1500.0d0, 2000.0d0,3*2500.0d0,19*2700.0d0/ rt=0. mst = data(2) sep=data(3) nfile = int(filing(mst,1.,2.,3.,2.)) c AGI agi=comnew(2) c if(law.le.1986)agi=agi-data(22) agi=agi-data(22) c for years 1982-1986 (inclusive) Georgia used 1981 federal law if(law.ge.1982.and.law.le.1986) then stira=min(max(data(29)-(comnew(11)-500.),0.0d0),500.0d0) stklim=min(data(28),7500.0d0) if(law.eq.1985.or.law.eq.1986)stklim=min(stklim,.15*comnew(37)) stkeo=max(comnew(14)-stklim,0.0d0) agi=agi+stira+stkeo agi=agi+comnew(32) if(law.eq.1982) then agi=agi-twn(data(13),0.0d0,200/sep) endif gemp=gmp(mst) femp=fmp(mst) stutx=min(.5*max(data(82)+agi-gemp,0.0d0),data(82)) fdutx=min(.5*max(data(82)+agi-femp,0.0d0),data(82)) agi=agi+(stutx-fdutx) if(data(9).gt.0) then if(data(71).ge.(100000/sep)) then glim=(25000/data(3)) flim=data(71)-(100000/sep) agi=agi+twn(flim,0.0d0,glim) endif endif endif old=data(9)+data(10) rtexc=0. if(old.gt.0) then rtexc = max(0.0d0,min(comnew(2),rtmax(law)*old)) if(law.ge.1986.and.law.le.1988) then if(comnew(37).gt.(1200.*data(7))) rtexc=0. endif c Retirement Income Exclusion if(law.ge.1989.and.data(9).gt.0) then rhy = max(0.0d0,data(14)+data(12)+data(23)+ & data(20)+ data(72)+ comnew(8)+data(24)) if(comnew(6).ge.0) then rhy = rhy + comnew(6) else rhy = rhy +.5*comnew(6) endif if(data(7).lt.2.and.data(7).gt.0) then rter=min(comnew(37),4000.0d0) rtexc=min(rtmax(law),rter+rhy) elseif (data(7).gt.1) then hearn = max(data(85),data(86)) + .5*max(0.0d0,data(17)) wearn = min(data(85),data(86)) + .5*max(0.0d0,data(17)) if(data(9).lt.2) then rterw = min(wearn,4000.0d0) rhyw = .5*(data(14)+data(12)+data(23)+comnew(8)) & +data(20)+data(72) if(comnew(6).ge.0) then rhyw = rhyw + .5*comnew(6) else rhyw = rhyw +.25*comnew(6) endif rtexc=min(rtmax(law),rterw+rhyw) else rterw = min(wearn,4000.0d0) rterh = min(hearn,4000.0d0) rtexc=min(rtmax(law),rterw+.5*rhy)+ & min(rtmax(law),rterh+.5*rhy) endif endif endif agi=agi-rtexc endif c Social Security Benefits (taxable portion) if(law.ge.1988)agi=agi-comnew(79) c EXEMPTIONS if(law.le.1986) then exemp=data(7)*1500.+(data(8)+old)*xmp(law) if(law.le.1986.and.nfile.eq.3.and.data(8).gt.0) exemp=exemp+800. else if(law.ge.1987.and.law.le.1993.) then exemp=xmp(law)*(data(7)+data(8)) else if(law.ge.1994.and.law.le.1997) then exemp=data(7)*1500.+data(8)*xmp(law) else if(law.ge.1998.and.law.le.2002) then exemp=xmp(law)*(data(7)+data(8)) else if(law.ge.2003.and.law.le.2012) then exemp=xmp(law)*data(7)+data(8)*3000 else if(law.ge.2013) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then exemp=xmp(law)*data(7)+data(8)*3000 else exemp=3700*data(7)+data(8)*3000 endif endif c Standard Deductions if(law.le.1982) then stded=twn(.15*agi,1300./data(3),2000./data(3)) else if(law.ge.1983.and.law.le.1986) then stded=twn(.15*agi,1500.0d0,2000.0d0) if(nfile.eq.2) then stded=twn(.18*agi,(1700./data(3)),(3000./data(3))) endif else if(law.ge.1987.and.law.le.1997) then if(nfile.ne.2) then stded=2300. + old*700. else stded=3000./data(3) + old*700. endif else c For years 1998+ the additional standard deduction $1300 for aged or blind if(nfile.ne.2) then stded=2300. + old*1300. else stded=3000./data(3) + old*1300. endif endif c ITEMIZED DEDUCTIONS xitded=(comnew(24)-data(50))*comnew(26) c xitded=comnew(24)*comnew(26) if(law.le.1986) then schedA=data(50)+data(55) xitded=(comnew(24)-schedA)*comnew(26) c GA uses 1982 fed medical and casualty provisions, 1983-86 agix=max(agi,0.0d0) gins=min(.5*data(47),150.0d0) gmed=((data(48)-(.01*agix))+data(47)-gins+data(49)-(.03*agix))+ & gins gxit=max((gmed-comnew(20)),0.0d0) if(law.ge.1983)xitded=xitded+gxit endif ided = data(4) if(law.eq.1999.and.ided.eq.-2) xitded=0 deduc=max(xitded,stded) taxinc=max(0.0d0,agi-deduc-exemp) if(nfile.eq.1) then call look(tabs,taxinc,6,n,statax,1.0d00,0.0d0,rt,data) else taxy=taxinc*sep call look(tabm,taxy,6,n,statax,1.0d00,1.0d0,rt,data) statax=statax/sep endif c Credits credit=0. chcr=0. c Child Care Credit is no longer allowable in 1987 if(law.ge.1978.and.law.le.1986) then chmax=twn(data(8)*2000.,2000.0d0,4000.0d0) chexp=min(data(64),chmax,(max(data(11)+data(17),0.0d0))) chcr=chexp*.02 if(chcr.gt.80.) then 91234 write(0,*)'Ga child care credit out of range.' continue endif else if(law.ge.2007) then chcare = min(comnew(53),max(0.0d0,comnew(52) - data(34))) if(law.eq.2007) chcr = .2*chcare if(law.ge.2008) chcr = .3*chcare endif c Low-Income Credit exists through 1986 and since 1992 ycred=0. if(law.le.1986) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then txp=1. else txp=2. endif ycred=max(0.0d0,min((15.*txp),(15.*txp-(comnew(2)-(3000.*txp))))) else if(law.ge.1992) then do 1 j=5,1,-1 if(comnew(2).lt.lic(j,1)) ycred=lic(j,2)*(data(7)+data(8)+old) 1 continue endif solar=0. solar=min(data(38),1000.0d0) if(law.le.2009) then statax=max(0.0d0,statax - chcr - solar) - ycred else statax=max(0.0d0,statax - chcr - solar - ycred) endif credit = chcr + solar + ycred return end c c HAWAII c State 12 c Updated through 2016 subroutine hitax(data,comnew, statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension stab77(2,12),stab87(2,8),stab88(2,8), stab89(2,8) dimension htab77(2,12),htab87(2,8),htab88(2,8), htab89(2,8) dimension htab99(2,9),stab99(2,9) dimension ex77(2,12),ex80(2,12),ex88(2,8) dimension htab01(2,9),stab01(2,9) dimension htab02(2,9),stab02(2,9) dimension htab07(2,9),stab07(2,9) dimension htab09(2,12),stab09(2,12) dimension htab16(2,9),stab16(2,9) dimension food(1977:1998) dimension food08(2,8),fd16(2,8),fds16(2,6) double precision lowcr c all are Ok, except hh(pre 1987) -I kept the old value in dimension data(255), comnew(255), std(1977:2016,7), & xmp(1977:2016),gencrd(1977:1995),rtab(1977:2016) data hiphas /166800./ c separate tax rates for single&married and heads of households data stab77/ 500.0d0, 2.25d0, 1000.0d0, 3.25d0, & 1500.0d0, 4.5d0 , 2000.0d0, 5.0d0 , & 3000.0d0, 6.5d0 , 5000.0d0, 7.5d0 , & 10000.0d0, 8.5d0 ,14000.0d0, 9.5d0 , & 20000.0d0, 10.0d0 ,30000.0d0,10.5d0 , & 100000.0d0, 11.0d0 , 1.e20,11.0d0/ data stab87/ 1000.0d0, 2.23d0, 2000.0d0, 4.25d0, & 3000.0d0, 6.25d0, 5000.0d0, 7.25d0, & 10000.0d0, 8.25d0, 14000.0d0, 9.25d0, & 20000.0d0, 9.75d0, 1.e20, 10.0d0/ data stab88/ 1200.0d0, 2.25d0, 2200.0d0, 4.25d0, & 3200.0d0, 6.25d0, 5200.0d0, 7.25d0, & 10200.0d0, 8.25d0, 14200.0d0, 9.25d0, & 20200.0d0, 9.75d0, 1.e20, 10.0d0/ data stab89/ 1500.0d0, 2.0d0 , 2500.0d0, 4.0d0 , & 3500.0d0, 6.0d0 , 5500.0d0, 7.25d0, & 10500.0d0, 8.0d0 , 15500.0d0, 8.75d0, & 20500.0d0, 9.5d0 , 1.e20,10.0d0/ data stab99/ 2000.0d0, 1.6d0 , 4000.0d0, 3.9d0, & 8000.0d0, 6.8d0 , 12000.0d0, 7.2d0, & 16000.0d0, 7.5d0 , 20000.0d0, 7.8d0, & 30000.0d0, 8.2d0 , 40000.0d0, 8.5d0, & 1.e20, 8.75d0/ data stab01/ 2000.0d0, 1.5d0 , 4000.0d0, 3.7d0, & 8000.0d0, 6.4d0 , 12000.0d0, 6.9d0, & 16000.0d0, 7.3d0 , 20000.0d0, 7.6d0, & 30000.0d0, 7.9d0 , 40000.0d0, 8.2d0, & 1.e20, 8.5d0/ data stab02/ 2000.0d0, 1.4d0 , 4000.0d0, 3.2d0, & 8000.0d0, 5.5d0 , 12000.0d0, 6.4d0, & 16000.0d0, 6.8d0 , 20000.0d0, 7.2d0, & 30000.0d0, 7.6d0 , 40000.0d0, 7.9d0, & 1.e20, 8.25d0/ data stab07/ 2400.0d0, 1.4d0 , 4800.0d0, 3.2d0, & 9600.0d0, 5.5d0 , 14400.0d0, 6.4d0, & 19200.0d0, 6.8d0 , 24000.0d0, 7.2d0, & 36000.0d0, 7.6d0 , 48000.0d0, 7.9d0, & 1.e20, 8.25d0/ data stab09/ 2400.0d0, 1.4d0 , 4800.0d0, 3.2d0, & 9600.0d0, 5.5d0 , 14400.0d0, 6.4d0, & 19200.0d0, 6.8d0 , 24000.0d0, 7.2d0, & 36000.0d0, 7.6d0 , 48000.0d0, 7.9d0, & 150000.0d0, 8.25d0,175000.0d0, 9.0d0, & 200000.0d0,10.0d0, 1.e20,11.0d0/ data stab16/ 2400.0d0, 1.4d0 , 4800.0d0, 3.2d0, & 9600.0d0, 5.5d0 , 14400.0d0, 6.4d0, & 19200.0d0, 6.8d0 , 24000.0d0, 7.2d0, & 36000.0d0, 7.6d0 , 48000.0d0, 7.9d0, & 1.e20, 8.25d0/ data htab77/ 500.0d0, 2.25d0, 1000.0d0, 2.75d0, & 1500.0d0, 3.9d0 , 2000.0d0, 4.10d0, & 3000.0d0, 5.5d0 , 5000.0d0, 6.60d0, & 10000.0d0, 7.9d0 ,20000.0d0, 9.15d0, & 30000.0d0,10.05d0,40000.0d0, 10.50d0, & 60000.0d0,10.750d0, 1.e20, 11.0d0/ data htab87/ 1000.0d0, 2.25d0, 2000.0d0, 3.25d0, & 3000.0d0, 5.25d0, 5000.0d0, 6.25d0, & 10000.0d0, 7.25d0, 20000.0d0, 8.90d0, & 40000.0d0, 9.80d0, 1.e20, 10.0d0/ data htab88/ 1200.0d0, 2.25d0, 2200.0d0, 3.25d0, & 3200.0d0, 5.25d0, 5200.0d0, 6.25d0, & 10400.0d0, 7.25d0, 20400.0d0, 8.90d0, & 40400.0d0, 9.80d0, 1.e20,10.0d0/ data htab89/ 1500.0d0, 2.0d0 , 2500.0d0, 3.0d0, & 3500.0d0, 4.5d0 , 5500.0d0, 5.9d0, & 11000.0d0, 7.25d0, 21000.0d0, 8.6d0, & 41000.0d0, 9.60d0, 1.e20,10.0d0/ data htab99/ 3000.0d0, 1.6d0 , 6000.0d0, 3.9d0, & 12000.0d0, 6.8d0 , 18000.0d0, 7.2d0, & 24000.0d0, 7.5d0 , 30000.0d0, 7.8d0, & 45000.0d0, 8.2d0 , 60000.0d0, 8.5d0, & 1.e20, 8.75d0/ data htab01/ 3000.0d0, 1.5d0, 6000.0d0, 3.7d0, & 12000.0d0, 6.4d0, 18000.0d0, 6.9d0, & 24000.0d0, 7.3d0, 30000.0d0, 7.6d0, & 45000.0d0, 7.9d0, 60000.0d0, 8.2d0, & 1.e20, 8.5d0/ data htab02/ 3000.0d0, 1.4d0, 6000.0d0, 3.2d0, & 12000.0d0, 5.5d0, 18000.0d0, 6.4d0, & 24000.0d0, 6.8d0, 30000.0d0, 7.2d0, & 45000.0d0, 7.6d0, 60000.0d0, 7.9d0, & 1.e20, 8.25d0/ data htab07/ 3600.0d0, 1.4d0, 7200.0d0, 3.2d0, & 14400.0d0, 5.5d0, 21600.0d0, 6.4d0, & 28800.0d0, 6.8d0, 36000.0d0, 7.2d0, & 54000.0d0, 7.6d0, 72000.0d0, 7.9d0, & 1.e20, 8.25d0/ data htab09/ 3600.0d0, 1.4d0 , 7200.0d0, 3.2d0, & 14400.0d0, 5.5d0 , 21600.0d0, 6.4d0, & 28800.0d0, 6.8d0 , 36000.0d0, 7.2d0, & 54000.0d0, 7.6d0 , 72000.0d0, 7.9d0, & 225000.0d0, 8.25d0,262500.0d0, 9.0d0, & 300000.0d0, 10.0d0 , 1.e20, 11.0d0/ data htab16/ 3600.0d0, 1.4d0 , 7200.0d0, 3.2d0, & 14400.0d0, 5.5d0 , 21600.0d0, 6.4d0, & 28800.0d0, 6.8d0 , 36000.0d0, 7.2d0, & 54000.0d0, 7.6d0 , 72000.0d0, 7.9d0, & 1.e20, 8.25d0/ c arrays for changing excise tax exemption amounts data ex77/ 5000.0d0, 40.0d0, 6000.0d0, 32.0d0, & 7000.0d0, 28.0d0, 8000.0d0, 26.0d0, & 9000.0d0, 22.0d0, 10000.0d0, 20.0d0, & 11000.0d0, 17.0d0, 12000.0d0, 14.0d0, & 13000.0d0, 11.0d0, 14000.0d0, 8.0d0, & 20000.0d0, 6.0d0, 1.e20, 0.0d0/ data ex80/ 5000.0d0, 48.0d0, 6000.0d0, 39.0d0, & 7000.0d0, 34.0d0, 8000.0d0, 32.0d0, & 9000.0d0, 27.0d0, 10000.0d0, 24.0d0, & 11000.0d0, 20.0d0, 12000.0d0, 17.0d0, & 13000.0d0, 14.0d0, 14000.0d0, 10.0d0, & 20000.0d0, 8.0d0, 1.e20, 0.0d0 / data ex88/ 6000.0d0, 55.0d0, 8000.0d0, 45.0d0, & 10000.0d0, 35.0d0, 12000.0d0, 25.0d0, & 15000.0d0, 20.0d0, 20000.0d0, 15.0d0, & 30000.0d0, 10.0d0, 1.e20, 0.0d0/ data food08/ 5000.0d0, 85.0d0, 10000.0d0, 75.0d0, & 15000.0d0, 65.0d0, 20000.0d0, 55.0d0, & 30000.0d0, 45.0d0, 40000.0d0, 35.0d0, & 50000.0d0, 25.0d0, 1.e20, 0.0d0/ data fd16/ 6000.0d0, 110.0d0, 10000.0d0, 100.0d0, & 15000.0d0, 85.0d0, 20000.0d0, 70.0d0, & 30000.0d0, 55.0d0, 40000.0d0, 45.0d0, & 50000.0d0, 35.0d0, 1.e20, 0.0d0/ data fds16/ 6000.0d0, 110.0d0, 10000.0d0, 100.0d0, & 15000.0d0, 85.0d0, 20000.0d0, 70.0d0, & 30000.0d0, 55.0d0, 1.e20, 0.0d0/ c Standard deduction for each marital status c each line is for each marital status and all years data std/ 1 5*1000.0d0, 5* 800.0d0, 2*1000.0d0,18*1500.0d0, 6*2000.0d0, 1 4*2200.0d0, 2 10*1000.0d0, 2*1700.0d0,18*1900.0d0, 6*4000.0d0, 4*4400.0d0, 3 10* 500.0d0, 2* 850.0d0,18* 950.0d0, 6*2000.0d0, 4*2200.0d0, 4 5*1000.0d0, 5* 800.0d0, 2*1500.0d0,18*1650.0d0, 6*2920.0d0, 4 4*3212.0d0, 5 10*1000.0d0, 2*1700.0d0,18*1900.0d0, 6*4000.0d0, 4*4400.0d0, 6 10* 500.0d0, 2* 850.0d0,18* 950.0d0, 6*2000.0d0, 4*2200.0d0, 7 5*1000.0d0, 5* 800.0d0, 2*1500.0d0,18*1650.0d0, 6*2920.0d0, 7 4*3212.0d0/ data xmp /3* 750.0d0, 5*1000.0d0,28*1040.0d0,4*1144.0d0/ data gencrd/4* 0.0d0, 100.0d0, 25.0d0, & 6* 1.0d0, 125.0d0, 60.0d0, & 5* 1.0d0/ data rtab/ 4* 20.0d0, 36*50.0d0/ data food/ 10* 0.0d0, 3*45.0d0,5* 55.0d0,4*27.0d0/ rt=0. mst = data(2) sep = data(3) reduce = 0. c AGI c Hawaii does not tax Social Security Benefits and c some kinds of pensions taxed federally c agi = data(11) + max(0.0d0,data(12)-data(13)) + data(14)+ c & data(62)+data(17)+data(21) c agi = comnew(2) - comnew(79)-data(20) agi = comnew(2) - comnew(79) - data(22) c (02.23.2017 change) Pensions are not taxable in HI agi = agi - data(72) c EXEMPTIONS exemp=(data(7)+data(8)+data(9))*xmp(law) exema = exemp c 2009-2015 personal exemption phaseout if(law.ge.2009.and.law.le.2015) then phex = 119963. if(mst.eq.4.or.mst.eq.7) then phex = 1.25*phex else phex = 1.5*phex/sep endif c------------------ c for exact amount -- just in case if(agi.gt.phex) then ln6 = int(1+ (agi-phex)/(2500./sep)) exemp = exema - exema*.02*ln6 endif c------------------- c for smooth function c ratio = 0.02*max(0.0d0,(agi-phex)/(2500./sep)) c exemp = max(exema*(1.-ratio),0.0d0) endif c disability exemption is exclusive of other exemptions n10 = data(10) n9 = data(9) if(n10.gt.0.) then exemp=7000.*data(10) if(n10.eq.1.and.n9.eq.2)exemp=9080. if(n10.eq.1.and.n9.eq.1)exemp=8040. endif c DEDUCTIONS stded=std(law,mst) if(law.eq.1980) stded=min(max(0.0d0,.1*agi),stded) if(law.le.1984.and.law.ge.1983) stded=stded & + (data(58)+data(59))*.25 if(law.eq.1985) stded=stded + (data(58)+data(59))*.5 if(law.eq.1986) stded=stded + data(58)+data(59) c For tax years beginning after 1986, the zero bracket amount c has been replaced by the standard deduction xitded = comnew(30) if(agi.gt.100000/sep.and.law.ge.1991.and.law.le.2010) then reduce = min(.8*xitded,.03*(agi-100000/sep)) if(law.ge.2006.and.law.le.2007) reduce = 2*reduce/3. if(law.ge.2008.and.law.le.2009) reduce = reduce/3. if(law.eq.2010) reduce = 0. xitded = xitded-reduce endif c phas92 -- limitation for the Federal AGI phas92=100000*data(7) if(mst.eq.4.or.mst.eq.7) phas92=150000. c hiphas($166,800) -- limitation for the HI AGI if(law.ge.2011.and.law.le.2015) then if(agi.gt.hiphas/sep) then reduce = min(.8*xitded,.03*(agi-hiphas/sep)) xitded = xitded-reduce endif if(comnew(2).gt.phas92.and.(mst.eq.4.or.mst.eq.7)) & xitded = min(37500.0d0,xitded) if(comnew(2).gt.phas92.and. & (mst.eq.1.or.mst.eq.2.or.mst.eq.3.or.mst.eq.6)) & xitded = min(25000*data(7),xitded) endif if(law.le.1986.and.law.ge.1982) then xitded=max(0.0d0,max(0.0d0,comnew(30)-std(law,mst))) stded =max(0.0d0,stded -std(law,mst)) endif c For years before 1987 std(law,mst) is the zero bracket amount ided = data(4) if(ided.eq.-2.and.law.eq.1999) xitded=0 deduc=max(xitded,stded) taxinc=max(0.0d0,agi - exemp - deduc) if (mst.eq.4.or.mst.eq.7) then if(law.le.1986)then call look(htab77,taxinc,12,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1987) then call look(htab87,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) elseif(law.eq.1988) then call look(htab88,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) elseif(law.ge.1989.and.law.le.1998) then call look(htab89,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) elseif(law.ge.1999.and.law.le.2000) then call look(htab99,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) elseif(law.eq.2001) then call look(htab01,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) elseif(law.ge.2002.and.law.le.2006) then call look(htab02,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) elseif(law.ge.2007.and.law.le.2008) then call look(htab07,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) elseif(law.ge.2009.and.law.le.2015) then call look(htab09,taxinc,12,n,statax,1.0d00,0.0d0,rt,data) elseif(law.ge.2016) then call look(htab16,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) endif elseif(mst.ne.4.and.mst.ne.7) then taxy = taxinc if(mst.eq.2)taxy=taxinc/2 if(law.le.1986)then call look(stab77,taxy,12,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1987) then call look(stab87,taxy,8,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1988) then call look(stab88,taxy,8,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1989.and.law.le.1998) then call look(stab89,taxy,8,n,statax,1.0d00,0.0d0,rt,data) elseif(law.ge.1999.and.law.le.2000) then call look(stab99,taxy,9,n,statax,1.0d00,0.0d0,rt,data) elseif(law.eq.2001) then call look(stab01,taxy,9,n,statax,1.0d00,0.0d0,rt,data) elseif(law.ge.2002.and.law.le.2006) then call look(stab02,taxy,9,n,statax,1.0d00,0.0d0,rt,data) elseif(law.ge.2007.and.law.le.2008) then call look(stab07,taxy,9,n,statax,1.0d00,0.0d0,rt,data) elseif(law.ge.2009.and.law.le.2015) then call look(stab09,taxy,12,n,statax,1.0d00,0.0d0,rt,data) elseif(law.ge.2016) then call look(stab16,taxy,9,n,statax,1.0d00,0.0d0,rt,data) endif if(mst.eq.2)statax=statax*2. endif c if(max(comnew(6),0.0d0)+data(176).gt.0) then if(max(comnew(6),0.0d0).gt.0) then if (mst.eq.4.or.mst.eq.7) then brack = 36000. else brack = 24000. * data(7) endif c non-gain taxable income c taxyng = max(0.0d0,taxinc - max(comnew(6),0.0d0)+data(176)) taxyng = max(0.0d0,taxinc - max(comnew(6),0.0d0)) taxyng = max(brack,taxyng) c amount of net capital gains eligible for alternative tax taxycg = max(0.0d0,taxinc - taxyng) c The Hawaii capital gains tax on real estate is 7.25% if (mst.eq.4.or.mst.eq.7) then if(law.le.1986)then call look(htab77,taxyng,12,n,statng,1.0d00,0.0d0,rt,data) else if(law.eq.1987) then call look(htab87,taxyng,8,n,statng,1.0d00,0.0d0,rt,data) elseif(law.eq.1988) then call look(htab88,taxyng,8,n,statng,1.0d00,0.0d0,rt,data) elseif(law.ge.1989.and.law.le.1998) then call look(htab89,taxyng,8,n,statng,1.0d00,0.0d0,rt,data) elseif(law.ge.1999.and.law.le.2000) then call look(htab99,taxyng,9,n,statng,1.0d00,0.0d0,rt,data) elseif(law.eq.2001) then call look(htab01,taxyng,9,n,statng,1.0d00,0.0d0,rt,data) elseif(law.ge.2002.and.law.le.2006) then call look(htab02,taxyng,9,n,statng,1.0d00,0.0d0,rt,data) elseif(law.ge.2007.and.law.le.2008) then call look(htab07,taxyng,9,n,statng,1.0d00,0.0d0,rt,data) elseif(law.ge.2009.and.law.le.2015) then call look(htab09,taxyng,12,n,statng,1.0d00,0.0d0,rt,data) elseif(law.ge.2016) then call look(htab16,taxyng,9,n,statng,1.0d00,0.0d0,rt,data) endif elseif(mst.ne.4.and.mst.ne.7) then taxy = taxyng if(mst.eq.2)taxy=taxyng/2 if(law.le.1986)then call look(stab77,taxy,12,n,statng,1.0d00,0.0d0,rt,data) else if(law.eq.1987) then call look(stab87,taxy,8,n,statng,1.0d00,0.0d0,rt,data) else if(law.eq.1988) then call look(stab88,taxy,8,n,statng,1.0d00,0.0d0,rt,data) else if(law.ge.1989.and.law.le.1998) then call look(stab89,taxy,8,n,statng,1.0d00,0.0d0,rt,data) elseif(law.ge.1999.and.law.le.2000) then call look(stab99,taxy,9,n,statng,1.0d00,0.0d0,rt,data) elseif(law.eq.2001) then call look(stab01,taxy,9,n,statng,1.0d00,0.0d0,rt,data) elseif(law.ge.2002.and.law.le.2006) then call look(stab02,taxy,9,n,statng,1.0d00,0.0d0,rt,data) elseif(law.ge.2007.and.law.le.2008) then call look(stab07,taxy,9,n,statng,1.0d00,0.0d0,rt,data) elseif(law.ge.2009.and.law.le.2015) then call look(stab09,taxy,12,n,statng,1.0d00,0.0d0,rt,data) elseif(law.ge.2016) then call look(stab16,taxy,9,n,statng,1.0d00,0.0d0,rt,data) endif if(mst.eq.2)statng=statng*2. endif statcg = taxycg * .0725 statax = min(statax,statng + statcg) endif c CREDITS c Child care credit child = min(data(64),2400.*min(data(8),2.0d0)) if(mst.eq.2) child = min(child,data(85),data(86)) if(law.le.1989) then chr=.01*max(10.0d0,15.-max((agi- 21000.)/2000.,0.0d0)) else if(law.ge.1990.and.law.le.2015) then chr=.01*max(15.0d0,25.-max((agi- 22000.)/2000.,0.0d0)) else if(law.ge.2016) then chr=.01*max(15.0d0,25.-max((agi- 25000.)/5000.,0.0d0)) endif chcr = chr*child c The General Income Tax Credit is not available in 1996+ gencr = 0. if(law.le.1995) then c gencr = (gencrd(law)*(data(7)+data(8))) + child gencr = gencrd(law)*(data(7)+data(8)) if(law.ge.1979) gencr = gencr + data(34) if(law.le.1979) gencr = gencr + .5*data(35) if(law.ge.1981.and.law.le.1986) gencr = gencr+(.6*data(38)) endif c The General Income Tax Credit in 2001:fixed amount of $1 per c qualified exemption if((law.ge.2001.and.law.le.2006).or.(law.ge.2008.and.law.le.2009)) & gencr = 1.*(data(7)+data(8)) c--------------------------------------------------------- c A General Income Tax Credit for 2007 based on c the taxpayer's filing status and amount of federal agi if(law.eq.2007) then if(mst.eq.4.or.mst.eq.7) then c inna made linear function for the table in instructions if(comnew(2).lt.60000) gencr = 140.-70.*comnew(2)/60000. else if(mst.eq.2.or.mst.eq.5) then if(comnew(2).lt.60000) gencr = 160.-90.*comnew(2)/60000. else if(comnew(2).lt.30000) gencr = 65.-25.*comnew(2)/30000. endif endif c---------------------------------------------------------- c not able to calc energy conservation credit (1990):not in PC Tax files c not able to calc new employee credit(1990):not in PC Tax files c credits which can be included in a refund c actual law treats surviving spouse as joint return rcred=0. xnum=data(7)+data(8)+data(9) if((data(160).ge.1000.).and. & ((law.le.1988.and.agi.lt.20000).or. & (law.ge.1989.and.agi.lt.30000)))rcred= rtab(law)*xnum c renters credit 30% of fed credit (1990) rcred=rcred*max(data(9),1.0d0) c The Excise Credit is repealed in 1995 exc=0. if(law.le.1979)then exc=tablki(ex77,12,agi,data)*max(data(9),1.0d0)*data(7) else if(law.ge.1980.and.law.le.1987) then exc=tablki(ex80,12,agi,data)*max(data(9),1.0d0)*data(7) elseif(law.ge.1988.and.law.le.1994) then exc=tablki(ex88,8,agi,data)*max(data(9),1.0d0)*data(7) endif c The Food Tax Credit is no longer available since 1999 foodcr = 0. if(law.le.1998) foodcr=food(law)*(data(7)+data(8)) c Low income refundable tax credit is provided c taxpayers with AGI=< $20k in 1999. lowcr = 0. if(law.ge.1999.and.law.le.2007) then if(agi.lt.10000) lowcr = (data(7)+data(8))*35 if(agi.ge.10000.and.agi.lt.15000) lowcr = (data(7)+data(8))*25 if(agi.ge.15000.and.agi.le.20000) lowcr = (data(7)+data(8))*10 endif fedagi = max(0.0d0,comnew(2)) if(law.ge.2008.and.law.le.2015) then c Refundable Food/Excise Credit in 2008 exc = (data(8)+data(7))*tablki(food08,8,fedagi,data) elseif(law.ge.2016.and.law.le.2017) then c The Refundable Food/Excise Tax Credit is amended for 2016-2017 if(mst.ne.1) then exc = (data(8)+data(7))*tablki(fd16,8,fedagi,data) else exc = (data(8)+data(7))*tablki(fds16,6,fedagi,data) endif endif credit = gencr+rcred+exc+foodcr+chcr+lowcr statax=statax-credit c1 format(1x,10f8.0) return end c c IDAHO c State 13 c Updated through 2016 c subroutine idtax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(100),xmp(1977:2012),gr(2008:2016) dimension tab77(2,6),tab87(2,8),tab00(2,8),tab01(2,8),tab12(2,7), & aif01(2001:2016), & ageded(1993:2016,2), dedj(1993:2016),deds(1993:2016), & dedh(1993:2016),dedw(1999:2016) double precision itc,lim integer sep dimension aif92(1992:2012),aif13(2013:2017) data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ c enter taxinc > $1000 value data gr/30.d0,40.d0,50.d0,60.d0,70.d0,80.d0,90.d0,2*100.d0/ data aif01/ & 2*1.0d0, 2*1.086d0 , 1.104d0,1.159d0,2*1.198d0, & 1.272d0, 1.32288d0, 1.338d0,1.38d0 , 1.409d0, & 1.429d0, 1.452d0 , 1.454d0/ data aif92/ & 1.0525d0, 1.0845d0, 1.118d0, 1.147d0 , 1.1795d0, & 1.2120d0, 1.2450d0, 1.266d0, 1.2895d0, 1.3295d0, & 1.3730d0, 1.3950d0, 1.427d0, 1.4595d0, 1.505d0 , & 1.5640d0, 1.5995d0, 1.668d0,2*1.6955d0, 1.7365d0/ data ageded/ & 900.0d0, 2*950.0d0, 2*1000.0d0, 2*1050.0d0, 2*1100.0d0, & 2*1150.0d0, 1200.0d0, 2*1250.0d0, 1300.0d0, 1350.0d0, & 2*1400.0d0,2*1450.0d0, 1500.0d0, 3*1550.0d0, & 700.0d0, 2*750.0d0, 2*800.0d0, 3*850.0d0, 2*900.0d0, & 2*950.0d0,2*1000.0d0, 2*1050.0d0, 2*1100.0d0, 2*1150.0d0, & 2*1200.d0,2*1250.0d0/ c standard deductions data dedj/ & 6200.0d0, 6350.0d0, 6550.0d0, 6700.0d0, 6900.0d0, & 7100.0d0, 7350.0d0, 8800.0d0, 9100.0d0, 9400.0d0, & 9500.0d0, 9700.0d0, 10000.0d0, 10300.0d0, 10700.0d0, & 10900.0d0,2*11400.0d0, 11600.0d0, 11900.0d0, 12200.0d0, & 12400.0d0,2*12600.0d0/ data deds/ & 3700.0d0, 3800.0d0, 3900.0d0, 4000.0d0, 4150.0d0, & 4250.0d0, 4300.0d0, 4400.0d0, 4550.0d0, 4700.0d0, & 4750.0d0, 4850.0d0, 5000.0d0, 5150.0d0, 5350.0d0, & 5450.0d0,2*5700.0d0, 5800.0d0, 5950.0d0, 6100.0d0, & 6200.0d0,2*6300.0d0/ data dedh/ & 5450.0d0, 5600.0d0, 5750.0d0, 5900.0d0, 6050.0d0, & 6250.0d0, 6350.0d0, 6450.0d0, 6650.0d0, 6900.0d0, & 7000.0d0, 7150.0d0, 7300.0d0, 7550.0d0, 7850.0d0, & 8000.0d0, 8350.0d0, 8400.0d0, 8500.0d0, 8700.0d0, & 8950.0d0, 9100.0d0, 9250.0d0, 9300.0d0/ data dedw/ & 7200.0d0, 7350.0d0, 7600.0d0, 7850.0d0, 9500.0d0, & 9700.0d0, 10000.0d0, 10300.0d0, 10700.0d0, 10900.0d0, & 2*11400.0d0, 11600.0d0, 11900.0d0, 12200.0d0, 12400.0d0, & 2*12600.0d0/ c XYZ rate tables data tab77 / & 1000.0d0, 2.0d0, 2000.0d0, 4.0d0, 3000.0d0, 4.5d0, & 4000.0d0, 5.5d0, 5000.0d0, 6.5d0, 1.e20, 7.5d0 / data tab87 / & 1000.0d0, 2.0d0, 2000.0d0, 4.0d0, 3000.0d0, 4.5d0, & 4000.0d0, 5.5d0, 5000.0d0, 6.5d0, 7500.0d0, 7.5d0, & 20000.0d0, 7.8d0, 1.e20, 8.2d0/ data tab00 / & 1000.0d0, 1.9d0, 2000.0d0, 3.9d0, 3000.0d0, 4.4d0, & 4000.0d0, 5.4d0, 5000.0d0, 6.4d0, 7500.0d0, 7.4d0, & 20000.0d0, 7.7d0, 1.e20, 8.1d0/ data tab01 / & 1000.0d0, 1.6d0, 2000.0d0, 3.6d0, 3000.0d0, 4.1d0, & 4000.0d0, 5.1d0, 5000.0d0, 6.1d0, 7500.0d0, 7.1d0, & 20000.0d0, 7.4d0, 1.e20, 7.8d0/ data tab12 / & 1000.0d0, 1.6d0, 2000.0d0, 3.6d0, 3000.0d0, 4.1d0, & 4000.0d0, 5.1d0, 5000.0d0, 6.1d0, 7500.0d0, 7.1d0, & 1.e20, 7.4d0/ data xmp/ & 3* 750.0d0, 5*1000.0d0, 1040.0d0, 1080.0d0, 2*1900.0d0, & 2000.0d0, 2050.0d0, 2150.0d0, 2300.0d0, 2350.0d0, & 2450.0d0, 2500.0d0, 2550.0d0, 2650.0d0, 2700.0d0, & 2750.0d0, 2800.0d0, 2900.0d0, 3000.0d0, 3050.0d0, & 3100.0d0, 3200.0d0, 3300.0d0, 3400.0d0, 3500.0d0, & 2*3650.0d0, 3700.0d0, 3800.0d0/ mst = data(2) c Married filing jointly and Head of households have the same tax rate schedule txp = data(7) if(mst.eq.4.or.mst.eq.7) txp = 2 sep=data(3) rt=0. nblage=data(9)+data(10) phas92=100000./data(3) if(law.ge.1992.and.law.le.2012)phas92=100000.*aif92(law)/data(3) if(law.ge.2013) & phas92 = aif13(law)*250000*filing(mst,1.,1.2,1.1,.6) c AGI c Basically federal agi definition agi=comnew(2) if(law.ge.1978) then c state tax refunds,alt energy costs agi = agi-data(22)-data(38) c Child and dependent care expenses if(law.le.2002) &agi = agi - min(data(64),comnew(37),2400.*min(2.0d0,data(8))) if(law.ge.2003) &agi = agi - min(data(64),comnew(37),3000.*min(2.0d0,data(8))) c Wages from jobs credit if(law.ge.1979.and.law.le.1986) agi=agi-xjobs(data,law) if(law.ge.1984)agi=agi-comnew(79) endif c Deductions c State Tax Declaration Phaseout xitded=max(0.d0,comnew(30)-data(50)) if(agi.gt.phas92.and.law.ge.1991.and.comnew(30).gt.0) & xitded=max(0.d0,comnew(24)-data(50)*comnew(24)/comnew(30)) c Standard deduction equals fed standard deduction most years if(law.eq.1977) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then stded=twn(.16*agi,1700.0d0,2400.0d0) else stded=twn(.16*agi,2100.0d0,2800.0d0) endif else if(law.ge.1978.and.law.le.1992) then stded=comnew(3) if(law.ge.1982.and.law.le.1986)stded=stded+comnew(23) if(sep.eq.2) then if(law.ge.1988.and.law.le.1989) then stded= stded-150.*nblage elseif(law.eq.1990) then stded= stded-150.*nblage+25. elseif(law.ge.1991.and.law.le.1992) then stded= stded-200.*nblage endif endif else if(law.ge.1993.and.law.le.1998) then if(mst.eq.1) then stded=deds(law) else if(mst.eq.4.or.mst.eq.7) then stded=dedh(law) else stded=dedj(law)/sep endif else if(law.ge.1999) then if(mst.eq.1) then stded=deds(law) else if(mst.eq.4.or.mst.eq.7) then stded=dedh(law) else if(mst.eq.2) then stded=dedj(law) else stded=dedw(law)/sep endif if(law.ge.2008.and.law.le.2009) stded = & stded + min(500.*data(7),data(51)) endif c nblage- number of age and blind exemptions if(nblage.ge.1.and.law.eq.1987) then if(mst.eq.1) then stded=3750.+750.*(nblage-1) else if(mst.eq.2.or.mst.eq.5) then stded=5600.+600.*(nblage-1) else if(mst.eq.3.or.mst.eq.6) then stded=3100.+600.*(nblage-1) else stded=5100.+800.*(nblage-1) endif elseif(nblage.ge.1.and.law.ge.1993) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then nmst=1 else nmst=2 endif stded=stded+ageded(law,nmst)*nblage endif deduc=max(xitded,stded) c Your Idaho exemption amount should be the same as your c federal exemption amount exemp = comnew(83) c Taxable income taxinc=max(0.0d0,agi-deduc-exemp) c Tax before credits calculation tinc = taxinc/txp if(law.le.1986) then call look(tab77,tinc,6,n,stat,1.0d00,0.0d0,rt,data) else if(law.ge.1987.and.law.le.1999) then call look(tab87,tinc,8,n,stat,1.0d00,0.0d0,rt,data) else if(law.eq.2000) then call look(tab00,tinc,8,n,stat,1.0d00,0.0d0,rt,data) else if(law.ge.2001.and.law.le.2011) then call look(tab01,tinc,8,n,stat,aif01(law),0.0d0,rt,data) else if(law.ge.2012) then call look(tab12,tinc,7,n,stat,aif01(law),0.0d0,rt,data) endif statax = stat * txp c New voluntary donation to the American Red Cross c if(law.ge.2006) statax = statax + 10*data(7) c Credits c Grocery credit if(law.le.2000) then grcred=(data(7)+data(8)+data(9))*15. if(law.eq.1977)grcred=grcred-(data(9)*10.) else if(law.gt.2000.and.law.le.2007) then grcred=(data(7)+data(8))*20+data(9)*15. else if(law.ge.2008) then if(taxinc.le.1000.and.law.le.2014) then if(law.le.2013)grcred = (data(7)+data(8))*(gr(law)+20) if(law.eq.2014)grcred = (data(7)+data(8))*(gr(law)+10) else grcred = (data(7)+data(8))*gr(law) endif grcred = grcred + data(9)*20 endif c Investment credit itc=min(data(33),.5*statax) polc=0. if(law.ge.1979)polc=min(.5*data(65),5.*data(7)) c Permanent builing fund tax lim=0. if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then lim=2300.+xif(law.ge.1981,1000.0d0)+(data(9)*1000.) else if(mst.eq.2.or.mst.eq.5) then lim=3400.+xif(law.ge.1981,2000.0d0)+(data(9)*1000.) else if(mst.eq.3.or.mst.eq.6) then lim=750.+xif(law.ge.1981,250.0d0) endif if(law.ge.1978) then if(hy.gt.lim.and.data(10).le.0.0d0)statax = statax + 10. endif credit = itc+polc+grcred statax = statax-credit return end c c ILLINOIS c State 14 c c Updated through 2016 subroutine iltax(data,comnew, statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255) dimension rate(1977:2016),xmp(1977:2016) data rate/6*.0250d0,.030d0,.02750d0,4*.0250d0,.02750d0, & 21*.030d0,4*.050d0,2*.0375d0/ data xmp/21*1000.0d0,1300.0d0,1650.0d0,12*2000.0d0,2050.0d0, & 2100.d0,2125.d0,2150.d0,2175.d0/ rt=rate(law) c AGI c Illinois agi does not include federal div or cap gns exclusions agi=comnew(2)+divexc(data,comnew,law)+comnew(7) c Illinois does not tax retirement plans penson=data(20)+data(72) c if(law.ge.1982)agi=agi-penson agi=agi-penson if(law.ge.1986)agi=agi-data(22) c Social Security benefits are not taxable in Illinois agi = agi - comnew(79) c Exemptions if(law.le.1989) then exemp=comnew(68)*xmp(law) else exemp = xmp(law)*(comnew(68)+data(105)) + & 1000.*(data(9)+data(10)) endif ptax=0. if(law.ge.1983.and.law.le.1990) then ptax=data(51) c note: for tax years 1989 and 1990 you can take twice the property tax c subtraction to which you would normally be entitled. if(law.ge.1989) ptax=ptax*2 endif taxinc=max(0.0d0,agi-exemp-ptax) statax=taxinc*rate(law) c Since 1991 Tax credit for Illinois property tax paid pcred=0. if(law.ge.1991) pcred=min(statax,.05*data(51)) statax=statax-pcred gcred=data(34) statax=max(0.0d0,statax-gcred) c Since 2000 Education Expense Credit - non-refundable edcred = 0. if(law.ge.2000) &edcred = min(500.0d0,.25*max(0.0d0,data(143)+data(144) - 250.)) statax = max(0.0d0,statax-edcred) c grant for elderly's property taxes allowed? c Taxpayers who claimed EITC in federal return may claim 5% since 2000 earncr = 0 if(law.ge.2000.and.law.le.2002) & earncr = max(0.0d0,min(.05*comnew(59),statax-pcred)) if(law.ge.2003.and.law.le.2011) earncr = .05*comnew(59) if(law.eq.2012) earncr = .075*comnew(59) if(law.ge.2013) earncr = .1*comnew(59) statax = statax - earncr credit = pcred + gcred + earncr + edcred return end c c INDIANA c State 15 c c Updated through 2016 subroutine intax(data,comnew,statax,law) implicit double precision (A-H,O-Z) real modagi common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255),eld1(2,4), eld2(2,4) dimension ptab(2,8),rate(1977:2016) dimension crmax(2011:2016,0:2), ymax(2011:2016,0:2) dimension rtbase(2011:2016,0:2), rtless(2011:2016,0:2) c EITC parameters 2011+ data crmax/ & 42.0d0, 43.0d0, 44.0d0,2*45.0d0,46.0d0, 1 279.0d0, 285.0d0, 293.0d0,297.0d0,302.d0,304.d0, 2 460.0d0, 471.0d0, 483.0d0,491.0d0,499.d0,501.d0/ data ymax/ & 7600.0d0, 7800.0d0, 8000.0d0, 8200.0d0,2* 8400.d0, 1 16750.0d0,17150.0d0,17550.0d0,17900.0d0,2*18200.d0, 2 16750.0d0,17150.0d0,17600.0d0,17950.0d0,2*18200.d0/ data rtbase/ & 6*.0066660d0, 1 6*.03042850d0, 2 6*.03585710d0/ data rtless/ & 6*.006880d0, 1 6*.01440d0, 2 6*.0190d0/ c data eld1/ 1000.0d0, 65.0d0,3000.0d0, 35.0d0,10000.0d0, & 25.0d0,1.e20,0.0d0/ data eld2/ 1000.0d0,100.0d0,3000.0d0, 50.0d0,10000.0d0, & 40.0d0,1.e20,0.0d0/ data ptab/ 500.0d0, .750d0, 1000.0d0, .70d0, 1500.0d0, .50d0, & 2000.0d0, .40d0, 2500.0d0,.30d0, 3000.0d0, .250d0, 4000.0d0, &.20d0, 5000.0d0, .10d0 / data rate/3*.02d0,3*.019d0,4*.03d0,.032d0,27*.034d0,2*.033d0/ rt = rate(law) mst = data(2) c AGI agi = max(0.0d0,comnew(2)-data(22)) c Social Security Benefits are not taxable in Indiana agi = agi - comnew(79) if(law.eq.1981) agi=agi+divexc(data,comnew,law)-min(data(12),100.* & data(7)) c 2009 you must add back the unemployment compensation c not included on your federal tax return if(law.eq.2009.and.data(82).gt.0.0d0) & agi = agi + min(data(82),data(7)*2400.0d0) c Nontaxable portion of unemployment compensation if(data(82).gt.0.0d0) then untax = 12000. if(mst.eq.2) untax = 18000. if(law.le.2008) then xlin6 = min(comnew(78),.5*max(0.0d0,comnew(2)-untax)) unded = comnew(78) - xlin6 else xlin7 = .5*max(0.0d0,comnew(2)+data(82)-comnew(78)-untax) unded = max(0.0d0,data(82) - xlin7) endif agi = agi - unded endif c Rent deduction up to $1500 dedr = 0. if(law.ge.1979.and.law.le.1998) then dedr = min(data(160),1500.0d0) else if(law.ge.1999.and.law.le.2002) then dedr = min(data(160),2000.0d0) else if(law.ge.2003.and.law.le.2007) then dedr = min(data(160),2500.0d0) else if(law.ge.2008) then dedr = min(data(160),3000.0d0) endif c New in 1999 Homeowner's Residential Property Tax Deduction dedown = 0. if(law.ge.1999) dedown = min(data(51),2500.0d0) c New 1997-1998 , an earned income tax deduction if agi<$12,000. dedei = 0. if((law.eq.1997.or.law.eq.1998).and.data(8).gt.0.and. & agi.lt.12000.and. & .8*max(0.0d0,agi).lt.data(11)+data(17)) & dedei = 12000. - max(0.0d0,agi) c Deductions deduc = dedr + dedei+dedown c Exemptions exemp=0. c Additional exemptions for elderly are correct if(law.le.1979) then exemp=(data(7)+data(9))*1000.+(data(8)+data(10))*500. else if(law.ge.1980.and.law.le.1984) then exemp=(comnew(68)+data(9))*500. if(mst.eq.2) then xtra1=twn((agi/3)-500.,0.0d0,500.0d0) xtra2=twn(((agi*2)/3)-500.,0.0d0,500.0d0) xtra=xtra1+xtra2 else if(mst.ne.2) then xtra=twn(agi-500.,0.0d0,500.0d0) endif exemp=exemp+xtra else if(law.eq.1985.or.law.eq.1986) then exemp=comnew(68)*1000. else if(law.ge.1987) then exemp=(comnew(68)+data(9)+data(10))*1000. c Beginning in 1997 , an additional exemption of $500 is allowed for c For 1999,an additional exemption of $500 for elder with fedagi < $40k if(law.ge.1999) exemp = exemp+ & xif(comnew(2).lt.40000.,500.0d0)*data(9) endif c 1997-1998 additional exemption for Dependent child $500 and $1500 in 1999 if(law.eq.1997.or.law.eq.1998) then exemp = exemp + 500.*data(8) elseif(law.ge.1999) then exemp = exemp + 1500.*data(8) endif c Calculation of Tax taxinc=max(0.0d0,agi-deduc-exemp) statax=taxinc*rate(law) if(law.eq.1979)statax=statax*.85 c Credits c Credit before 1981 ptax=data(51)+.2*data(160) pcred=0. if(law.le.1980.and.data(9).gt.0)pcred=twn(tablki(ptab,8, & data(159),data)*ptax,0.0d0,500.0d0) c Elderly credits for all years ecred=0. if(data(9).gt.0.and.comnew(2).lt.10000) then if(law.le.1980)ecred=xif(data(159).lt.15000.,25.0d0) if(law.le.1979)ecred=ecred+2./15.*comnew(54) if(law.eq.1980)ecred=ecred+19./150.*comnew(54) if(law.ge.1981.and.law.le.1984) then ecred=tablki(eld1,4,comnew(2),data) if(data(9).gt.1..and.mst.eq.2) ecred=ecred+25. endif if(law.ge.1985) then ecred=tablki(eld2,4,comnew(2),data) if(data(9).gt.1.and.mst.eq.2)ecred=ecred + 40. endif endif c 60 continue c Since 1999, Earned Income Credit: Schedule IN-EIC. earncr = 0. if(law.ge.1999.and.law.le.2002 & . and.data(8).gt.0.and.comnew(37).gt..8*comnew(65) & .and.comnew(65).lt.12000) & earncr = .034*(12000.-max(0.0d0,comnew(65))) c 2003 - Indiana's earned income has changed. if(law.ge.2003.and.law.le.2008.and.comnew(59).ge.9.0d0) & earncr = .06*comnew(59) c 2009 - Indiana's earned income has changed. if(law.ge.2009.and.comnew(59).ge.6.0d0) then if(law.eq.2009.or.law.eq.2010) then d8 = data(8) if(d8.gt.2) then data(8) = 2 call nlaw(data,law) data(8) = d8 endif endif earncr = .09*comnew(59) c Earned income credit change 2011 if(law.ge.2011) then ieic = min(2.0d0,data(8)) crm = crmax(law,ieic) ym = ymax(law,ieic) rtbs = rtbase(law,ieic) rtlw = rtless(law,ieic) earny = comnew(37) modagi = max(0.0d0,agi) eic11 = min(rtbs*earny,crm) if (modagi.gt.ym.or.earny.gt.ym) then eicpo = rtlw*max(0.0d0,max(modagi,earny)- ym) eic11= min(eic11,max(0.0d0,crm - eicpo)) endif earncr=min(earncr,eic11) endif endif credit = pcred + ecred + earncr c negative tax is refunded; 2/13/91 new accounting for refundable crdt statax = statax - credit c 2012 year only -- Automatic Taxpayer Refund Credit if(law.eq.2012.and.statax.gt.0) then credit = credit + 111*data(7) statax = statax - 111*data(7) endif if(law.ge.1980.and.law.le.1994) & statax = statax-min(data(38),max(statax,0.0d0)) c The Solar and Wind Energy Carry-Over Credit has been repealed since 1995. c Therefore, no additional carryover credits are allowed. return end c c IOWA c State 16 c c Updated through 2016 c subroutine iatax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension tab(2,13),tab87(2,9),tab98(2,9), &chcr90(2,8),chcr93(2,6),chcr06(2,7),eicr(1977:2016,2) dimension aif(1977:2016),xmp(1977:2016) dimension alt1(7),alt2(7),rat(1985:2016) dimension data(255),comnew(255),stnd(1977:2016,3) &,exy(1977:2016,2),ssbp(2007:2013),pen(1995:2016) dimension aif92(1992:2012),aif13(2013:2017) integer sep data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ data aif92/ & 1.0525d0, 1.0845d0, 1.118d0, 1.147d0 , 1.1795d0, & 1.212d0 , 1.2450d0, 1.266d0, 1.2895d0, 1.3295d0, & 1.373d0 , 1.3950d0, 1.427d0, 1.4595d0, 1.5050d0, & 1.564d0 , 1.5995d0, 1.668d0,2*1.6955d0, 1.7365d0/ data ssbp / 2*.68d0, .57d0, .55d0, .67d0, .77d0, .89d0/ data pen / 3*3000.0d0,3*5000.0d0,16*6000.0d0/ data alt1 / 26000.0d0, 35000.0d0, 17500.0d0,2*26000.0d0, & 17500.0d0, 26000.0d0 / data alt2 / 112500.0d0, 150000.0d0, 75000.0d0,2*112500.0d0, & 75000.0d0, 112500.0d0 / data rat / 0.09d0,12*0.075d0, 0.068d0, 18*.067d0 / data eicr /13*1.e20, 20264.0d0 , 21250.0d0, 22370.0d0, 23050.0d0, & 23*1.e20, & 13*0. , .05d0, .06d0, 15*.065d0,6*.07d0, & .14d0 ,3*.15d0/ data tab / 1000.0d0, .5d0, 2000.0d0, 1.25d0, 3000.0d0, 2.75d0, & 4000.0d0, 3.5d0, 7000.0d0, 5.0d0 , 9000.0d0, 6.0d0 , & 15000.0d0, 7.0d0, 20000.0d0, 8.0d0 ,25000.0d0, 9.0d0 , & 30000.0d0, 10.0d0, 40000.0d0,11.0d0 ,75000.0d0,12.0d0 , & 1.e20, 13.0d0/ data tab87/ 1000.0d0, .4d0 , 2000.0d0, .8d0, 4000.0d0,2.7d0, & 9000.0d0, 5.0d0 , 15000.0d0, 6.8d0, 20000.0d0,7.2d0, & 30000.0d0, 7.55d0, 45000.0d0, 8.8d0, 1.e20,9.98d0/ c in 1998 tax rate was reduced on 10% data tab98/ 1000.0d0, .36d0, 2000.0d0, .72d0, 4000.0d0,2.43d0, & 9000.0d0, 4.5d0 ,15000.0d0,6.12d0, 20000.0d0,6.48d0, & 30000.0d0, 6.8d0 ,45000.0d0,7.92d0, 1.e20,8.98d0/ data chcr90/10000.0d0, .75d0, 20000.0d0, .65d0, 25000.0d0,.55d0, & 35000.0d0, .50d0, 40000.0d0, .40d0, 45000.0d0,.30d0, & 50000.0d0, .20d0, 1.e20, .10d0/ data chcr93/10000.0d0, .75d0, 20000.0d0, .65d0, 25000.0d0,.55d0, & 35000.0d0, .50d0, 40000.0d0, .40d0, 1.e20,.0d0/ data chcr06/10000.0d0, .75d0, 20000.0d0, .65d0, 25000.0d0,.55d0, & 35000.0d0, .50d0, 40000.0d0, .40d0, 45000.0d0,.30d0, & 1.e20, .0d0/ data xmp/2*10.0d0,11.0d0,12.0d0,13.0d0,14.0d0,12*15.0d0, & 22*40.0d0/ data aif/ & 2*1.0d0 , 8*1.023d0, 2*1.0d0, 1.016d0, 1.038d0, & 4*1.060d0, 1.068d0, 1.089d0, 1.112d0, 1.136d0, & 1.148d0, 1.162d0, 1.185d0, 1.211d0, 1.224d0, & 1.242d0, 1.269d0, 1.30d0 , 1.343d0, 1.379d0, & 1.407d0, 1.428d0, 1.439d0, 1.469d0, 1.494d0, & 1.515d0, 1.539d0, 1.554d0/ data stnd/ 2*.10d0, 8*.150d0, 30*1.0d0, s 2*1000.0d0, 8*1200.0d0, 3*1230.0d0, 1260.0d0, 1280.0d0, i 1310.0d0, 1330.0d0, 1340.0d0, 1360.0d0, 1380.0d0, n 1410.0d0, 1440.0d0, 1460.0d0, 1470.0d0, 1500.0d0, g 1540.0d0, 1550.0d0, 1580.0d0, 1610.0d0, 1650.0d0, l 1700.0d0, 1750.0d0, 1780.0d0, 1810.0d0, 1830.0d0, e 1860.0d0, 1900.0d0, 1920.0d0, 1950.0d0, 1970.0d0, m 2*1000.0d0, 8*3000.0d0, 3*3030.0d0, 3100.0d0, 3160.0d0, a 3220.0d0, 3270.0d0, 3310.0d0, 3350.0d0, 3400.0d0, r 3480.0d0, 3550.0d0, 3590.0d0, 3630.0d0, 3700.0d0, r 3780.0d0, 3830.0d0, 3880.0d0, 3970.0d0, 4060.0d0, i 4200.0d0, 4310.0d0, 4390.0d0, 4460.0d0, 4500.0d0, e 4590.0d0, 4670.0d0, 4740.0d0, 4810.0d0, 4860.0d0/ c y levels for other and single filers which exempt them from taxes data exy/ & 2*4000.0d0, 13*5000.0d0, 7500.0d0, 24*9000.0d0, & 2*4000.0d0, 8*5000.0d0,5*7500.0d0, 11500.0d0, & 24*13500.0d0/ c only income brackets and a pnsion exclusion are indexed pre-1987. c indexing is contingent on a general fund surplus. xlin3 = 0. xlin5 = 0. rt = 0. addph = 0. mst = data(2) sep = data(3) nfile = int(filing(mst,1.,2.,3.,2.)) phas92=100000./data(3) if(law.ge.1992.and.law.le.2012)phas92=100000.*aif92(law)/data(3) if(law.ge.2013) & phas92 = aif13(law)*250000*filing(mst,1.,1.2,1.1,.6) c AGI agi=comnew(2) c federal tax refunds are included in agi, but are not in the program agi = agi - data(22) c Iowa doesn't tax Social Security benefits in the same manner as IRS if(comnew(79).gt.0) then agi = agi - comnew(79) c Iowa will fully exempt ssb beginning 2014 if(law.le.2013) then exc = max(0.0d0,agi) pha = 0. if(sep.eq.1) pha = 25000. if(mst.eq.2) pha = 32000. ssb = min(.5* max(0.0d0,.5*data(91)+exc-pha),.5*data(91)) c New in 2007 -- Social Security Phase-out if(law.ge.2007) ssb = ssb - ssbp(law)*ssb agi = agi + ssb addph = comnew(79) - ssb endif endif if(law.le.1987)agi = agi-xjobs(data,law) if(law.ge.1982.and.law.le.1984)agi = agi+comnew(32) txp = data(7) if (law.eq.1981) then agi = agi+divexc(data,comnew,law)-twn(data(12)+data(14),0.0d0, & 100.0d0*txp) endif c Pension/retirement income exclusion starts in 1995 c Effective for tax years beginning 1998, the pension/retirement c income exclusion has increased to up to $5000 for individuals c and to up to $10000 for married taxpayers who file a joint return penexc = 0. if(data(9).gt.0.and.law.ge.1995) penexc = & min(data(9)*pen(law),data(20)+data(72)) agi = agi - penexc c 2009 Iowa doesn't couples with the exclusion of the first $2,400 of c unemployment compensation if(law.eq.2009.and.data(82).gt.0) then agi = agi + min(data(82),data(7)*2400) endif c Federal tax is a deduction fedded = max(0.0d0,comnew(1)) xlin35 = agi - fedded +data(43) c Standard Deduct if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then stded = twn(stnd(law,1)*agi,0.0d0,stnd(law,2)) else stded = twn(stnd(law,1)*agi,0.0d0,stnd(law,3)) endif c charitable contribution deduction for non-itemizers if(law.ge.1984.and.law.le.1986) then stded = stded+twn(.25*(data(58)+data(59)+data(60)),0.0d0,75.0d0) endif c Itemized Deduct xitded=max(0.0d0,comnew(30)-data(50)) if(agi.gt.phas92.and.law.ge.1991.and.comnew(26).gt.0.) then xlin3=comnew(24)-comnew(20)-data(57)-max(0.0d0,data(61)-.1*agi) xlin5=comnew(30)-comnew(20)-data(57)-max(0.0d0,data(61)-.1*agi) if(xlin5.gt.0)xitded = max(0.d0,comnew(24)-data(50)*xlin3/xlin5) endif if(law.le.1985)xitded = xitded+min(.05*data(65),100.*data(7)) c Deductions ided = data(4) if(ided.eq.-2) xitded = 0 deduc = max(stded,xitded) c Taxable Income taxinc = max(0.0d0,agi-deduc+data(43)-fedded) c Tax Calculation if(mst.eq.2.and.agi.gt.0) then agih = max(data(85),data(86))+.5*(agi - data(11)) agiw = agi-agih if(agiw.gt.0) then stdedh = twn(stnd(law,1)*agi,0.0d0,stnd(law,2)) stdedw = stdedh xitdh = xitded*agih/agi xitdw = xitded-xitdh dedh = max(stdedh,xitdh) dedw = max(stdedw,xitdw) taxinh=max(0.0d0,agih-dedh+.5*data(43)-.5*fedded) taxinw=max(0.0d0,agiw-dedw+.5*data(43)-.5*fedded) else stdedh = stded stdedw = 0 xitdh = xitded xitdw = 0 dedh = max(stdedh,xitdh) dedw = 0 taxinh=taxinc taxinw=0 endif endif if(law.le.1986) then call look(tab,taxinc,13,n,statax,aif(law),0.0d0,rt,data) if(agi.gt.0.and.mst.eq.2) then taxinh=max(0.0d0,agih-dedh+data(43)*agih/agi-fedded*agih/agi) taxinw=max(0.0d0,agiw-dedw+data(43)*agiw/agi-fedded*agiw/agi) call look(tab,taxinh,13,n,stath,aif(law),0.0d0,rt,data) call look(tab,taxinw,13,n,statw,aif(law),0.0d0,rt,data) statax = min(statax,stath+statw) endif else if(law.ge.1987.and.law.le.1997) then call look(tab87,taxinc,9,n,statax,aif(law),0.0d0,rt,data) if(agi.gt.0.and.mst.eq.2) then call look(tab87,taxinh,9,n,stath,aif(law),0.0d0,rt,data) call look(tab87,taxinw,9,n,statw,aif(law),0.0d0,rt,data) statax = min(statax,stath+statw) endif else call look(tab98,taxinc,9,n,statax,aif(law),0.0d0,rt,data) if(agi.gt.0.and.mst.eq.2) then call look(tab98,taxinh,9,n,stath,aif(law),0.0d0,rt,data) call look(tab98,taxinw,9,n,statw,aif(law),0.0d0,rt,data) statax = min(statax,stath+statw) endif endif c Alternate Tax may reduce tax liability if(law.ge.1987.and.mst.ne.1) then if(law.le.1997) then altax = max(0.0d0,(agi-exy(law,2))*.0998) else subtr = exy(law,2) if(data(9).gt.0.and.law.ge.2007) then if(law.le.2008) subtr = 24000. if(law.ge.2009) subtr = 32000. endif xlin1 = agi + penexc + addph altax = max(0.0d0,(xlin1-subtr)*.0898) endif statax = min(statax,altax) endif c extra lump-sum distribution tax can not be calculated c Credits c Personal Exemption Credit if(law.le.1994) then gcred = (xmp(law)+5.)*(data(7)+data(9)+data(10))+ & xmp(law)*data(8) if(nfile.eq.3)gcred = gcred+xmp(law)+5. else if(law.ge.1995.and.law.le.1997) then gcred = (xmp(law)/2.)*(data(7)+data(9)+data(10))+ & (xmp(law)*data(8)) if(nfile.eq.3)gcred = gcred+xmp(law)/2 else gcred = (xmp(law)/2)*(data(9)+data(10))+ & (xmp(law)*(data(8)+data(7))) if(nfile.eq.3)gcred = gcred+xmp(law) endif gcred = gcred+data(34) statax = max(0.0d0,statax - gcred) c alternative minimum tax if(law.le.1981) then alty = 0. else if(law.eq.1982) then alty = comnew(70)*.25 else if(law.eq.1983.or.law.eq.1984) then alty = comnew(70)*.7 c for years 1985+ min tax is calculated using Form 6251 c rat(law) is only a guess for 1986-1995 because of the absence c of the form 6251 for these years else if(law.ge.1985) then c alty = max(0.0d0,max(0.0d0,rat(law)* c & (max(0.0d0,comnew(69)-alt1(mst))+ c & .25*max(0.0d0,(comnew(69)-alt2(mst))))-statax)) addprf = data(51) + comnew(20) + comnew(97) + data(81) alminy = taxinc + addprf if(xlin5.gt.0) alminy = alminy - data(50)*xlin3/xlin5 exclnt = alt1(mst) if(alminy.gt.alt2(mst)) & exclnt = max(0.0d0,alt1(mst) - .25*(alminy-alt2(mst))) alty = max(0.0d0,rat(law)*(alminy-exclnt) - statax) endif statax = statax + alty c child care credit is refundable for 1990+ posagi = max(agi,0.d0) if(law.le.1981) then chcr = comnew(176)*.05 else if(law.ge.1982.and.law.le.1985) then chcr = data(64)*.1 else if(law.ge.1986.and.law.le.1989) then chcr = comnew(176)*.45 else if(law.ge.1990.and.law.le.1992) then chcr = comnew(176)*tablki(chcr90,8,comnew(2),data) else if(law.ge.1993.and.law.le.2005) then c Only taxpayers <$40,000 of net income are eligible for 1993-2005 chcr = comnew(176)*tablki(chcr93,6,posagi,data) else if(law.ge.2006) then c Only taxpayers with <$45,000 of net income are eligible for 2006+ chcr = comnew(176)*tablki(chcr06,7,posagi,data) endif c Earned Income Credit started in 1990 earncr = 0. earned = comnew(37) if(comnew(2).lt.eicr(law,1)) earncr = eicr(law,2)*comnew(59) c worksheet if additional calculation required if(law.eq.2009.and.mst.eq.2.and.earncr.gt.0) then if(data(8).eq.0) xlin2 = 10590. if(data(8).ge.1.and.data(8).le.2) xlin2 = 19540. if(data(8).ge.3) xlin2 = 16420. xlin3 = max(0.0d0,earned - xlin2) if(data(8).eq.0) xlin5 = max(0.0d0,457. - xlin3*.0765) if(data(8).eq.1) xlin5 = max(0.0d0,3043. - xlin3*.1598) if(data(8).ge.2) xlin5 = max(0.0d0,5028. - xlin3*.2106) earncr = .07*xlin5 endif c Taxpayers may be eligible for Federal EITC, but not eligible for IA if(law.eq.2010.and.mst.eq.2.and.earncr.gt.0) then if(data(8).lt.1.and. & (earned.gt.16590.or.agi.gt.16590)) earncr = 0 if(data(8).eq.1.and. & (earned.gt.38665.or.agi.gt.38665)) earncr = 0 if(data(8).ge.2.and. & (earned.gt.43493.or.agi.gt.43493)) earncr = 0 else if(data(8).lt.1.and. & (earned.gt.13460.or.agi.gt.13460)) earncr = 0 if(data(8).eq.1.and. & (earned.gt.35535.or.agi.gt.35535)) earncr = 0 if(data(8).ge.2.and. & (earned.gt.40363.or.agi.gt.40363)) earncr = 0 endif credit = gcred + chcr + earncr if(law.le.1989) statax = max(0.0d0, statax-chcr-earncr) if(law.ge.1990.and.law.le.2006) & statax = max(0.0d0,statax-earncr)-chcr c Tax reducing income for single taxpayers if(mst.eq.1) statax = max(min(agi-exy(law,1),statax),0.0d0) c Starting 2007 EIC is refundable at 7% of the Federal EIC if(law.ge.2007) statax = statax - earncr - chcr c low income have 0 tax 1992+ if(statax.gt.0.and.law.ge.1992) then if(mst.eq.1.and.comnew(2).le.exy(law,1)) statax = 0. if(mst.gt.1.and.comnew(2).le.exy(law,2)) statax = 0. endif return end c KANSAS c State 17 c Updated through 2016 subroutine kstax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common/temp/ct dimension tab(2,8), & tabs88(2,2), tabj88(2,2) dimension tabs90(2,2), tabj90(2,2), tabs92(2,3), tabj92(2,3), &tabs97(2,3),tabs98(2,3),aif(1991:2009),eicr(1998:2016) dimension tab13(2,2),tab14(2,2),tab15(2,2) dimension socmax(1977:1997),selfmx(1977:1997) dimension data(255),comnew(255),xmp(1977:2016),child(2,11) dimension ftabm(2,4), ftabs(2,5) dimension agimax(1998:2016), food(1998:2016),aifit(2013:2016) dimension prc(2008:2016),hyprc(2008:2016),prop(1997:2016), & hom08(2,22), hom98(2,23),pt(1997:2016) double precision fedded,fedtax data pt/10*600.d0,10*700.d0/ data prc/3*.45d0,6*.75d0/ data hyprc/16800.d0,2*17500.d0,17700.d0,18200.d0,18600.d0, & 18900.d0, 19100.d0,19200.d0/ data prop/7*25001.d0,26301.d0,27001.d0,28001.d0,29101.d0, & 29701.d0,31301.d0,30801.d0,31201.d0,32401.d0, & 32901.d0,33401.d0,34001.d0,34101.d0/ data hom08/ & 6000.0d0, 1.0d0 , 7000.0d0, .96d0, 8000.0d0, .92d0, & 9000.0d0, .88d0,10000.0d0, .84d0, 11000.0d0, .80d0, & 12000.0d0, .76d0,13000.0d0, .72d0, 14000.0d0, .68d0, & 15000.0d0, .64d0,16000.0d0, .60d0, 17000.0d0, .55d0, & 18000.0d0, .50d0,19000.0d0, .45d0, 20000.0d0, .40d0, & 21000.0d0, .35d0,22000.0d0, .30d0, 23000.0d0, .25d0, & 24000.0d0, .20d0,25000.0d0, .15d0, 26000.0d0, .10d0, & 1.e20, .05d0/ data hom98/ & 3001.0d0, 1.0d0 , 4001.0d0, .88d0, 5001.0d0, .84d0, & 6001.0d0, .8d0 , 7001.0d0, .76d0, 8001.0d0, .72d0, & 9001.0d0, .68d0,10001.0d0, .64d0, 11001.0d0, .60d0, & 12001.0d0, .56d0,13001.0d0, .52d0, 14001.0d0, .48d0, & 15001.0d0, .44d0,16001.0d0, .40d0, 17001.0d0, .36d0, & 18001.0d0, .32d0,19001.0d0, .28d0, 20001.0d0, .24d0, & 21001.0d0, .20d0,22001.0d0, .16d0, 23001.0d0, .12d0, & 24001.0d0, .08d0, 1.e20, .04d0/ data aifit/.7d0,.65d0,2*.5d0/ data agimax/ & 5*12500.0d0,13150.0d0,13450.0d0,13800.0d0, & 14300.0d0,14850.0d0,15150.0d0,15950.0d0, & 2*17500.0d0,18350.0d0,4*30615.0d0/ data food/ & 5*30.0d0,3*36.0d0,37.0d0, 38.0d0,39.0d0, & 41.0d0,2*45.0d0,47.0d0,4*125.0d0/ c EIC rate 1998+ data eicr/ & 4*.1d0, 5*.15d0, 3*.17d0,3*.18d0,4*.17d0/ data aif / 1.0d0, 1.05250d0, 1.08450d0, 1.1180d0, 1.1470d0, & 1.17950d0, 1.2120d0 , 1.2450d0, 1.2660d0, 1.28950d0, & 1.32950d0, 1.3730d0 , 1.3950d0, 1.4270d0, 1.45950d0, & 1.5050d0, 1.5640d0, 1.59950d0, 1.6680d0 / data tab / & 2000.0d0, 2.0d0, 3000.0d0, 3.5d0, 5000.0d0, 4.0d0, & 7000.0d0, 5.0d0, 10000.0d0, 6.5d0, 20000.0d0, 7.5d0, & 25000.0d0, 8.5d0, 1.e20, 9.0d0 / data tabs88/ & 27500.0d0, 4.8d0, 1.e20, 6.1d0/ data tabj88/ & 35000.0d0, 4.05d0, 1.e20, 5.3d0/ data tabs90/ & 27500.0d0, 4.50d0, 1.e20, 5.95d0/ data tabj90/ & 35000.0d0, 3.65d0, 1.e20, 5.15d0/ data tabs92/ & 20000.0d0, 4.4d0, 30000.0d0, 7.5d0, 1.e20, 7.75d0/ data tabj92/ & 30000.0d0, 3.5d0, 60000.0d0, 6.25d0, 1.e20, 6.45d0/ data tabs97/ & 20000.0d0, 4.1d0, 30000.0d0, 7.50d0, 1.e20, 7.75d0/ data tabs98/ & 15000.0d0, 3.5d0, 30000.0d0, 6.25d0, 1.e20, 6.45d0/ data tab13/ 15000.0d0, 3.0d0, 1.e20, 4.9d0 / data tab14/ 15000.0d0, 2.7d0, 1.e20, 4.8d0 / data tab15/ 15000.0d0, 2.7d0, 1.e20, 4.6d0 / data ftabm/ & 20000.0d0, 4.75d0, 35000.0d0,5.0d0, 45000.0d0, 8.5d0, & 1.e20, 8.75d0/ data ftabs/ & 2000.0d0, 4.75d0, 10000.0d0,5.6d0, 20000.0d0,5.75d0, & 30000.0d0, 8.50d0, 1.e20,8.75d0/ data xmp/ & 2*750.0d0, 9*1000.0d0, 1950.0d0, 9*2000.0d0, 19*2250.0d0/ data child/ & 5000.0d0, 1.0d0, 6000.0d0, .9d0, 7000.0d0, .8d0, & 8000.0d0, .7d0 , 9000.0d0, .6d0, 10000.0d0, .5d0, & 11000.0d0, .4d0 , 12000.0d0, .3d0, 13000.0d0, .2d0, & 14000.0d0, .1d0 , 1.e20, .0d0/ data socmax/ & 965.25d0, 1070.8d0, 1403.8d0, 1587.7d0, 1975.05d0, & 2170.8d0 , 2391.9d0, 2532.6d0, 13*1.e20/ data selfmx/ & 1303.5d0, 1433.7d0 , 1854.9d0, 2097.9d0, 2405.7d0, & 3029.4d0, 3337.95d0, 4271.4d0, 13*1.e20/ rt=0. mst = data(2) txp = 1 if(mst.eq.2) txp = 2 c AGI agi = comnew(2)-data(22) if(law.le.1987)agi=agi-xjobs(data,law) c New in 2007 -- Social Security Benefits are not taxable if(law.eq.2007.and.comnew(2).le.50000) agi = agi - comnew(79) if(law.ge.2008.and.comnew(2).le.75000) agi = agi - comnew(79) c New in 2013 Schedule S Part A -- income modifications if(law.ge.2013) then agi = agi + .5*data(43) - comnew(8) - data(17) - data(21) endif c Standard Deduction if(law.le.1987) then if(mst.ne.2.and.mst.ne.3.and.mst.ne.6) then stded=twn(.16*agi,1700.0d0,2400.0d0) else if(mst.eq.2.or.mst.eq.3.or.mst.eq.6) then stded=twn(.16*agi,2100./data(3),2800./data(3)) endif else if(law.ge.1988.and.law.le.1997) then stded=filing(mst,3000.,5000.,4400.,2500.) xstd=data(9)+data(10) xstd=xstd*sorm(mst,750.0d0,600.0d0) stded=stded+xstd else if(law.ge.1998) then stded = filing(mst,3000.,6000.,4500.,3000.) if(law.ge.2013) stded = filing(mst,3000.,7500.,5500.,3000.) c Standard Deduction for Dependents if(data(105).gt.0.) stded = min(stded,max(500.0d0,comnew(37))) c Standard Deduction for People 65 or Older and/or Blind xstd = data(9)+data(10) xstd = xstd*sorm(mst,850.0d0,700.0d0) stded = stded+xstd endif c Federal tax deduction c the $5000/$10000 special tax limitation on the federal tax income deduction c expired on December 31,1984. c in 1987 all taxpayers are allowed to deduct their federal income tax fedtax=max(0.0d0,comnew(1)) if(law.le.1982.or.(law.ge.1987.and.law.le.1988)) then fedded=fedtax else if(law.eq.1983.or.law.eq.1984) then if(fedtax.le.5000.*data(7)) then fedded=fedtax else if(fedtax.gt.5000*data(7).and.fedtax.le.10000*data(7)) then fedded=5000.*data(7) else fedded=.5*fedtax endif else if(law.ge.1985.and.law.le.1986) then fedded=fedtax*max(agi,0.0d0)/max(comnew(2),1.0d0) else if(law.ge.1989) then fedded=0. endif c Itemized Deductions c if you did not itemize your deductions on your federal return, c you must take the stanard deduction on your Kansas return. xitded = 0. if(comnew(26).gt.0) then if(law.le.1987) then edm=max(0.0d0,data(49)+data(48)+data(47)-50.) soc=twn(socsec(data,law),0.0d0,socmax(law)*data(7)) addtx=twn(data(43)+data(44),0.0d0,selfmx(law)*data(7)) xitded=comnew(24)-data(50)-comnew(20)+edm+soc+addtx if(law.ge.1979.and.law.le.1986) & xitded=xitded+min(comnew(25),100.*data(7)) else if(law.ge.1988.and.law.le.1990) then xitded= max(0.d0,comnew(24)-data(50)) else if(law.ge.1991.and.law.le.2009) then if(comnew(2).le.100000.*aif(law)/data(3)) then xitded= max(0.d0,comnew(24)-data(50)) else ag = max(0.0d0,agi) fline3 = max(0.0d0, & comnew(24)-comnew(20)-max(data(61)-.1*ag,0.0d0)) if(fline3.gt.0.) then fline9 = min(.03*max(comnew(2)-100000.*aif(law),0.0d0), & .8 *fline3) sline1 = fline9/fline3 c fline3,fline9 - lines 3 and 9 of the federal it.ded. worksheet c sline1 - the first line of the state it. ded. worksheet xitded = max(0.d0,comnew(24) -data(50)*(1-sline1)) else xitded= max(0.d0,comnew(24)-data(50)) endif endif else if(law.ge.2010.and.law.le.2012) then xitded = max(comnew(24)-data(50),0.0d0) else if(law.ge.2013) then xitded = aifit(law)*max(comnew(24)-data(50)-comnew(23),0.0d0) & + comnew(23) endif endif deduc=max(stded,xitded) c Exemptions exemps = comnew(68) if(mst.eq.4.or.mst.eq.7) exemps = exemps+1 exemp = exemps*xmp(law) c Taxable Income taxinc=max(0.0d0,agi-deduc-exemp-fedded) c Calculation of Tax if (law.le.1987) then tinc = taxinc/data(7) call look(tab,tinc,8,n,stat,1.0d00,0.0d0,rt,data) statax = stat * data(7) else if(law.eq.1988.or.law.eq.1989)then if(mst.ne.2) & call look(tabs88,taxinc,2,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.2) & call look(tabj88,taxinc,2,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1990.or.law.eq.1991) then if(mst.ne.2) & call look(tabs90,taxinc,2,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.2) & call look(tabj90,taxinc,2,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1989.and.law.le.1991) then c if claiming a deduct for fed inc tax....only lasts through 1991 taxy=max(0.0d0,taxinc-fedtax) if(mst.ne.2) & call look(ftabs,taxy,5,n,ftax,1.0d00,0.0d0,rt,data) if(mst.eq.2) & call look(ftabm,taxy,4,n,ftax,1.0d00,0.0d0,rt,data) statax=min(statax,ftax) else if(law.ge.1992.and.law.le.2012) then if(mst.ne.2) then if(law.le.1996) then call look(tabs92,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1997) then call look(tabs97,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1998) then call look(tabs98,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) endif else call look(tabj92,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) endif else if(law.eq.2013) then call look(tab13,taxinc/txp,2,n,statax,1.0d00,0.0d0,rt,data) statax = statax*txp else if(law.eq.2014) then call look(tab14,taxinc/txp,2,n,statax,1.0d00,0.0d0,rt,data) statax = statax*txp else if(law.ge.2015) then call look(tab15,taxinc/txp,2,n,statax,1.0d00,0.0d0,rt,data) statax = statax*txp if(law.eq.2016.and.mst.ne.2.and.taxinc.le.5000.0d0) statax = 0. if(law.eq.2016.and.mst.eq.2.and.taxinc.le.12500.0d0)statax = 0. endif c Credits c child care credit chcare = min(comnew(53),max(0.0d0,comnew(52)-data(34))) if(law.le.1987) then chcr=chcare*tablki(child,11,agi,data) else if(law.ge.1988.and.law.le.2012) then chcr=.25*chcare else if(law.ge.2013) then chcr=0. endif c federal and kansas solar energy credits expire after 1986, but c carryover should still be counted by data(38) c the credit was limited to $1500. per dwelling for tax years 1984 and 1985 c the solar energy credit expired as December 31,1985 if(law.le.1979) then encred=min(1000.0d0,data(38)) else if(law.ge.1980.and.law.le.1985) then encred=min(1500.0d0,data(38)) else encred=0. endif c Homestead and Food Sales Tax c food credit pcred=0 if(law.eq.1977.or.law.eq.1978) then if(law.eq.1977) then bound=8150. else bound=9200. endif if(data(159).le.bound) then pr1=data(51)+.12*data(160) if(data(159).le.3400.) then pcred = pr1 else if(data(159).gt.3400) then if(data(159).le.4200.) then claw =max(0.0d0,(data(159)-3400.)*.02) else if(data(159).gt.4200.and.data(159).le.4600.)then claw = 16.+ max(0.0d0,(data(159)-4200)*.04) else claw = 32.+ max(0.0d0,(data(159)-4600)*.045) endif pcred=max(0.0d0,min(395.0d0,pr1-claw)) c if(pcred.lt.5.) pcred=0. endif endif c formulas interpolate the table in the booklet else if(law.ge.1979.and.law.le.1988.and.data(159).le.12800.)then pr1=data(51)+.15*data(160) if(data(159).le.3400.) then pcred = pr1 else if(data(159).gt.3400) then if(data(159).le.3500.) then claw =max(0.0d0,(data(159)-3400.)*.01) else if(data(159).gt.3500.and.data(159).le.4000.)then claw = 1. + max(0.0d0,(data(159)-3500.)*.02) else if(data(159).gt.4000.and.data(159).le.4600.) then claw = 11.+ max(0.0d0,(data(159)-4000.)*.03) else if(data(159).gt.4600.and.data(159).le.8600.) then claw = 29.+ max(0.0d0,(data(159)-4600.)*.04) else claw = 189.+ max(0.0d0,(data(159)-8600.)*.05) endif c pcred=max(0.0d0,min(395.0d0,int(pr1/5)*5.)-claw) c using int doesn't give us a monotone function pcred=max(0.0d0,min(395.0d0,pr1)-claw) c if(pcred.lt.5.) pcred=0. endif else if(law.ge.1989.and.law.le.1994.and.data(159).le.15000.)then pr1=data(51)+.15*data(160) if(data(159).le.3400.) then pcred = pr1 else if(data(159).gt.3400) then if(data(159).le.4200.) then claw =max(0.0d0,(data(159)-3400.)*.02) else if(data(159).gt.4200.and.data(159).le.4600.) then claw = 16.+ max(0.0d0,(data(159)-4200)*.04) else claw = 32.+ max(0.0d0,(data(159)-4600)*.045) endif c pcred=max(0.0d0,min(490.0d0,int(pr1/10)*10.)-claw) pcred=max(0.0d0,min(490.0d0,pr1)-claw) c if(pcred.lt.5.) pcred=0. endif c Homestead refund else if(law.eq.1996.or.law.eq.1995.and.data(159).le.17200.)then pr1=data(51)+.15*data(160) if(data(159).le.3400.) then pcred = pr1 else if(data(159).gt.3400) then if(data(159).le.4200.) then claw =max(0.0d0,(data(159)-3400.)*.02) else if(data(159).gt.4200.and.data(159).le.4600.) then claw = 16.+ max(0.0d0,(data(159)-4200)*.04) else claw = 32.+ max(0.0d0,(data(159)-4600)*.045) endif c pcred=max(0.0d0,min(590.0d0,int(pr1/10)*10.)-claw) pcred=max(0.0d0,min(590.0d0,pr1)-claw) c if(pcred.lt.5.) pcred=0. endif else if(law.ge.1997) then c Kansas provides a homestead refund ptax = min(pt(law),data(51)+.2*data(160)) if(law.le.2005) then hhy = hy else hhy = hy - .5*data(91) endif pmax = prop(law) if(hhy.lt.pmax) then if(law.le.2004) pcred = ptax*tablki(hom98,23,hhy,data) if(law.ge.2005) pcred = ptax*tablki(hom08,22,hhy,data) endif c Kansas Property Tax Relief Claim for Low Income Seniors 2008+ c Claimants who receive this property tax refund cannot claim a Homestead refund if(data(9).gt.0.d0.and.data(51).gt.0.d0.and.law.ge.2008) then if(hy.lt.hyprc(law)) pcred = prc(law)*data(51) endif endif c Kansas food sales tax refund fd=0. if(law.le.1985) then if(data(159).le.10000.) & fd=20.*twn(data(9)+data(10),0.0d0,data(7)+data(8)) else if(law.ge.1986.and.law.le.1997) then if(data(159).lt.5000.) & fd=40.+30.*(data(7)+data(8)-1.) if(data(159).ge.5000..and.data(159).lt.10000.) & fd=30.+25.*(data(7)+data(8)-1.) if(data(159).ge.10000..and.data(159).le.13000.) & fd=20.+15.*(data(7)+data(8)-1.) else if(law.ge.1998.and.data(8)+data(9)+data(10).gt.0.) then if(law.le.2012) then if(agi.le.agimax(law)) then fd = 2*food(law)*exemps else if(agi.le.2*agimax(law)) then fd = food(law)*exemps endif else if(law.ge.2013) then if(comnew(2).le.agimax(law))fd = food(law)*comnew(68) endif endif c Earned Income Credit - new in 1998 c Kansas allows a State Earned Income Credit based on c a percentage of the federal EIC earncr = 0. if(law.ge.1998) earncr = eicr(law)*comnew(59) credit = chcr + encred + pcred + fd + earncr if(law.le.2012) then statax = max(0.0d0,statax - encred-chcr)-fd-earncr-pcred else if(law.ge.2013) then c 2013 Food Sales tax credit is non-refundable in 2013+ statax = max(0.0d0,statax - encred-chcr-fd)-earncr-pcred endif return end c KENTUCKY c State 18 c Updated 2016 subroutine kytax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255) double precision lowcrd,modagi integer count dimension tab(2,5),ch(1982:1986,2),ded(1977:2016), & retire(1995:2016,2),tab05(2,6) dimension fam051(2,11),fam052(2,11), fam053(2,11), fam054(2,11) c Beginning with 1995 , part of most types of pension and c retirement income is excluded from tax by Kentucky. c Year Percent Up to c excluded Maximum of c 1995 25 $6250 c 1996 50 $12500 c 1997 75 $18750 c 1998 100 $35000 c 1999 100 $35700 c 2000 100 $36414 c 2001 100 $37500 c 2002 100 $38775 c 2003 100 $39400 c 2004 100 $40200 c 2005-2016 100 $41110 dimension aif92(1992:2012),aiff1(2005:2016),aiff2(2005:2016), &aiff3(2005:2016),aiff4(2005:2016),aif13(2013:2017) data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ data aif92/ & 1.0525d0, 1.0845d0, 1.118d0, 1.1470d0, 1.1795d0, & 1.2120d0, 1.2450d0, 1.266d0, 1.2895d0, 1.3295d0, & 1.3730d0, 1.3950d0, 1.427d0, 1.4595d0, 1.5050d0, & 1.5640d0, 1.5995d0, 1.668d0,2*1.6955d0, 1.7365d0/ data aiff1/ & 1.0d0,1.024d0,1.067d0,1.087d0,2*1.132d0,1.138d0, & 1.1567d0, 1.2d0, 1.220d0,1.230d0,1.2413793d0/ data aiff2/ & 1.0d0,1.029d0,1.067d0,1.091d0,2*1.136d0,1.1465d0, & 1.179d0, 1.2d0, 1.226d0,1.242d0,1.248636d0/ data aiff3/ & 1.0d0,1.0317d0,1.067d0,1.0938d0,2*1.138d0,1.1516d0, & 1.1865d0,1.214d0, 1.23d0 ,1.249d0,1.2529521d0/ data aiff4/ & 1.0d0,1.0336d0,1.067d0,1.0996d0,2*1.13953d0,1.155d0, & 1.191d0,1.217d0, 1.23d0 ,1.253d0,1.2558139d0/ data tab/ & 3000.0d0,2.0d0,4000.0d0,3.0d0,5000.0d0,4.0d0, & 8000.0d0,5.0d0, 1.e20,6.0d0/ data tab05/ & 3000.0d0,2.0d0, 4000.0d0,3.0d0,5000.0d0,4.0d0, & 8000.0d0,5.0d0,75000.0d0,5.80d0, 1.e20,6.0d0/ data retire/ 1 6250.0d0, 12500.0d0, 18750.0d0, 35000.0d0, 35700.0d0, 1 36414.0d0, 37500.0d0, 38775.0d0, 39400.0d0, 40200.0d0, 1 12*41110.0d0, 2 .25d0, .5d0, .75d0, 19*1.0d0/ c contains rates and limits for non-itemizer charitable deduction data ch/ & 3*.25d0, 2*.5d0, 2*50.0d0, 75.0d0, 2*1.e20/ data ded/ & 20* 650.0d0, 900.0d0, 1200.0d0, 1500.0d0, 1700.0d0, & 1750.0d0, 1800.0d0, 1830.0d0, 1870.0d0, 1910.0d0, & 1970.0d0, 2050.0d0, 2100.0d0, 2190.0d0, 2210.0d0, & 2240.0d0, 2290.0d0, 2360.0d0, 2400.0d0, 2440.0d0, & 2460.0d0/ data fam051 / & 9570.0d0, 1.0d0, 9953.0d0, .9d0, 10336.0d0, .8d0, & 10718.0d0, .70d0,11101.0d0, .6d0, 11484.0d0, .5d0, & 11867.0d0, .40d0,12154.0d0, .3d0, 12441.0d0, .2d0, & 12728.0d0, .10d0, 1.e20, .0d0/ data fam052 / & 12830.0d0, 1.0d0,13343.0d0, .9d0, 13856.0d0, .8d0, & 14370.0d0, .70d0,14883.0d0, .6d0, 15396.0d0, .5d0, & 15909.0d0, .40d0,16294.0d0, .3d0, 16679.0d0, .2d0, & 17064.0d0, .10d0, 1.e20, .0d0/ data fam053 / & 16090.0d0, 1.0d0,16734.0d0, .9d0, 17377.0d0, .8d0, & 18021.0d0, .70d0,18664.0d0, .6d0, 19308.0d0, .5d0, & 19952.0d0, .40d0,20434.0d0, .3d0, 20917.0d0, .2d0, & 21400.0d0, .10d0, 1.e20, .0d0/ data fam054 / & 19350.0d0, 1.0d0,20124.0d0, .9d0, 20898.0d0, .8d0, & 21672.0d0, .70d0,22446.0d0, .6d0, 23220.0d0, .5d0, & 23994.0d0, .40d0,24575.0d0, .3d0, 25155.0d0, .2d0, & 25736.0d0, .10d0, 1.e20, .0d0/ excli=.15*twn(data(14)-data(57),0.0d0,450*data(7)) fedtax=max(0.0d0,comnew(1)-data(43)- & max(0.0d0,comnew(70)-comnew(28))) rt=0. mst = data(2) phas92=100000./data(3) if(law.ge.1992.and.law.le.2012)phas92=100000.*aif92(law)/data(3) if(law.ge.2013) & phas92 = aif13(law)*250000*filing(mst,1.,1.2,1.1,.6) c AGI c ky agi becomes more like fed agi in 1990 c self-employed health ins deduction is an addition to federal agi addit=data(124) subtra=data(22) if(law.eq.1990) subtra=subtra+comnew(1) if(law.le.1989) agi=comnew(2)-fedtax-xif(law.eq.1985,excli) if(law.ge.1990) agi=comnew(2)+addit-subtra c 2009 KY has not adopted federal $2400 for unemployment if(law.eq.2009) agi = agi - comnew(78) + data(82) if(law.ge.1984) agi=agi-comnew(79) c fed also has $100 dividend exclusion before 1986; c ky keeps after 86 through 1989 if(law.ge.1987.and.law.le.1989) agi=agi-divexc(data,comnew,law) if(law.le.1997) agi=agi-twn(data(12),0.0d0,100.*data(7)) if(law.ge.1982.and.law.le.1986)agi=agi+comnew(32) c ira contributions are not subject to federal limits after 1986 if(law.ge.1987)agi=agi-max(data(29),0.0d0) c Retirement income exclusion retexc = 0. if(law.ge.1995) retexc = & min(retire(law,2)*(data(20)+data(72)),retire(law,1)) agi = agi - retexc c 1987-1989 KY gives a 60% exclusion for long term capital gains if(law.ge.1987.and.law.le.1989.and.comnew(6).gt.0) then agi = agi - .6*max(0.0d0,min(data(70),data(70)+data(60))) endif c Deductions c Standard deduction stded = ded(law) c if(law.ge.1997) stded=2*ded(law) if(law.ge.1982.and.law.le.1986) then char=data(58)+data(59) stded=stded+min(char*ch(law,1),ch(law,2)) endif c Itemized Deduction xitded=max(0.d0,comnew(30)-data(50)) if(agi.gt.phas92.and.law.ge.1991) then reduce = min(.8*xitded,.03*(agi-phas92)) if(law.ge.2006.and.law.le.2007) reduce = 2*reduce/3 if(law.ge.2008.and.law.le.2009) reduce = reduce/3 if(law.eq.2010) reduce = 0 xitded = xitded-reduce endif if(law.le.1989)then child=0 ytest=agi+fedtax if(ytest.le.44600.) then if(data(8).gt.0..and.data(8).lt.2.) then child=min(2400.0d0,comnew(53)) else if(data(8).gt.1.and.data(8).lt.3.) then child=min(3600.0d0,comnew(53)) else if(data(8).gt.2.) then child=min(4800.0d0,comnew(53)) endif if(ytest.ge.35000.)child=max(0.0d0,child-((ytest-35000)/2.)) endif xitded=xitded+child endif ided = data(4) if(ided.eq.-2.and.law.eq.1999) xitded=0 deduc=max(stded,xitded) c ignore additional deduc. for separate returns w/ dep. spouse y=0. c Taxable Income taxinc=max(0.0d0,agi-deduc) if(mst.eq.2.and.agi.gt.0) then agih = max(data(85),data(86))+.5*(agi - data(11)) agiw = agi-agih xitdh = xitded*agih/agi xitdw = xitded-xitdh dedh = max(stded,xitdh) dedw = max(stded,xitdw) taxinh=max(0.0d0,agih-dedh) taxinw=max(0.0d0,agiw-dedw) endif if(law.le.2004) then call look(tab,taxinc,5,n,statax,1.0d0,0.0d0,rt,data) if(mst.eq.2.and.agi.gt.0) then call look(tab,taxinh,5,n,stath,1.0d0,0.0d0,rt,data) call look(tab,taxinw,5,n,statw,1.0d0,0.0d0,rt,data) statax = min(statax,stath+statw) endif else call look(tab05,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) if(mst.eq.2.and.agi.gt.0) then call look(tab05,taxinh,6,n,stath,1.0d0,0.0d0,rt,data) call look(tab05,taxinw,6,n,statw,1.0d0,0.0d0,rt,data) statax = min(statax,stath+statw) endif endif gcred = 0. lowcrd = 0. chcr = 0. credit = 0. if(law.le.1989) then if(law.ge.1984.and.law.le.1986) credit=min(data(38),1500.0d0) statax=max(statax-credit,0.0d0) else c elderly and blind get 2 credits for each condition (Personal Credits) count=data(7)+data(8)+2*(data(9)+data(10)) gcred=20.*count if(law.ge.2014) & gcred = 10*(data(7) + data(8)) + 40*(data(9)+data(10)) statax=max(statax-gcred,0.0d0) c low income credit chcr = comnew(176)*.2 if(law.ge.1990.and.law.le.2004) then if(agi.le.5000.)lowcrd=statax*1. if(agi.gt.5000..and.agi.le.10000.)lowcrd=statax*.5 if(agi.gt.10000..and.agi.le.15000.)lowcrd=statax*.25 if(agi.gt.15000..and.agi.le.20000.)lowcrd=statax*.15 if(agi.gt.20000..and.agi.le.25000.)lowcrd=statax*.05 credit=chcr+lowcrd statax=max(statax-credit,0.0d0) credit = credit + gcred elseif(law.ge.2005) then c Family Size Credit and Personal tax credit 2005+ famcr = 0. perc = 0. num = min(data(7)+data(8)+data(9),4.0d0) modagi = max(agi,comnew(2)) if(num.eq.1) perc=tablki(fam051,11,modagi/aiff1(law),data) if(num.eq.2) perc=tablki(fam052,11,modagi/aiff2(law),data) if(num.eq.3) perc=tablki(fam053,11,modagi/aiff3(law),data) if(num.eq.4) perc=tablki(fam054,11,modagi/aiff4(law),data) famcr = statax * perc credit = credit + famcr + chcr + gcred statax = max(0.0d0,statax - famcr - chcr) endif endif return end c LOUISIANA c state 19 c Updated through 2016 c subroutine latax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common /user/ zbrack(3,1987:2018),exem(1987:2018), &crmax(1987:2018,0:3,1:2),ymax(1987:2023,0:3,1:2), 1rtbase(1987:2023,0:3), rtless(1987:2023,0:3), 2chmax(1998:2023),ealim(2001:2023),cphas(7) dimension data(255),comnew(100),tab77(2,3) dimension tab80(2,3),stxmp(1977:2016,2),xmpd(1977:2016) c real tab83(2,3) dimension tab83s(2,5), tab83m(2,5),tab03m(2,3),tab03s(2,3), &tab03h(2,3),tab02h(2,3),tab09m(2,3),tab09s(2,3),tab09h(2,3) integer txp,sep data tab77/ & 7500.0d0, 2.0d0,50000.0d0, 4.0d0,1.e20, 6.0d0/ data tab80/ & 10000.0d0, 2.0d0,50000.0d0, 4.0d0,1.e20, 6.0d0/ data tab83s/ & 5000.0d0, 2.0d0, 6000.0d0, 3.3d0, 45000.0d0, 4.0d0, & 46000.0d0, 5.3d0, 1.e20, 6.0d0/ data tab83m/ & 10500.0d0, 2.0d0,11500.0d0, 3.3d0, 90500.0d0, 4.0d0, & 91500.0d0, 5.3d0, 1.e20, 6.0d0/ data tab03m/ & 16000.0d0, 2.0d0,41000.0d0, 4.0d0, 1.e20, 6.0d0/ data tab09m/ & 16000.0d0, 2.0d0,91000.0d0, 4.0d0, 1.e20, 6.0d0/ data tab03s/ & 8000.0d0, 2.0d0,20000.0d0, 4.0d0, 1.e20, 6.0d0/ data tab09s/ & 7500.0d0, 2.0d0,45500.0d0, 4.0d0, 1.e20, 6.0d0/ data tab03h/ & 3750.0d0, 2.0d0,17000.0d0, 4.0d0, 1.e20, 6.0d0/ data tab09h/ & 3500.0d0, 2.0d0,41000.0d0, 4.0d0, 1.e20, 6.0d0/ data tab02h/ & 2000.0d0, 2.75d0,41000.0d0,4.0d0, 1.e20, 6.0d0/ c Louisiana combines standard deduction and exemptions data stxmp/ & 3*3500.0d0,3* 6000.0d0,34*4500.0d0, & 3*6000.0d0,3*12000.0d0,34*9000.0d0/ data xmpd/ & 3*400.0d0,37*1000.0d0/ rt=0. mst=data(2) sep = data(3) c AGI agi = comnew(2) c Annual retirement income exemption for taxpayers 65 and over. penexc = 0. if(law.ge.1981)penexc = twn(data(20)+data(72),0.0d0,6000.*data(9)) c Taxable social security benefits ssi = 0 if(law.ge.1985) ssi = comnew(79) subtr = ssi + penexc c federal tax applicable to exempt income Schedule E ftadd = 0 if(comnew(2).gt.0.d0.and.comnew(1).gt.0.d0.and.subtr.gt.0.d0)then if(subtr.le.50000.d0) then ftadd1 = .25*max(0.d0,subtr-15000.d0) else ftadd1 = 8750.d0 + .4*(subtr - 50000.d0) endif perc = min(1.d0,subtr/comnew(2)) ftadd2 = comnew(1)*perc ftadd = min(ftadd1,ftadd2) endif c (subtr-ftadd) <-- exempt income agi = agi - (subtr - ftadd) deduc = 0. ided = data(4) if(ided.eq.-2.and.law.eq.1999) comnew(26)=0. c Excess federal Itemized deductions if(comnew(26).gt.0.and.law.ge.1980) then if(mst.eq.1) then nfile = 1 else if(mst.eq.4.or.mst.eq.7) then nfile = 3 else nfile = 2 endif if(law.ge.1987) then fedbas = zbrack(nfile,law)/sep else fedbas = comnew(3) endif if((law.ge.1980.and.law.le.1999).or.law.ge.2009) then deduc = max(0.0d0,comnew(24)-fedbas) else if(law.ge.2000.and.law.le.2001) then deduc = .5*max(0.0d0,comnew(24)-fedbas) else if(law.eq.2002) then deduc = .57*max(0.0d0,comnew(24)-fedbas) else if(law.eq.2007) then deduc = .575*max(0.0d0,comnew(24) - fedbas) else if(law.eq.2008) then pded = 0.d0 if(data(51).gt.0) pded = min(500.*data(7),data(51)) deduc = .65 *max(0.0d0,comnew(24) - (fedbas+pded)) endif endif c Federal income tax deduction if(law.le.1979) then fedtax = max(0.0d0,comnew(28)) else fedtax = (max(0.0d0,comnew(52)-comnew(58))+comnew(70)) endif taxinc = max(0.0d0,agi - deduc - fedtax) c Exemptions c txp = data(7) c if(mst.eq.4.or.mst.eq.7) txp = data(7)+1 txp = 1 if(mst.eq.2.or.mst.eq.4.or.mst.eq.7) txp = 2 taxinc = max(0.0d0,taxinc - stxmp(law,txp)) exemp = stxmp(law,txp) c tax calculation if(law.ge.1977.and.law.le.1979) then call look(tab77,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1980.and.law.le.1982) then call look(tab80,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) else if(mst.eq.1.or.sep.eq.2) then if(law.le.2002) & call look(tab83s,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) if(law.ge.2003.and.law.le.2008) & call look(tab03s,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) if(law.ge.2009) & call look(tab09s,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) statax=max(0.0d0, & statax-.02*xmpd(law)*(data(8)+data(9)+data(10))) else if(mst.eq.2.or.mst.eq.5) then if(law.le.2002) & call look(tab83m,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) if(law.ge.2003.and.law.le.2008) & call look(tab03m,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) if(law.ge.2009) & call look(tab09m,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) statax=max(0.0d0, & statax-.02*xmpd(law)*(data(8)+data(9)+data(10))) else c 1983-2002 ,hoh if(law.le.2002) then call look(tab02h,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) statax=max(0.0d0, & statax-xmpd(law)*(.02*min(1.0d0,data(8)+data(9)+data(10))+ & .04*max(0.0d0,data(8)+data(9)+data(10)-1))) endif c 2003+ , hoh if(law.ge.2003) then if(law.le.2008) & call look(tab03h,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) if(law.ge.2009) & call look(tab09h,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) statax=max(0.0d0, & statax-xmpd(law)*(.02*min(3.0d0,data(8)+data(9)+data(10))+ & .03*min(1.0d0,max(0.0d0,data(8)+data(9)+data(10)-4))+ & .04*max(0.0d0,data(8)+data(9)+data(10)-5))) endif endif endif c Credits c credit for child education edcr=0. if(((law.ge.1979.and.law.le.1985).or. & (law.ge.1996.and.law.le.1999)).and.data(8).ge.1) then edcr=25*data(8) endif if(law.ge.2015.and.data(8).ge.1) edcr=18*data(8) c 10% of federal credits given if(law.le.1979) then fedcr=0. else fedcr=.1*(data(34)+comnew(53)+comnew(54)) endif if(law.ge.1986)fedcr=min(fedcr,25.0d0) c credits for blindness and other disabilties bcr=data(10)*100. c child care credit since 2003 chcr = 0. chcref = 0. if(law.ge.2003) then base = comnew(2) if(base.le.25000) chcref = .5*comnew(53) if(base.gt.25000.and.base.le.35000) chcr = .3*comnew(53) if(base.gt.35000.and.base.le.60000) chcr = .1*comnew(53) if(base.gt.60000) chcr = min(.1*comnew(53),25.0d0) endif c credits can not exceed tax amounts - non-refundable credit = fedcr+edcr+bcr+chcr statax=max(statax-credit,0.0d0) c Earned income credit -- refundable and since 2008 earncr = 0. if(law.ge.2008) earncr = 0.035 * comnew(59) credit = credit + earncr + chcref statax = statax - earncr - chcref c1 format(1x,10f8.0) c next line is only for chcr comparison if(law.ge.2003.and.chcref.gt.0) chcr = chcref return end c MAINE c State 20 c c Updated through 2016 subroutine metax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common/temp/count integer txp dimension data(255), comnew(255), std(7),aif93(1993:2012) dimension xmp(1977:2012), hylim(1977:1994,2), child(1977:2016) c real yindx(3), fed(7), aif(1977:1993) dimension tab(2,8),tabh(2,8),tabm(2,8),tab93(2,4),tab93h(2,4), & tab13h(2,3),tab13(2,3),tab16h(2,3),tab16(2,3), & stdm(2003:2016), old(2003:2016),olds(2016:2016),xitd(2013:2016) c no need to make a change in stdm in 2012 because state std = federal std dimension tabm88(2,4), tabs88(2,4), tabh88(2,4) dimension tabm89(2,4), tabs89(2,4), tabh89(2,4) dimension tabm91(2,5), tabs91(2,5), tabh91(2,5) dimension pended(2000:2016) double precision mxmp(2,3), sxmp(2,3), hxmp(2,3),iratax integer sep data pended/14*6000.d0,3*10000.d0/ data xitd/27500.0d0,27950.0d0,28350.0d0,28450.0d0/ data aif93/ & 9*1.0375d0,1.05d0 ,1.0625d0,1.0875d0,1.125d0, & 1.1375d0,1.1875d0,1.2125d0,1.2625d0,1.2375d0, & 1.25d0 ,1.275d0 / c Standard Deductions for married couples 2003+ data stdm/ & 7950.0d0, 8150.0d0, 8300.0d0, 8600.0d0, 8900.0d0, & 9100.0d0, 9500.0d0, 9550.0d0, 9650.0d0,2*10150.0d0, & 12400.0d0,12600.0d0,23200.0d0/ data old/ & 4*1000.0d0, 2*1050.0d0, 2*1100.0d0, 1150.0d0,3*1200.0d0, & 2*1250.0d0/ data olds/1550.0d0/ c 1977 year data tab/ & 2000.0d0, 1.0d0, 4000.0d0, 2.0d0, 6000.0d0, 4.0d0, & 8000.0d0, 6.0d0, 10000.0d0, 7.0d0, 15000.0d0, 8.0d0, & 25000.0d0, 9.0d0, 1.e20,10.0d0/ data tabh/ & 3000.0d0, 1.0d0, 6000.0d0, 2.0d0, 9000.0d0, 4.0d0, & 12000.0d0, 6.0d0, 15000.0d0, 7.0d0, 22500.0d0, 8.0d0, & 37500.0d0, 9.0d0, 1.e20,10.0d0/ data tabm/ & 4000.0d0, 1.0d0, 8000.0d0, 2.0d0, 12000.0d0, 4.0d0, & 16000.0d0, 6.0d0, 20000.0d0, 7.0d0, 30000.0d0, 8.0d0, & 50000.0d0, 9.0d0, 1.e20,10.0d0/ c 1988 year data tabs88/ & 6000.0d0, 2.0d0,10000.0d0, 4.0d0,16250.0d0,6.0d0,1.e20, 8.0d0/ data tabm88/ & 13000.0d0, 2.0d0,20000.0d0, 4.0d0,30000.0d0,6.0d0,1.e20, 8.0d0/ data tabh88/ & 10000.0d0, 2.0d0,15150.0d0, 4.0d0,22000.0d0,6.0d0,1.e20, 8.0d0/ c 1989-1990 years data tabm89/ & 8000.0d0, 2.0d0,16000.0d0, 4.5d0,32000.0d0,7.0d0,1.e20, 8.5d0/ data tabs89/ & 4000.0d0, 2.0d0, 8000.0d0, 4.5d0,16000.0d0,7.0d0,1.e20, 8.5d0/ data tabh89/ & 6000.0d0, 2.0d0,12000.0d0, 4.5d0,24000.0d0,7.0d0,1.e20, 8.5d0/ c 1991-1992 years data tabm91/ & 8250.0d0, 2.1d0, 16500.0d0, 4.725d0,33000.0d0, 7.35d0, & 75000.0d0, 8.925d0, 1.e20, 9.89d0/ data tabs91/ & 4150.0d0, 2.1d0 , 8250.0d0, 4.725d0,16500.0d0, 7.35d0, & 37500.0d0, 8.925d0, 1.e20, 9.89d0/ data tabh91/ & 6200.0d0, 2.10d0 , 12400.0d0, 4.725d0,24750.0d0, 7.35d0, & 56250.0d0, 8.925d0, 1.e20, 9.89d0/ c 1993 + data tab93/ 4000.0d0, 2.0d0, 8000.0d0, 4.5d0, 16000.0d0, 7.0d0, & 1.e20, 8.50d0/ data tab93h/ 6000.0d0, 2.0d0, 12000.0d0, 4.5d0, 24000.0d0, 7.0d0, & 1.e20, 8.50d0/ data tab13 / 5200.0d0, 0.0d0, 20900.0d0, 6.5d0, 1.e20, 7.95d0/ data tab13h/ 7850.0d0, 0.0d0, 31350.0d0, 6.5d0, 1.e20, 7.95d0/ data tab16 /21050.0d0, 5.8d0, 37500.0d0, 6.75d0, 1.e20, 7.15d0/ data tab16h/31550.0d0, 5.8d0, 56250.0d0, 6.75d0, 1.e20, 7.15d0/ c data mxmp/ 40000.0d0, 55.0d0, 50000.0d0, 65.0d0, 1.e20, 30.0d0/ data sxmp/ 20000.0d0, 55.0d0, 25000.0d0, 65.0d0, 1.e20, 30.0d0/ data hxmp/ 30000.0d0, 55.0d0, 37500.0d0, 65.0d0, 1.e20, 30.0d0/ data std/60.0d0,100.0d0,50.0d0,88.0d0,100.0d0,50.0d0,88.0d0/ data xmp / & 1000.0d0, 1200.0d0,9*1000.0d0, .0d0, 4*2000.0d0, & 4*2100.0d0, 2150.0d0, 2400.0d0, 2750.0d0,13*2850.0d0/ c *** missing values for 85, 86 and 89: guessed data hylim/4500.0d0, 3*5000.0d0, 5600.0d0, 3*6200.0d0, & 3*7400.0d0,7*0.0d0, 5000.0d0, 3*6000.0d0, 6700.0d0, & 3*7400.0d0,3*9200.0d0,7*0.0d0/ data child/ & 9*.15d0, .16d0, .2d0, 15*.25d0 ,3*.215d0,11*.25d0/ mst=int(data(2)) sep=data(3) c zero bracket amount for itemized deductions; 1988 law rt=0. c AGI agi=comnew(2) if(law.ge.1979)agi=agi-data(22) if(law.ge.1981)agi=agi-xjobs(data,law) c fed and maine have different div and int exclusions in 1981 if(law.eq.1981) then agi=agi+divexc(data,comnew,law) agi=agi-min(data(12),100.*data(7)) endif c Social Security benefits are not taxable in Maine if(law.ge.1984)agi=agi-comnew(79) c New in 2000 : Pension Benefits Income Deduction up to $6000 c for taxpayer and his spouse; 2014+ up to $10000 if(law.ge.2000) agi = agi - & min(data(20)+data(72),max(0.0d0,pended(law)*data(9)-data(91))) c Standard Deductions and Exemptions if(law.le.1982) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then stded=twn(.16*agi,1700.0d0,2400.0d0) else stded=twn(.16*agi,2100.0d0/sep,2800.0d0/sep) endif else if(law.ge.1983.and.law.le.1987) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then stded=twn(.16*agi,1700.0d0,2500.0d0) else if(mst.eq.2.or.mst.eq.5) then stded=twn(.16*agi,2100.0d0,2900.0d0) elseif(mst.eq.3.or.mst.eq.6) then stded=twn(.16*agi,1100.0d0,1400.0d0) endif else if(law.eq.1988) then c in 1988, the standard deduction becomes a credit stded=0. else stded=comnew(3) if((law.ge.2003.and.law.le.2011).or.law.ge.2013) then if(mst.eq.5.or.mst.eq.2.or.sep.eq.2) & stded = stdm(law)/data(3)+(data(9)+data(10))*old(law) endif if(law.ge.2016) then if(mst.eq.4.or.mst.eq.7) & stded = 17400+(data(9)+data(10))*olds(law) if(mst.eq.1) stded = 11600+(data(9)+data(10))*olds(law) endif endif c no income taxes from ANY jurisdiction are allowed as itemized deds c eventually decided not to subtract data(55) c Itemized Deductions if(comnew(26).gt.0.and.comnew(30).gt.0.d0) then if(law.le.1988) then xitded=max(0.d0,comnew(24)-data(50)) c since everyone takes the standard credit, must subtract c standard deduc from itemized deducs in 1988 if(law.eq.1988) xitded=max(0.0d0,xitded- comnew(3)) else if(law.ge.1989.and.law.le.2012) then xitded=max(0.0d0,comnew(24)-data(50)) else if(law.ge.2013) then statit = data(50)-data(50)*(comnew(30)-comnew(24))/comnew(30) xitded = min(xitd(law),max(0.d0,comnew(24) - statit)) endif deduc = max(stded,xitded) else deduc = stded endif if(mst.eq.4.or.mst.eq.7) then phase = 105000 thrsh = 112500 else phase = 70000*data(7) thrsh = 75000*data(7) endif if(law.ge.2016.and.agi.gt.phase) then c Phase out of standard/itemized deductions for 2016 deduc = max(0.0d0,deduc - deduc*(agi-phase)/thrsh) endif c Exemptions c exemptions are a credit in 1988; xmp(1988)=0 if(law.le.2012) then exemp=comnew(68)*xmp(law)+xif(law.eq.1988,((data(9)+data(10)) & *xmp(law))) else if (law.ge.2013) then exemp = comnew(83) endif taxinc = max(0.0d0,agi - deduc - exemp) c before 1978, heads of household are taxed at the single rate if(law.le.1987.and.law.ge.1978) then if(law.eq.1978) then tab(2,3) = 3.5 tab(2,7) = 9.1 tabh(2,3) = 3.5 tabh(2,7) = 9.1 tabm(2,3) = 3.5 tabm(2,7) = 9.1 else if(law.ge.1979.and.law.le.1982) then tab(2,3) = 3. tab(2,7) = 9.2 tabh(2,3) = 3. tabh(2,7) = 9.2 tabm(2,3) = 3. tabm(2,7) = 9.2 else if(law.eq.1983) then tab(2,3) = 3. tabh(2,3) = 3. tabm(2,3) = 3. tab(2,4) = 5.85 tabm(2,4) = 5.85 tabh(2,4) = 5.75 tab(2,5) = 6.85 tab(2,6) = 7.96 tab(2,7) = 9.16 tabh(2,5) = 6.85 tabh(2,6) = 7.96 tabh(2,7) = 9.3 tabm(2,5) = 6.85 tabm(2,6) = 7.96 tabm(2,7) = 9.3 else if(law.eq.1984) then tab(2,2) = 1.975 tabh(2,2) = 1.9 tabm(2,2) = 1.975 tab(2,3) = 2.95 tabh(2,3) = 2.96 tabm(2,3) = 2.925 tab(2,4) = 5.75 tabh(2,4) = 5.64 tabm(2,4) = 5.65 tab(2,5) = 6.85 tabh(2,5) = 6.85 tabm(2,5) = 6.825 tab(2,6) = 7.92 tabh(2,6) = 7.9 tabm(2,6) = 7.92 tab(2,7) = 9.14 tabh(2,7) = 9.15 tabm(2,7) = 9.1 else if(law.eq.1985) then tabh(2,2) = 1.93 tabm(2,2) = 1.95 tab(2,3) = 2.9 tabh(2,3) = 2.9 tabm(2,3) = 2.875 tab(2,4) = 5.6 tabh(2,4) = 5.43 tabm(2,4) = 5.5 tab(2,5) = 6.75 tabm(2,5) = 6.75 tabh(2,5) = 6.77 tab(2,6) = 7.88 tabh(2,6) = 7.88 tabm(2,6) = 7.88 tab(2,7) = 9.1 tabh(2,7) = 9.1 tabm(2,7) = 9.075 else if(law.eq.1986) then tabh(2,2) = 1.93 tabm(2,2) = 1.925 tab(2,3) = 2.85 tabm(2,3) = 2.85 tabh(2,3) = 2.87 tab(2,4) = 5.45 tabh(2,4) = 5.33 tabm(2,4) = 5.35 tab(2,5) = 6.7 tabh(2,5) = 6.7 tabm(2,5) = 6.675 tabh(2,6) = 7.85 tabm(2,6) = 7.85 tab(2,6) = 7.84 tab(2,7) = 9.08 tabm(2,7) = 9.045 tabh(2,7) = 9.06 else if(law.eq.1987) then tabh(2,2) = 1.93 tabm(2,2) = 1.9 tab(2,3) = 2.8 tabh(2,3) = 2.83 tabm(2,3) = 2.825 tab(2,4) = 5.3 tabh(2,4) = 5.23 tabm(2,4) = 5.2 tab(2,5) = 6.65 tabm(2,5) = 6.625 tabh(2,5) = 5.63 tab(2,6) = 7.82 tabm(2,6) = 7.82 tabh(2,6) = 7.83 tab(2,7) = 9.05 tabm(2,7) = 9.02 tabh(2,7) = 9.01 endif endif if(law.eq.1977) then if(mst.eq.2.or.mst.eq.5) then call look(tabm,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) else call look(tab,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) endif else if(law.ge.1978.and.law.le.1987) then if(mst.eq.2.or.mst.eq.5) then call look(tabm,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tabh,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) else call look(tab,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) endif else if(law.eq.1988) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then call look(tabs88,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tabh88,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) else call look(tabm88,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) endif else if(law.ge.1989.and.law.le.1990) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then call look(tabs89,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tabh89,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) else call look(tabm89,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) endif else if(law.ge.1991.and.law.le.1992) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then call look(tabs91,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tabh91,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) else call look(tabm91,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) endif else if(law.ge.1993.and.law.le.2012) then if(mst.eq.4.or.mst.eq.7) then call look(tab93h,taxinc,4,n,statax,aif93(law),0.0d0,rt,data) else tinc = taxinc/data(7) call look(tab93,tinc,4,n,stat,aif93(law),0.0d0,rt,data) statax = stat*data(7) endif else if(law.ge.2013.and.law.le.2015) then if(mst.eq.4.or.mst.eq.7) then call look(tab13h,taxinc,3,n,statax,1.0d0,0.0d0,rt,data) else tinc = taxinc/data(7) call look(tab13,tinc,3,n,stat,1.0d0,0.0d0,rt,data) statax = stat*data(7) endif else if(law.ge.2016) then if(mst.eq.4.or.mst.eq.7) then call look(tab16h,taxinc,3,n,statax,1.0d0,0.0d0,rt,data) else tinc = taxinc/data(7) call look(tab16,tinc,3,n,stat,1.0d0,0.0d0,rt,data) statax = stat*data(7) endif endif c Low-Income Tax Credit for 1997 and on-------------- if(law.ge.1997.and.taxinc.le.2000.) statax=0. c --------------------------------------------------- c Extra Tax txm=0. if(comnew(70).gt.0.) then if(law.le.1985) then txm=.15*max(0.0d0,comnew(70)-comnew(28)) else if (law.ge.1986.and.law.le.1990) then txm=max(0.0d0,.03*comnew(69)-statax) else if (law.ge.1991) then txm=.27*max(0.0d0,comnew(70)-comnew(28)) endif endif iratax=0.0d0 if(law.ge.1986)iratax=.15*data(42) statax=statax+txm+iratax c Credits c The Maine EITC is nonrefundable 2000-2015 and 2016+ refundable earncr = 0. if((law.ge.2000.and.law.le.2002).or.(law.ge.2006.and.law.le.2008). &or.law.ge.2011) earncr = .05*comnew(59) if(law.ge.2003.and.law.le.2005) earncr = .0492*comnew(59) if(law.ge.2009.and.law.le.2010) earncr = .04*comnew(59) c Credit for elderly eldcr=0. c Credit for the elderly and disabled is repealed for 2016+ if(law.ge.1978.and.law.le.2016)eldcr=.2*comnew(54) c Energy System Credit encred=0. if(law.ge.1979.and.law.le.1988)encred=min(data(38)*1.3,100.0d0) c Child Care Credit (up to $500 refundable) chcr=child(law)*min(comnew(53),max(0.0d0,comnew(52)-data(34))) c refundable part chcrr = min(500.0d0,chcr) c non-refundable part chcrn = chcr - chcrr credit = eldcr + encred + chcrn if(law.ge.2000.and.law.le.2015) credit = credit + earncr c Property tax credit txp=twn(data(7),1.0d0,2.0d0) pcred=0. ptax=max(data(51),.25*data(160)) qual=0. if(data(25).gt.0)qual=1. if(law.le.1987) then if(data(159).le.hylim(law,txp)) then if(law.eq.1977) then pcred=twn(ptax-.1*max(0.0d0,data(159)-3000.),0.0d0,400.0d0) pcred=pcred*twn(data(9),0.0d0,1.0d0) else if(law.ge.1978.and.law.le.1987) then pcred=twn(ptax,0.0d0,400.0d0) pcred=pcred*twn(data(9)+data(10)+qual,0.0d0,1.0d0) endif endif else if(law.eq.1988) then if(data(9)+data(10).gt.0) then if(txp.eq.1) then if(data(159).le.6800)pcred=min(400.0d0,ptax) if(data(159).gt.6800.and.data(159).le.7000) & pcred=min(300.0d0,.75*ptax) if(data(159).gt.7000.and.data(159).le.7200) & pcred=min(200.0d0,.50*ptax) if(data(159).gt.7200.and.data(159).le.7400) & pcred=min(100.0d0,.25*ptax) else if(txp.eq.2) then if(data(159).le.8100)pcred=min(400.0d0,ptax) if(data(159).gt.8100.and.data(159).le.8500) & pcred=min(300.0d0,.75*ptax) if(data(159).gt.8500.and.data(159).le.8800) & pcred=min(200.0d0,.50*ptax) if(data(159).gt.8800.and.data(159).le.9200) & pcred=min(100.0d0,.25*ptax) endif endif c there is a table for people with hy.lt.28000 else if(law.ge.1989) then pcred=0. endif pcred=pcred*twn(data(9)+data(10),0.0d0,1.0d0) c 2013+ Refundable Property Tax Fairness Credit (PTFC) nexem = comnew(68) ptfc = 0. if(law.eq.2013) then agix = max(0.d0,agi) bagix = .1*agix base = data(51) + .25*.85*data(160) if(agix.le.40000.and.base.gt.bagix) then ptfc = min(300.d0/sep,.4*(base - bagix)) if(data(9).gt.0) ptfc = min(400.d0/sep,.4*(base - bagix)) endif else if(law.ge.2014) then base = data(51) + .15*.85*data(160) tix = max(0.0d0,comnew(2)+data(91)-comnew(79)) if(mst.eq.1) then base = min( 2000.0d0,base) tix = min(33333.d0/sep,tix) else if(nexem.le.2) then base = min( 2600.d0/sep,base) tix = min(43333.d0/sep,tix) else base = min( 3200.d0/sep,base) tix = min(53333.d0/sep,tix) endif endif ptfc = min(600.d0/sep,.5*max(0.0d0,base-.06*tix)) if(data(9).gt.0) & ptfc = min(900.d0/sep,.5*max(0.0d0,base-.06*tix)) endif c 2016+ refundable Sales Tax Fairness Credit (STFC) stfc = 0. if(law.ge.2016) then c total income; loss add-backs tix = hy - min(0.d0,comnew(6)) if(mst.eq.1) then if(nexem.eq.1) then stfc = max(0.0d0,100.0d0-max((tix- 20000)/50,0.0d0)) else if(nexem.eq.2) then stfc = max(0.0d0,140.0d0-max((tix- 20000)/50,0.0d0)) else if(nexem.eq.3) then stfc = max(0.0d0,160.0d0-max((tix- 20000)/50,0.0d0)) else if(nexem.ge.4) then stfc = max(0.0d0,180.0d0-max((tix- 20000)/50,0.0d0)) endif else if(mst.eq.4.or.mst.eq.7) then if(nexem.eq.1) then stfc = max(0.0d0,100.0d0-max((tix- 30000)/75,0.0d0)) else if(nexem.eq.2) then stfc = max(0.0d0,140.0d0-max((tix- 30000)/75,0.0d0)) else if(nexem.eq.3) then stfc = max(0.0d0,160.0d0-max((tix- 30000)/75,0.0d0)) else if(nexem.ge.4) then stfc = max(0.0d0,180.0d0-max((tix- 30000)/75,0.0d0)) endif else if(mst.eq.2.or.mst.eq.5) then if(nexem.eq.1) then stfc = max(0.0d0,100.0d0-max((tix- 40000)/50,0.0d0)) else if(nexem.eq.2) then stfc = max(0.0d0,140.0d0-max((tix- 40000)/50,0.0d0)) else if(nexem.eq.3) then stfc = max(0.0d0,160.0d0-max((tix- 40000)/50,0.0d0)) else if(nexem.ge.4) then stfc = max(0.0d0,180.0d0-max((tix- 40000)/50,0.0d0)) endif endif endif if(law.eq.1987)credit=credit+(data(7)+data(8)+data(9)+data(10))*9. if(law.eq.1978) then credit=credit+max(0.0d0,min(data(160),32.0d0), & min(64.0d0,data(51))) endif c standard deduction credit for 1988 if(law.eq.1988) then credit=credit+twn(.02*comnew(37),10.0d0,std(mst)) if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then credit=credit+tablki(sxmp,3,agi,data) else if(mst.eq.4.or.mst.eq.7) then credit=credit+tablki(hxmp,3,agi,data) else credit=credit+tablki(mxmp,3,agi,data) endif endif statax=max(0.0d0,statax-credit) c new accounting for refundable property tax credit statax=max(0.0d0,statax-pcred) statax = statax - chcrr - ptfc - stfc credit = credit + chcrr + ptfc + stfc + pcred if(law.ge.2016) then c 2016+ the Earned Income Credit is refundable statax = statax - earncr credit = credit + earncr endif return end c c MARYLAND c State 21 c c Updated through 2016 subroutine mdtax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255) dimension aif92(1992:2012),aif13(2013:2017) &,tab92(2,5),tab(2,4),tab95(2,4),tab08(2,8),tab12(2,8),tab9507(2,4) &,pov1(1997:2016),pov2(1997:2016) dimension pex(1977:2016),xmp(1977:2016),eicr(1998:2016) integer sep data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ data eicr/ & 2*.1d0,.15d0,2*.16d0,.18d0,4*.2d0,7*.25d0,.255d0,.26d0/ data tab92/ & 1000.0d0, 2.0d0, 2000.0d0, 3.0d0, 3000.0d0, 4.0d0, & 150000.0d0, 5.0d0, 1.e20, 6.0d0/ data tab95/ & 1000.0d0, 2.0d0, 2000.0d0, 3.0d0, 3000.0d0, 4.0d0, & 1.e20, 5.0d0/ c Rates for 2008-2011 data tab08/ & 1000.0d0, 2.0d0 , 2000.0d0, 3.0d0 , 3000.0d0, 4.0d0 , & 2.e5, 4.75d0, 35.e4, 5.0d0 , 5.e5, 5.25d0, & 1.e6, 5.50d0, 1.e20, 6.25d0/ c Rates for 2012 data tab12/ & 1000.0d0, 2.0d0 , 2000.0d0, 3.0d0 , 3000.0d0, 4.0d0 , & 15.e4, 4.75d0, 175.e3, 5.0d0 , 225.e3, 5.25d0, & 3.e5, 5.50d0, 1.e20, 5.75d0/ data tab / & 1000.0d0, 2.0d0 , 2000.0d0, 3.0d0 , 3000.0d0, 4.0d0, & 1.e20,5.0d0 / data aif92/ & 1.0525d0, 1.0840d0, 1.118d0, 1.147d0 , 1.1795d0, & 1.212d0 , 1.245d0 , 1.266d0, 1.2895d0, 1.3295d0, & 1.373d0 , 1.395d0 , 1.427d0, 1.4595d0, 1.5050d0, & 1.564d0 , 1.5995d0, 1.668d0,2*1.6955d0, 1.7365d0/ c pnsion exclusion data pex/ & 3200.0d0, 5200.0d0, 5700.0d0, 6400.0d0, 7400.0d0, & 8700.0d0,3*8500.0d0, 8600.0d0, 9100.0d0, 9500.0d0, & 10100.0d0, 10800.0d0, 11800.0d0, 12300.0d0, 13100.0d0, & 13600.0d0, 13800.0d0, 14400.0d0, 15000.0d0, 15900.0d0, & 16100.0d0, 16500.0d0, 17300.0d0, 18500.0d0, 19900.0d0, & 20700.0d0, 21500.0d0, 22600.0d0, 23600.0d0, 24000.0d0, & 24500.0d0, 26100.0d0, 26300.0d0, 27100.0d0, 27800.0d0, & 29000.0d0, 29200.0d0, 29400.0d0/ data xmp/ & 10*800.0d0, 2*1000.0d0, 2*1100.0d0, 7*1200.0d0, 1750.0d0, & 2*1850.0d0, 2100.0d0, 6*2400.0d0, 9*3200.0d0/ data pov1/ & 7890.0d0, 8050.0d0, 8240.0d0, 8350.0d0, 8590.0d0, & 8860.0d0, 8980.0d0, 9310.0d0, 9570.0d0, 9800.0d0, & 10210.0d0, 10400.0d0,2*10830.0d0, 10890.0d0,11170.0d0, & 11490.0d0, 11670.0d0, 11770.0d0, 11880.0d0/ data pov2/ & 2720.0d0, 2800.0d0, 2820.0d0, 2900.0d0, 3020.0d0, & 3080.0d0, 3140.0d0, 3180.0d0, 3260.0d0, 3400.0d0, & 3480.0d0, 3600.0d0, 2*3740.0d0, 3820.0d0, 3960.0d0, & 4020.0d0, 4060.0d0, 4160.0d0, 4220.0d0/ mst = data(2) txp = data(7) sep = data(3) rt = 0. phas92=100000./data(3) if(law.ge.1992.and.law.le.2012)phas92=100000.*aif92(law)/data(3) if(law.ge.2013) & phas92 = aif13(law)*250000*filing(mst,1.,1.2,1.1,.6) c AGI c Taxable refunds agi = comnew(2)-data(22) c Child and dependent care expenses c subtraction from agi -- child care expenses chnum = min(2.0d0,data(8)) chexp = 0. if(law.ge.1978.and.law.le.2002) chexp = min(2400.*chnum,data(64)) if(law.ge.2003)chexp = min(3000.*chnum,data(64)) agi = agi - chexp c Pension exclusion penmax = max(0.0d0,pex(law)*data(9)-data(91)) c penexc = twn(data(20)+data(72),0.0d0,penmax) c Pension exclusion -- does not include IRA as data(20) for the base penexc = twn(data(72),0.0d0,penmax) if(mst.eq.2.and.data(9).lt.2.and.data(9).gt.0) then c penmax = max(0.0d0,pex(law)-.5*data(91)) c penexc = twn(.5*data(72),0.0d0,penmax) subh = 0. subw = penexc endif agi = agi- penexc c Taxable Social Security if(law.ge.1985)agi = agi-comnew(79) if(law.le.1986) agi = agi+.5*max(comnew(36)-10000.*txp,0.0d0) & +divexc(data,comnew,law) if(law.eq.1980)agi = agi-twn(data(14),0.0d0,200.*data(7)) if(law.ge.1980.and.law.le.1986)agi=agi-min(comnew(25),50*data(7)) c two-income married couple subraction if(law.ge.1982.and.law.le.1986)agi = agi+comnew(32) if (mst.eq.2.and.comnew(2).gt.0) then agih = data(85) + .5*(comnew(2)-data(11)) agiw = comnew(2) - agih subtr = data(22) + penexc + chexp + comnew(79) twoh = max(0.0d0,agih - .5*subtr) twow = max(0.0d0,agiw - .5*subtr) if(data(9).eq.1.and.penexc.gt.0)then twoh = max(0.0d0,agih - .5*(data(22)+chexp+comnew(79))-subh) twow = max(0.0d0,agiw - .5*(data(22)+chexp+comnew(79))-subw) endif twoear = 0. if(law.ge.1992.and.agih*agiw.gt.0) then if(law.le.1994)then if(comnew(2).le.150000.) twoear = 1200. if(comnew(2).gt.150000.) twoear = 1000. twoear = min(twoear,min(twoh,twow)) else if(law.ge.1995) then twoear = 1200. if(law.eq.1998) twoear = 1154. twoear = min(twoear,min(twoh,twow)) endif agi = max(0.0d0,agi-twoear) endif endif if(law.ge.1984) agi = agi-xjobs(data,law) c 1985 is correct; not 1984:controller ask some to withhold until law c is passed on ssagi & whether or not taxable c capital gains stuff:discontinued in 1992 if(law.ge.1987.and.law.le.1990.and.comnew(5).gt.0) & agi = agi-(.4*comnew(5)) if(law.eq.1991.and.comnew(5).gt.0)then if(mst.eq.2) then astep = min(.3*comnew(5),15000.0d0) bstep =max((comnew(2)-comnew(5))-100000.,0.0d0)*.5 else astep = min(.3*comnew(5),7500.0d0) bstep = max((comnew(2)-comnew(5))-50000.,0.0d0)*.5 endif capded = max(astep-bstep,0.0d0) agi = agi-capded endif c Standard Deduction txpded = txp if(mst.eq.4.or.mst.eq.7) txpded = txpded+1 if(law.le.1978) then stded = min(txpded*500.,.1*max(0.0d0,agi)) else if(law.ge.1979.and.law.le.1986) then stded = min(txpded*1500.,.13*max(0.0d0,agi)) else if(law.ge.1987.and.law.le.1989) then stded = twn(.15*agi,txpded*1000.,txpded*2000.) stded = stded+(data(9)+data(10))*800. else if(law.ge.1990) then stded = twn(.15*agi,txpded*1500.,txpded*2000.) endif c Itemized Deductions xitded = 0. if(comnew(26).gt.0..and.law.ge.1987.and.comnew(30).gt.0) then xitded=max(0.d0,comnew(30)-data(50)) if(agi.gt.phas92.and.law.ge.1991.and.comnew(30).gt.0) & xitded=max(0.d0,comnew(24)-data(50)*comnew(24)/comnew(30)) else if(law.le.1986) then xitded = max(comnew(30)-data(50),comnew(3)) endif deduc = max(xitded,stded) c Exemptions amount exemp = 0. if(law.le.1989)exemp = comnew(68)*xmp(law) if(law.ge.1990)then blage = (data(9)+data(10))*1000 exemp = blage +(data(7)+data(8))*xmp(law) if(data(105).lt.1) then c 2008 Singles and separate exemptions phaseouts if(mst.eq.1.or.sep.eq.2) then c fed agi E ]100k,125k] if(comnew(2).gt.100000.and.comnew(2).le.125000.0d0) then c 2008-2011 if(law.ge.2008.and.law.le.2011) then exemp = blage +(data(7)+data(8))*2400 c 2012+ else if(law.ge.2012) then exemp = blage +(data(7)+data(8))*1600 endif c fed agi E ]125k,150k] else if(comnew(2).gt.125000.and.comnew(2).le.150000.0d0) then c 2008-2011 if(law.ge.2008.and.law.le.2011) then exemp = blage +(data(7)+data(8))*1800 c 2012+ else if(law.ge.2012) then exemp = blage +(data(7)+data(8))*800 endif c fed agi E ]150k,200k] else if(comnew(2).gt.150000.and.comnew(2).le.200000.0d0) then c 2008-2011 if(law.ge.2008.and.law.le.2011) then exemp = blage +(data(7)+data(8))*1200 else if(law.ge.2012) then c 2012+ exemp = 0 endif c fed agi E ]200k,+[ else if(comnew(2).gt.200000) then c 2008-2011 if(law.ge.2008.and.law.le.2011) then exemp = blage +(data(7)+data(8))*600 c 2012+ else if(law.ge.2012) then exemp = 0 endif endif else c 2008 Married and Head of Household exemptions phaseouts if(comnew(2).gt.150000.and.comnew(2).le.175000.0d0) then if(law.ge.2008.and.law.le.2011) then exemp = blage +(data(7)+data(8))*2400 else if(law.ge.2012) then exemp = blage +(data(7)+data(8))*1600 endif else if(comnew(2).gt.175000.and.comnew(2).le.200000.0d0) then if(law.ge.2008.and.law.le.2011) then exemp = blage +(data(7)+data(8))*1800 else if(law.ge.2012) then exemp = blage +(data(7)+data(8))*800 endif else if(comnew(2).gt.200000.and.comnew(2).le.250000.0d0) then if(law.ge.2008.and.law.le.2011) then exemp = blage +(data(7)+data(8))*1200 else if(law.ge.2012) then exemp = 0 endif else if(comnew(2).gt.250000) then if(law.ge.2008.and.law.le.2011) then exemp = blage +(data(7)+data(8))*600 else if(law.ge.2012) then exemp = 0 endif endif endif else c dependent exemption if(law.ge.2008) exemp = 0. endif endif taxinc = max(0.0d0,agi-deduc-exemp) c Tax Calcuation if(law.le.1991) then call look(tab,taxinc,4,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.1992.and.law.le.1994) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) tab92(1,4) = 100000. call look(tab92,taxinc,5,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.1995.and.law.le.2007) then do 111 i=1,2 do 111 j=1,4 111 tab9507(i,j) = tab95(i,j) if(law.eq.1998) tab9507(2,4) = 4.875 if(law.ge.1999.and.law.le.2000) tab9507(2,4) = 4.85 if(law.eq.2001) tab9507(2,4) = 4.8 if(law.ge.2002.and.law.le.2007) tab9507(2,4) = 4.75 call look(tab9507,taxinc,4,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2008.and.law.le.2011) then if(mst.eq.1.or.sep.eq.2.or.data(105).gt.0) then tab08(1,4) = 1.5e5 tab08(1,5) = 3.e5 endif call look(tab08,taxinc,8,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2012) then if(mst.eq.1.or.sep.eq.2.or.data(105).gt.0) then tab12(1,4) = 1.e5 tab12(1,5) = 1.25e5 tab12(1,6) = 1.5e5 tab12(1,7) = 2.5e5 endif call look(tab12,taxinc,8,n,statax,1.0d0,0.0d0,rt,data) endif taxbc = statax c Credits c Earned Income Credit - non-refundable earncr = 0. if(law.ge.1987) earncr = .5*comnew(59) pretax = max(0.0d0,taxbc - earncr) c If you are a MD resident who qualifies for the state earncr, c you may also qualify for a local earned income tax credit. statax = pretax c refundable Earned Income Credit refcr = 0. c if(pretax.lt.1.and.data(8).gt.0.and.taxbc.gt.0.and. c & (law.ge.1998.and.law.le.2008)) c & refcr = max(0.0d0,eicr(law)*comnew(59)-taxbc) c if(pretax.lt.1.and.law.ge.2009.and.taxbc.gt.0.d0) c & refcr = max(0.0d0,eicr(law)*comnew(59)-taxbc) if(data(8).gt.0.d0.and.(law.ge.1998.and.law.le.2008)) & refcr = max(0.0d0,eicr(law)*comnew(59)-taxbc) if(law.ge.2009) & refcr = max(0.0d0,eicr(law)*comnew(59)-taxbc) c Non-refundable Credit for Child and Dependent Care Expenses c New in 2000 chr = 0. if(law.eq.2000) then chr =.001*max(0.0d0, & (250.-max((comnew(2)-30000/data(3))/(40/data(3)),0.0d0))) elseif(law.ge.2001) then chr =.0001*max(0.0d0, &(3250.-max((comnew(2)-41000/data(3))/(1000/(325*data(3))),0.0d0))) endif chcr = chr*min(comnew(53),max(0.0d0,comnew(52)-data(34))) statax = max(0.0d0,statax-chcr) c Poverty Level credit since 1997 - nonrefundable ptcr = 0. if(law.ge.1997.and.data(105).lt.1.) then xlin3 = pov1(law)+pov2(law)*(comnew(68)-1) xlin4 = max(comnew(2),comnew(37)) if (xlin3.ge.xlin4) ptcr = .05*comnew(37) endif if(law.le.1996) then statax = statax - ptcr else statax = max(0.0d0,statax - ptcr) endif statax = statax-refcr credit = earncr + ptcr + refcr + chcr earncr = earncr + refcr return end c MASSACHUSETTS c State 22 (when update, do not forget to update function socsec) c Updated through 2016 subroutine matax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common/times/zitem,ptax,txrate,h dimension data(255), comnew(255) integer s double precision blind, bus, ch, fica, rnt, scred, ntscr double precision ntsr, licrr,loss1,loss2 dimension xmps(1977:2016),xmplim(1977:2016),surtax(1977:2016) dimension sec(1977:2016),xmpd(1977:2016), xmpo(1977:2016) dimension gnx(1977:2016),sslim(1977:2016),eicr(1997:2016) dimension tab89(1977:2016),add(1995:2016),txph(1994:2016) double precision nts(1977:2016,2), &licrh(1995:2016),licrm(1995:2016) data eicr/4*.1d0,15*.15d0,.23d0/ data txph/2*3400.0d0,4520.0d0,4065.0d0,7385.0d0,3*6800.0d0, & 3*5100.0d0,5525.0d0,5950.0d0,6375.0d0,9*6800.0d0/ data licrh/19250.0d0,21210.0d0,20414.0d0,26224.0d0, & 3*25200.0d0,3*22225.0d0,22969.0d0,23713.0d0,24456.0d0, & 9*25200.0d0/ data add/1000.0d0,1330.0d0,1195.0d0,2175.0d0,3*2000.0d0, & 1750.0d0,2*1500.0d0,1635.0d0,1750.0d0,1875.0d0,9*1750.0d0/ data licrm/21000.0d0,23536.0d0,22505.0d0,30030.0d0, & 3*28700.0d0,3*24850.0d0,25813.0d0,26775.0d0,27738.0d0, & 9*28700.0d0/ data xmps/5*2000.d0,14*2200.d0,2925.d0,2630.d0,4780.d0, & 3*4400.d0,3*3300.d0,3575.d0,3850.d0,4185.d0,9*4400.d0/ data xmpd/600.0d0, 9*700.0d0,30*1000.0d0/ data xmpo/600.0d0, 39*700.0d0/ data sec/600.0d0,700.0d0,3*800.0d0,5*1000.0d0,30*0.0d0/ data xmplim/4400.0d0, 4500.0d0, 3*4600.0d0, 4800.0d0, & 13*4400.0d0,5850.0d0,5260.0d0, & 9560.0d0,3*8800.0d0,3*6600.0d0,7150.0d0, & 7700.0d0,8250.0d0,9*8800.0d0/ data surtax/9*1.0750d0,31*1.0d0/ data gnx/3*0.0d0, .20d0, .40d0, .60d0, 14*.50d0,20*0.0d0/ data sslim/5*1.e20, 2170.80d0, 34*2000.0d0/ data nts/ s 7*3000.0d0, 3600.0d0, 4400.0d0, 6000.0d0, 30*8000.0d0, m 7*5000.0d0, 6100.0d0, 7200.0d0, 10000.0d0, 8*12000.0d0, m 11000.0d0,12120.0d0,11665.0d0,14965.0d0,3*14400.0d0, m 3*12700.0d0,13125.0d0,13550.0d0,13975.0d0,9*14400.0d0/ data tab89/ 12*.05d0, .05375d0,.0595d0,.0625d0,8*.0595d0, & .0585d0,0.056d0,10*.053d0,2*.0525d0,.052d0, .0515d0,.051d0/ c condition for receiving extra exemptions mst = data(2) blind=0. bus=0. ch=0. fica=0. ntscr=0. rnt=0. scred=0. s=0 txcr=0. x=0. rt=0. c AGI if(law.le.1984.and.mst.eq.2)x=1. if(law.ge.1985.and.(mst.ne.3.or.mst.ne.6))x=1. c calculate A INCOME; taxed at 10%; after 1990 taxed at 12% if(law.le.1996) then cg = 0. c calculc cap gain using massachusetts exclusion,limit loss carryforward cfd = 0. ccg = data(67)+data(69) c carryovers already included in gains figures if(law.le.1982)cg = data(70)-max(data(70)*gnx(law),0.0d0) & +data(68)+ccg if(law.ge.1983)cg = data(70)+data(68) & -max((data(70)+data(68))*gnx(law),0.0d0)+ccg if(ccg.le.cg) then cg = cg-ccg cfd = 0. else cfd = min(1000.0d0,ccg-cg) cg = max(0.0d0,cg-ccg) endif ainc = cg + max(0.0d0,data(14)+data(12)-cfd) else if(law.eq.1997.or.law.eq.1998) then ainc = data(12) + data(14) else ainc = 0. endif c calculate B INCOME; taxed at approximately 5% c uses federal agi definitions (w/adjustments) from previous years b1inc=data(11)+data(17)+data(21) b2inc=data(72)+data(24)+data(23)+data(20)+data(19) if(law.eq.1977) then b1inc=b1inc+comnew(8) edical=comnew(20) binc=b1inc+b2inc else if(law.ge.1978.and.law.le.1982) then b1inc=b1inc+comnew(8) if(law.eq.1982)b2inc=b2inc+comnew(78) edical=comnew(20) binc=b1inc+b2inc else if(law.ge.1983.and.law.le.1985) then b1inc=b1inc+comnew(8) b2inc=b2inc+comnew(78) edical=comnew(20) binc=b1inc+b2inc else if(law.eq.1986.or.law.eq.1987) then b1inc=b1inc+(comnew(8)-data(72)) b2inc=b2inc+comnew(78) edical=comnew(20) binc=b1inc+b2inc else if(law.ge.1988.and.law.le.1989) then b1inc=b1inc+comnew(8) b2inc=b2inc+comnew(78) edical=comnew(20) binc=b1inc+b2inc else if(law.ge.1990) then binc = b1inc+b2inc+ comnew(8)+ comnew(78) if(law.eq.2009) binc = binc - comnew(78) + data(82) edical=comnew(20) endif c Applicable to tax years beginning on or after January 1,1999, c the tax rate on dividends and interst (other than interst from c Massachusetts banks) is LOWERED from 12% to 5.95% if(law.ge.1999) then binc = binc + max(0.0d0,data(14)-100*data(7)) if(comnew(6).ge.0) then if(law.le.2002.or.law.ge.2013) binc = binc + data(12) if(law.ge.2003.and.law.le.2012) then c Qualified Dividends if(data(177)+data(176).gt.0) then binc = binc + data(177) else binc = binc +.33*data(12) endif endif else c Taxpayer has dividends&capital gain loss xlin2 = min(data(12),2000.0d0) xlin3 = abs(min(data(68),0.0d0)) xlin4 = max(0.0d0,xlin2 - xlin3) xlin5 = abs(comnew(6)) xlin6 = min(xlin4,xlin5) binc = binc+data(12)-xlin6 endif endif c Calculate C INCOME - long term capital gain income since 1997 cinc = 0. if(law.ge.1997.and.comnew(6).ge.0) then cinc = comnew(15) if(law.ge.2013) cinc = comnew(6) endif c if(law.ge.1997.and.law.le.2002) then c cinc = max(0.0d0,data(70)) c elseif (law.ge.2003) then c cinc = max(0.0d0,data(70))+data(176) c endif c Deductions c Amount paid to Soc. Sec , Medicare fica=min(socsec(data,law),sslim(law)) if(data(2).eq.2) then data85=data(85) data86=data(86) temp86 = min(data(86),data(85)) data(86) = 0. fica85=min(socsec(data,law)-.5*(data(43)+data(44)),sslim(law)) data(86) = temp86 temp85 = max(data(85),data(86)) data(85) = 0. fica86=min(socsec(data,law)-.5*(data(43)+data(44)),sslim(law)) data(85) = temp85 fica = fica85 + fica86 data(85)=data85 data(86)=data86 endif c assumes dependents are less than 12 years old if(data(8).gt.0.and.law.le.1996) ch=600. if(data(8).gt.0.and.law.ge.1997.and.law.le.2000) ch=1200. if(data(8).gt.0.and.law.eq.2001) ch=2400.*min(data(8),2.0d0) if(data(8).gt.0.and.law.ge.2002) ch=3600.*min(data(8),2.0d0) if(law.eq.1982)ch=min(ch,2000.*data(8)) c 50% rental deduction if(law.eq.1981) rnt = data(160)*.5 if(law.ge.1982) rnt = min(data(160)*.5,2500.0d0) if(law.ge.1997.and.law.le.2001.and.(mst.eq.3.or.mst.eq.6)) & rnt=min(data(160)*.5,1250.0d0) if(law.ge.2001) rnt=min(data(160)*.5,3000./data(3)) c provision actually starts earlier;TAXSIM var does not until 1982 if(law.ge.1982)bus=data(27) bded=fica+ch+rnt+bus+data(26)+data(30)+data(62) txp=xmps(law) if(mst.eq.2) then if(law.le.1986) then spy=min(data(85),data(86)) txp=txp+(spy+sec(law)) txp=min(txp,xmplim(law)) else txp=min(data(7)*xmps(law),xmplim(law)) endif endif if(law.ge.1994) then if(mst.eq.4.or.mst.eq.7) txp=txph(law) endif edical=edical*x c Blind and Dependent Exemptions blind=data(10)*2200. exemp=(data(8)*xmpd(law))+(data(9)*xmpo(law))+txp+edical+blind excxmp = 0. if(binc-bded.lt.exemp) excxmp = exemp - max(0.0d0,binc-bded) c Massachusettes AGI c agi=ainc + binc + max(0.0d0,cinc-excxmp) agi=ainc + binc + cinc if(law.ne.1989.or.law.ne.2001) taxbin= max(0.0d0,binc-bded-exemp) if(law.eq.2001) taxbin= max(0.0d0, &binc-bded-exemp-data(58)-data(59)) c Specific order in which deductions/exemptions must be taken if(law.le.1989) then loss1=0. loss2=0. if(b1inc.lt.0.)loss1=b1inc if(b2inc.lt.0.)loss2=b2inc if(law.le.1988) then binc=max(0.0d0,binc-bded) xtra=max(0.0d0,exemp-binc) binc=max(0.0d0,binc-exemp) ainc=max(0.0d0,ainc-(x*xtra)) else if(law.eq.1989) then c calculate 5.375% taxable income b1inc=max(0.0d0,b1inc+loss2) xded=max(0.0d0,min(bded,bded-b1inc)) b1inc=max(0.0d0,b1inc-bded) xex=max(0.0d0,exemp-b1inc) b1inc=max(0.0d0,b1inc-exemp) c calculate 5% taxable income b2inc=max(0.0d0,b2inc+loss1) b2inc=max(0.0d0,b2inc-xded) xex2=max(0.0d0,xex-b2inc) b2inc=max(0.0d0,b2inc-xex) c 'x' is marital status binary variable ainc=max(0.0d0,ainc-(x*xex2)) endif else bagi = binc - bded if(bagi.lt.exemp.and.(mst.ne.3.and.mst.ne.6)) then exded = exemp - bagi ainc=max(0.0d0,ainc-exded) endif endif taxinc=taxbin+ainc c State Tax on B income (5%) if(law.ne.1989) then statxb=tab89(law)*taxbin else statxb=.05*b2inc+tab89(law)*max(0.0d0,b1inc) endif rt=tab89(law) c State Tax on A income (12%) if(law.le.1989)statxa=.10*ainc if(law.ge.1990)statxa=.12*ainc c State Tax on C income - long term capital gains income statxc = 0. if(law.ge.1997.and.law.le.2002) then statxc = .05*max(0.0d0,cinc-excxmp) elseif(law.ge.2003.and.law.le.2011) then statxc = .053*max(0.0d0,cinc-excxmp) elseif(law.ge.2012.and.law.le.2013) then statxc = .0525*max(0.0d0,cinc-excxmp) elseif(law.eq.2014) then statxc = .052*max(0.0d0,cinc-excxmp) elseif(law.eq.2015) then statxc = .0515*max(0.0d0,cinc-excxmp) elseif(law.ge.2016) then statxc = .051*max(0.0d0,cinc-excxmp) endif if(law.ne.1984) then pretax=(statxa+statxb+statxc) * surtax(law) else if(binc.gt.60000.) statxb = surtax(law)*statxb if(ainc.gt.60000.) statxa = surtax(law)*statxa pretax = statxa + statxb endif c only single and joint filers can receive credits c for 1995 and on only single, joint and head of household c can receive credits: No Tax Status or Limited Income Credit if ( law.le.1994.and.law.ge.1984) then if(mst.eq.1.or.mst.eq.7.or.mst.eq.4) then s=1 else if(mst.eq.2) then s=2 endif elseif(law.ge.1995) then if(mst.eq.1) then s=1 elseif(mst.eq.2.or.mst.eq.7.or.mst.eq.4) then s=2 endif endif c no tax status determination and sales tax credit if(law.ge.1984.and.law.le.1994) then if(s.eq.1) then if(agi.le.nts(law,1)) then ntscr=pretax else if((agi.le.14000..and.agi.gt.nts(law,1)).and. & (pretax.ge..1*(agi-nts(law,1)))) then txcr=max(pretax-((agi-nts(law,1))*.1),0.0d0) endif else if(s.eq.2) then if(agi.le.nts(law,2)) then ntscr=pretax else if(agi.le.21000..and.agi.gt.nts(law,2)) then txcr=max(pretax-((agi-nts(law,2))*.1),0.0d0) endif endif else if(law.ge.1995) then if(s.eq.1) then if(agi.le.nts(law,1))then ntscr=pretax else if(agi.gt.nts(law,1).and.agi.le.14000.) then txcr=max(0.0d0,pretax - .1*(agi - nts(law,1))) endif else if(s.eq.2) then numdep = data(8) if(mst.eq.7.or.mst.eq.4) then ntsr = nts (law,2) licrr = licrh(law) elseif (mst.eq.2) then ntsr = nts (law,2) + add(law) licrr = licrm(law) endif if (agi.le.ntsr + numdep * 1000.) then ntscr = pretax else if(agi.gt.ntsr+numdep*1000.and. & agi.le.licrr+numdep*1750.)then txcr=max(0.0d0,pretax-0.1*(agi - ntsr - numdep*1000.)) endif endif else scred=(8.*data(7))+(4.*data(8)) endif c tax can not reduce income below a certain point c Credits credit=ntscr + txcr + scred + min(data(38),1000.0d0) statax=max(0.0d0,pretax-credit) c 1997-2000 State Earned Income Credit 10% of federal c 2001 State Earned Income Credit 15% of federal c 2016 State Earned Income Credit 23% of federal if(law.ge.1997) then earncr = eicr(law)*comnew(59) statax = statax - earncr credit = credit + earncr endif return end c MICHIGAN c State 23 c c Updated through 2016 subroutine mitax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common/times/zitem,ptax,txrate,h dimension data(255),comnew(100) dimension proptb(2,5),fuelc1(6),rate(1977:2016),cin(1977:1984) dimension xmp(1977:2016,2),pallow(1977:2016),fuelc2(6,1985:2005) dimension flmax(1984:2016),altmax(3,1984:2010) dimension cin2(1985:2016),fuelc3(2006:2016),frt(2006:2016) dimension oldded(1994:2016),pended(1994:2016) dimension pcra(2,11) data pcra / & 21001.d0, 1.d0,22001.d0,.96d0,23001.d0,.92d0,24001.d0,.88d0, & 25001.d0,.84d0,26001.d0,.80d0,27001.d0,.76d0,28001.d0,.72d0, & 29001.d0,.68d0,30001.d0,.64d0,50001.d0,.60d0/ data pended/ & 13125.0d0, 30945.0d0, 31920.0d0, 32880.0d0, & 33630.0d0, 34170.0d0, 34920.0d0, 36090.0d0, & 37110.0d0, 37710.0d0, 38550.0d0, 39570.0d0, & 40920.0d0, 42240.0d0, 43440.0d0,2*45120.0d0, & 45842.0d0, 47309.0d0, 48302.0d0, 49027.0d0, & 49811.0d0, 49861.0d0/ data oldded/ & 250.0d0, 1032.0d0, 1064.0d0, 3500.0d0, & 7500.0d0, 7620.0d0, 7785.0d0, 8048.0d0, & 8273.0d0, 8408.0d0, 8595.0d0, 8828.0d0, & 9128.0d0, 9420.0d0, 9690.0d0,2*10058.0d0, & 10218.0d0, 10545.0d0, 10767.0d0, 10929.0d0, & 11104.0d0, 11115.0d0/ data rate/ & 5*.046d0, .051d0 , .0635d0, .0585d0, .0533d0, & 8*.046d0, .0447d0,5*.044d0 ,2*.042d0 , .041d0 , & .04d0 , .0395d0,2*.039d0 , .0401d0,4*.0435d0, & .0433d0,4*.0425d0/ c 2012+ no longer special exemption for seniors age 65 or older c 2012+ no longer spercial exemp for unemployment comp = at least .5*agi data xmp/ 1 10*1500.0d0, 1600.0d0, 1800.0d0, 2000.0d0, 5*2100.0d0, 1 2*2400.0d0, 2500.0d0,2*2800.0d0,2*2900.0d0, 3000.0d0, 1 2*3100.0d0, 3200.0d0, 3300.0d0, 3400.0d0, 3500.0d0, 1 2*3600.0d0, 3700.0d0, 3763.0d0, 3950.0d0, 3*4000.0d0, 2 10*.0d0, 1400.0d0, 1200.0d0, 1000.0d0, 10*900.0d0, 2 1800.0d0,3*1900.0d0,2*2000.0d0, 2100.0d0, 2*2200.0d0, 2 2*2300.0d0,2400.0d0, 5*0.0d0/ data pallow/ & 5*1.e20, 65000.0d0, 68500.0d0, 70950.0d0, & 27*73650.0d0,5*41000.0d0/ data proptb / & 3000.0d0, .0d0, 4000.0d0, .01d0, & 5000.0d0, .02d0, 6000.0d0, .03d0, & 1.e20, .035d0/ data frt / & .76d0,.53d0,8*.5d0,.67d0/ data fuelc3 / & 378.0d0, 394.0d0, 401.0d0, 2*418.0d0, & 420.0d0, 431.0d0, 443.0d0, 2*450.0d0, & 458.0d0/ data fuelc1 / & 200.0d0, 240.0d0, 280.0d0, 310.0d0, & 340.0d0, 370.0d0/ data fuelc2/ & 272.0d0, 326.0d0, 379.0d0, 421.0d0, 480.0d0, 550.0d0, & 272.0d0, 326.0d0, 379.0d0, 425.0d0, 497.0d0, 570.0d0, & 272.0d0, 326.0d0, 379.0d0, 433.0d0, 506.0d0, 579.0d0, & 272.0d0, 326.0d0, 379.0d0, 450.0d0, 525.0d0, 601.0d0, & 272.0d0, 326.0d0, 389.0d0, 467.0d0, 546.0d0, 624.0d0, & 272.0d0, 326.0d0, 408.0d0, 490.0d0, 573.0d0, 655.0d0, & 272.0d0, 326.0d0, 408.0d0, 490.0d0, 573.0d0, 655.0d0, & 272.0d0, 355.0d0, 447.0d0, 539.0d0, 630.0d0, 722.0d0, & 272.0d0, 365.0d0, 459.0d0, 554.0d0, 649.0d0, 743.0d0, & 285.0d0, 380.0d0, 476.0d0, 571.0d0, 667.0d0, 762.0d0, & 285.0d0, 380.0d0, 476.0d0, 571.0d0, 667.0d0, 762.0d0, & 285.0d0, 380.0d0, 476.0d0, 571.0d0, 667.0d0, 762.0d0, & 305.0d0, 410.0d0, 515.0d0, 619.0d0, 724.0d0, 829.0d0, & 312.0d0, 420.0d0, 528.0d0, 635.0d0, 743.0d0, 851.0d0, & 319.0d0, 428.0d0, 536.0d0, 645.0d0, 754.0d0, 862.0d0, & 323.0d0, 435.0d0, 547.0d0, 658.0d0, 770.0d0, 882.0d0, & 332.0d0, 448.0d0, 565.0d0, 681.0d0, 797.0d0, 914.0d0, & 342.0d0, 461.0d0, 579.0d0, 698.0d0, 816.0d0, 935.0d0, & 347.0d0, 468.0d0, 589.0d0, 709.0d0, 830.0d0, 951.0d0, & 359.0d0, 482.0d0, 604.0d0, 727.0d0, 849.0d0, 972.0d0, & 369.0d0, 495.0d0, 620.0d0, 746.0d0, 871.0d0, 997.0d0/ data altmax/ & 6263.0d0, 8428.0d0, 9231.0d0, 6463.0d0, 8698.0d0, & 9108.0d0, 6569.0d0, 8840.0d0, 9315.0d0, & 6678.0d0, 9122.0d0, 9285.0d0, 7060.0d0, 9154.0d0, & 9154.0d0, 7420.0d0, 9986.0d0, 11218.0d0, & 7790.0d0,10485.0d0,11491.0d0, 7790.0d0,10485.0d0, & 11491.0d0, 8313.0d0,11190.0d0, 11718.0d0, & 8523.0d0,11473.0d0,11927.0d0, 8789.0d0,11831.0d0, & 11927.0d0, 8789.0d0,11831.0d0, 11927.0d0, & 8789.0d0,11831.0d0,11927.0d0, 9558.0d0,12755.0d0, & 12755.0d0, 9774.0d0,12764.0d0, 12764.0d0, & 10011.0d0,12873.0d0,12873.0d0, 10350.0d0,13209.0d0, & 13209.0d0,10703.0d0,13573.0d0, 13573.0d0, & 10922.0d0,14345.0d0,14346.0d0, 10922.0d0,14345.0d0, & 14346.0d0,10922.0d0,14345.0d0, 14346.0d0, & 10922.0d0,14345.0d0,14346.0d0, 12066.0d0,16230.0d0, & 20282.0d0,12263.0d0,16502.0d0, 20282.0d0, & 12590.0d0,16942.0d0,21298.0d0, 12590.0d0,16942.0d0, & 21298.0d0,12691.0d0,17078.0d0, 21469.0d0/ data flmax/ & 1200.0d0, 1184.0d0, 1211.0d0, 1207.0d0, 1190.0d0, & 1234.0d0, 1264.0d0, 1264.0d0, 1289.0d0,3*1312.0d0, & 1400.0d0, 1403.0d0, 1404.0d0, 1416.0d0, 1453.0d0, & 1493.0d0, 1578.0d0, 1687.0d0, 1843.0d0, 2028.0d0, & 2*2231.0d0, 2351.0d0, 2430.0d0,2*2506.0d0,4*2598.0d0, & 2642.0d0/ c inflation factor for fuel credit; uneven in later years data cin/ & .0d0, 2*1.0d0, 1.13d0, 1.16d0, 1.27d0, 2*1.36d0/ c alternate inflation factor for some backets, fuel credit data cin2/ & 70.0d0, 73.0d0, 74.0d0, 76.0d0, 79.0d0, 83.0d0, & 86.0d0, 92.0d0, 95.0d0, 96.0d0, 99.0d0, 102.0d0, & 105.0d0, 108.0d0, 111.0d0, 112.0d0, 116.0d0, 119.0d0, & 121.0d0, 122.0d0, 126.0d0, 131.0d0, 134.0d0, 139.0d0, & 2*144.0d0, 147.0d0, 152.0d0, 155.0d0,2*156.d0, 160.0d0/ mst=data(2) nfile = int(filing(mst,1.,2.,3.,2.)) rt=rate(law) stded = 0. c AGI agi=comnew(2)+min(data(65),data(7)*50.) if(law.ge.1982.and.law.le.1986)agi=agi+comnew(32) c Social Security benefits are not taxable in Michigan if(law.ge.1984) agi = agi-comnew(79) c Additions to income if(law.ge.1998.and.law.ne.2011.and.law.ne.2012) & agi = agi + .5*data(43) if(law.eq.2011.or.law.eq.2012) then c 2011-2012 : 5.65% instead of 7.65% if(data(43).le.14204.) then agi = agi + .5751*data(43) else agi = agi + .5*data(43) + 1067 endif endif c Pensions Exclusion penexc = 0. if(law.le.1993) then if(nfile.ne.2)then penexc = min(data(20)+data(72),7500.0d0) else if(nfile.eq.2) then penexc = min(((data(20)+data(72))/data(3)),10000.0d0) endif else penexc = min(data(20)+data(72),pended(law)*data(7)) if(law.eq.1994.and.mst.eq.2) & penexc = min(data(20)+data(72),22500.0d0) endif if(data(9).lt.1) penexc = 0. c 1994+ Senior citizens age 65+ who do not deduct retirement benefits c may deduct part of their dividend and interest income (+capgn for 1997+) divded = 0. if(law.ge.1994.and.data(9).gt.0) then if(law.le.1996) then unearned = data(12)+data(14) else unearned = data(12)+data(14)+max(0.0d0,comnew(6)) endif divded = min(unearned,oldded(law)*data(7)) endif c Michigan Standard Deduction. Taxpayers who reach the c age of 67 during 2013+ may deduct $20,000 for single or c married, filing separately, or $40,000 for joint filers c against all income. If you qualify for the Michigan c Standard Deduction, you are not eligible to deduct pension c and retirement benefits on the Michigan Pension Schedule (Form 4884). pens = max(penexc,divded) if (law.ge.2013.and.data(9).gt.0.d0) then stded = 20000*data(7) pens = stded endif agi = agi-pens c Exemptions num=data(7)+data(8)+data(9)+data(10) old=data(9)+data(10) if(law.lt.1987) then exemp=num*xmp(law,1) else if(law.ge.1987) then c extra exemption for the unemployed ump=0. if(data(82).ge.comnew(2)*.5)ump=1. exemp=((num-old)*xmp(law,1))+((old+ump)*xmp(law,2)) if(law.ge.2000.and.law.le.2011) exemp = exemp + data(8)*600 if((law.eq.1998.or.law.eq.1999).and.data(8).gt.0) & exemp = exemp + 300*data(8) endif c Computation of Taxable Income and Tax taxinc=max(agi-exemp,0.0d0) regtax=rate(law)*taxinc c solar energy credit solar=0. if(law.ge.1979)solar=data(38) c regular property tax credit is refundable ptax=0. pcred=0. c Non-negative household income hy = max(0.d0,data(159)) all=0. all=pallow(law) if(hy.le.all+9000) then ptax=data(51)+xif(law.le.1993,.17*data(160)) & +xif(law.ge.1994,.2*data(160)) if(old.lt.1.) then pcred=.6*max(ptax-.035*hy,0.0d0) else if(data(9).gt.0.and.data(10).lt.1.) then c special old age property tax credit c assume state equalized value of homestead less than r3500. if(law.lt.1980) then pcred=ptax else if(law.ge.1980) then tbl2 = tablki(proptb,5,hy,data) pcred = max(ptax - tbl2*hy,0.d0) if(law.ge.2012) then c percentage for 2012+ for senior claimants tbl1 = tablki(pcra,11,hy,data) pcred = pcred*tablki(pcra,11,hy,data) endif c for senior renters if(data(160).gt.0) pcred = max(pcred,data(160)-.4*hy) endif else if(data(10).gt.0) then c special blind or veteran's property tax credit pcred=ptax endif pcred=min(pcred,1200.0d0) c reduction of credit for hy over a certain amount if(hy.gt.all) then over=(max(hy-all,0.0d0))/1000. pcred=pcred*max(0.0d0,(1.-.1*over)) endif endif c fuel credit - Home Heating Credit Claim fuel = 0. c Standard Credit nexemp = 0 amex = data(7)+data(8)+data(10) c Looks like MI does not include elderly exemption in amex nexemp=min(amex,6.0d0) xemp=max(0.0d0,amex - 6.) if(nexemp.gt.0) then if(law.le.1984) then fuel=max(0.0d0,(fuelc1(nexemp)*cin(law))-.035*hy) else if(law.ge.1985.and.law.le.2005) then c fuel credits are unevenly adjusted 1985-2005 fc=fuelc2(nexemp,law)+xemp*cin2(law) fuel=max(0.0d0,(fc-.035*hy)) else if(law.ge.2006) then c for years 2006+ fc=fuelc3(law)+max(0.0d0,amex-1)*cin2(law) hyc = .035*hy fuel=max(0.0d0,(fc-.035*hy))*frt(law) endif endif c Alternate Credit c if(law.ge.1984) then c num = 2 c if(amex.ge.3) then c num = 3 c else if(amex.le.1) then c num = 1 c endif c if(data(159).le.altmax(num,law)) then c fuel = max(fuel,.7 * max(0.0d0,flmax(law)-.11*hy)) c endif c endif if(law.le.2006) fuel = .76*fuel if(law.eq.2007) fuel = .53*fuel if(law.ge.2008.and.law.le.2009) fuel = .65*fuel if(law.ge.2010.and.law.le.2011) fuel = .52*fuel if(law.eq.2012) fuel = .48*fuel c Earned income credit since 2008 earncr = 0. if(law.eq.2008) earncr = .1*comnew(59) if(law.ge.2009.and.law.le.2011) earncr = .2*comnew(59) if(law.ge.2012) earncr = .06*comnew(59) credit=solar+fuel+pcred+earncr c changed for new accounting of refundable credits; solar was the c only regularly non-refundable credit statax=max(0.0d0,regtax-solar)-pcred-fuel-earncr c50 continue return end c MINNESOTA c State 24 c c Updated through 2016 subroutine mntax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ &hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255) common/temp/count integer deps c Schedule M1MT, Alternative Minimum Tax dimension phase(3),excl(2001:2016,3),perc(2001:2016) c stadd 2011-2013 only dimension aif01(2001:2008),stadd(2011:2013) dimension wfc0(1999:2013,2),wfc1(1999:2013,4),wfc2(1999:2013,4) c wfcj for 2002-2013 dimension wfcj(2002:2013,0:2) dimension rwfc0(1999:2013),rwfc1(1999:2013,3),rwfc2(1999:2013,3) dimension fc0(1999:2013),fc1(1999:2013,2),fc2(1999:2013,2) c working family credit 2014-2016 dimension wf0(2014:2016),w01(2014:2016),w02(2014:2016), &wj02(2014:2016) dimension wf1(2014:2016),w11(2014:2016),w12(2014:2016), &wj12(2014:2016) dimension wf2(2014:2016),w21(2014:2016),w22(2014:2016), &wj22(2014:2016) c dimension cred(1977:1986),plmax(1977:1986),cded(1977:2016) dimension stnd(1988:2016,5),base(2),workcr(2) dimension stdaif(1977:1986), cmax(1977:2016,2), seless(1977:2016) dimension pnsion (1977:1986,2),semax(1977:2016) c cymax max hy for Child and Dependent Care credit Form M1CD dimension eld88(4,3),ylow(6,4),cymax(1977:2016,2),eld94(4,3), &fuel(2009:2009,3), ph(2011:2016) double precision irales,keoles,maxcrd integer txp data stadd/1950.0d0,2000.0d0,2050.0d0/ data ph /169550.0d0,173650.0d0,178150.0d0,181150.0d0,184000.0d0, & 184850.0d0/ data fuel/ 22730.d0,33220.d0,27980.d0/ data perc/ .0d0, .013d0,3* .01d0, 11* .0d0/ data phase/112500.d0,150000.d0,112500.d0/ c 2001 2002 2003 2004 2005 2006 2007 2008 2009 data excl / 1 5*30000.0d0, 45000.0d0, 46760.0d0, 47830.0d0, 1 49860.0d0, 49960.0d0, 50700.0d0, 51930.0d0, 1 53260.0d0, 54160.0d0, 55020.0d0, 55270.0d0, 2 5*40000.0d0, 60000.0d0, 62340.0d0, 63770.0d0, 2 66490.0d0, 66610.0d0, 67590.0d0, 69230.0d0, 2 71010.0d0, 72220.0d0, 73360.0d0, 73690.0d0, 3 5*30000.0d0, 45000.0d0, 46760.0d0, 47830.0d0, 3 49960.0d0, 49960.0d0, 50700.0d0, 51930.0d0, 3 53260.0d0, 54160.0d0, 55020.0d0, 55270.0d0/ c year 1999 2000 2001 2002 2003 2004 2005 data wfc0/ & 4540.0d0,4620.0d0,4760.0d0,4960.0d0,4960.0d0,5110.0d0,5230.0d0, 1 5390.0d0,5600.0d0,5730.0d0,5980.0d0,5990.0d0,6080.0d0,6220.0d0, 1 6380.0d0, & 5660.0d0,5770.0d0,5950.0d0,6150.0d0,6240.0d0,6390.0d0,6530.0d0, 2 6740.0d0,7000.0d0,7160.0d0,7460.0d0,7480.0d0,7590.0d0,7770.0d0, 2 7970.0d0/ c year 2002 2003 2004 2005 2006 2007 2008 data wfcj / & 7210.0d0,7240.0d0,7390.0d0,8530.0d0,8740.0d0,9000.0d0,10160.0d0, 1 10590.0d0,10610.0d0,12670.0d0,2*13310.0d0, & 17130.0d0,17320.0d0,17690.0d0,19070.0d0,19600.0d0,20290.0d0, 2 21710.0d0,22640.0d0,22670.0d0,24910.0d0,2*26170.0d0, & 20120.0d0,20360.0d0,20800.0d0,22250.0d0,22880.0d0,23700.0d0, 3 25190.0d0,26270.0d0,26310.0d0,28610.0d0,2*30060.0d0/ c year 1999 2000 2001 2002 2003 2004 data wfc1 / a 6790.0d0, 6920.0d0, 7140.0d0, 7370.0d0, 7490.0d0, 7660.0d0, a 7830.0d0, 8080.0d0, 8390.0d0, 8580.0d0, 8950.0d0, 8970.0d0, a 9100.0d0, 9320.0d0, 9560.0d0, b 11850.0d0, 12060.0d0, 12460.0d0, 12870.0d0, 13080.0d0,13370.0d0, b 13680.0d0, 14100.0d0, 14650.0d0, 14990.0d0, 15630.0d0,15650.0d0, b 15890.0d0, 16270.0d0, 16690.0d0, c 13210.0d0, 13450.0d0, 13870.0d0, 14320.0d0, 14560.0d0,14880.0d0, c 15230.0d0, 15700.0d0, 16310.0d0, 16690.0d0, 17400.0d0,17430.0d0, c 17690.0d0, 18120.0d0, 18580.0d0, d 14810.0d0, 15080.0d0, 15550.0d0, 16060.0d0, 16320.0d0,16690.0d0, d 17070.0d0, 17600.0d0, 18290.0d0, 18710.0d0, 19510.0d0,2*19540.0d0 d,20310.0d0, 20830.0d0/ data wfc2 / a 9550.0d0, 9720.0d0, 10020.0d0, 10350.0d0, 10520.0d0, 10760.0d0, a 11000.0d0,11350.0d0, 11790.0d0, 12060.0d0, 12570.0d0, 12600.0d0, a 12780.0d0,13090.0d0, 13430.0d0, b 14590.0d0,14860.0d0, 15320.0d0, 15830.0d0, 16100.0d0, 16440.0d0, b 16820.0d0,17350.0d0, 18020.0d0, 18440.0d0, 19220.0d0, 19260.0d0, b 19540.0d0,20020.0d0, 20530.0d0, c 16500.0d0,16800.0d0, 17320.0d0, 17890.0d0, 18190.0d0, 18590.0d0, c 19020.0d0,19610.0d0, 20380.0d0, 20840.0d0, 21730.0d0, 21770.0d0, c 22090.0d0,22630.0d0, 23210.0d0, d 17570.0d0,17890.0d0, 18450.0d0, 19050.0d0, 19360.0d0, 19800.0d0, d 20250.0d0,20880.0d0, 21700.0d0, 22190.0d0, 23140.0d0, 23180.0d0, d 23530.0d0,24100.0d0, 24720.0d0/ data rwfc0 / .011475d0, 14*.019125d0/ data rwfc1 / .07450d0, 14*.0850d0 , & .0850d0 , 14*.0850d0 , & .05130d0, 14*.05730d0/ data rwfc2 / .0880d0, 14*.10d0, & .20d0, 14*.20d0, & .09380d0, 14*.1030d0/ data fc0 / & 52.0d0, 88.0d0, 91.0d0, 94.0d0, 96.0d0, 98.0d0, & 100.0d0, 103.0d0, 107.0d0, 110.0d0, 114.0d0, 115.0d0, & 116.0d0, 119.0d0, 122.0d0/ data fc1 / & 505.0d0, 588.0d0, 607.0d0, 626.0d0, 637.0d0, 651.0d0, & 665.0d0, 687.0d0, 713.0d0, 729.0d0, 761.0d0, 762.0d0, & 774.0d0, 792.0d0, 820.0d0, & 620.0d0, 706.0d0, 727.0d0, 750.0d0, 762.0d0, 779.0d0, & 797.0d0, 823.0d0, 854.0d0, 874.0d0, 911.0d0, 914.0d0, & 927.0d0, 949.0d0, 973.0d0/ data fc2 / & 840.0d0, 972.0d0,1002.0d0,1035.0d0,1052.0d0,1076.0d0, & 1100.0d0,1135.0d0,1179.0d0,1206.0d0,1257.0d0,1260.0d0, & 1278.0d0,1309.0d0,1343.0d0, & 1222.0d0,1360.0d0,1402.0d0,1447.0d0,1472.0d0,1506.0d0, & 1540.0d0,1587.0d0,1651.0d0,1686.0d0,1759.0d0,1762.0d0, & 1788.0d0,1831.0d0,1879.0d0 / data wf0 / 130.0d0, 132.0d0, 133.d0/ data w01 / 6180.0d0, 6280.0d0, 6310.d0/ data w02 / 8130.0d0, 8260.0d0, 8300.d0/ data wj02/13560.0d0,13780.0d0,13840.d0/ data wf1 / 1040.0d0, 1057.0d0, 1061.d0/ data w11 /11120.0d0,11300.0d0,11350.d0/ data w12 /21190.0d0,21520.0d0,21620.d0/ data wj12/26620.0d0,27040.0d0,27160.d0/ data wf2 / 2006.0d0, 2038.0d0, 2047.d0/ data w21 /18240.0d0,18530.0d0,18610.d0/ data w22 /25130.0d0,25530.0d0,25640.d0/ data wj22/30560.0d0,31050.0d0,31180.d0/ data stnd/ 1 3000.0d0, 3100.0d0, 3250.0d0, 3400.0d0, 3600.0d0, 1 3700.0d0, 3800.0d0, 3900.0d0, 4000.0d0, 4150.0d0, 1 4250.0d0, 4300.0d0, 4350.0d0, 4550.0d0, 4700.0d0, 1 4750.0d0, 4850.0d0, 5000.0d0, 5150.0d0, 5350.0d0, 1 5450.0d0, 2*5700.0d0, 5800.0d0, 5950.0d0, 6100.0d0, 1 6200.0d0, 2*6300.0d0, 2 5000.0d0, 5200.0d0, 5450.0d0, 5700.0d0, 6000.0d0, 2 6200.0d0, 6350.0d0, 6550.0d0, 6700.0d0, 6900.0d0, 2 7100.0d0, 7200.0d0, 7250.0d0, 7600.0d0, 7850.0d0, 2 9500.0d0, 9700.0d0,10000.0d0, 10300.0d0, 10700.0d0, 2 10900.0d0,2*11400.0d0, 9650.0d0, 9900.0d0, 10150.0d0, 2 12400.0d0,2*12600.0d0, 3 4400.0d0, 4550.0d0, 4750.0d0, 5000.0d0, 5250.0d0, 3 5450.0d0, 5600.0d0, 5750.0d0, 5900.0d0, 6050.0d0, 3 6250.0d0, 6350.0d0, 6350.0d0, 6650.0d0, 6900.0d0, 3 7000.0d0, 7150.0d0, 7300.0d0, 7550.0d0, 7850.0d0, 3 8000.0d0, 8350.0d0, 8400.0d0, 8500.0d0, 8700.0d0, 3 8950.0d0, 9100.0d0, 9250.0d0, 9300.0d0, 4 2*750.0d0, 800.0d0, 850.0d0, 2*900.0d0, 2*950.0d0, 4 2*1000.0d0, 3*1050.0d0, 1100.0d0,2*1150.0d0, 1200.0d0, 4 2*1250.0d0, 1300.0d0, 1350.0d0,2*1400.0d0, 2*1450.0d0, 4 1500.0d0, 3*1550.0d0, 5 2*600.0d0, 2*650.0d0,2* 700.0d0, 2*750.0d0, 2*800.0d0, 5 3*850.0d0, 2*900.0d0,2* 950.0d0,2*1000.0d0, 2*1050.0d0, 5 2*1100.0d0, 2*1150.0d0,2*1200.0d0,2*1250.0d0/ data ylow / & 4400.d0,5200.d0,6000.d0, 6700.d0, 7300.d0, 7800.d0, & 4800.d0,5800.d0,6900.d0, 7800.d0, 8400.d0, 8900.d0, & 5500.d0,7000.d0,8000.d0, 8900.d0, 9600.d0,10000.d0, & 5800.d0,7400.d0,8800.d0,10000.d0, 10500.d0,11000.d0/ data pnsion/ & 0.d0, 7200.d0, 10000.d0, 7*11000.d0, & 0.d0, 13000.d0, 8*17000.d0/ data eld88/35000.0d0, 32000.0d0, 28000.0d0, 17500.0d0, & 10000.0d0, 10000.0d0, 8000.0d0, 5000.0d0, & 15000.0d0, 12000.0d0, 12000.0d0, 7500.0d0/ data eld94/42000.0d0, 38500.0d0, 33700.0d0, 21000.0d0, & 12000.0d0, 12000.0d0, 9600.0d0, 6000.0d0, & 18000.0d0, 14500.0d0, 14500.0d0, 9000.0d0/ data seless/ & 2*.75d0, 2*.76d0, 2*1.0d0, 3*.75d0, & .60d0, 30*1.0d0/ data semax/ & 1.e20, 358.43d0, 445.18d0, 503.5d0, 36*1.e20/ data cred / 21.0d0, 40.0d0, 55.0d0, 60.0d0, 66.0d0, & 67.0d0, 68.0d0, 2* 70.0d0, 73.0d0/ data plmax / 2*25.0d0,8*50.0d0/ data cded/ & 4*12000.0d0, 2*15000.0d0, 14000.0d0, 5*10000.0d0, & 5*13351.0d0, 15640.0d0, 16050.0d0, 16500.0d0, & 16960.0d0, 17420.0d0, 17720.0d0, 18040.0d0, & 18600.0d0, 19210.0d0, 19520.0d0, 19960.0d0, & 20420.0d0, 21060.0d0, 21880.0d0, 22380.0d0, & 23330.0d0, 23380.0d0, 23720.0d0, 24300.0d0, & 24920.0d0, 25350.0d0, 25750.0d0, 25860.0d0/ data cymax/ 4*18000.0d0, 2*23000.0d0, 6*24000.0d0,4*27000.0d0, 1 28830.0d0,29290.0d0, 1 29700.0d0, 30150.0d0, 30610.0d0, 31070.0d0, 31370.0d0, 1 31690.0d0, 32250.0d0, 32860.0d0, 1 33170.0d0, 33610.0d0, 34070.0d0, 34710.0d0, 35530.0d0, 1 36030.0d0, 36980.0d0, 37030.0d0, 37370.0d0, 37950.0d0, 1 38570.0d0, 39000.0d0, 39400.0d0, 39510.0d0, & 4*15000.0d0, 2*31000.0d0, 6*24000.0d0,4*27000.0d0, & 28830.0d0, 29290.0d0, & 29700.0d0, 30150.0d0, 30610.0d0, 31070.0d0, 31370.0d0, & 31690.0d0, 32250.0d0, 32860.0d0, & 33170.0d0, 33610.0d0, 34070.0d0, 34710.0d0, 35530.0d0, & 36030.0d0, 36980.0d0, 37030.0d0, 37370.0d0, 37950.0d0, & 38570.0d0, 39000.0d0, 39400.0d0, 39510.0d0/ data cmax/ 4*150.0d0, 2*400.0d0, 480.0d0, 33* 720.0d0, & 4*300.0d0, 2*800.0d0, 960.0d0, 33*1440.0d0/ data stdaif/4*1.0d0,1.1030d0, 1.1250d0, 1.1350d0, 1.150d0, & 1.20d0, 1.250d0/ data aif01/1.0d0,1.020d0,1.040d0,1.060d0,1.090d0,1.1330d0, & 1.170d0,1.21060d0/ c indexing covers brackets,standard deduction and general credit. rt=0. mst=data(2) nfile = int(filing(mst,1.,2.,3.,2.)) c AGI agi = comnew(2)-data(22) c 2009 unemployment compensation is taxed in full if(law.eq.2009) agi = agi - comnew(78) + data(82) if(law.le.1982)agi=agi-data(33) if(law.le.1984)agi=agi-xjobs(data,law) c lower capital gains deduction if(law.ge.1979.and.law.le.1982)agi=agi + (.1*comnew(7)) if(law.ge.1979.and.law.le.1986)agi=agi-comnew(78) if(law.ge.1982.and.law.le.1985)agi=agi+comnew(32) c Looks like MN applies the state income tax to Social Security benefits c that are taxable at the federal level. c if(law.eq.1984)agi=agi-comnew(79) c pnsion exclusion if(law.le.1986) then taxpen=data(20)+data(72) tlim=max(0.0d0,comnew(2)-pnsion(law,2)) penexc=min(taxpen,max(0.0d0,pnsion(law,1) - tlim)) c true after 1987********************** if(law.eq.1985.or.law.eq.1986) then if(data(9).lt.1..and.data(10).lt.1.)penexc=0. endif else penexc=0. endif agi=agi-penexc c use old ira and keough limits for some years if(law.ge.1982.and.law.le.1984) then agi=agi+keoles(data,comnew,1981) agi=agi+irales(data,comnew,1981) endif c federal tax deduction fedtax=max(0.0d0,comnew(1)-(data(43)*seless(law))) fedtax=max(0.0d0,fedtax- & max(((1.-seless(law))*data(43))-semax(law),0.0d0)) c prorated by minnesota agi / federal agi if(comnew(2).gt.0.and.agi.ge.0) then fedtax=fedtax*min(1.0d0,((agi+data(22))/comnew(2))) endif if(law.le.1984)agi=agi-fedtax c deduction for the elderly and disabled eldded=0. num=data(9)+data(10) if(law.ge.1988.and.num.gt.0) then if(mst.eq.2.and.num.ge.2)ndx=1 if(mst.eq.2.and.num.eq.1)ndx=2 if(mst.ne.2.and.mst.ne.3.and.mst.ne.6)ndx=3 if(mst.eq.3.or.mst.eq.6)ndx=4 c income limits if(law.le.1993) then if(comnew(2).le.eld88(ndx,1)) then eldded=eld88(ndx,2)-(comnew(84)-comnew(79)) yless=max(0.0d0,comnew(2)-eld88(ndx,3))/2. eldded=max(0.0d0,eldded-yless) endif else if(comnew(2).le.eld94(ndx,1)) then eldded=eld94(ndx,2)-(comnew(84)-comnew(79)) yless=max(0.0d0,comnew(2)-eld94(ndx,3))/2. eldded=max(0.0d0,eldded-yless) endif endif endif c Since 1987 line 1 in Minnesota Form M-1 is Federal Taxable Income. c Our code repeats calculations with Federal AGI in Federal Form ,and c Minnesota taxinc is the same if it had been calculated from Fed. taxinc exemp=0. if(law.ge.1987) exemp=comnew(83) c deductions. percentage standard deduction or itemized. txp=data(7) sep=data(3) ag=max(0.0d0,agi) if(law.le.1978) then stded=min(1000.*stdaif(law),.1*ag) else if(law.ge.1979.and.law.le.1984) then stded=min(2000*stdaif(law),.1*ag) else if(law.eq.1985.or.law.eq.1986) then stded=min((2000*stdaif(law))/sep,.1*ag) else if(law.ge.1987) then stded=comnew(3) c MN doesn't adopt the federal increase (only for 2005) c for the standard deduction for married taxpayers if(law.eq.2005.and.(mst.eq.2.or.mst.eq.3.or.mst.eq.6)) & stded = stded - 1300./data(3) if((law.eq.2008.or.law.eq.2009).and.data(51).gt.0) stded = & stded - min(data(51),500.*data(7)) if(law.eq.2013.and.(mst.eq.2.or.mst.eq.3.or.mst.eq.6)) & stded = stded - 2050./data(3) if(law.eq.2012.and.(mst.eq.2.or.mst.eq.3.or.mst.eq.6)) & stded = stded - 2000./data(3) if(law.eq.2011.and.(mst.eq.2.or.mst.eq.3.or.mst.eq.6)) & stded = stded - 1950./data(3) endif c Itemized Deductions if(law.le.1986) then xitded=max(0.0d0,comnew(24)-data(50)) if(law.le.1981)xitded=max(0.d0,xitded- & comnew(20)+data(47)+data(48)+data(49)) if(law.le.1982)xitded=xitded + min(data(65),100.0d0*txp) if(law.le.1984)xitded=max(0.d0, & xitded-max(comnew(23)-.3*ag,0.0d0)) else if(law.ge.1987) then xitded=comnew(24)*comnew(26) endif deduc=max(stded,xitded) taxinc = agi-deduc-exemp c Form M1 -- line 2 state income tax addition for itemizers if(law.ge.1987) then old=data(9)+data(10) oldd = 0 if(law.ge.1988) then oldd=stnd(law,5)*old if(nfile.eq.1.or.nfile.eq.3) oldd=old*stnd(law,4) endif endif add = 0. if(comnew(26).gt.0) then if(law.ge.1988) then add=min(max(comnew(24)-stnd(law,nfile)/sep-oldd,0.0d0), & data(50)) else if(law.lt.1988) then add = data(50) if(comnew(24)-data(50).lt.comnew(3)) & add = comnew(24) - comnew(3) endif endif c subrac=data(22)+eldded subrac= eldded c New charitable contribution subtraction for nonitemizers in 1999 if(law.ge.1999.and.comnew(26).lt.1.and.comnew(23).gt.0) & subrac = subrac + .5*max(0.0d0,comnew(23)-500.) taxinc = taxinc - subrac + add c Schedule M1M -- adiitions to taxable income if(law.ge.2011.and.law.le.2013) then c line 1 of 2011-2013 Schedule M1M c If you took standard deduction on your federal return and c are filing married/sep or widow, you are required to add back c $1950/sep in 2011 or $2000/sep on 2012 or $2050/sep in 2013 if(comnew(26).eq.0.and. & (mst.eq.2.or.mst.eq.3.or.mst.eq.6.or.mst.eq.5)) & taxinc = taxinc + stadd(law)/sep c line 2 of 2011-2012 Schedule M1M -- worksheet line-by-line c if your AGI exceeds the applicable threshold, you are requered c to add back the amount that WOULD HAVE BEEN LIMITED under PRIOR c federal law for itemized deductions and exemptions if(comnew(26).eq.1.and.comnew(2).gt.ph(law)) then xl2 = comnew(20) + max(0.0d0,data(61) - .1*comnew(2)) xl4 = .8*max(0.0d0,comnew(24) - xl2) xl8 = .03*max(0.0d0,comnew(2) - ph(law)/sep) xl9 = min(xl4,xl8) xl10 = add xl11 = xl10 + xl9 if(mst.eq.1) then stdmn = stnd(law,1) else if(mst.eq.4.or.mst.eq.7) then stdmn = stnd(law,3) else stdmn = stnd(law,2)/sep endif xl14 = max(0.0d0, comnew(24) - stdmn) if(xl11.le.xl14) then xl15 = xl9 else xl15 = max(0.0d0,xl14-xl10) endif taxinc = taxinc + xl15 endif c line 3 of 2011 Schedule M1M if(mst.eq.2.or.mst.eq.3.or.mst.eq.6) then phamex = 1.5*ph(law)/sep else if(mst.eq.1) then phamex = ph(law) else phamex = 1.25*ph(law) endif if(comnew(2).gt.phamex) then if(comnew(2) - phamex.le.122500/sep) then xxxl7 = .02*(comnew(2) - phamex)/(2500/sep) addxmp = xxxl7*comnew(83) else addxmp = comnew(83) endif taxinc = taxinc + addxmp endif endif taxinc = max(0.0d0, taxinc) c** the end of 2011-2012 taxinc additions ********* call mnrate(mst,taxinc,fedtax,law,statax,rt,data) c MARK polcr=0. if(law.le.1986) then c IGNORE this section if you are trying to get a simple idea of the c minn tax system c calculate credit value of political contributions deduction; can c take either deduction or credit xitded=xitded+min(data(65),100.0d0*txp) deduc=max(stded,xitded) taxinc=max(0.0d0,agi-deduc-exemp) c calculate tax with political deduction call mnrate(mst,taxinc,fedtax,law,poltax,prt,data) c credit value is difference between tax w/ & w/out the deduction polcr1=max(0.0d0,statax-poltax) c credit value can not be greater than statax polcr2=min(.5*data(65),plmax(law)*txp,statax) c if(polcr1.gt.polcr2) then statax=poltax else if(polcr2.ge.polcr1) then xitded=max(0.d0,xitded-min(data(65),100.0d0*txp)) deduc=max(stded,xitded) taxinc=max(0.0d0,agi-deduc-exemp) call mnrate(mst,taxinc,fedtax,law,statax,rt,data) polcr=min(.5*data(65),plmax(law)*txp) endif endif c Since 2001, Alternative Minimum Tax (Schedule M1MT) almtax = 0. if(law.ge.2001) then char = max(0.0d0,comnew(23) - perc(law)*(max(0.0d0,comnew(2)))) alminy = comnew(2) + min(.025*max(0.0d0,comnew(2)),comnew(20)) - & comnew(20) - data(53) - char - data(61) - data(22) alminc = max(0.0d0,alminy - max(0.0d0,excl(law,nfile)/data(3) - & .25*max(alminy - phase(nfile)/data(3),0.0d0))) if(law.le.2012) then almtax = max(0.0d0,.064*alminc - statax) else almtax = max(0.0d0,.0675*alminc - statax) endif endif statax = statax + almtax c Non-Refundable Credits if(law.eq.1977) then gcred=(data(7)+data(8)+data(9))*cred(law) gcred=gcred + (data(10)*25.) else if(law.eq.1978) then c taxpayer exemption is r40; additional taxpayer exemptions for c age and blindness are r20 for the first exemption for each c taxpayer, and r30 for the next exemption for each taxpayer. c Dependent exemptions are r40 each. gcred=(40.*data(7))+(20.*data(9))+(20*data(10)) gcred=gcred+(10.*max(0.0d0,data(10)+data(9)-data(7))) gcred=gcred+(40.*data(8)) else if(law.ge.1979.and.law.le.1986) then gcred=comnew(68)*cred(law) else if(law.ge.1987) then gcred=0. endif c homemaker credit c credit for homemakers with at least one dependent hcred=0. if(law.ge.1978.and.law.le.1984) then hcred=50. if(txp.eq.1) then if(data(11).gt.50.or.data(17).gt.0)hcred=0. endif if(data(85).gt.50.or.data(86).gt.50)hcred=0. if(mst.eq.3.or.mst.eq.6)hcred=0. if(data(8).lt.1)hcred=0. if(comnew(2).gt.(25000./sep))hcred=0. if(data(105).lt.1.d0) hcred = 0.d0 endif c residential energy credit encred=0. if(law.ge.1979.and.law.le.1984)encred=.7*data(38) c credit for elderly and disabled eldcr=0. if(law.eq.1987)eldcr=comnew(54)*.4 credit=gcred+polcr+hcred+encred+eldcr c low income credit crlow=0. if(law.le.1984.and.comnew(2).le.20000.and.data(105).lt.1) then npop=min(data(7)+data(8),6.0d0) c ndx=nint(min(law-1976.,4.0d0)) ndx=min(law-1976,4) ytest=max(0.0d0,.15*(data(159)-ylow(npop,ndx))) crlow=max(0.0d0,statax-credit-ytest) endif credit=credit+crlow c 1999+ marriage credit c crmarr includes tables, crmarr1 smoothes the result c call crmarr(data,comnew,taxinc,fedtax,statax,crmar,law) call crmarr1(data,comnew,taxinc,fedtax,statax,crmar,law) credit = credit + crmar c 1991 credit for working family - refundable earncr = 0. work = 0. if(law.ge.1991.and.law.le.1992) then work = .1 * comnew(59) else if(law.ge.1993.and.law.le.1997.and.comnew(59).gt.0) then work = .15 * comnew(59) else if(law.ge.1998.and.comnew(59).ge.5) then c Eligibility for the federal EIC causes the eligibility for c the Minnesota Working Family Credit base(1) = comnew(37) base(2) = comnew(2) if(law.eq.1998) then if(data(8).lt.1) then do 95 i = 1,2 workcr(i) = 0. if (base(i).le.4400.) workcr(i) = 0.012*base(i) if(base(i).le.5600.) workcr(i) = 51. if(base(i).lt.10000.) & workcr(i) = max(0.0d0,51. - .012* (base(i)-5600.)) 95 continue if(comnew(2).le.5570.) then work = workcr(1) else work = min(workcr(1),workcr(2)) endif endif if(data(8).gt.0.and.data(8).lt.2) then do 96 i = 1,2 workcr(i) = 0. if (base(i).lt.6700.) workcr(i) = 0.068*base(i) if(base(i).lt.11700.and.base(i).ge.6700) workcr(i) = 454. if(base(i).lt.13000.and.base(i).ge.11700) & workcr(i) =.086* (base(i)-11700.) + 454. if(base(i).lt.14600.and.base(i).ge.13000.) workcr(i) = 568. if(base(i).lt.26500.and.base(i).ge.14600.) & workcr(i) = 568. - .048*(base(i)-14600.) 96 continue if(comnew(2).le.14560.) then work = workcr(1) else work = min(workcr(1),workcr(2)) endif endif if(data(8).gt.1) then do 97 i = 1,2 workcr(i) = 0. if (base(i).lt.9400.) workcr(i) = 0.08*base(i) if(base(i).lt.14400.and.base(i).ge.9400) workcr(i) = 751. if(base(i).lt.16200.and.base(i).ge.14400) & workcr(i) =.2* (base(i)-14400.) + 751. if(base(i).lt.17300.and.base(i).ge.16200) workcr(i) =1127. if(base(i).lt.30100.and.base(i).ge.17300) & workcr(i) = 1127. - .088*(base(i)-17300.) 97 continue if(comnew(2).le.17280) then work = workcr(1) else work = min(workcr(1),workcr(2)) endif endif else if(law.ge.2014) then c 2014+ The Minnesota Working Family Credit calculation was simplified wmax = max(base(1),base(2)) if(data(8).lt.1) then work = wf0(law) if(base(1).le.w01(law)) work = .021*base(1) if(mst.eq.2) wbase = wj02(law) if(mst.ne.2) wbase = w02(law) work = max(0.0d0,work - .0201*max(0.0d0,wmax-wbase)) else if(data(8).eq.1) then work = wf1(law) if(base(1).le.w11(law)) work = .0935*base(1) if(mst.eq.2) wbase = wj12(law) if(mst.ne.2) wbase = w12(law) work = max(0.0d0,work - .0602*max(0.0d0,wmax-wbase)) else if(data(8).gt.1) then work = wf2(law) if(base(1).le.w21(law)) work = .11*base(1) if(mst.eq.2) wbase = wj22(law) if(mst.ne.2) wbase = w12(law) work = max(0.0d0,work - .1082*max(0.0d0,wmax-wbase)) endif else if(law.ge.1999.and.law.le.2013) then c Taxpayer with no children if(data(8).lt.1) then wfc00=wfc0(law,2) if(mst.eq.2) then if((law.ge.2002.and.law.le.2011).or.law.eq.2013) & wfc00 = wfcj(law,0) endif do 98 i = 1,2 workcr(i) = 0. if (base(i).le.wfc0(law,1)) workcr(i) = rwfc0(law)*base(i) if(base(i).le.wfc00) then workcr(i) = min(wfc00,fc0(law)) else workcr(i) = max(0.0d0,fc0(law) - rwfc0(law) & * (base(i)-wfc00)) endif 98 continue if(comnew(2).le.wfc00) then work = workcr(1) else work = min(workcr(1),workcr(2)) endif endif c Taxpayer with one child if(data(8).gt.0.and.data(8).lt.2) then wfc11 = wfc1(law,4) if(mst.eq.2) then if((law.ge.2002.and.law.le.2011).or.law.eq.2013) & wfc11 = wfcj(law,1) endif do 99 i = 1,2 workcr(i) = 0. if (base(i).lt.wfc1(law,1)) workcr(i)=rwfc1(law,1)*base(i) if(base(i).lt.wfc1(law,2).and.base(i).ge.wfc1(law,1)) & workcr(i) = min(wfc11,fc1(law,1)) if(base(i).lt.wfc1(law,3).and.base(i).ge.wfc1(law,2)) & workcr(i) =rwfc1(law,2)* (base(i)-wfc1(law,2))+ fc1(law,1) if(base(i).lt.wfc11.and.base(i).ge.wfc1(law,3)) & workcr(i) = fc1(law,2) if(base(i).ge.wfc11) & workcr(i) = max(0.0d0,fc1(law,2) - rwfc1(law,3) & * (base(i)-wfc11)) 99 continue if(comnew(2).le.wfc11) then work = workcr(1) else work = min(workcr(1),workcr(2)) endif endif c Taxpayer with two or more children if(data(8).gt.1) then wfc22 = wfc2(law,4) if(mst.eq.2) then if((law.ge.2002.and.law.le.2011).or.law.eq.2013) & wfc22 = wfcj(law,2) endif do 100 i = 1,2 workcr(i) = 0. if (base(i).lt.wfc2(law,1)) & workcr(i)=rwfc2(law,1)*base(i) if(base(i).lt.wfc2(law,2).and.base(i).ge.wfc2(law,1)) & workcr(i) = min(wfc22,fc2(law,1)) if(base(i).lt.wfc2(law,3).and.base(i).ge.wfc2(law,2)) & workcr(i) =rwfc2(law,2)* & (base(i)-wfc2(law,2))+fc2(law,1) if(base(i).lt.wfc22.and.base(i).ge.wfc2(law,3)) & workcr(i) =fc2(law,2) if(base(i).ge.wfc22) & workcr(i) = max(0.0d0,fc2(law,2) - rwfc2(law,3) & *(base(i)-wfc22)) 100 continue if(comnew(2).le.wfc22)then work = workcr(1) else work = min(workcr(1),workcr(2)) endif endif endif endif earncr = work c child care credit: refundable chcr=0. deps=min(data(8),2.0d0) if(deps.gt.0.0d0) then if(hy.le.cymax(law,deps)) then cost=0. if(law.le.1980) then cost=comnew(53)/2. else if(law.eq.1981) then cost=comnew(53) else if(law.eq.1982.or.law.eq.1983) then cost=.2*comnew(53) else if(law.ge.1984) then cost=comnew(53) endif cost=min(cost,cmax(law,deps)) over=max(0.0d0,hy-cded(law)) if(law.le.1982) then chcr=max(0.0d0,cost-(.05*over)) else if(law.ge.1983) then chcr=max(0.0d0,cost-(.052*deps*over)) endif endif endif c pcred calculation call mncred(data,comnew,statax,law) c MN has a new refundable credit - an Education credit since 1999. edcred = 0. tuition = data(143) + data(144) if(law.ge.2002) tuition = .75*(data(143) + data(144)) if(law.ge.1999.and.law.le.2004) then tuit = data(208)*min(1000.0d0,.25*max(0.0d0,37500. - hy)) edcred = min(2000.0d0,min(tuition,tuit)) else if(law.ge.2005) then if(data(208).le.1.) prc = .25 if(data(208).ge.2.) prc = .5 edcred = min(tuition, & max(0.0d0,1000.*data(208) - prc*max(0.0d0,hy - 33500.))) endif c 2009 only lower income motor fuels tax credit(refundable) crfuel = 0. if(law.eq.2009) then if(mst.eq.1) then nfuel = 1 else if (mst.eq.4.or.mst.eq.7) then nfuel = 3 else nfuel = 2 endif if(taxinc.le.fuel(law,nfuel)/data(3)) crfuel = 25./data(3) endif statax = max(0.0d0,statax-credit) statax = statax - chcr - work - pcred - edcred - crfuel credit = credit + chcr + work + pcred + edcred + crfuel return end subroutine mncred(data,comnew,statax,law) implicit double precision (A-H,O-Z) common /user/ zbrack(3,1987:2018),exem(1987:2018), &crmax(1987:2018,0:3,1:2),ymax(1987:2023,0:3,1:2), 1rtbase(1987:2023,0:3), rtless(1987:2023,0:3), 2chmax(1998:2023),ealim(2001:2023),cphas(7) common/calc/ &hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255) c Property Tax Refund -- dependent Subtraction dimension dep(0:5,1994:2016),oldep(0:5) &,aif2(1989:2016),aifr(1989:2016) dimension owner(1989:2016) &,p101(2,17),p201(2,23),p216(2,14),p210(2,22) &,p2o(2,8),p1o(2,20),p16o(2,8),p10o(2,8) &,p1(2,16),p2(2,31),p2eld(2,19), &p112r(2,8),p212r(2,23),p116r(2,14),p216r(2,11),p16r(2,10) dimension p85x(2,11),p85y(2,31),p83(2,34) &,p82(2,27),p821(2,21),p822(2,21),p771(2,21),p772(2,21) dimension p87x1(2,17),p87x2(2,17),p87y(2,26) dimension p88x(2,33),p88y(2,26) dimension p3(2,5) dimension p116(2,10),p110(2,16),p107(2,17) data p3/ & 21000.d0,380.d0,22000.d0,364.d0,23000.d0,348.d0, & 24000.d0,286.d0,25000.d0,268.d0/ data p110/ & 2000.d0, 1560.d0, 4000.d0, 1514.d0, 7000.d0, 1455.d0, & 9000.d0, 1400.d0, 11000.d0, 1356.d0, 16000.d0, 1245.d0, & 21000.d0, 1200.d0, 30000.d0, 1145.d0, 40000.d0, 1040.d0, & 45000.d0, 935.d0, 50000.d0, 835.d0, 55000.d0, 730.d0, & 58000.d0, 625.d0, 60000.d0, 515.d0, 62000.d0, 420.d0, & 65000.d0, 300.d0/ c 2004-2007 homeowners pcred data p107/ & 2000.d0, 1225.d0, 4000.d0, 1190.d0, 7000.d0, 1150.d0, & 9000.d0, 1105.d0, 11000.d0, 1065.d0, 14000.d0, 1022.d0, & 17000.d0, 980.d0, 21000.d0, 938.d0, 30000.d0, 900.d0, & 40000.d0, 820.d0, 45000.d0, 735.d0, 50000.d0, 655.d0, & 55000.d0, 575.d0, 58000.d0, 490.d0, 60000.d0, 405.d0, & 62000.d0, 330.d0, 65000.d0, 245.d0/ data p82/ & 3000.d0,.05d0, 3500.d0,.06d0, 4000.d0,.07d0, 4500.d0,.08d0, & 5000.d0,.09d0, 6000.d0,.10d0, 7000.d0,.11d0, 8000.d0,.12d0, & 9000.d0,.13d0,10000.d0,.14d0,11000.d0,.15d0,12000.d0,.16d0, &13000.d0,.17d0,14000.d0,.18d0,15000.d0,.19d0,16000.d0,.20d0, &17000.d0,.21d0,18000.d0,.22d0,19000.d0,.24d0,20000.d0,.26d0, &21000.d0,.28d0,22000.d0,.30d0,23000.d0,.32d0,24000.d0,.34d0, &25000.d0,.36d0,26000.d0,.38d0, 1.e20 ,.40d0/ data p771/ & 3000.d0, 10.d0, 3500.d0, 20.d0, 4000.d0, 30.d0, 4500.d0, 40.d0, & 5000.d0, 50.d0, 6000.d0, 70.d0, 7000.d0, 90.d0, 8000.d0,110.d0, & 9000.d0,130.d0,10000.d0,150.d0,11000.d0,170.d0,12000.d0,190.d0, &13000.d0,210.d0,14000.d0,250.d0,15000.d0,300.d0,16000.d0,350.d0, &17000.d0,375.d0,18000.d0,400.d0,19000.d0,425.d0,20000.d0,450.d0, &21000.d0,475.d0/ data p772/ & 3000.d0, 13.d0, 3500.d0, 25.d0, 4000.d0, 50.d0, 4500.d0, 70.d0, & 5000.d0, 90.d0, 6000.d0,110.d0, 7000.d0,130.d0, 8000.d0,160.d0, & 9000.d0,200.d0,10000.d0,240.d0,11000.d0,280.d0,12000.d0,320.d0, &13000.d0,360.d0,14000.d0,400.d0,15000.d0,440.d0,16000.d0,480.d0, &17000.d0,520.d0,18000.d0,560.d0,19000.d0,600.d0,20000.d0,640.d0, &21000.d0,675.d0/ data p83/ & 3000.d0, 13.d0, 3500.d0, 15.d0, 4000.d0, 18.d0, 4500.d0, 20.d0, & 5000.d0, 23.d0, 6000.d0, 40.d0, 7000.d0, 54.d0, 8000.d0, 70.d0, & 9000.d0, 88.d0, 10000.d0,108.d0,11000.d0,130.d0,12000.d0,154.d0, &13000.d0,180.d0, 14000.d0,195.d0,15000.d0,210.d0,16000.d0,225.d0, &17000.d0,240.d0, 18000.d0,255.d0,19000.d0,270.d0,20000.d0,285.d0, &21000.d0,320.d0, 22000.d0,336.d0,23000.d0,352.d0,24000.d0,414.d0, &25000.d0,432.d0, 26000.d0,450.d0,27000.d0,520.d0,28000.d0,540.d0, &29000.d0,560.d0, 30000.d0,580.d0,31000.d0,600.d0,32000.d0,620.d0, &33000.d0,640.d0, 34000.d0,700.d0/ data p821/ & 3000.d0, 10.d0, 3500.d0, 20.d0, 4000.d0, 30.d0, 4500.d0, 40.d0, & 5000.d0, 50.d0, 6000.d0, 70.d0, 7000.d0,100.d0, 8000.d0,130.d0, & 9000.d0,150.d0,10000.d0,180.d0,11000.d0,200.d0,12000.d0,220.d0, &13000.d0,250.d0,14000.d0,300.d0,15000.d0,350.d0,16000.d0,400.d0, &17000.d0,450.d0,18000.d0,500.d0,19000.d0,550.d0,20000.d0,600.d0, &21000.d0,650.d0/ data p822/ & 3000.d0, 13.d0, 3500.d0, 25.d0, 4000.d0, 50.d0, 4500.d0, 70.d0, & 5000.d0,100.d0, 6000.d0,130.d0, 7000.d0,150.d0, 8000.d0,200.d0, & 9000.d0,250.d0,10000.d0,300.d0,11000.d0,350.d0,12000.d0,400.d0, &13000.d0,450.d0,14000.d0,500.d0,15000.d0,550.d0,16000.d0,600.d0, &17000.d0,650.d0,18000.d0,700.d0,19000.d0,750.d0,20000.d0,800.d0, &21000.d0,850.d0/ data p88x/ & 3000.d0,.01d0 , 4000.d0,.011d0, 5000.d0,.012d0, 6000.d0,.013d0, & 7000.d0,.014d0, 8000.d0,.015d0, 9000.d0,.016d0,10000.d0,.017d0, &11000.d0,.018d0,12000.d0,.019d0,13000.d0,.020d0,14000.d0,.021d0, &15000.d0,.022d0,16000.d0,.023d0,17000.d0,.024d0,18000.d0,.025d0, &19000.d0,.026d0,20000.d0,.027d0,21000.d0,.028d0,22000.d0,.027d0, &23000.d0,.028d0,24000.d0,.029d0,25000.d0,.030d0,26000.d0,.031d0, &27000.d0,.032d0,28000.d0,.033d0,29000.d0,.034d0,30000.d0,.035d0, &31000.d0,.036d0,32000.d0,.037d0,33000.d0,.038d0,34000.d0,.039d0, & 1e20,.040d0/ data p85y/ & 3000.d0,.05d0, 3500.d0,.06d0, 4000.d0,.07d0, 4500.d0,.08d0, & 5000.d0,.09d0, 6000.d0,.10d0, 7000.d0,.11d0, 8000.d0,.12d0, & 9000.d0,.13d0,10000.d0,.14d0,11000.d0,.15d0,12000.d0,.16d0, & 13000.d0,.17d0,14000.d0,.18d0,15000.d0,.19d0,16000.d0,.20d0, & 17000.d0,.21d0,18000.d0,.22d0,19000.d0,.23d0,20000.d0,.24d0, & 21000.d0,.25d0,22000.d0,.27d0,23000.d0,.29d0,24000.d0,.31d0, & 25000.d0,.33d0,26000.d0,.35d0,27000.d0,.38d0,28000.d0,.41d0, & 29000.d0,.44d0,30000.d0,.47d0, 1.e20,.50d0 / data p85x/ & 8000.d0,.01d0 , 9000.d0,.011d0,10000.d0,.012d0,11000.d0,.013d0, &12000.d0,.014d0,20000.d0,.015d0,23000.d0,.016d0,26000.d0,.018d0, &31000.d0,.020d0,36000.d0,.022d0, 1.e20,.024d0/ data p87x1/ & 8000.d0,.010d0, 9000.d0,.011d0,10000.d0,.0120d0,11000.d0,.013d0, &12000.d0,.014d0,13000.d0,.015d0,14000.d0,.0160d0,15000.d0,.017d0, &16000.d0,.018d0,17000.d0,.019d0,18000.d0,.0195d0,20000.d0,.020d0, &21000.d0,.021d0,24000.d0,.022d0,27000.d0,.0230d0,31000.d0,.024d0, & 1.e20,.025d0/ data p87x2/ & 8000.d0,.025d0, 9000.d0,.026d0,10000.d0,.027d0 ,11000.d0,.028d0, &12000.d0,.029d0,13000.d0,.030d0,14000.d0,.031d0 ,15000.d0,.032d0, &16000.d0,.033d0,17000.d0,.034d0,18000.d0,.0345d0,20000.d0,.035d0, &21000.d0,.036d0,24000.d0,.037d0,27000.d0,.038d0 ,31000.d0,.039d0, & 1.e20,.040d0/ data p87y/ & 9000.d0,.10d0,10000.d0,.11d0,11000.d0,.12d0,12000.d0,.13d0, &13000.d0,.14d0,14000.d0,.15d0,15000.d0,.16d0,16000.d0,.17d0, &17000.d0,.18d0,18000.d0,.19d0,19000.d0,.20d0,20000.d0,.22d0, &21000.d0,.24d0,22000.d0,.26d0,23000.d0,.28d0,24000.d0,.30d0, &25000.d0,.32d0,26000.d0,.34d0,27000.d0,.36d0,28000.d0,.38d0, &29000.d0,.40d0,30000.d0,.42d0,31000.d0,.44d0,32000.d0,.46d0, &33000.d0,.48d0, 1.e20,.50d0/ data p88y/ & 9000.d0,.10d0,10000.d0,.12d0,11000.d0,.14d0,12000.d0,.16d0, &13000.d0,.18d0,14000.d0,.20d0,15000.d0,.22d0,16000.d0,.24d0, &17000.d0,.26d0,18000.d0,.28d0,19000.d0,.30d0,20000.d0,.32d0, &21000.d0,.34d0,22000.d0,.36d0,23000.d0,.38d0,24000.d0,.40d0, &25000.d0,.42d0,26000.d0,.44d0,27000.d0,.46d0,28000.d0,.48d0, &29000.d0,.50d0,30000.d0,.52d0,31000.d0,.54d0,32000.d0,.56d0, &33000.d0,.58d0, 1.e20,.60d0/ data p2eld/ & 10000.d0, .05d0, 11000.d0, .06d0, 12000.d0, .07d0, & 13000.d0, .08d0, 14000.d0, .09d0, 16000.d0, .10d0, & 18000.d0, .11d0, 20000.d0, .12d0, 21000.d0, .13d0, & 22000.d0, .15d0, 23000.d0, .18d0, 24000.d0, .21d0, & 25000.d0, .24d0, 26000.d0, .27d0, 27000.d0, .30d0, & 28000.d0, .35d0, 29000.d0, .40d0, 30000.d0, .45d0, & 1.e20, .50d0/ data p1/ & 3000.d0, .005d0, 4000.d0, .006d0, 5000.d0, .007d0, & 6000.d0, .008d0, 7000.d0, .009d0, 8000.d0, .010d0, & 9000.d0, .011d0, 10000.d0, .012d0, 11000.d0, .013d0, & 12000.d0, .014d0, 20000.d0, .015d0, 23000.d0, .016d0, & 26000.d0, .018d0, 31000.d0, .020d0, 36000.d0, .022d0, & 1.e20, .024d0/ data p2/ & 3000.d0, .05d0, 3500.d0, .06d0, 4000.d0, .07d0, 4500.d0,.08d0, & 5000.d0, .09d0, 6000.d0, .10d0, 7000.d0, .11d0, 8000.d0,.12d0, & 9000.d0, .13d0,10000.d0, .14d0,11000.d0, .15d0,12000.d0,.16d0, &13000.d0, .17d0,14000.d0, .18d0,15000.d0, .19d0,16000.d0,.20d0, &17000.d0, .21d0,18000.d0, .22d0,19000.d0, .23d0,20000.d0,.24d0, &21000.d0, .25d0,22000.d0, .27d0,23000.d0, .29d0,24000.d0,.31d0, &25000.d0, .33d0,26000.d0, .35d0,27000.d0, .38d0,28000.d0,.41d0, &29000.d0, .44d0,30000.d0, .47d0, 1.e20, .50d0/ c 2011-2016 homeowners pcred data p216/ & 1000.d0, 1.d0 , 2000.d0, 1.1d0, 3000.d0, 1.2d0, 4000.d0,1.3d0, & 5000.0d0,1.4d0, 7000.d0, 1.5d0, 8000.d0, 1.6d0, 9000.d0,1.7d0, &10000.d0, 1.8d0,11000.d0, 1.9d0,40000.d0, 2.0d0,45000.d0,2.1d0, &50000.0d0,2.2d0,65000.d0, 2.5d0/ data p116/ & 24000.d0, 1600.d0, 35000.d0, 1288.d0, 40000.d0, 1130.d0, & 45000.d0, 950.d0, 50000.d0, 850.d0, 55000.d0, 750.d0, & 58000.d0, 600.d0, 60000.d0, 500.d0, 62000.d0, 425.d0, & 65000.d0, 300.d0/ c 2013-2016 renters pcred data p216r/ & 4000.d0, 1.d0 , 5000.d0, 1.1d0, 7000.d0, 1.2d0, 9000.d0,1.3d0, &11000.0d0,1.4d0,13000.d0, 1.5d0,14000.d0, 1.6d0,15000.d0,1.7d0, &17000.d0, 1.8d0,18000.d0, 1.9d0,35000.d0, 2.0d0/ data p116r/ & 4000.d0,1235.d0, 5000.d0,1200.d0, 7000.d0,1175.d0, & 10000.d0,1100.d0,11000.d0,1075.d0,13000.d0,1050.d0, & 28000.d0,1020.d0,29000.d0, 925.d0,30000.d0, 835.d0, & 31000.d0, 707.d0,32000.d0, 617.d0,33000.d0, 557.d0, & 34000.d0, 305.d0,35000.d0, 125.d0/ data p16r/ & 3000.d0, .05d0, 7000.d0, .1d0, 10000.d0,.15d0,14000.d0,.2d0, & 17000.d0, .25d0,21000.d0, .3d0, 24000.d0,.35d0,28000.d0,.4d0, & 31000.d0, .45d0,35000.d0, .5d0/ c 2012 renters pcred data p112r/ & 28000.d0, 995.d0,29000.d0, 900.d0,30000.d0, 800.d0, & 31000.d0, 700.d0,32000.d0, 600.d0,33000.d0, 500.d0, & 34000.d0, 300.d0,35000.d0, 100.d0/ data p212r/ & 4000.d0, 1.d0 , 5000.d0, 1.1d0, 7000.d0, 1.2d0, 9000.d0,1.3d0, &11000.0d0,1.4d0,13000.d0, 1.5d0,14000.d0, 1.6d0,15000.d0,1.7d0, &17000.d0, 1.8d0,18000.d0, 1.9d0,19000.d0, 2.0d0,20000.d0,2.2d0, &21000.d0, 2.4d0,22000.d0, 2.6d0,23000.d0, 2.7d0,24000.d0,2.8d0, &25000.d0, 2.9d0,26000.d0, 3.0d0,27000.d0, 3.1d0,28000.d0,3.2d0, &29000.d0, 3.3d0,30000.d0, 3.4d0,35000.d0, 3.5d0/ c 2008-2010 homeowners pcred data p210/ & 1000.d0, 1.d0 , 2000.d0, 1.1d0, 3000.d0, 1.2d0, 4000.d0,1.3d0, & 5000.0d0,1.4d0, 7000.d0, 1.5d0, 8000.d0, 1.6d0, 9000.d0,1.7d0, &10000.d0, 1.8d0,11000.d0, 1.9d0,12000.d0, 2.0d0,14000.d0,2.1d0, &15000.d0, 2.2d0,16000.d0, 2.3d0,17000.d0, 2.4d0,21000.d0,2.5d0, &24000.d0, 2.6d0,30000.d0, 2.7d0,35000.d0, 2.8d0,40000.d0,3.0d0, &45000.d0, 3.2d0,65000.d0, 3.5d0/ data p101/ & 2000.0d0, 1550.0d0, 4000.0d0, 1500.0d0, 7000.0d0, 1450.0d0, & 9000.0d0, 1400.0d0,11000.0d0, 1350.0d0,14000.0d0, 1300.0d0, &16000.0d0, 1250.0d0,21000.0d0, 1200.0d0,30000.0d0, 1150.0d0, &40000.0d0, 1100.0d0,45000.0d0, 950.0d0,50000.0d0, 850.0d0, &55000.0d0, 750.0d0,58000.0d0, 600.0d0,60000.0d0, 500.0d0, &62000.0d0, 425.0d0,65000.0d0, 300.0d0/ data p201/ & 1000.d0, 1.0d0, 2000.d0, 1.1d0, 3000.d0, 1.2d0, 4000.d0,1.3d0, & 5000.d0, 1.4d0, 7000.d0, 1.5d0, 8000.d0, 1.6d0, 9000.d0,1.7d0, & 10000.d0, 1.8d0,11000.d0, 1.9d0,12000.d0, 2.0d0,14000.d0,2.1d0, & 15000.d0, 2.2d0,16000.d0, 2.3d0,17000.d0, 2.4d0,21000.d0,2.5d0, & 24000.d0, 2.6d0,30000.d0, 2.7d0,35000.d0, 2.8d0,40000.d0,3.0d0, & 45000.d0, 3.2d0,50000.d0, 3.5d0,65000.d0, 4.0d0/ data owner/12*60000.d0,15*65000.d0,64600.d0/ data p2o/ & 3000.d0, .15d0, 7000.d0, .2d0, 10000.d0, .25d0, 14000.d0,.3d0, & 17000.d0, .35d0,30000.d0, .4d0, 45000.d0, .45d0, 65000.d0,.5d0/ data p1o/ & 1000.d0, 1.2d0, 2000.d0, 1.3d0, 3000.d0, 1.4d0, 4000.d0,1.6d0, & 5000.d0, 1.7d0, 7000.d0, 1.9d0, 8000.d0, 2.1d0, 9000.d0,2.2d0, & 10000.d0, 2.3d0,11000.d0, 2.4d0,12000.d0, 2.5d0,14000.d0,2.6d0, & 15000.d0, 2.8d0,16000.d0, 3.0d0,17000.d0, 3.2d0,21000.d0,3.3d0, & 24000.d0, 3.4d0,35000.d0, 3.5d0,40000.d0, 3.7d0, 1.e20,4.0d0/ data p10o/ & 3000.d0, .15d0, 7000.d0, .2d0, 10000.d0,.25d0,14000.d0,.3d0, & 17000.d0, .35d0, 30000.d0, .4d0,45000.d0,.45d0,65000.d0,.5d0 / data p16o/ & 3000.d0, .15d0, 10000.d0, .2d0, 14000.d0,.25d0,17000.d0,.3d0, & 35000.d0, .35d0, 55000.d0, .4d0, 60000.d0,.45d0,65000.d0,.5d0 / data aif2/ & 5*1.0d0, 1.03d0 , 1.06d0 , 1.09d0, 1.12d0 , 1.14d0, & 1.16d0, 1.195d0, 1.233d0 , 1.255d0, 1.279d0, 1.309d0, & 1.349d0, 1.399d0, 1.429d0, 1.489d0, 1.509d0, 1.519d0, & 1.549d0, 1.599d0, 1.619d0, 1.649d0, 1.659d0, 1.669d0/ data aifr/ & 5*1.0d0, 1.03d0 , 1.06d0 , 1.09d0, 1.12d0 , 1.14d0, & 1.16d0, 1.195d0, 1.235d0 , 1.259d0, 1.289d0, 1.309d0, & 1.349d0, 1.399d0, 1.439d0, 1.489d0, 1.519d0, 1.529d0, & 1.559d0, 1.609d0, 1.619d0, 1.649d0, 1.659d0, 1.669d0/ data dep / & .0d0,3430.0d0, 6615.0d0, 9555.0d0,12250.0d0,14700.0d0, & .0d0,3500.0d0, 6750.0d0, 9750.0d0,12500.0d0,15000.0d0, & .0d0,3570.0d0, 6885.0d0, 9945.0d0,12750.0d0,15300.0d0, & .0d0,3710.0d0, 7155.0d0,10335.0d0,13250.0d0,15900.0d0, & .0d0,3780.0d0, 7290.0d0,10530.0d0,13500.0d0,16200.0d0, & .0d0,3850.0d0, 7425.0d0,10725.0d0,13750.0d0,16500.0d0, & .0d0,3920.0d0, 7560.0d0,10920.0d0,14000.0d0,16800.0d0, & .0d0,4060.0d0, 7830.0d0,11310.0d0,14500.0d0,17400.0d0, & .0d0,4200.0d0, 8100.0d0,11700.0d0,15000.0d0,18000.0d0, & .0d0,4270.0d0, 8235.0d0,11895.0d0,15250.0d0,18300.0d0, & .0d0,4340.0d0, 8370.0d0,12090.0d0,15500.0d0,18600.0d0, & .0d0,4480.0d0, 8640.0d0,12480.0d0,16000.0d0,19200.0d0, & .0d0,4620.0d0, 8910.0d0,12870.0d0,16500.0d0,19800.0d0, & .0d0,4760.0d0, 9180.0d0,13260.0d0,17000.0d0,20400.0d0, & .0d0,4900.0d0, 9450.0d0,13650.0d0,17500.0d0,21000.0d0, & .0d0,5110.0d0, 9855.0d0,14235.0d0,18250.0d0,21900.0d0, & .0d0,5110.0d0, 9855.0d0,14235.0d0,18250.0d0,21900.0d0, & .0d0,5180.0d0, 9990.0d0,14430.0d0,18500.0d0,22200.0d0, & .0d0,5320.0d0,10260.0d0,14820.0d0,19000.0d0,22800.0d0, & .0d0,5460.0d0,10530.0d0,15210.0d0,19500.0d0,23400.0d0, & .0d0,5530.0d0,10665.0d0,15405.0d0,19750.0d0,23700.0d0, & .0d0,5600.0d0,10800.0d0,15600.0d0,20000.0d0,24000.0d0, & .0d0,5670.0d0,10935.0d0,15795.0d0,20250.0d0,24300.0d0/ data oldep / & .0d0,5880.0d0, 9065.0d0,12005.0d0,14700.0d0,17150.0d0/ c property tax refund pcred = 0. refo = 0. thrate = 0. copay = 0. pcredo = 0. pcredr = 0. hhy = max(0.0d0,comnew(2)+data(91)-comnew(79)) c add back Capital Loss if(comnew(6).lt.0) & hhy = max(0.0d0,comnew(2)+data(91)-comnew(79)-comnew(6)) if(law.ge.1989) then c for years 1989 and on ptxo = data(51) if(law.le.2008.or.law.eq.2010) then ptxr= .19*data(160) else if (law.eq.2009) then ptxr= .15*data(160) else ptxr= .17*data(160) endif c subtraction for dependents and for those age 65 or older or disabled c This could be in 1993 but I don't have instructions for 1993 if(law.ge.1994) then kid = min(5.0d0,data(8)) if(data(9).gt.0.or.data(10).gt.0) then if(law.eq.1994) then hhy=max(0.0d0,hhy-oldep(kid)) else hhy=max(0.0d0,hhy-dep(kid,law)-exem(law)) endif else hhy=max(0.0d0,hhy-dep(kid,law)) endif endif a = 35000*aifr(law) if(ptxr.gt.0.and.hhy.le.35000*aifr(law)) then if(law.ge.2013.and.law.le.2016) then c refr -max refund for renters refr=tablki(p116r,14,hhy/aifr(law),data)*aifr(law) thrate = tablki(p216r,11,hhy/aifr(law),data) else refr=tablki(p112r,8,hhy/aifr(law),data)*aifr(law) thrate = tablki(p212r,23,hhy/aifr(law),data) endif c copay - percent paid by claimant copay = tablki(p16r,10,hhy/aifr(law),data) thres = min(ptxr,thrate*hhy/100) c pcredr - property tax refund for renters pcredr = min(refr,max(0.0d0,ptxr - thres)*(1.-copay)) pcredr = max(0.0d0,pcredr) else if(ptxo.gt.0..and.hhy.le.owner(law)*aif2(law)) then c refo -max refund for homeowners if(law.le.2000) then if(hhy.le.58000.0d0*aif2(law)) then clawo=max(0.0d0,min(430.0d0*aif2(law), & (hhy-57000.0d0*aif2(law))*.143)) else if(hhy.gt.58000.0d0*aif2(law).and. & hhy.le.60000.0d0*aif2(law)) then clawo=max(0.0d0,min(430.0d0*aif2(law), & (hhy-58000.0d0*aif2(law))*.215)) else clawo=430.0d0*aif2(law) endif refo=430.*aif2(law) - clawo c tablk(p1o,...) is treshold percentage for homeowners 1989-2000 thrate = tablki(p1o,20,hhy/aif2(law),data) else if(law.le.2002) then refo=tablki(p101,17,hhy/aif2(law),data)*aif2(law) c tablk(p201...) is treshold percentage for homeowners 2001+ thrate = tablki(p201,23,hhy/aif2(law),data) else if (law.ge.2003.and.law.le.2007) then refo=tablki(p107,17,hhy/aif2(law),data)*aif2(law) thrate = tablki(p210,22,hhy/aif2(law),data) else if (law.ge.2008.and.law.le.2010) then refo=tablki(p110,16,hhy/aif2(law),data)*aif2(law) thrate = tablki(p210,22,hhy/aif2(law),data) else refo=tablki(p116,10,hhy/aif2(law),data)*aif2(law) thrate = tablki(p216,14,hhy/aif2(law),data) endif endif c copay - percent paid by claimant if(law.le.2002) then copay = tablki(p2o,8,hhy/aif2(law),data) else if (law.ge.2003.and.law.le.2010) then copay = tablki(p10o,8,hhy/aif2(law),data) else copay = tablki(p16o,8,hhy/aif2(law),data) endif thres = min(ptxo,thrate*hhy/100) pcredo = min(refo,max(0.0d0,ptxo - thres)*(1.-copay)) pcredo = max(0.0d0,pcredo) c pcredo - property tax refund for owners endif pcred = pcredo + pcredr else if(law.le.1988) then c for years before 1988 ptx = data(51) + .2*data(160) c 1988 and 1987 excess = 0. if((law.ge.1987.and.law.le.1988).and.data(159).lt.35000.0d0) then if(law.eq.1988) then if(ptx.gt.tablki(p88x,33,data(159),data)*data(159)) & excess = ptx-tablki(p88x,33,data(159),data)*data(159) elseif(law.eq.1987) then if(data(8).gt.0.or.data(9).gt.0.or.data(10).gt.0) then if(ptx.gt.tablki(p87x1,17,data(159),data)*data(159)) & excess = ptx-tablki(p87x1,17,data(159),data)*data(159) else if(ptx.gt.tablki(p87x2,17,data(159),data)*data(159)) & excess = ptx-tablki(p87x2,17,data(159),data)*data(159) endif endif if(data(159).lt.10000) then maxcrd= 1100. elseif(data(159).ge.10000.and.data(159).lt.17000) then maxcrd= 1075. elseif(data(159).ge.17000.and.data(159).lt.23000) then maxcrd= 1050. elseif(data(159).ge.23000.and.data(159).lt.26500) then maxcrd= 1025. elseif(data(159).ge.26500.and.data(159).lt.27000) then maxcrd= 1013. elseif(data(159).ge.27000.and.data(159).lt.32500) then maxcrd= 1000.-.1*(data(159)-27000) else maxcrd= 500.-.2*(data(159)-32000) endif if(law.eq.1988) then pcred = max(0.0d0, & (1.0d0-tablki(p88y,26,data(159),data))*excess) elseif(law.eq.1987) then pcred = max(0.0d0, & (1.0d0-tablki(p87y,26,data(159),data))*excess) endif if(pcred.gt.maxcrd) pcred = maxcrd endif c 1985-1986 if(law.ge.1985.and.law.le.1986) then hy85=data(159) if(data(9).gt.0) hy85=max(0.0d0,hy85-2000.0d0) if(ptx.gt.tablki(p85x,11,hy85,data)*hy85.and. & hy85.lt.40000)then excess = ptx-tablki(p85x,11,hy85,data)*hy85 if(hy85.lt.23500) then maxcrd= 1125. elseif(hy85.ge.23500.and.hy85.lt.31250) then maxcrd= 1125.-.0290322*(hy85-23500.0d0) else maxcrd= 900.-.1*(hy85-31250.0d0) endif pcred = max(0.0d0,(1-tablki(p85y,31,hy85,data))*excess) if(pcred.gt.maxcrd) pcred = maxcrd c pcred = min(maxcrd,pcred) endif endif c 1983-1984 c From 1977-1984 the formula required a two step calculation. if((law.ge.1983.and.law.le.1984).and.data(159).lt.40000.and. &ptx.gt.0.and.ptx.gt.tablki(p1,16,data(159),data)*data(159))then excess = ptx-tablki(p1,16,data(159),data)*data(159) c First Step Credit if(data(159).lt.34000) then step1= min(excess,tablki(p83,34,data(159),data)) else step1 = min(excess,700.0d0-.1*(data(159)-33000.0d0)) endif c Second Step Maximum Credit if(data(159).lt.24000) then maxcrd= 1125 elseif(data(159).ge.24000.and.data(159).lt.25000) then maxcrd= 1105 elseif(data(159).ge.25000.and.data(159).lt.26000) then maxcrd= 1080 elseif(data(159).ge.26000.and.data(159).lt.27000) then maxcrd= 1050 elseif(data(159).ge.27000.and.data(159).lt.28000) then maxcrd= 1020 elseif(data(159).ge.28000.and.data(159).lt.29000) then maxcrd= 990 elseif(data(159).ge.29000.and.data(159).lt.30000) then maxcrd= 960 elseif(data(159).ge.30000.and.data(159).lt.31000) then maxcrd= 930 else maxcrd= 900-.1*(data(159)-31000.0d0) endif c Full Credit if(data(9)+data(10).eq.0) then pcred = max(0.0d0, & (1-tablki(p2,31,data(159),data))*max(0.0d0,excess-step1)) & +step1 else pcred = max(0.0d0, & (1-tablki(p2eld,19,data(159),data))*max(0.0d0,excess-step1)) & +step1 endif if(pcred.gt.maxcrd) pcred = maxcrd c pcred = min(maxcrd,pcred) if(data(159).ge.33000.and.data(159).lt.36000) then pcred = max(0.0d0,min(pcred,ptx-.022*data(159))) else if(data(159).ge.36000.and.data(159).lt.40000) then pcred = max(0.0d0,min(pcred,ptx-.024*data(159))) endif endif c 1979-1982 if((law.ge.1979.and.law.le.1982).and. &ptx.gt.0.and.ptx.gt.tablki(p82,27,data(159),data)*data(159))then excess = ptx-tablki(p82,27,data(159),data)*data(159) c First Step Credit if(data(159).lt.21000) then if(data(9)+data(10).eq.0) then step1= min(excess,tablki(p821,21,data(159),data)) else step1= min(excess,tablki(p822,21,data(159),data)) endif else if(data(9)+data(10).eq.0) then step1 = max(0.0d0,min(excess,650-.1*(data(159)-21000))) else step1 = max(0.0d0,min(excess,850-.1*(data(159)-21000))) endif endif c Second Step Maximum Credit if(data(159).lt.28000) then maxcrd= 1000 elseif(data(159).ge.28000.and.data(159).lt.29000) then maxcrd= 990 elseif(data(159).ge.29000.and.data(159).lt.30000) then maxcrd= 960 elseif(data(159).ge.30000.and.data(159).lt.31000) then maxcrd= 930 else maxcrd= max(0.0d0,900-.1*(data(159)-31000)) endif c Full Credit pcred = max(0.0d0,.5*max(0.0d0,excess-step1))+step1 if(pcred.gt.maxcrd) pcred = maxcrd endif c 1977-1978 if((law.ge.1977.and.law.le.1978).and. &ptx.gt.0.and.ptx.gt.tablki(p82,27,data(159),data)*data(159))then excess = ptx-tablki(p82,27,data(159),data)*data(159) c First Step Credit if(data(159).lt.21000) then if(data(9)+data(10).eq.0) then step1= min(excess,tablki(p771,21,data(159),data)) else step1= min(excess,tablki(p772,21,data(159),data)) endif else if(data(9)+data(10).eq.0) then step1 = max(0.0d0,min(excess,475-.1*(data(159)-21000))) else step1 = max(0.0d0,min(excess,675-.1*(data(159)-21000))) endif endif c Second Step Maximum Credit if(data(159).lt.28000) then maxcrd= 800 else maxcrd= max(0.0d0,800-.1*(data(159)-28000)) endif c Full Credit if(data(9)+data(10).eq.0) then pcred = max(0.0d0,.35*max(0.0d0,excess-step1))+step1 else pcred = max(0.0d0,.5*max(0.0d0,excess-step1))+step1 endif if(pcred.gt.maxcrd) pcred = maxcrd endif endif pcred = max(0.0d0,pcred) return end subroutine crmarr(data,comnew,taxinc,fedtax,statax,crmar,law) implicit double precision (A-H,O-Z) common /user/ zbrack(3,1987:2018),exem(1987:2018), &crmax(1987:2018,0:3,1:2),ymax(1987:2023,0:3,1:2), 1rtbase(1987:2023,0:3), rtless(1987:2023,0:3), 2chmax(1998:2023),ealim(2001:2023),cphas(7) dimension crmax1(2002:2016),eam(2002:2016),ceil(2002:2016) dimension data(255),comnew(255) double precision m25(2,11),m100(2,36),m25680(2,12),m10203(2,35) &,irales,keoles,m26480(2,12),m10520(2,36),m28000(2,9),m40000(2,13) &,m60000(2,13),m80000(2,10),m10000(2,16),m12000(2,21) c Arrays for marriage credit dimension cel(6,2003:2007),ei(2003:2016), &cel08(7,2008:2011),cel12(13,2012:2012),cel13(14,2013:2013), &cel14(12,2014:2014) c start of earn arrays data eam/16000.0d0,3*17000.0d0,18000.0d0,19000.0d0,5*20000.0d0, & 21000.0d0,2*22000.0d0,23000.0d0/ data ceil/2*28000.0d0,29000.0d0,30000.0d0,31000.0d0,2*32000.0d0, & 3*34000.0d0,35000.0d0,36000.0d0,3*37000.0d0/ data crmax1/ & 285.0d0, & 290.0d0, 296.0d0, 303.0d0, 313.0d0, & 325.0d0, 332.0d0, 2*347.0d0, 352.0d0, & 361.0d0, 370.0d0, 376.0d0, 382.0d0, & 384.0d0/ double precision & m103(2,9),m203(2,13),m303(2,13),m403(2,10),m503(2,15),m603(2,21) &,m104(2,9),m204(2,13),m304(2,13),m404(2,10),m504(2,15),m604(2,21) &,m105(2,13),m205(2,14),m305(2,11),m405(2,13),m505(2,18),m605(2,22) &,m106(2,13),m206(2,13),m306(2,13),m406(2,11),m506(2,17),m606(2,23) &,m107(2,13),m207(2,13),m307(2,13),m407(2,11),m507(2,15),m607(2,23) &,m108(2,12),m208(2,13),m308(2,13),m408(2,11),m508(2,17),m608(2,23) &,m708(2,23) &,m109(2,12),m209(2,15),m309(2,15),m409(2,10),m509(2,17),m609(2,23) &,m709(2,25) &,m110(2,13),m210(2,15),m310(2,15),m410(2,10),m510(2,17),m610(2,23) &,m710(2,25) &,m111(2,13),m211(2,15),m311(2,15),m411(2,10),m511(2,16),m611(2,22) &,m711(2,25) &,m112(2,9),m212(2,15),m312(2,15),m412(2,15),m512(2,15),m612(2,15) &,m712(2,8),m812(2,11),m912(2,14),m1012(2,17),m1112(2,18) &,m1212(2,23),m1312(2,25) double precision & m113(2,13),m213(2,15),m313(2,15),m413(2,12),m513(2,20),m613(2,24) &,m713(2,28),m813(2,25),m913(2,18),m1013(2,11),m1113(2,8) &,m1213(2,6),m1313(2,6),m1413(2,6) &,m114(2,13),m214(2,16),m314(2,16),m414(2,12),m514(2,19),m614(2,23) &,m714(2,29),m814(2,27),m914(2,20),m1014(2,12),m1114(2,8) &,m1214(2,5) &,m115(2,13),m215(2,16),m315(2,17),m415(2,12),m515(2,18),m615(2,22) &,m715(2,29),m815(2,27),m915(2,20),m1015(2,13),m1115(2,9) &,m1215(2,5) &,m116(2,13),m216(2,15),m316(2,15),m416(2,11),m516(2,18),m616(2,22) &,m716(2,30),m816(2,27),m916(2,20),m1016(2,14),m1116(2,10) &,m1216(2,5) c Marriage Credit arrays for years 2003+ c 2003 data m103/ & 17000.0d0, .0d0, 19000.0d0, 24.0d0, 21000.0d0, 58.0d0, & 23000.0d0, 92.0d0, 27000.0d0, 106.0d0, 29000.0d0, 86.0d0, & 31000.0d0, 52.0d0, 33000.0d0, 18.0d0, 1.e20, .0d0/ data m203/ & 17000.0d0, .0d0, 19000.0d0, 24.0d0, 21000.0d0, 58.0d0, & 23000.0d0, 92.0d0, 25000.0d0, 126.0d0, 27000.0d0,160.0d0, & 39000.0d0,174.0d0, 41000.0d0, 154.0d0, 43000.0d0,120.0d0, & 45000.0d0, 86.0d0, 47000.0d0, 52.0d0, 48000.0d0, 18.0d0, & 1.e20, .0d0/ data m303/ & 17000.0d0, .0d0, 19000.0d0, 24.0d0, 21000.0d0, 58.0d0, & 23000.0d0, 92.0d0, 25000.0d0, 126.0d0, 27000.0d0,160.0d0, & 59000.0d0,174.0d0, 61000.0d0, 154.0d0, 63000.0d0,120.0d0, & 65000.0d0, 86.0d0, 67000.0d0, 52.0d0, 69000.0d0, 18.0d0, & 1.e20, .0d0/ data m403/ & 23000.0d0, .0d0, 25000.0d0, 35.0d0, 27000.0d0, 85.0d0, & 29000.0d0,115.0d0, 31000.0d0, 131.0d0, 33000.0d0,147.0d0, & 35000.0d0,163.0d0, 37000.0d0, 174.0d0, 71000.0d0,160.0d0, & 1.e20, .0d0/ data m503/ & 33000.0d0, .0d0, 35000.0d0, 3.0d0, 37000.0d0, 19.0d0, & 39000.0d0, 35.0d0, 41000.0d0, 51.0d0, 43000.0d0, 67.0d0, & 45000.0d0, 83.0d0, 47000.0d0, 99.0d0, 49000.0d0,115.0d0, & 51000.0d0,131.0d0, 53000.0d0, 147.0d0, 55000.0d0,163.0d0, & 71000.0d0,174.0d0, 73000.0d0, 160.0d0, 1.e20, .0d0/ data m603/ & 35000.0d0, .0d0, 37000.0d0, 16.0d0, 39000.0d0, 32.0d0, & 41000.0d0, 48.0d0, 43000.0d0, 64.0d0, 45000.0d0, 80.0d0, & 47000.0d0, 96.0d0, 49000.0d0, 112.0d0, 51000.0d0,128.0d0, & 53000.0d0,144.0d0, 55000.0d0, 160.0d0, 57000.0d0,176.0d0, & 59000.0d0,192.0d0, 61000.0d0, 208.0d0, 63000.0d0,224.0d0, & 65000.0d0,240.0d0, 67000.0d0, 256.0d0, 69000.0d0,272.0d0, & 71000.0d0,288.0d0, 76000.0d0, 290.0d0, 1.e20, .0d0/ c 2004 data m104/ & 17000.0d0, .0d0, 19000.0d0, 18.0d0, 21000.0d0, 52.0d0, & 23000.0d0, 86.0d0, 27000.0d0, 103.0d0, 29000.0d0, 93.0d0, & 31000.0d0, 59.0d0, 33000.0d0, 25.0d0, 1.e20, .0d0/ data m204/ & 17000.0d0, .0d0, 19000.0d0, 18.0d0, 21000.0d0, 52.0d0, & 23000.0d0, 86.0d0, 25000.0d0, 120.0d0, 27000.0d0,154.0d0, & 39000.0d0,178.0d0, 41000.0d0, 152.0d0, 43000.0d0,118.0d0, & 45000.0d0, 84.0d0, 47000.0d0, 50.0d0, 48000.0d0, 16.0d0, & 1.e20, .0d0/ data m304/ & 17000.0d0, .0d0, 19000.0d0, 18.0d0, 21000.0d0, 52.0d0, & 23000.0d0, 86.0d0, 25000.0d0, 120.0d0, 27000.0d0,154.0d0, & 59000.0d0,178.0d0, 61000.0d0, 152.0d0, 63000.0d0,118.0d0, & 65000.0d0, 84.0d0, 67000.0d0, 50.0d0, 69000.0d0, 16.0d0, & 1.e20, .0d0/ data m404/ & 23000.0d0, .0d0, 25000.0d0, 39.0d0, 27000.0d0, 89.0d0, & 29000.0d0,129.0d0, 31000.0d0, 145.0d0, 33000.0d0,161.0d0, & 35000.0d0,177.0d0, 37000.0d0, 178.0d0, 71000.0d0,176.0d0, & 1.e20, .0d0/ data m504/ & 33000.0d0, .0d0, 35000.0d0, 1.0d0, 37000.0d0, 17.0d0, & 39000.0d0, 33.0d0, 41000.0d0, 49.0d0, 43000.0d0, 65.0d0, & 45000.0d0, 81.0d0, 47000.0d0, 97.0d0, 49000.0d0,113.0d0, & 51000.0d0,129.0d0, 53000.0d0, 145.0d0, 55000.0d0,161.0d0, & 71000.0d0,178.0d0, 73000.0d0, 176.0d0, 1.e20, .0d0/ data m604/ & 35000.0d0, .0d0, 37000.0d0, 10.0d0, 39000.0d0, 26.0d0, & 41000.0d0, 42.0d0, 43000.0d0, 58.0d0, 45000.0d0, 74.0d0, & 47000.0d0, 90.0d0, 49000.0d0, 106.0d0, 51000.0d0,122.0d0, & 53000.0d0,138.0d0, 55000.0d0, 154.0d0, 57000.0d0,170.0d0, & 59000.0d0,186.0d0, 61000.0d0, 202.0d0, 63000.0d0,218.0d0, & 65000.0d0,234.0d0, 67000.0d0, 250.0d0, 69000.0d0,266.0d0, & 71000.0d0,282.0d0, 76000.0d0, 296.0d0, 1.e20, .0d0/ c 2005 data m105/ & 17000.0d0, .0d0, 19000.0d0, 22.0d0, 21000.0d0, 56.0d0, & 23000.0d0, 90.0d0, 25000.0d0, 124.0d0, 27000.0d0,158.0d0, & 29000.0d0,176.0d0, 31000.0d0, 142.0d0, 33000.0d0,108.0d0, & 35000.0d0, 74.0d0, 37000.0d0, 40.0d0, 39000.0d0, 6.0d0, & 1.e20, .0d0/ data m205/ & 17000.0d0, .0d0, 19000.0d0, 22.0d0, 21000.0d0, 56.0d0, & 23000.0d0, 90.0d0, 25000.0d0, 124.0d0, 27000.0d0,158.0d0, & 47000.0d0,182.0d0, 49000.0d0, 176.0d0, 51000.0d0,142.0d0, & 53000.0d0,108.0d0, 55000.0d0, 74.0d0, 57000.0d0, 40.0d0, & 59000.0d0, 6.0d0, 1.e20, .0d0/ data m305/ & 19000.0d0, .0d0, 21000.0d0, 38.0d0, 23000.0d0, 88.0d0, & 25000.0d0,124.0d0, 27000.0d0, 158.0d0, 67000.0d0,182.0d0, & 69000.0d0,176.0d0, 71000.0d0, 142.0d0, 73000.0d0,108.0d0, & 75000.0d0, 65.0d0, 1.e20, .0d0/ data m405/ & 25000.0d0, .0d0, 27000.0d0, 28.0d0, 29000.0d0, 68.0d0, & 31000.0d0, 84.0d0, 33000.0d0, 100.0d0, 35000.0d0,116.0d0, & 37000.0d0,132.0d0, 39000.0d0, 148.0d0, 41000.0d0,164.0d0, & 43000.0d0,180.0d0, 73000.0d0, 182.0d0, 75000.0d0,173.0d0, & 1.e20, .0d0/ data m505/ & 35000.0d0, .0d0, 37000.0d0, 8.0d0, 39000.0d0, 24.0d0, & 41000.0d0, 40.0d0, 43000.0d0, 56.0d0, 45000.0d0, 72.0d0, & 47000.0d0, 88.0d0, 49000.0d0, 104.0d0, 51000.0d0,120.0d0, & 53000.0d0,136.0d0, 55000.0d0, 152.0d0, 57000.0d0,168.0d0, & 59000.0d0,184.0d0, 61000.0d0, 200.0d0, 63000.0d0,216.0d0, & 73000.0d0,218.0d0, 75000.0d0, 209.0d0, 1.e20, .0d0/ data m605/ & 35000.0d0, .0d0, 37000.0d0, 8.0d0, 39000.0d0, 24.0d0, & 41000.0d0, 40.0d0, 43000.0d0, 56.0d0, 45000.0d0, 72.0d0, & 47000.0d0, 88.0d0, 49000.0d0, 104.0d0, 51000.0d0,120.0d0, & 53000.0d0,136.0d0, 55000.0d0, 152.0d0, 57000.0d0,168.0d0, & 59000.0d0,184.0d0, 61000.0d0, 200.0d0, 63000.0d0,216.0d0, & 65000.0d0,232.0d0, 67000.0d0, 248.0d0, 69000.0d0,264.0d0, & 71000.0d0,280.0d0, 73000.0d0, 296.0d0, 75000.0d0,303.0d0, & 1.e20, .0d0/ c 2006 data m106/ & 18000.0d0, .0d0, 20000.0d0, 18.0d0, 22000.0d0, 52.0d0, & 24000.0d0, 86.0d0, 26000.0d0, 120.0d0, 28000.0d0,154.0d0, & 30000.0d0,178.0d0, 32000.0d0, 144.0d0, 34000.0d0,110.0d0, & 36000.0d0, 76.0d0, 38000.0d0, 42.0d0, 40000.0d0, 8.0d0, & 1.e20, .0d0/ data m206/ & 18000.0d0, .0d0, 20000.0d0, 18.0d0, 22000.0d0, 52.0d0, & 24000.0d0, 86.0d0, 26000.0d0, 120.0d0, 28000.0d0,154.0d0, & 48000.0d0,188.0d0, 50000.0d0, 170.0d0, 52000.0d0,136.0d0, & 54000.0d0,102.0d0, 56000.0d0, 68.0d0, 58000.0d0, 34.0d0, & 1.e20, .0d0/ data m306/ & 18000.0d0, .0d0, 20000.0d0, 2.0d0, 22000.0d0, 52.0d0, & 24000.0d0, 86.0d0, 26000.0d0, 120.0d0, 28000.0d0,154.0d0, & 68000.0d0,188.0d0, 70000.0d0, 170.0d0, 72000.0d0,136.0d0, & 74000.0d0,102.0d0, 76000.0d0, 68.0d0, 78000.0d0, 24.0d0, & 1.e20, .0d0/ data m406/ & 26000.0d0, .0d0, 28000.0d0, 42.0d0, 30000.0d0, 91.0d0, & 32000.0d0,107.0d0, 34000.0d0, 123.0d0, 36000.0d0,139.0d0, & 38000.0d0,155.0d0, 40000.0d0, 171.0d0, 76000.0d0,188.0d0, & 78000.0d0,178.0d0, 1.e20, .0d0/ data m506/ & 36000.0d0, .0d0, 38000.0d0, 2.0d0, 40000.0d0, 18.0d0, & 42000.0d0, 34.0d0, 44000.0d0, 50.0d0, 46000.0d0, 66.0d0, & 48000.0d0, 82.0d0, 50000.0d0, 98.0d0, 52000.0d0,114.0d0, & 54000.0d0,130.0d0, 56000.0d0, 146.0d0, 58000.0d0,162.0d0, & 60000.0d0,178.0d0, 62000.0d0, 194.0d0, 76000.0d0,195.0d0, & 78000.0d0,185.0d0, 1.e20, .0d0/ data m606/ & 36000.0d0, .0d0, 38000.0d0, 2.0d0, 40000.0d0, 18.0d0, & 42000.0d0, 34.0d0, 44000.0d0, 50.0d0, 46000.0d0, 66.0d0, & 48000.0d0, 82.0d0, 50000.0d0, 98.0d0, 52000.0d0,114.0d0, & 54000.0d0,130.0d0, 56000.0d0, 146.0d0, 58000.0d0,162.0d0, & 60000.0d0,178.0d0, 62000.0d0, 194.0d0, 64000.0d0,210.0d0, & 66000.0d0,226.0d0, 68000.0d0, 242.0d0, 70000.0d0,258.0d0, & 72000.0d0,274.0d0, 74000.0d0, 290.0d0, 76000.0d0,306.0d0, & 78000.0d0,313.0d0, 1.e20, .0d0/ c 2007 data m107/ & 19000.0d0, .0d0, 21000.0d0, 24.0d0, 23000.0d0, 58.0d0, & 25000.0d0, 92.0d0, 27000.0d0, 126.0d0, 29000.0d0,160.0d0, & 31000.0d0,184.0d0, 33000.0d0, 151.0d0, 35000.0d0,117.0d0, & 37000.0d0, 83.0d0, 39000.0d0, 49.0d0, 41000.0d0, 15.0d0, & 1.e20, .0d0/ data m207/ & 19000.0d0, .0d0, 21000.0d0, 24.0d0, 23000.0d0, 58.0d0, & 25000.0d0, 92.0d0, 27000.0d0, 126.0d0, 29000.0d0,160.0d0, & 49000.0d0,195.0d0, 51000.0d0, 185.0d0, 53000.0d0,151.0d0, & 55000.0d0,117.0d0, 57000.0d0, 83.0d0, 59000.0d0, 49.0d0, & 1.e20, .0d0/ data m307/ & 19000.0d0, 0.0d0, 21000.0d0, 18.0d0, 23000.0d0, 58.0d0, & 25000.0d0, 92.0d0, 27000.0d0, 126.0d0, 29000.0d0,160.0d0, & 69000.0d0,195.0d0, 71000.0d0, 185.0d0, 73000.0d0,151.0d0, & 75000.0d0,117.0d0, 77000.0d0, 83.0d0, 79000.0d0, 49.0d0, & 1.e20, .0d0/ data m407/ & 25000.0d0, .0d0, 27000.0d0, 58.0d0, 31000.0d0,108.0d0, & 33000.0d0,125.0d0, 35000.0d0, 141.0d0, 37000.0d0,157.0d0, & 39000.0d0,173.0d0, 41000.0d0, 189.0d0, 79000.0d0,195.0d0, & 81000.0d0,185.0d0, 1.e20, .0d0/ data m507/ & 37000.0d0, .0d0, 39000.0d0, 13.0d0, 41000.0d0, 29.0d0, & 43000.0d0, 45.0d0, 45000.0d0, 61.0d0, 47000.0d0, 77.0d0, & 49000.0d0, 93.0d0, 51000.0d0, 109.0d0, 53000.0d0,125.0d0, & 55000.0d0,141.0d0, 57000.0d0, 173.0d0, 59000.0d0,189.0d0, & 79000.0d0,185.0d0, 81000.0d0, 185.0d0, 1.e20, .0d0/ data m607/ & 39000.0d0, .0d0, 41000.0d0, 15.0d0, 43000.0d0, 31.0d0, & 45000.0d0, 47.0d0, 47000.0d0, 63.0d0, 49000.0d0, 79.0d0, & 51000.0d0, 95.0d0, 53000.0d0, 111.0d0, 55000.0d0,127.0d0, & 57000.0d0,143.0d0, 59000.0d0, 159.0d0, 61000.0d0,175.0d0, & 63000.0d0,191.0d0, 65000.0d0, 207.0d0, 67000.0d0,223.0d0, & 69000.0d0,239.0d0, 71000.0d0, 255.0d0, 73000.0d0,271.0d0, & 75000.0d0,287.0d0, 77000.0d0, 303.0d0, 79000.0d0,319.0d0, & 81000.0d0,325.0d0, 1.e20, .0d0/ c 2008 data m108/ & 20000.0d0, .0d0, 22000.0d0, 34.0d0, 24000.0d0, 68.0d0, & 26000.0d0,102.0d0, 28000.0d0, 136.0d0, 30000.0d0,170.0d0, & 32000.0d0,168.0d0, 34000.0d0, 134.0d0, 36000.0d0,100.0d0, & 38000.0d0, 66.0d0, 40000.0d0, 32.0d0, 1.e20, .0d0/ data m208/ & 20000.0d0, .0d0, 22000.0d0, 34.0d0, 24000.0d0, 68.0d0, & 26000.0d0,102.0d0, 28000.0d0, 136.0d0, 30000.0d0,170.0d0, & 32000.0d0,200.0d0, 52000.0d0, 168.0d0, 54000.0d0,134.0d0, & 56000.0d0,100.0d0, 58000.0d0, 66.0d0, 60000.0d0, 32.0d0, & 1.e20, .0d0/ data m308/ & 20000.0d0, .0d0, 22000.0d0, 34.0d0, 24000.0d0, 68.0d0, & 26000.0d0,102.0d0, 28000.0d0, 136.0d0, 30000.0d0,170.0d0, & 32000.0d0,200.0d0, 72000.0d0, 168.0d0, 74000.0d0,134.0d0, & 76000.0d0,100.0d0, 78000.0d0, 66.0d0, 80000.0d0, 32.0d0, & 1.e20, .0d0/ data m408/ & 26000.0d0, .0d0, 28000.0d0, 37.0d0, 30000.0d0, 87.0d0, & 32000.0d0,133.0d0, 34000.0d0, 149.0d0, 36000.0d0,165.0d0, & 38000.0d0,181.0d0, 40000.0d0, 197.0d0, 42000.0d0,200.0d0, & 82000.0d0,196.0d0, 1.e20, .0d0/ data m508/ & 34000.0d0, .0d0, 36000.0d0, 5.0d0, 38000.0d0, 21.0d0, & 40000.0d0, 37.0d0, 42000.0d0, 53.0d0, 44000.0d0, 69.0d0, & 46000.0d0, 85.0d0, 48000.0d0, 101.0d0, 50000.0d0,117.0d0, & 52000.0d0,133.0d0, 54000.0d0, 149.0d0, 56000.0d0,165.0d0, & 58000.0d0,181.0d0, 60000.0d0, 197.0d0, 62000.0d0,200.0d0, & 82000.0d0,196.0d0, 1.e20, .0d0/ data m608/ & 40000.0d0, .0d0, 42000.0d0, 16.0d0, 44000.0d0, 32.0d0, & 46000.0d0, 48.0d0, 48000.0d0, 64.0d0, 50000.0d0, 80.0d0, & 52000.0d0, 96.0d0, 54000.0d0, 112.0d0, 56000.0d0,128.0d0, & 58000.0d0,144.0d0, 60000.0d0, 160.0d0, 62000.0d0,176.0d0, & 64000.0d0,192.0d0, 66000.0d0, 208.0d0, 68000.0d0,224.0d0, & 70000.0d0,240.0d0, 72000.0d0, 256.0d0, 74000.0d0,272.0d0, & 76000.0d0,288.0d0, 78000.0d0, 304.0d0, 80000.0d0,320.0d0, & 82000.0d0,319.0d0, 1.e20, .0d0/ data m708/ & 40000.0d0, .0d0, 42000.0d0, 16.0d0, 44000.0d0, 32.0d0, & 46000.0d0, 48.0d0, 48000.0d0, 64.0d0, 50000.0d0, 80.0d0, & 52000.0d0, 96.0d0, 54000.0d0, 112.0d0, 56000.0d0,128.0d0, & 58000.0d0,144.0d0, 60000.0d0, 160.0d0, 62000.0d0,176.0d0, & 64000.0d0,192.0d0, 66000.0d0, 208.0d0, 68000.0d0,224.0d0, & 70000.0d0,240.0d0, 72000.0d0, 256.0d0, 74000.0d0,272.0d0, & 76000.0d0,288.0d0, 78000.0d0, 304.0d0, 80000.0d0,320.0d0, & 82000.0d0,332.0d0, 1.e20, .0d0/ c 2009 data m109/ & 20000.0d0, .0d0, 22000.0d0, 20.0d0, 24000.0d0, 54.0d0, & 26000.0d0, 88.0d0, 28000.0d0, 122.0d0, 30000.0d0,183.0d0, & 32000.0d0,168.0d0, 34000.0d0, 134.0d0, 36000.0d0,100.0d0, & 38000.0d0, 66.0d0, 40000.0d0, 32.0d0, 1.e20, .0d0/ data m209/ & 20000.0d0, .0d0, 22000.0d0, 20.0d0, 24000.0d0, 54.0d0, & 26000.0d0, 88.0d0, 28000.0d0, 122.0d0, 30000.0d0,156.0d0, & 32000.0d0,190.0d0, 34000.0d0, 208.0d0, 50000.0d0,202.0d0, & 54000.0d0,168.0d0, 56000.0d0, 134.0d0, 58000.0d0,100.0d0, & 60000.0d0, 66.0d0, 62000.0d0, 32.0d0, 1.e20, .0d0/ data m309/ & 20000.0d0, .0d0, 22000.0d0, 20.0d0, 24000.0d0, 54.0d0, & 26000.0d0, 88.0d0, 28000.0d0, 122.0d0, 30000.0d0,156.0d0, & 32000.0d0,190.0d0, 34000.0d0, 208.0d0, 70000.0d0,202.0d0, & 72000.0d0,168.0d0, 74000.0d0, 134.0d0, 76000.0d0,100.0d0, & 78000.0d0, 66.0d0, 80000.0d0, 32.0d0, 1.e20, .0d0/ data m409/ & 26000.0d0, .0d0, 28000.0d0, 28.0d0, 30000.0d0, 78.0d0, & 32000.0d0,128.0d0, 34000.0d0, 162.0d0, 36000.0d0,178.0d0, & 38000.0d0,194.0d0, 40000.0d0, 208.0d0, 84000.0d0,200.0d0, & 1.e20, .0d0/ data m509/ & 32000.0d0, .0d0, 34000.0d0, 2.0d0, 36000.0d0, 18.0d0, & 38000.0d0, 34.0d0, 40000.0d0, 50.0d0, 42000.0d0, 66.0d0, & 44000.0d0, 82.0d0, 46000.0d0, 98.0d0, 48000.0d0,114.0d0, & 50000.0d0,130.0d0, 52000.0d0, 146.0d0, 54000.0d0,162.0d0, & 56000.0d0,178.0d0, 58000.0d0, 194.0d0, 60000.0d0,208.0d0, & 84000.0d0,200.0d0, 1.e20, .0d0/ data m609/ & 40000.0d0, .0d0, 42000.0d0, 3.0d0, 44000.0d0, 19.0d0, & 46000.0d0, 35.0d0, 48000.0d0, 51.0d0, 50000.0d0, 67.0d0, & 52000.0d0, 83.0d0, 54000.0d0, 99.0d0, 56000.0d0,115.0d0, & 58000.0d0,131.0d0, 60000.0d0, 147.0d0, 62000.0d0,163.0d0, & 64000.0d0,179.0d0, 66000.0d0, 195.0d0, 68000.0d0,211.0d0, & 70000.0d0,227.0d0, 72000.0d0, 243.0d0, 74000.0d0,259.0d0, & 76000.0d0,275.0d0, 78000.0d0, 291.0d0, 80000.0d0,304.0d0, & 84000.0d0,296.0d0, 1.e20, .0d0/ data m709/ & 40000.0d0, .0d0, 42000.0d0, 3.0d0, 44000.0d0, 19.0d0, & 46000.0d0, 35.0d0, 48000.0d0, 51.0d0, 50000.0d0, 67.0d0, & 52000.0d0, 83.0d0, 54000.0d0, 99.0d0, 56000.0d0,115.0d0, & 58000.0d0,131.0d0, 60000.0d0, 147.0d0, 62000.0d0,163.0d0, & 64000.0d0,179.0d0, 66000.0d0, 195.0d0, 68000.0d0,211.0d0, & 70000.0d0,227.0d0, 72000.0d0, 243.0d0, 74000.0d0,259.0d0, & 76000.0d0,275.0d0, 78000.0d0, 291.0d0, 80000.0d0,307.0d0, & 82000.0d0,323.0d0, 84000.0d0, 339.0d0, 86000.0d0,347.0d0, & 1.e20, .0d0/ c 2010 data m110/ & 20000.0d0, .0d0, 22000.0d0, 19.0d0, 24000.0d0, 53.0d0, & 26000.0d0, 87.0d0, 28000.0d0, 121.0d0, 30000.0d0,155.0d0, & 32000.0d0,182.0d0, 34000.0d0, 167.0d0, 36000.0d0,133.0d0, & 38000.0d0, 99.0d0, 40000.0d0, 65.0d0, 42000.0d0, 31.0d0, & 1.e20, .0d0/ data m210/ & 20000.0d0, .0d0, 22000.0d0, 19.0d0, 24000.0d0, 53.0d0, & 26000.0d0, 87.0d0, 28000.0d0, 121.0d0, 30000.0d0,155.0d0, & 32000.0d0,189.0d0, 34000.0d0, 208.0d0, 50000.0d0,201.0d0, & 54000.0d0,167.0d0, 56000.0d0, 133.0d0, 58000.0d0, 99.0d0, & 60000.0d0, 65.0d0, 62000.0d0, 31.0d0, 1.e20, .0d0/ data m310/ & 20000.0d0, .0d0, 22000.0d0, 19.0d0, 24000.0d0, 53.0d0, & 26000.0d0, 87.0d0, 28000.0d0, 121.0d0, 30000.0d0,155.0d0, & 32000.0d0,189.0d0, 34000.0d0, 208.0d0, 70000.0d0,201.0d0, & 72000.0d0,167.0d0, 74000.0d0, 133.0d0, 76000.0d0, 99.0d0, & 78000.0d0, 65.0d0, 80000.0d0, 31.0d0, 1.e20, .0d0/ data m410/ & 26000.0d0, .0d0, 28000.0d0, 29.0d0, 30000.0d0, 79.0d0, & 32000.0d0,129.0d0, 34000.0d0, 164.0d0, 36000.0d0,180.0d0, & 38000.0d0,196.0d0, 40000.0d0, 208.0d0, 84000.0d0,201.0d0, & 1.e20, .0d0/ data m510/ & 32000.0d0, .0d0, 34000.0d0, 4.0d0, 36000.0d0, 20.0d0, & 38000.0d0, 36.0d0, 40000.0d0, 52.0d0, 42000.0d0, 68.0d0, & 44000.0d0, 84.0d0, 46000.0d0, 100.0d0, 48000.0d0,116.0d0, & 50000.0d0,132.0d0, 52000.0d0, 148.0d0, 54000.0d0,164.0d0, & 56000.0d0,180.0d0, 58000.0d0, 196.0d0, 60000.0d0,208.0d0, & 84000.0d0,201.0d0, 1.e20, .0d0/ data m610/ & 40000.0d0, .0d0, 42000.0d0, 2.0d0, 44000.0d0, 18.0d0, & 46000.0d0, 34.0d0, 48000.0d0, 50.0d0, 50000.0d0, 66.0d0, & 52000.0d0, 82.0d0, 54000.0d0, 98.0d0, 56000.0d0,114.0d0, & 58000.0d0,130.0d0, 60000.0d0, 146.0d0, 62000.0d0,162.0d0, & 64000.0d0,178.0d0, 66000.0d0, 194.0d0, 68000.0d0,210.0d0, & 70000.0d0,226.0d0, 72000.0d0, 242.0d0, 74000.0d0,258.0d0, & 76000.0d0,274.0d0, 78000.0d0, 290.0d0, 80000.0d0,303.0d0, & 86000.0d0,296.0d0, 1.e20, .0d0/ data m710/ & 40000.0d0, .0d0, 42000.0d0, 2.0d0, 44000.0d0, 18.0d0, & 46000.0d0, 34.0d0, 48000.0d0, 50.0d0, 50000.0d0, 66.0d0, & 52000.0d0, 82.0d0, 54000.0d0, 98.0d0, 56000.0d0,114.0d0, & 58000.0d0,130.0d0, 60000.0d0, 146.0d0, 62000.0d0,162.0d0, & 64000.0d0,178.0d0, 66000.0d0, 194.0d0, 68000.0d0,210.0d0, & 70000.0d0,226.0d0, 72000.0d0, 242.0d0, 74000.0d0,258.0d0, & 76000.0d0,274.0d0, 78000.0d0, 290.0d0, 80000.0d0,306.0d0, & 82000.0d0,322.0d0, 84000.0d0, 338.0d0, 86000.0d0,347.0d0, & 1.e20, .0d0/ c 2011 data m111/ & 20000.0d0, .0d0, 22000.0d0, 31.0d0, 24000.0d0, 65.0d0, & 26000.0d0, 99.0d0, 28000.0d0, 133.0d0, 30000.0d0,167.0d0, & 32000.0d0,174.0d0, 34000.0d0, 151.0d0, 36000.0d0,117.0d0, & 38000.0d0, 83.0d0, 40000.0d0, 49.0d0, 42000.0d0, 15.0d0, & 1.e20, .0d0/ data m211/ & 20000.0d0, .0d0, 22000.0d0, 31.0d0, 24000.0d0, 65.0d0, & 26000.0d0, 99.0d0, 28000.0d0, 133.0d0, 30000.0d0,167.0d0, & 32000.0d0,201.0d0, 50000.0d0, 211.0d0, 52000.0d0,185.0d0, & 54000.0d0,151.0d0, 56000.0d0, 117.0d0, 58000.0d0, 83.0d0, & 60000.0d0, 49.0d0, 62000.0d0, 15.0d0, 1.e20, .0d0/ data m311/ & 20000.0d0, .0d0, 22000.0d0, 31.0d0, 24000.0d0, 65.0d0, & 26000.0d0, 99.0d0, 28000.0d0, 133.0d0, 30000.0d0,167.0d0, & 32000.0d0,201.0d0, 70000.0d0, 211.0d0, 72000.0d0,185.0d0, & 74000.0d0,151.0d0, 76000.0d0, 117.0d0, 78000.0d0, 83.0d0, & 80000.0d0, 49.0d0, 82000.0d0, 15.0d0, 1.e20, .0d0/ data m411/ & 24000.0d0, .0d0, 26000.0d0, 6.0d0, 28000.0d0, 56.0d0, & 30000.0d0,106.0d0, 32000.0d0, 156.0d0, 34000.0d0,182.0d0, & 36000.0d0,198.0d0, 84000.0d0, 211.0d0, 86000.0d0,207.0d0, & 1.e20, .0d0/ data m511/ & 32000.0d0, .0d0, 34000.0d0, 22.0d0, 36000.0d0, 38.0d0, & 38000.0d0, 54.0d0, 40000.0d0, 70.0d0, 42000.0d0, 86.0d0, & 44000.0d0,102.0d0, 46000.0d0, 118.0d0, 48000.0d0,134.0d0, & 50000.0d0,150.0d0, 52000.0d0, 166.0d0, 54000.0d0,182.0d0, & 56000.0d0,198.0d0, 84000.0d0, 211.0d0, 86000.0d0,207.0d0, & 1.e20, .0d0/ data m611/ & 40000.0d0, .0d0, 42000.0d0, 5.0d0, 44000.0d0, 21.0d0, & 46000.0d0, 37.0d0, 48000.0d0, 53.0d0, 50000.0d0, 69.0d0, & 52000.0d0, 85.0d0, 54000.0d0, 101.0d0, 56000.0d0,117.0d0, & 58000.0d0,133.0d0, 60000.0d0, 149.0d0, 62000.0d0,165.0d0, & 64000.0d0,181.0d0, 66000.0d0, 197.0d0, 68000.0d0,213.0d0, & 70000.0d0,229.0d0, 72000.0d0, 245.0d0, 74000.0d0,261.0d0, & 76000.0d0,277.0d0, 84000.0d0, 290.0d0, 86000.0d0,285.0d0, & 1.e20, .0d0/ data m711/ & 40000.0d0, .0d0, 42000.0d0, 5.0d0, 44000.0d0, 21.0d0, & 46000.0d0, 37.0d0, 48000.0d0, 53.0d0, 50000.0d0, 69.0d0, & 52000.0d0, 85.0d0, 54000.0d0, 101.0d0, 56000.0d0,117.0d0, & 58000.0d0,133.0d0, 60000.0d0, 149.0d0, 62000.0d0,165.0d0, & 64000.0d0,181.0d0, 66000.0d0, 197.0d0, 68000.0d0,213.0d0, & 70000.0d0,229.0d0, 72000.0d0, 245.0d0, 74000.0d0,261.0d0, & 76000.0d0,277.0d0, 78000.0d0, 293.0d0, 80000.0d0,309.0d0, & 82000.0d0,325.0d0, 84000.0d0, 341.0d0, 86000.0d0,352.0d0, & 1.e20, .0d0/ c 2012 data m112/ & 20000.0d0, .0d0, 22000.0d0, 23.0d0, 24000.0d0, 57.0d0, & 26000.0d0, 91.0d0, 32000.0d0, 92.0d0, 34000.0d0, 82.0d0, & 36000.0d0, 48.0d0, 38000.0d0, 14.0d0, 1.e20, .0d0/ data m212/ & 20000.0d0, .0d0, 22000.0d0, 23.0d0, 24000.0d0, 57.0d0, & 26000.0d0, 91.0d0, 28000.0d0, 125.0d0, 30000.0d0,159.0d0, & 32000.0d0,193.0d0, 36000.0d0, 217.0d0, 38000.0d0,184.0d0, & 40000.0d0,150.0d0, 42000.0d0, 116.0d0, 44000.0d0, 82.0d0, & 46000.0d0, 48.0d0, 48000.0d0, 14.0d0, 1.e20, .0d0/ data m312/ & 20000.0d0, .0d0, 22000.0d0, 23.0d0, 24000.0d0, 57.0d0, & 26000.0d0, 91.0d0, 28000.0d0, 125.0d0, 30000.0d0,159.0d0, & 32000.0d0,193.0d0, 46000.0d0, 217.0d0, 48000.0d0,184.0d0, & 50000.0d0,150.0d0, 52000.0d0, 116.0d0, 54000.0d0, 82.0d0, & 56000.0d0, 48.0d0, 58000.0d0, 14.0d0, 1.e20, .0d0/ data m412/ & 20000.0d0, .0d0, 22000.0d0, 23.0d0, 24000.0d0, 57.0d0, & 26000.0d0, 91.0d0, 28000.0d0, 125.0d0, 30000.0d0,159.0d0, & 32000.0d0,193.0d0, 56000.0d0, 217.0d0, 58000.0d0,184.0d0, & 60000.0d0,150.0d0, 62000.0d0, 116.0d0, 64000.0d0, 82.0d0, & 66000.0d0, 48.0d0, 68000.0d0, 14.0d0, 1.e20, .0d0/ data m512/ & 20000.0d0, .0d0, 22000.0d0, 23.0d0, 24000.0d0, 57.0d0, & 26000.0d0, 91.0d0, 28000.0d0, 125.0d0, 30000.0d0,159.0d0, & 32000.0d0,193.0d0, 66000.0d0, 217.0d0, 68000.0d0,184.0d0, & 70000.0d0,150.0d0, 72000.0d0, 116.0d0, 74000.0d0, 82.0d0, & 76000.0d0, 48.0d0, 78000.0d0, 14.0d0, 1.e20, .0d0/ data m612/ & 20000.0d0, .0d0, 22000.0d0, 22.0d0, 24000.0d0, 57.0d0, & 26000.0d0, 91.0d0, 28000.0d0, 125.0d0, 30000.0d0,159.0d0, & 32000.0d0,193.0d0, 76000.0d0, 217.0d0, 78000.0d0,184.0d0, & 80000.0d0,150.0d0, 82000.0d0, 116.0d0, 84000.0d0, 82.0d0, & 86000.0d0, 48.0d0, 86000.0d0, 10.0d0, 1.e20, .0d0/ data m712/ & 24000.0d0, .0d0, 26000.0d0, 42.0d0, 28000.0d0, 92.0d0, & 30000.0d0,142.0d0, 32000.0d0, 192.0d0, 86000.0d0,217.0d0, & 88000.0d0,180.0d0, 1.e20, .0d0/ data m812/ & 26000.0d0, .0d0, 28000.0d0, 12.0d0, 30000.0d0, 62.0d0, & 32000.0d0,112.0d0, 34000.0d0, 153.0d0, 36000.0d0,169.0d0, & 38000.0d0,185.0d0, 40000.0d0, 201.0d0, 86000.0d0,217.0d0, & 88000.0d0,213.0d0, 1.e20, .0d0/ data m912/ & 30000.0d0, .0d0, 32000.0d0, 32.0d0, 34000.0d0, 73.0d0, & 36000.0d0, 89.0d0, 38000.0d0, 105.0d0, 40000.0d0,121.0d0, & 42000.0d0,137.0d0, 44000.0d0, 153.0d0, 46000.0d0,169.0d0, & 48000.0d0,185.0d0, 50000.0d0, 201.0d0, 86000.0d0,217.0d0, & 88000.0d0,213.0d0, 1.e20, .0d0/ data m1012/ & 34000.0d0, .0d0, 36000.0d0, 9.0d0, 38000.0d0, 25.0d0, & 40000.0d0, 41.0d0, 42000.0d0, 57.0d0, 44000.0d0, 73.0d0, & 46000.0d0, 89.0d0, 48000.0d0, 105.0d0, 50000.0d0,121.0d0, & 52000.0d0,137.0d0, 54000.0d0, 153.0d0, 56000.0d0,169.0d0, & 58000.0d0,185.0d0, 60000.0d0, 201.0d0, 86000.0d0,217.0d0, & 88000.0d0,213.0d0, 1.e20, .0d0/ data m1112/ & 42000.0d0, .0d0, 44000.0d0, 13.0d0, 46000.0d0, 25.0d0, & 48000.0d0, 45.0d0, 50000.0d0, 61.0d0, 52000.0d0, 77.0d0, & 54000.0d0, 93.0d0, 56000.0d0, 109.0d0, 58000.0d0,125.0d0, & 60000.0d0,141.0d0, 62000.0d0, 157.0d0, 64000.0d0,173.0d0, & 66000.0d0,189.0d0, 68000.0d0, 205.0d0, 70000.0d0,221.0d0, & 86000.0d0,237.0d0, 88000.0d0, 233.0d0, 1.e20, .0d0/ data m1212/ & 42000.0d0, .0d0, 44000.0d0, 13.0d0, 46000.0d0, 25.0d0, & 48000.0d0, 45.0d0, 50000.0d0, 61.0d0, 52000.0d0, 77.0d0, & 54000.0d0, 93.0d0, 56000.0d0, 109.0d0, 58000.0d0,125.0d0, & 60000.0d0,141.0d0, 62000.0d0, 157.0d0, 64000.0d0,173.0d0, & 66000.0d0,189.0d0, 68000.0d0, 205.0d0, 70000.0d0,221.0d0, & 72000.0d0,237.0d0, 74000.0d0, 253.0d0, 76000.0d0,269.0d0, & 78000.0d0,285.0d0, 80000.0d0, 301.0d0, 86000.0d0,317.0d0, & 88000.0d0,313.0d0, 1.e20, .0d0/ data m1312/ & 42000.0d0, .0d0, 44000.0d0, 13.0d0, 46000.0d0, 25.0d0, & 48000.0d0, 45.0d0, 50000.0d0, 61.0d0, 52000.0d0, 77.0d0, & 54000.0d0, 93.0d0, 56000.0d0, 109.0d0, 58000.0d0,125.0d0, & 60000.0d0,141.0d0, 62000.0d0, 157.0d0, 64000.0d0,173.0d0, & 66000.0d0,189.0d0, 68000.0d0, 205.0d0, 70000.0d0,221.0d0, & 72000.0d0,237.0d0, 74000.0d0, 253.0d0, 76000.0d0,269.0d0, & 78000.0d0,285.0d0, 80000.0d0, 301.0d0, 82000.0d0,317.0d0, & 84000.0d0,333.0d0, 86000.0d0, 349.0d0, 88000.0d0,313.0d0, & 1.e20, .0d0/ c 2013 data m113/ & 21000.0d0, .0d0, 23000.0d0, 31.0d0, 25000.0d0, 65.0d0, & 27000.0d0, 99.0d0, 29000.0d0, 133.0d0, 31000.0d0,167.0d0, & 33000.0d0,179.0d0, 35000.0d0, 166.0d0, 37000.0d0,132.0d0, & 39000.0d0, 98.0d0, 41000.0d0, 64.0d0, 43000.0d0, 30.0d0, & 1.e20, .0d0/ data m213/ & 21000.0d0, .0d0, 23000.0d0, 31.0d0, 25000.0d0, 65.0d0, & 27000.0d0, 99.0d0, 29000.0d0, 133.0d0, 31000.0d0,167.0d0, & 33000.0d0,201.0d0, 51000.0d0, 222.0d0, 53000.0d0,200.0d0, & 55000.0d0,166.0d0, 57000.0d0, 132.0d0, 59000.0d0, 98.0d0, & 61000.0d0, 64.0d0, 63000.0d0, 30.0d0, 1.e20, .0d0/ data m313/ & 21000.0d0, .0d0, 23000.0d0, 31.0d0, 25000.0d0, 65.0d0, & 27000.0d0, 99.0d0, 29000.0d0, 133.0d0, 31000.0d0,167.0d0, & 33000.0d0,201.0d0, 71000.0d0, 222.0d0, 73000.0d0,200.0d0, & 75000.0d0,166.0d0, 77000.0d0, 132.0d0, 79000.0d0, 98.0d0, & 81000.0d0, 64.0d0, 83000.0d0, 30.0d0, 1.e20, .0d0/ data m413/ & 25000.0d0, .0d0, 27000.0d0, 25.0d0, 29000.0d0, 75.0d0, & 31000.0d0,125.0d0, 33000.0d0, 175.0d0, 35000.0d0,212.0d0, & 91000.0d0,222.0d0, 93000.0d0, 212.0d0, 95000.0d0,174.0d0, & 97000.0d0,124.0d0, 99000.0d0, 24.0d0, 1.e20, .0d0/ data m513/ & 33000.0d0, .0d0, 35000.0d0, 15.0d0, 37000.0d0, 52.0d0, & 39000.0d0, 68.0d0, 41000.0d0, 84.0d0, 43000.0d0,100.0d0, & 45000.0d0,116.0d0, 47000.0d0, 132.0d0, 49000.0d0,148.0d0, & 51000.0d0,164.0d0, 53000.0d0, 180.0d0, 55000.0d0,196.0d0, & 57000.0d0,212.0d0, 89000.0d0, 222.0d0, 91000.0d0,212.0d0, & 93000.0d0,196.0d0, 95000.0d0, 180.0d0, 97000.0d0,164.0d0, & 99000.0d0,148.0d0, 1.e20, .0d0/ data m613/ & 43000.0d0, .0d0, 45000.0d0, 12.0d0, 47000.0d0, 28.0d0, & 49000.0d0, 44.0d0, 51000.0d0, 60.0d0, 53000.0d0, 76.0d0, & 55000.0d0, 92.0d0, 57000.0d0, 108.0d0, 59000.0d0,124.0d0, & 61000.0d0,140.0d0, 63000.0d0, 156.0d0, 65000.0d0,172.0d0, & 67000.0d0,188.0d0, 69000.0d0, 204.0d0, 71000.0d0,220.0d0, & 73000.0d0,236.0d0, 75000.0d0, 252.0d0, 89000.0d0,262.0d0, & 91000.0d0,252.0d0, 93000.0d0, 236.0d0, 95000.0d0,220.0d0, & 97000.0d0,204.0d0, 99000.0d0, 188.0d0, 1.e20, .0d0/ data m713/ & 43000.0d0, .0d0, 45000.0d0, 12.0d0, 47000.0d0, 28.0d0, & 49000.0d0, 44.0d0, 51000.0d0, 60.0d0, 53000.0d0, 76.0d0, & 55000.0d0, 92.0d0, 57000.0d0, 108.0d0, 59000.0d0,124.0d0, & 61000.0d0,140.0d0, 63000.0d0, 156.0d0, 65000.0d0,172.0d0, & 67000.0d0,188.0d0, 69000.0d0, 204.0d0, 71000.0d0,220.0d0, & 73000.0d0,236.0d0, 75000.0d0, 252.0d0, 77000.0d0,268.0d0, & 79000.0d0,284.0d0, 81000.0d0, 300.0d0, 83000.0d0,316.0d0, & 85000.0d0,332.0d0, 87000.0d0, 348.0d0, 89000.0d0,364.0d0, & 95000.0d0,370.0d0, 97000.0d0,364.0d0, 99000.0d0,348.0d0, & 1.e20, .0d0/ data m813/ & 45000.0d0, .0d0, 47000.0d0, 28.0d0, 49000.0d0, 44.0d0, & 51000.0d0, 60.0d0, 53000.0d0, 76.0d0, 55000.0d0, 92.0d0, & 57000.0d0,108.0d0, 59000.0d0, 124.0d0, 61000.0d0,140.0d0, & 63000.0d0,156.0d0, 65000.0d0, 172.0d0, 67000.0d0,188.0d0, & 69000.0d0,204.0d0, 71000.0d0, 220.0d0, 73000.0d0,236.0d0, & 75000.0d0,252.0d0, 77000.0d0, 268.0d0, 79000.0d0,284.0d0, & 81000.0d0,300.0d0, 83000.0d0, 316.0d0, 85000.0d0,332.0d0, & 87000.0d0,348.0d0, 89000.0d0, 364.0d0, 99000.0d0,370.0d0, & 1.e20, .0d0/ data m913/ & 59000.0d0, .0d0, 61000.0d0, 41.0d0, 63000.0d0, 97.0d0, & 65000.0d0,153.0d0, 67000.0d0, 188.0d0, 69000.0d0,204.0d0, & 71000.0d0,220.0d0, 73000.0d0, 236.0d0, 75000.0d0,252.0d0, & 77000.0d0,268.0d0, 79000.0d0, 284.0d0, 81000.0d0,300.0d0, & 83000.0d0,316.0d0, 85000.0d0, 332.0d0, 87000.0d0,348.0d0, & 89000.0d0,364.0d0, 99000.0d0, 370.0d0, 1.e20, .0d0/ data m1013/ & 73000.0d0, .0d0, 75000.0d0, 33.0d0, 77000.0d0, 89.0d0, & 79000.0d0,145.0d0, 81000.0d0, 201.0d0, 83000.0d0,257.0d0, & 85000.0d0,313.0d0, 87000.0d0, 348.0d0, 89000.0d0,364.0d0, & 99000.0d0,370.0d0, 1.e20, .0d0/ data m1113/ & 87000.0d0, .0d0, 89000.0d0, 25.0d0, 91000.0d0, 71.0d0, & 93000.0d0,111.0d0, 95000.0d0, 151.0d0, 97000.0d0,191.0d0, & 99000.0d0,231.0d0, 1.e20, .0d0/ data m1213/ & 91000.0d0, .0d0, 93000.0d0, 31.0d0, 95000.0d0, 71.0d0, & 97000.0d0,111.0d0, 99000.0d0, 151.0d0, 1.e20, .0d0/ data m1313/ & 91000.0d0, .0d0, 93000.0d0, 31.0d0, 95000.0d0, 71.0d0, & 97000.0d0,111.0d0, 99000.0d0, 151.0d0, 1.e20, .0d0/ data m1413/ & 91000.0d0, .0d0, 93000.0d0, 31.0d0, 95000.0d0, 71.0d0, & 97000.0d0,111.0d0, 99000.0d0, 151.0d0, 1.e20, .0d0/ c 2014 data m114/ & 22000.0d0, .0d0, 24000.0d0, 25.0d0, 26000.0d0, 59.0d0, & 28000.0d0, 93.0d0, 30000.0d0, 127.0d0, 32000.0d0,161.0d0, & 34000.0d0,186.0d0, 36000.0d0, 183.0d0, 38000.0d0,149.0d0, & 40000.0d0,115.0d0, 42000.0d0, 47.0d0, 44000.0d0, 13.0d0, & 1.e20, .0d0/ data m214/ & 22000.0d0, .0d0, 24000.0d0, 25.0d0, 26000.0d0, 59.0d0, & 28000.0d0, 93.0d0, 30000.0d0, 127.0d0, 32000.0d0,161.0d0, & 34000.0d0,195.0d0, 52000.0d0, 226.0d0, 54000.0d0,217.0d0, & 56000.0d0,183.0d0, 58000.0d0, 149.0d0, 60000.0d0,115.0d0, & 62000.0d0, 81.0d0, 64000.0d0, 47.0d0, 66000.0d0, 13.0d0, & 1.e20, .0d0/ data m314/ & 22000.0d0, .0d0, 24000.0d0, 25.0d0, 26000.0d0, 59.0d0, & 28000.0d0, 93.0d0, 30000.0d0, 127.0d0, 32000.0d0,161.0d0, & 34000.0d0,195.0d0, 36000.0d0, 226.0d0, 74000.0d0,217.0d0, & 76000.0d0,183.0d0, 78000.0d0, 149.0d0, 80000.0d0,115.0d0, & 82000.0d0, 81.0d0, 84000.0d0, 47.0d0, 86000.0d0, 13.0d0, & 1.e20, .0d0/ data m414/ & 26000.0d0, .0d0, 28000.0d0, 20.0d0, 30000.0d0, 70.0d0, & 32000.0d0,120.0d0, 34000.0d0, 170.0d0, 36000.0d0,217.0d0, & 92000.0d0,226.0d0, 94000.0d0, 203.0d0, 96000.0d0,153.0d0, & 98000.0d0,103.0d0, 100000.0d0, 53.0d0, 1.e20, .0d0/ data m514/ & 32000.0d0, .0d0, 34000.0d0, 10.0d0, 36000.0d0, 57.0d0, & 38000.0d0, 73.0d0, 40000.0d0, 89.0d0, 42000.0d0,105.0d0, & 44000.0d0,121.0d0, 46000.0d0, 137.0d0, 48000.0d0,153.0d0, & 50000.0d0,169.0d0, 52000.0d0, 185.0d0, 54000.0d0,201.0d0, & 56000.0d0,217.0d0, 92000.0d0, 226.0d0, 94000.0d0,212.0d0, & 96000.0d0,196.0d0, 98000.0d0, 180.0d0,100000.0d0,164.0d0, & 1.e20, .0d0/ data m614/ & 44000.0d0, .0d0, 46000.0d0, 6.0d0, 48000.0d0, 22.0d0, & 50000.0d0, 38.0d0, 52000.0d0, 54.0d0, 54000.0d0, 70.0d0, & 56000.0d0, 86.0d0, 58000.0d0, 102.0d0, 60000.0d0,118.0d0, & 62000.0d0,134.0d0, 64000.0d0, 150.0d0, 66000.0d0,166.0d0, & 68000.0d0,182.0d0, 70000.0d0, 198.0d0, 72000.0d0,214.0d0, & 74000.0d0,230.0d0, 76000.0d0, 246.0d0, 92000.0d0,255.0d0, & 94000.0d0,241.0d0, 96000.0d0, 225.0d0, 98000.0d0,209.0d0, & 100000.0d0,193.0d0, 1.e20, .0d0/ data m714/ & 44000.0d0, .0d0, 46000.0d0, 6.0d0, 48000.0d0, 22.0d0, & 50000.0d0, 38.0d0, 52000.0d0, 54.0d0, 54000.0d0, 70.0d0, & 56000.0d0, 86.0d0, 58000.0d0, 102.0d0, 60000.0d0,118.0d0, & 62000.0d0,134.0d0, 64000.0d0, 150.0d0, 66000.0d0,166.0d0, & 68000.0d0,182.0d0, 70000.0d0, 198.0d0, 72000.0d0,214.0d0, & 74000.0d0,230.0d0, 76000.0d0, 246.0d0, 78000.0d0,262.0d0, & 80000.0d0,278.0d0, 82000.0d0, 294.0d0, 84000.0d0,310.0d0, & 86000.0d0,326.0d0, 88000.0d0, 342.0d0, 90000.0d0,358.0d0, & 92000.0d0,374.0d0, 96000.0d0, 376.0d0, 98000.0d0,369.0d0, & 100000.0d0,353.0d0, 1.e20, .0d0/ data m814/ & 44000.0d0, .0d0, 46000.0d0, 6.0d0, 48000.0d0, 22.0d0, & 50000.0d0, 38.0d0, 52000.0d0, 54.0d0, 54000.0d0, 70.0d0, & 56000.0d0, 86.0d0, 58000.0d0, 102.0d0, 60000.0d0,118.0d0, & 62000.0d0,134.0d0, 64000.0d0, 150.0d0, 66000.0d0,166.0d0, & 68000.0d0,182.0d0, 70000.0d0, 198.0d0, 72000.0d0,214.0d0, & 74000.0d0,230.0d0, 76000.0d0, 246.0d0, 78000.0d0,262.0d0, & 80000.0d0,278.0d0, 82000.0d0, 294.0d0, 84000.0d0,310.0d0, & 86000.0d0,326.0d0, 88000.0d0, 342.0d0, 90000.0d0,358.0d0, & 92000.0d0,374.0d0, 100000.0d0, 376.0d0, 1.e20, .0d0/ data m914/ & 58000.0d0, .0d0, 60000.0d0, 6.0d0, 62000.0d0, 62.0d0, & 64000.0d0,118.0d0, 66000.0d0, 166.0d0, 68000.0d0,182.0d0, & 70000.0d0,198.0d0, 72000.0d0, 214.0d0, 74000.0d0,230.0d0, & 76000.0d0,246.0d0, 78000.0d0, 262.0d0, 80000.0d0,278.0d0, & 82000.0d0,294.0d0, 84000.0d0, 310.0d0, 86000.0d0,326.0d0, & 88000.0d0,342.0d0, 90000.0d0, 358.0d0, 92000.0d0,374.0d0, & 100000.0d0,376.0d0, 1.e20, .0d0/ data m1014/ & 74000.0d0, .0d0, 76000.0d0, 54.0d0, 78000.0d0,110.0d0, & 80000.0d0,166.0d0, 82000.0d0, 222.0d0, 84000.0d0,278.0d0, & 86000.0d0,326.0d0, 88000.0d0, 342.0d0, 90000.0d0,358.0d0, & 92000.0d0,374.0d0, 100000.0d0, 376.0d0, 1.e20, .0d0/ data m1114/ & 88000.0d0, .0d0, 90000.0d0, 46.0d0, 92000.0d0,102.0d0, & 94000.0d0,144.0d0, 96000.0d0, 184.0d0, 98000.0d0,224.0d0, & 100000.0d0,264.0d0, 1.e20, .0d0/ data m1214/ & 94000.0d0, .0d0, 96000.0d0, 39.0d0, 98000.0d0, 79.0d0, & 100000.0d0, 119.0d0, 1.e20, .0d0/ c 2015 data m115/ & 22000.0d0, .0d0, 24000.0d0, 19.0d0, 26000.0d0, 53.0d0, & 28000.0d0, 87.0d0, 30000.0d0, 121.0d0, 32000.0d0,155.0d0, & 36000.0d0, 176.0d0, 38000.0d0, 148.0d0, 40000.0d0,114.0d0, & 42000.0d0, 80.0d0, 44000.0d0, 46.0d0, 46000.0d0, 12.0d0, & 1.e20, .0d0/ data m215/ & 22000.0d0, .0d0, 24000.0d0, 19.0d0, 26000.0d0, 53.0d0, & 28000.0d0, 87.0d0, 30000.0d0, 121.0d0, 32000.0d0,155.0d0, & 34000.0d0,189.0d0, 52000.0d0, 229.0d0, 54000.0d0,216.0d0, & 56000.0d0,182.0d0, 58000.0d0, 148.0d0, 60000.0d0,114.0d0, & 62000.0d0, 80.0d0, 64000.0d0, 46.0d0, 66000.0d0, 12.0d0, & 1.e20, .0d0/ data m315/ & 22000.0d0, .0d0, 24000.0d0, 19.0d0, 26000.0d0, 53.0d0, & 28000.0d0, 87.0d0, 30000.0d0, 121.0d0, 32000.0d0,155.0d0, & 34000.0d0,189.0d0, 36000.0d0, 223.0d0, 72000.0d0,229.0d0, & 74000.0d0,216.0d0, 76000.0d0, 182.0d0, 78000.0d0,148.0d0, & 80000.0d0,114.0d0, 82000.0d0, 80.0d0, 84000.0d0, 46.0d0, & 86000.0d0, 126.0d0, 1.e20, .0d0/ data m415/ & 26000.0d0, .0d0, 28000.0d0, 24.0d0, 30000.0d0, 74.0d0, & 32000.0d0,121.0d0, 34000.0d0, 174.0d0, 36000.0d0,223.0d0, & 92000.0d0,229.0d0, 94000.0d0, 214.0d0, 96000.0d0,164.0d0, & 98000.0d0,114.0d0, 100000.0d0, 64.0d0, 1.e20, .0d0/ data m515/ & 32000.0d0, .0d0, 34000.0d0, 14.0d0, 36000.0d0, 64.0d0, & 38000.0d0, 86.0d0, 40000.0d0, 102.0d0, 42000.0d0,118.0d0, & 44000.0d0,134.0d0, 46000.0d0, 150.0d0, 48000.0d0,166.0d0, & 50000.0d0,182.0d0, 52000.0d0, 198.0d0, 54000.0d0,214.0d0, & 92000.0d0,229.0d0, 94000.0d0, 227.0d0, 96000.0d0,211.0d0, & 98000.0d0,195.0d0, 100000.0d0, 179.0d0, 1.e20, .0d0/ data m615/ & 44000.0d0, .0d0, 46000.0d0, 1.0d0, 48000.0d0, 17.0d0, & 50000.0d0, 33.0d0, 52000.0d0, 49.0d0, 54000.0d0, 65.0d0, & 56000.0d0, 81.0d0, 58000.0d0, 97.0d0, 60000.0d0,113.0d0, & 62000.0d0,129.0d0, 64000.0d0, 145.0d0, 66000.0d0,161.0d0, & 68000.0d0,177.0d0, 70000.0d0, 193.0d0, 72000.0d0,209.0d0, & 74000.0d0,225.0d0, 92000.0d0, 240.0d0, 94000.0d0,238.0d0, & 96000.0d0,222.0d0, 98000.0d0, 206.0d0,100000.0d0,190.0d0, & 1.e20, .0d0/ data m715/ & 44000.0d0, .0d0, 46000.0d0, 1.0d0, 48000.0d0, 17.0d0, & 50000.0d0, 33.0d0, 52000.0d0, 49.0d0, 54000.0d0, 65.0d0, & 56000.0d0, 81.0d0, 58000.0d0, 97.0d0, 60000.0d0,113.0d0, & 62000.0d0,129.0d0, 64000.0d0, 145.0d0, 66000.0d0,161.0d0, & 68000.0d0,177.0d0, 70000.0d0, 193.0d0, 72000.0d0,209.0d0, & 74000.0d0,225.0d0, 76000.0d0, 241.0d0, 78000.0d0,257.0d0, & 80000.0d0,273.0d0, 82000.0d0, 289.0d0, 84000.0d0,305.0d0, & 86000.0d0,321.0d0, 88000.0d0, 337.0d0, 90000.0d0,353.0d0, & 92000.0d0,369.0d0, 96000.0d0, 382.0d0, 98000.0d0,366.0d0, & 100000.0d0,350.0d0, 1.e20, .0d0/ data m815/ & 44000.0d0, .0d0, 46000.0d0, 1.0d0, 48000.0d0, 17.0d0, & 50000.0d0, 33.0d0, 52000.0d0, 49.0d0, 54000.0d0, 65.0d0, & 56000.0d0, 81.0d0, 58000.0d0, 97.0d0, 60000.0d0,113.0d0, & 62000.0d0,129.0d0, 64000.0d0, 145.0d0, 66000.0d0,161.0d0, & 68000.0d0,177.0d0, 70000.0d0, 193.0d0, 72000.0d0,209.0d0, & 74000.0d0,225.0d0, 76000.0d0, 241.0d0, 78000.0d0,257.0d0, & 80000.0d0,273.0d0, 82000.0d0, 289.0d0, 84000.0d0,305.0d0, & 86000.0d0,321.0d0, 88000.0d0, 337.0d0, 90000.0d0,353.0d0, & 92000.0d0,369.0d0, 100000.0d0, 382.0d0, 1.e20, .0d0/ data m915/ & 58000.0d0, .0d0, 60000.0d0, 46.0d0, 62000.0d0,102.0d0, & 64000.0d0,145.0d0, 66000.0d0, 161.0d0, 68000.0d0,177.0d0, & 70000.0d0,193.0d0, 72000.0d0, 209.0d0, 74000.0d0,225.0d0, & 76000.0d0,241.0d0, 78000.0d0, 257.0d0, 80000.0d0,273.0d0, & 82000.0d0,289.0d0, 84000.0d0, 305.0d0, 86000.0d0,321.0d0, & 88000.0d0,337.0d0, 90000.0d0, 353.0d0, 92000.0d0,369.0d0, & 100000.0d0,382.0d0, 1.e20, .0d0/ data m1015/ & 72000.0d0, .0d0, 74000.0d0, 46.0d0, 76000.0d0,102.0d0, & 78000.0d0,145.0d0, 80000.0d0, 206.0d0, 82000.0d0,262.0d0, & 84000.0d0,305.0d0, 86000.0d0, 321.0d0, 88000.0d0,337.0d0, & 90000.0d0,353.0d0, 92000.0d0, 369.0d0,100000.0d0,382.0d0, & 1.e20, .0d0/ data m1115/ & 86000.0d0, .0d0, 88000.0d0, 30.0d0, 90000.0d0, 86.0d0, & 92000.0d0,142.0d0, 94000.0d0, 195.0d0, 96000.0d0,235.0d0, & 98000.0d0,275.0d0, 100000.0d0, 315. 0d0, 1.e20, .0d0/ data m1215/ & 94000.0d0, .0d0, 96000.0d0, 10.0d0, 98000.0d0, 50.0d0, & 100000.0d0, 90.0d0, 1.e20, .0d0/ c 2016 data m116/ & 23000.0d0, .0d0, 25000.0d0, 34.0d0, 27000.0d0, 68.0d0, & 29000.0d0,102.0d0, 31000.0d0, 136.0d0, 33000.0d0,170.0d0, & 35000.0d0,173.0d0, 37000.0d0, 165.0d0, 39000.0d0,131.0d0, & 41000.0d0, 97.0d0, 43000.0d0, 63.0d0, 45000.0d0, 29.0d0, & 1.e20, .0d0/ data m216/ & 23000.0d0, .0d0, 25000.0d0, 34.0d0, 27000.0d0, 68.0d0, & 29000.0d0,102.0d0, 31000.0d0, 136.0d0, 33000.0d0,170.0d0, & 35000.0d0,204.0d0, 53000.0d0, 230.0d0, 55000.0d0,199.0d0, & 57000.0d0,165.0d0, 59000.0d0, 131.0d0, 61000.0d0, 97.0d0, & 63000.0d0, 63.0d0, 65000.0d0, 29.0d0, 1.e20, .0d0/ data m316/ & 23000.0d0, .0d0, 25000.0d0, 34.0d0, 27000.0d0, 68.0d0, & 29000.0d0,102.0d0, 31000.0d0, 136.0d0, 33000.0d0,170.0d0, & 35000.0d0,204.0d0, 73000.0d0, 230.0d0, 75000.0d0,199.0d0, & 77000.0d0,165.0d0, 79000.0d0, 131.0d0, 81000.0d0, 97.0d0, & 83000.0d0, 63.0d0, 85000.0d0, 29.0d0, 1.e20, .0d0/ data m416/ & 29000.0d0, .0d0, 31000.0d0, 49.0d0, 33000.0d0, 99.0d0, & 35000.0d0,149.0d0, 37000.0d0, 199.0d0, 93000.0d0,230.0d0, & 95000.0d0,192.0d0, 97000.0d0, 142.0d0, 99000.0d0, 92.0d0, & 101000.0d0, 42.0d0, 1.e20, .0d0/ data m516/ & 33000.0d0, .0d0, 35000.0d0, 39.0d0, 37000.0d0, 81.0d0, & 39000.0d0, 97.0d0, 41000.0d0, 113.0d0, 43000.0d0,129.0d0, & 45000.0d0,145.0d0, 47000.0d0, 161.0d0, 49000.0d0,177.0d0, & 51000.0d0,193.0d0, 53000.0d0, 209.0d0, 55000.0d0,225.0d0, & 93000.0d0,230.0d0, 95000.0d0, 223.0d0, 97000.0d0,207.0d0, & 99000.0d0,191.0d0, 101000.0d0, 175.0d0, 1.e20, .0d0/ data m616/ & 45000.0d0, .0d0, 47000.0d0, 7.0d0, 49000.0d0, 23.0d0, & 51000.0d0, 39.0d0, 53000.0d0, 55.0d0, 55000.0d0, 71.0d0, & 57000.0d0, 87.0d0, 59000.0d0, 103.0d0, 61000.0d0,119.0d0, & 63000.0d0,135.0d0, 65000.0d0, 151.0d0, 67000.0d0,167.0d0, & 69000.0d0,183.0d0, 71000.0d0, 199.0d0, 73000.0d0,215.0d0, & 75000.0d0,231.0d0, 93000.0d0, 236.0d0, 95000.0d0,229.0d0, & 97000.0d0,213.0d0, 99000.0d0, 197.0d0,101000.0d0,181.0d0, & 1.e20, .0d0/ data m716/ & 45000.0d0, .0d0, 47000.0d0, 7.0d0, 49000.0d0, 23.0d0, & 51000.0d0, 39.0d0, 53000.0d0, 55.0d0, 55000.0d0, 71.0d0, & 57000.0d0, 87.0d0, 59000.0d0, 103.0d0, 61000.0d0,119.0d0, & 63000.0d0,135.0d0, 65000.0d0, 151.0d0, 67000.0d0,167.0d0, & 69000.0d0,183.0d0, 71000.0d0, 199.0d0, 73000.0d0,215.0d0, & 75000.0d0,231.0d0, 77000.0d0, 247.0d0, 79000.0d0,263.0d0, & 81000.0d0,279.0d0, 83000.0d0, 295.0d0, 85000.0d0,311.0d0, & 87000.0d0,327.0d0, 89000.0d0, 343.0d0, 91000.0d0,359.0d0, & 93000.0d0,375.0d0, 95000.0d0, 384.0d0, 97000.0d0,373.0d0, & 99000.0d0,357.0d0, 100001.0d0, 341.0d0, 1.e20, .0d0/ data m816/ & 45000.0d0, .0d0, 47000.0d0, 7.0d0, 49000.0d0, 23.0d0, & 51000.0d0, 39.0d0, 53000.0d0, 55.0d0, 55000.0d0, 71.0d0, & 57000.0d0, 87.0d0, 59000.0d0, 103.0d0, 61000.0d0,119.0d0, & 63000.0d0,135.0d0, 65000.0d0, 151.0d0, 67000.0d0,167.0d0, & 69000.0d0,183.0d0, 71000.0d0, 199.0d0, 73000.0d0,215.0d0, & 75000.0d0,231.0d0, 77000.0d0, 247.0d0, 79000.0d0,263.0d0, & 81000.0d0,279.0d0, 83000.0d0, 295.0d0, 85000.0d0,311.0d0, & 87000.0d0,327.0d0, 89000.0d0, 343.0d0, 91000.0d0,359.0d0, & 93000.0d0,375.0d0, 101000.0d0, 384.0d0, 1.e20, .0d0/ data m916/ & 57000.0d0, .0d0, 59000.0d0, 29.0d0, 61000.0d0, 85.0d0, & 63000.0d0,135.0d0, 65000.0d0, 151.0d0, 67000.0d0,167.0d0, & 69000.0d0,183.0d0, 71000.0d0, 199.0d0, 73000.0d0,215.0d0, & 75000.0d0,247.0d0, 77000.0d0, 263.0d0, 79000.0d0,279.0d0, & 81000.0d0,295.0d0, 83000.0d0, 311.0d0, 85000.0d0,327.0d0, & 87000.0d0,343.0d0, 89000.0d0, 359.0d0, 91000.0d0,375.0d0, & 100001.0d0,384.0d0, 1.e20, .0d0/ data m1016/ & 71000.0d0, .0d0, 73000.0d0, 21.0d0, 75000.0d0, 77.0d0, & 77000.0d0,133.0d0, 79000.0d0, 189.0d0, 81000.0d0,245.0d0, & 83000.0d0,295.0d0, 85000.0d0, 311.0d0, 87000.0d0,327.0d0, & 89000.0d0,343.0d0, 91000.0d0, 359.0d0, 93000.0d0,375.0d0, & 100001.0d0,384.0d0, 1.e20, .0d0/ data m1116/ & 85000.0d0, .0d0, 87000.0d0, 13.0d0, 89000.0d0, 69.0d0, & 91000.0d0,125.0d0, 93000.0d0, 181.0d0, 95000.0d0,230.0d0, & 97000.0d0,270.0d0, 99000.0d0, 310.0d0,100001.0d0,350.0d0, & 1.e20, .0d0/ data m1216/ & 95000.0d0, .0d0, 97000.0d0, 21.0d0, 99000.0d0, 61.0d0, & 100001.0d0,101.0d0, 1.e20, .0d0/ c data cel/ 328000.0d0, 40000.0d0, 60000.0d0, 80000.0d0,100000.0d0,120000.0d0, 429000.0d0, 40000.0d0, 60000.0d0, 80000.0d0,100000.0d0,120000.0d0, 530000.0d0, 50000.0d0, 70000.0d0, 90000.0d0,110000.0d0,130000.0d0, 631000.0d0, 50000.0d0, 70000.0d0, 90000.0d0,110000.0d0,130000.0d0, 732000.0d0, 52000.0d0, 72000.0d0, 92000.0d0,112000.0d0,132000.0d0/ data cel08/ 8 32000.0d0, 52000.0d0, 72000.0d0, 92000.0d0, 8 112000.0d0, 132000.0d0, 152000.0d0, 9 34000.0d0, 54000.0d0, 74000.0d0, 94000.0d0, 9 114000.0d0, 134000.0d0, 154000.0d0, & 34000.0d0, 54000.0d0, 74000.0d0, 94000.0d0, & 114000.0d0, 134000.0d0, 154000.0d0, 1 34000.0d0, 54000.0d0, 74000.0d0, 94000.0d0, 1 114000.0d0, 134000.0d0, 154000.0d0/ data cel12/ 2 35000.0d0, 45000.0d0, 55000.0d0, 65000.0d0, 2 75000.0d0, 85000.0d0, 95000.0d0, 105000.0d0, 2 115000.0d0, 125000.0d0, 135000.0d0, 145000.0d0, 2 155000.0d0/ data cel13/ 3 36000.0d0, 56000.0d0, 76000.0d0, 96000.0d0, 3 116000.0d0, 136000.0d0, 156000.0d0, 176000.0d0, 3 196000.0d0, 216000.0d0, 236000.0d0, 256000.0d0, 3 276000.0d0, 296000.0d0/ data cel14/ 4 37000.0d0, 57000.0d0, 77000.0d0, 97000.0d0, 4 117000.0d0, 137000.0d0, 157000.0d0, 177000.0d0, 4 197000.0d0, 217000.0d0, 237000.0d0, 257000.0d0/ data ei/ & 2*73000.d0, 75000.d0, 78000.d0, 81000.d0, & 82000.d0, 3*86000.d0, 88000.d0, 99000.d0, & 2*100000.d0, 101000.d0/ data m25 / & 14000.0d0, .0d0, 15000.0d0, 9.0d0, 16000.0d0, 27.0d0, & 17000.0d0, 44.0d0, 18000.0d0, 62.0d0, 19000.0d0, 79.0d0, & 20000.0d0, 97.0d0, 21000.0d0,114.0d0, 22000.0d0,132.0d0, & 23000.0d0, 149.0d0, 1.e20,162.0d0/ data m100/ & 28000.0d0, .0d0, 29000.0d0, 9.0d0, 30000.0d0, 16.0d0, & 31000.0d0, 24.0d0, 32000.0d0, 31.0d0, 33000.0d0, 39.0d0, & 34000.0d0, 46.0d0, 35000.0d0, 54.0d0, 36000.0d0, 61.0d0, & 37000.0d0, 69.0d0, 38000.0d0, 76.0d0, 39000.0d0, 84.0d0, & 40000.0d0, 91.0d0, 41000.0d0, 99.0d0, 42000.0d0,106.0d0, & 43000.0d0, 114.0d0, 44000.0d0,121.0d0, 45000.0d0,129.0d0, & 46000.0d0, 136.0d0, 47000.0d0,144.0d0, 48000.0d0,151.0d0, & 49000.0d0, 159.0d0, 50000.0d0,166.0d0, 51000.0d0,174.0d0, & 52000.0d0, 181.0d0, 53000.0d0,189.0d0, 54000.0d0,196.0d0, & 55000.0d0, 204.0d0, 56000.0d0,211.0d0, 57000.0d0,219.0d0, & 58000.0d0, 226.0d0, 59000.0d0,234.0d0, 60000.0d0,241.0d0, & 61000.0d0, 249.0d0, 62000.0d0,256.0d0, 1.e20,261.0d0/ data m25680 / & 14250.0d0, .0d0, 15250.0d0, 7.0d0, 16250.0d0, 24.0d0, & 17250.0d0, 41.0d0, 18250.0d0, 58.0d0, 19250.0d0, 75.0d0, & 20250.0d0, 92.0d0, 21250.0d0,109.0d0, 22250.0d0,126.0d0, & 23250.0d0,143.0d0, 24250.0d0,160.0d0, 1.e20,161.0d0/ data m26480 / & 15000.0d0, .0d0, 16000.0d0, 7.0d0, 17000.0d0, 24.0d0, & 18000.0d0, 41.0d0, 19000.0d0, 58.0d0, 20000.0d0, 75.0d0, & 21000.0d0, 92.0d0, 22000.0d0,109.0d0, 23000.0d0,126.0d0, & 24000.0d0,143.0d0, 25000.0d0,160.0d0, 1.e20,166.0d0/ data m28000 / & 16000.0d0, .0d0, 18000.0d0, 24.0d0, 20000.0d0, 58.0d0, & 22000.0d0, 92.0d0, 26000.0d0,113.0d0, 28000.0d0, 90.0d0, & 30000.0d0, 56.0d0, 32000.0d0, 22.0d0, 1.e20, .0d0/ data m40000 / & 16000.0d0, .0d0, 18000.0d0, 24.0d0, 20000.0d0, 58.0d0, & 22000.0d0, 92.0d0, 24000.0d0,126.0d0, 26000.0d0,160.0d0, & 38000.0d0,171.0d0, 40000.0d0,158.0d0, 42000.0d0,124.0d0, & 44000.0d0, 90.0d0, 46000.0d0, 56.0d0, 48000.0d0, 22.0d0, & 1.e20, .0d0/ data m60000 / & 16000.0d0, .0d0, 18000.0d0, 24.0d0, 20000.0d0, 58.0d0, & 22000.0d0, 92.0d0, 24000.0d0,126.0d0, 26000.0d0,160.0d0, & 58000.0d0,171.0d0, 60000.0d0,158.0d0, 62000.0d0,124.0d0, & 64000.0d0, 90.0d0, 66000.0d0, 56.0d0, 68000.0d0, 22.0d0, & 1.e20, .0d0/ data m80000 / & 22000.0d0, .0d0, 24000.0d0, 27.0d0, 26000.0d0, 77.0d0, & 28000.0d0,103.0d0, 30000.0d0,119.0d0, 32000.0d0,135.0d0, & 34000.0d0,151.0d0, 36000.0d0,167.0d0, 68000.0d0,166.0d0, & 1.e20, .0d0/ data m10000 / & 32000.0d0, .0d0, 34000.0d0, 2.0d0, 36000.0d0, 18.0d0, & 38000.0d0, 34.0d0, 40000.0d0, 50.0d0, 42000.0d0, 66.0d0, & 44000.0d0, 82.0d0, 46000.0d0, 98.0d0, 48000.0d0,114.0d0, & 50000.0d0,130.0d0, 52000.0d0,146.0d0, 54000.0d0,162.0d0, & 56000.0d0,178.0d0, 68000.0d0,182.0d0, 70000.0d0,177.0d0, & 1.e20, .0d0/ data m12000 / & 32000.0d0, .0d0, 34000.0d0, 2.0d0, 36000.0d0, 18.0d0, & 38000.0d0, 34.0d0, 40000.0d0, 50.0d0, 42000.0d0, 66.0d0, & 44000.0d0, 82.0d0, 46000.0d0, 98.0d0, 48000.0d0,114.0d0, & 50000.0d0,130.0d0, 52000.0d0,146.0d0, 54000.0d0,162.0d0, & 56000.0d0,178.0d0, 58000.0d0,194.0d0, 60000.0d0,210.0d0, & 62000.0d0,226.0d0, 64000.0d0,242.0d0, 66000.0d0,258.0d0, & 68000.0d0,274.0d0, 70000.0d0,285.0d0, 1.e20, .0d0/ data m10203/ & 31250.0d0, .0d0, 32250.0d0, 6.0d0, 33250.0d0, 14.0d0, & 34250.0d0, 22.0d0, 35250.0d0, 30.0d0, 36250.0d0, 38.0d0, & 37250.0d0, 46.0d0, 38250.0d0, 54.0d0, 39250.0d0, 62.0d0, & 40250.0d0, 70.0d0, 41250.0d0, 78.0d0, 42250.0d0, 86.0d0, & 43250.0d0, 94.0d0, 44250.0d0,102.0d0, 45250.0d0,110.0d0, & 46250.0d0,118.0d0, 47250.0d0,126.0d0, 48250.0d0,134.0d0, & 49250.0d0,142.0d0, 50250.0d0,150.0d0, 51250.0d0,158.0d0, & 52250.0d0,166.0d0, 53250.0d0,174.0d0, 54250.0d0,182.0d0, & 55250.0d0,190.0d0, 56250.0d0,198.0d0, 57250.0d0,206.0d0, & 58250.0d0,214.0d0, 59250.0d0,222.0d0, 60250.0d0,230.0d0, & 61250.0d0,238.0d0, 62250.0d0,246.0d0, 63250.0d0,254.0d0, & 64250.0d0,262.0d0, 1.e20,268.0d0/ data m10520/ & 32000.0d0, .0d0, 33000.0d0, 7.0d0, 34000.0d0, 15.0d0, & 35000.0d0, 23.0d0, 36000.0d0, 31.0d0, 37000.0d0, 39.0d0, & 38000.0d0, 47.0d0, 39000.0d0, 55.0d0, 40000.0d0, 63.0d0, & 41000.0d0, 71.0d0, 42000.0d0, 79.0d0, 43000.0d0, 87.0d0, & 44000.0d0, 95.0d0, 45000.0d0,103.0d0, 46000.0d0,111.0d0, & 47000.0d0,119.0d0, 48000.0d0,127.0d0, 49000.0d0,135.0d0, & 50000.0d0,143.0d0, 51000.0d0,151.0d0, 52000.0d0,159.0d0, & 53000.0d0,167.0d0, 54000.0d0,175.0d0, 55000.0d0,183.0d0, & 56000.0d0,191.0d0, 57000.0d0,199.0d0, 58000.0d0,207.0d0, & 59000.0d0,215.0d0, 60000.0d0,223.0d0, 61000.0d0,231.0d0, & 62000.0d0,239.0d0, 63000.0d0,247.0d0, 64000.0d0,255.0d0, & 65000.0d0,263.0d0, 66000.0d0,271.0d0, 1.e20,276.0d0/ mst = data(2) c 1999 - marriage credit - non refundable crmar = 0. c total earned income,taxable pensions,taxable SSB,self-employment inc c and farm income less the self-employment tax deduction earn = 0. if(law.eq.1999.and.mst.eq.2) then c 1999 "earned income" as wages and SE income earn = min(data(85),data(86))+.5*( & max(0.0d0,data(21))+max(0.0d0,data(17))-.5*data(43)) else if(law.ge.2000.and.mst.eq.2) then c 2000+ expansion to include taxable pension and SS income c total earned income,taxable pensions,taxable SSB,self-employment inc c and farm income less the self-employment tax deduction earn = min(data(85),data(86))+.5*(data(20)+data(72)+comnew(79)+ & max(0.0d0,data(21))+max(0.0d0,data(17))-.5*data(43)) endif c for 1999 if(law.eq.1999.and.mst.eq.2) then if(taxinc.ge.25000.d0.and.taxinc.lt.100000.d0) & crmar = tablki(m25,11,earn,data) if(taxinc.ge.100000.) crmar = tablki(m100,36,earn,data) c for 2000 else if(law.eq.2000.and.mst.eq.2) then if(taxinc.ge.25680.and.taxinc.lt.102030.) & crmar = tablki(m25680,12,earn,data) if(taxinc.ge.102030.) crmar = tablki(m10203,35,earn,data) c for 2001 else if(law.eq.2001.and.mst.eq.2) then if(taxinc.ge.26480.and.taxinc.lt.105200.) & crmar = tablki(m26480,12,earn,data) if(taxinc.ge.105200.) crmar = tablki(m10520,36,earn,data) c for 2002+ else if(law.ge.2002.and.law.le.2016.and.mst.eq.2) then c for 2002 if(law.eq.2002) then if(taxinc.ge.28000.and.taxinc.lt.40000.) & crmar = tablki(m28000,9,earn,data) if(taxinc.ge.40000.and.taxinc.lt.60000.) & crmar = tablki(m40000,13,earn,data) if(taxinc.ge.60000.and.taxinc.lt.80000.) & crmar = tablki(m60000,13,earn,data) if(taxinc.ge.80000.and.taxinc.lt.100000.) & crmar = tablki(m80000,10,earn,data) if(taxinc.ge.100000.and.taxinc.lt.120000.) & crmar = tablki(m10000,16,earn,data) if(taxinc.ge.120000.) crmar = tablki(m12000,21,earn,data) if(earn.ge.70000) then call mnrate(1,earn-6925.,fedtax,law,x1,rt,data) a=max(0.0d0,taxinc-earn-6925.) call mnrate(1,a,fedtax,law,x2,rt,data) crmar=min(285.0d0,max(0.0d0,statax-(x1+x2))) endif c for 2003+ else if(law.ge.2003) then if(earn.lt.ei(law))then c Marriage Credit Worksheet if(law.le.2007) then if(taxinc.ge.cel(1,law).and.taxinc.lt.cel(2,law)) then if(law.eq.2003) crmar = tablki(m103,9,earn,data) if(law.eq.2004) crmar = tablki(m104,9,earn,data) if(law.eq.2005) crmar = tablki(m105,13,earn,data) if(law.eq.2006) crmar = tablki(m106,13,earn,data) if(law.eq.2007) crmar = tablki(m107,13,earn,data) else if(taxinc.ge.cel(2,law).and.taxinc.lt.cel(3,law)) then if(law.eq.2003) crmar = tablki(m203,13,earn,data) if(law.eq.2004) crmar = tablki(m204,13,earn,data) if(law.eq.2005) crmar = tablki(m205,14,earn,data) if(law.eq.2006) crmar = tablki(m206,13,earn,data) if(law.eq.2007) crmar = tablki(m207,13,earn,data) else if(taxinc.ge.cel(3,law).and.taxinc.lt.cel(4,law)) then if(law.eq.2003) crmar = tablki(m303,13,earn,data) if(law.eq.2004) crmar = tablki(m304,13,earn,data) if(law.eq.2005) crmar = tablki(m305,11,earn,data) if(law.eq.2006) crmar = tablki(m306,13,earn,data) if(law.eq.2007) crmar = tablki(m307,13,earn,data) else if(taxinc.ge.cel(4,law).and.taxinc.lt.cel(5,law)) then if(law.eq.2003) crmar = tablki(m403,10,earn,data) if(law.eq.2004) crmar = tablki(m404,10,earn,data) if(law.eq.2005) crmar = tablki(m405,13,earn,data) if(law.eq.2006) crmar = tablki(m406,11,earn,data) if(law.eq.2007) crmar = tablki(m407,11,earn,data) else if(taxinc.ge.cel(5,law).and.taxinc.lt.cel(6,law)) then if(law.eq.2003) crmar = tablki(m503,15,earn,data) if(law.eq.2004) crmar = tablki(m504,15,earn,data) if(law.eq.2005) crmar = tablki(m505,18,earn,data) if(law.eq.2006) crmar = tablki(m506,17,earn,data) if(law.eq.2007) crmar = tablki(m507,15,earn,data) else if(taxinc.ge.cel(6,law)) then if(law.eq.2003) crmar = tablki(m603,21,earn,data) if(law.eq.2004) crmar = tablki(m604,21,earn,data) if(law.eq.2005) crmar = tablki(m605,22,earn,data) if(law.eq.2006) crmar = tablki(m606,23,earn,data) if(law.eq.2007) crmar = tablki(m607,23,earn,data) endif else if(law.ge.2008.and.law.le.2011) then if(taxinc.ge.cel08(1,law).and.taxinc.lt.cel08(2,law)) then if(law.eq.2008)crmar = tablki(m108,12,earn,data) if(law.eq.2009)crmar = tablki(m109,12,earn,data) if(law.eq.2010)crmar = tablki(m110,13,earn,data) if(law.eq.2011)crmar = tablki(m111,13,earn,data) else if(taxinc.ge.cel08(2,law).and.taxinc.lt.cel08(3,law))then if(law.eq.2008)crmar = tablki(m208,13,earn,data) if(law.eq.2009)crmar = tablki(m209,15,earn,data) if(law.eq.2010)crmar = tablki(m210,15,earn,data) if(law.eq.2011)crmar = tablki(m211,15,earn,data) else if(taxinc.ge.cel08(3,law).and.taxinc.lt.cel08(4,law))then if(law.eq.2008)crmar = tablki(m308,13,earn,data) if(law.eq.2009)crmar = tablki(m309,15,earn,data) if(law.eq.2010)crmar = tablki(m310,15,earn,data) if(law.eq.2011)crmar = tablki(m311,15,earn,data) else if(taxinc.ge.cel08(4,law).and.taxinc.lt.cel08(5,law))then if(law.eq.2008)crmar = tablki(m408,11,earn,data) if(law.eq.2009)crmar = tablki(m409,10,earn,data) if(law.eq.2010)crmar = tablki(m410,10,earn,data) if(law.eq.2011)crmar = tablki(m411,10,earn,data) else if(taxinc.ge.cel08(5,law).and.taxinc.lt.cel08(6,law))then if(law.eq.2008)crmar = tablki(m508,17,earn,data) if(law.eq.2009)crmar = tablki(m509,17,earn,data) if(law.eq.2010)crmar = tablki(m510,17,earn,data) if(law.eq.2011)crmar = tablki(m510,16,earn,data) else if(taxinc.ge.cel08(6,law).and.taxinc.lt.cel08(7,law))then if(law.eq.2008)crmar = tablki(m608,23,earn,data) if(law.eq.2009)crmar = tablki(m609,23,earn,data) if(law.eq.2010)crmar = tablki(m610,23,earn,data) if(law.eq.2011)crmar = tablki(m611,22,earn,data) else if(taxinc.ge.cel08(7,law)) then if(law.eq.2008)crmar = tablki(m708,23,earn,data) if(law.eq.2009)crmar = tablki(m709,25,earn,data) if(law.eq.2010)crmar = tablki(m710,25,earn,data) if(law.eq.2011)crmar = tablki(m711,25,earn,data) endif else if(law.eq.2012) then if(taxinc.ge.cel12(1,law).and.taxinc.lt.cel12(2,law)) then crmar = tablki(m112,9,earn,data) else if(taxinc.ge.cel12(2,law).and.taxinc.lt.cel12(3,law))then crmar = tablki(m212,15,earn,data) else if(taxinc.ge.cel12(3,law).and.taxinc.lt.cel12(4,law))then crmar = tablki(m312,15,earn,data) else if(taxinc.ge.cel12(4,law).and.taxinc.lt.cel12(5,law))then crmar = tablki(m412,15,earn,data) else if(taxinc.ge.cel12(5,law).and.taxinc.lt.cel12(6,law))then crmar = tablki(m512,15,earn,data) else if(taxinc.ge.cel12(6,law).and.taxinc.lt.cel12(7,law))then crmar = tablki(m612,15,earn,data) else if(taxinc.ge.cel12(7,law).and.taxinc.lt.cel12(8,law))then crmar = tablki(m712,8,earn,data) else if(taxinc.ge.cel12(8,law).and.taxinc.lt.cel12(9,law))then crmar = tablki(m812,11,earn,data) else if(taxinc.ge.cel12(9,law).and.taxinc.lt.cel12(10,law)) & then crmar = tablki(m912,14,earn,data) else if(taxinc.ge.cel12(10,law).and.taxinc.lt.cel12(11,law)) & then crmar = tablki(m1012,17,earn,data) else if(taxinc.ge.cel12(11,law).and.taxinc.lt.cel12(12,law)) & then crmar = tablki(m1112,18,earn,data) else if(taxinc.ge.cel12(12,law).and.taxinc.lt.cel12(13,law)) & then crmar = tablki(m1212,23,earn,data) else if(taxinc.ge.cel12(13,law))then crmar = tablki(m1312,25,earn,data) endif else if(law.eq.2013) then if(taxinc.ge.cel13(1,law).and.taxinc.lt.cel13(2,law)) then crmar = tablki(m113,13,earn,data) else if(taxinc.ge.cel13(2,law).and.taxinc.lt.cel13(3,law))then crmar = tablki(m213,15,earn,data) else if(taxinc.ge.cel13(3,law).and.taxinc.lt.cel13(4,law))then crmar = tablki(m313,15,earn,data) else if(taxinc.ge.cel13(4,law).and.taxinc.lt.cel13(5,law))then crmar = tablki(m413,12,earn,data) else if(taxinc.ge.cel13(5,law).and.taxinc.lt.cel13(6,law))then crmar = tablki(m513,20,earn,data) else if(taxinc.ge.cel13(6,law).and.taxinc.lt.cel13(7,law))then crmar = tablki(m613,24,earn,data) else if(taxinc.ge.cel13(7,law).and.taxinc.lt.cel13(8,law))then crmar = tablki(m713,28,earn,data) else if(taxinc.ge.cel13(8,law).and.taxinc.lt.cel13(9,law))then crmar = tablki(m813,25,earn,data) else if(taxinc.ge.cel13(9,law).and.taxinc.lt.cel13(10,law)) & then crmar = tablki(m913,18,earn,data) else if(taxinc.ge.cel13(10,law).and.taxinc.lt.cel13(11,law)) & then crmar = tablki(m1013,11,earn,data) else if(taxinc.ge.cel13(11,law).and.taxinc.lt.cel13(12,law)) & then crmar = tablki(m1113,8,earn,data) else if(taxinc.ge.cel13(12,law).and.taxinc.lt.cel13(13,law)) & then crmar = tablki(m1213,6,earn,data) else if(taxinc.ge.cel13(13,law).and.taxinc.lt.cel13(14,law)) & then crmar = tablki(m1313,6,earn,data) else if(taxinc.ge.cel13(13,law)) then crmar = tablki(m1413,6,earn,data) endif else if(law.ge.2014.and.law.le.2016) then if(taxinc.ge.cel14(1,2014).and.taxinc.lt.cel14(2,2014)) then if(law.eq.2014)crmar = tablki(m114,13,earn,data) if(law.eq.2015)crmar = tablki(m115,13,earn,data) if(law.eq.2016)crmar = tablki(m116,13,earn,data) else if(taxinc.ge.cel14(2,2014).and.taxinc.lt.cel14(3,2014)) & then if(law.eq.2014)crmar = tablki(m214,16,earn,data) if(law.eq.2015)crmar = tablki(m215,16,earn,data) if(law.eq.2016)crmar = tablki(m216,15,earn,data) else if(taxinc.ge.cel14(3,2014).and.taxinc.lt.cel14(4,2014)) & then if(law.eq.2014)crmar = tablki(m314,16,earn,data) if(law.eq.2015)crmar = tablki(m315,17,earn,data) if(law.eq.2016)crmar = tablki(m316,15,earn,data) else if(taxinc.ge.cel14(4,2014).and.taxinc.lt.cel14(5,2014)) & then if(law.eq.2014)crmar = tablki(m414,12,earn,data) if(law.eq.2015)crmar = tablki(m415,12,earn,data) if(law.eq.2016)crmar = tablki(m416,11,earn,data) else if(taxinc.ge.cel14(5,2014).and.taxinc.lt.cel14(6,2014)) & then if(law.eq.2014)crmar = tablki(m514,19,earn,data) if(law.eq.2015)crmar = tablki(m515,18,earn,data) if(law.eq.2016)crmar = tablki(m516,18,earn,data) else if(taxinc.ge.cel14(6,2014).and.taxinc.lt.cel14(7,2014)) & then if(law.eq.2014)crmar = tablki(m614,23,earn,data) if(law.eq.2015)crmar = tablki(m615,22,earn,data) if(law.eq.2016)crmar = tablki(m616,22,earn,data) else if(taxinc.ge.cel14(7,2014).and.taxinc.lt.cel14(8,2014)) & then if(law.eq.2014)crmar = tablki(m714,29,earn,data) if(law.eq.2015)crmar = tablki(m715,29,earn,data) if(law.eq.2016)crmar = tablki(m716,30,earn,data) else if(taxinc.ge.cel14(8,2014).and.taxinc.lt.cel14(9,2014)) & then if(law.eq.2014)crmar = tablki(m814,27,earn,data) if(law.eq.2015)crmar = tablki(m815,27,earn,data) if(law.eq.2016)crmar = tablki(m816,27,earn,data) else if(taxinc.ge.cel14(9,2014).and.taxinc.lt.cel14(10,2014)) & then if(law.eq.2014)crmar = tablki(m914,20,earn,data) if(law.eq.2015)crmar = tablki(m915,20,earn,data) if(law.eq.2016)crmar = tablki(m916,20,earn,data) else if(taxinc.ge.cel14(10,2014).and.taxinc.lt.cel14(11,2014)) & then if(law.eq.2014)crmar = tablki(m1014,12,earn,data) if(law.eq.2015)crmar = tablki(m1015,13,earn,data) if(law.eq.2016)crmar = tablki(m1016,14,earn,data) else if(taxinc.ge.cel14(11,2014).and.taxinc.lt.cel14(12,2014)) & then if(law.eq.2014)crmar = tablki(m1114,8,earn,data) if(law.eq.2015)crmar = tablki(m1115,9,earn,data) if(law.eq.2016)crmar = tablki(m1116,10,earn,data) else if(taxinc.ge.cel14(12,2014)) then if(law.eq.2014)crmar = tablki(m1214,5,earn,data) if(law.eq.2015)crmar = tablki(m1215,5,earn,data) if(law.eq.2016)crmar = tablki(m1216,5,earn,data) endif endif else if(earn.ge.ei(law)) then c one personal exemption and 1/2 of the married-joint stded xl10 = exem(law) + zbrack(2,law)/2 c computed taxable income of spouse B xl11 = max(0.0d0,earn - xl10) c the tax for computed taxable income of Spouse B c using the rate schedule for SINGLE call mnrate(1,xl11,fedtax,law,x1,rt,data) c computed taxable income of spouse A xl15 = max(0.0d0,taxinc - xl11) c the tax for computed taxable income of Spouse A c using the rate schedule for SINGLE call mnrate(1,xl15,fedtax,law,x2,rt,data) c Marriage credit eamb = eam(law) cel1 = ceil(law) statm = statax if(taxinc.lt.cel1.or.earn.lt.eamb) statm = 0. crmar = min(crmax1(law),max(0.0d0,statm-(x1+x2))) endif endif endif return end subroutine crmarr1(data,comnew,taxinc,fedtax,statax,crmar,law) implicit double precision (A-H,O-Z) common /user/ zbrack(3,1987:2018),exem(1987:2018), &crmax(1987:2018,0:3,1:2),ymax(1987:2023,0:3,1:2), 1rtbase(1987:2023,0:3), rtless(1987:2023,0:3), 2chmax(1998:2023),ealim(2001:2023),cphas(7) dimension crmax1(1999:2016),eam(1999:2016),ceil(1999:2016) dimension data(255),comnew(255) c start of earn arrays data eam/14000.d0, 14250.d0,15000.d0, 16000.d0,3*17000.d0, &18000.d0,19000.d0,5*20000.d0,21000.d0,2*22000.d0, 23000.d0/ c start of taxinc arrays data ceil/ 25000.d0, 25680.d0, 26480.d0,2*28000.d0,29000.d0, & 30000.d0,31000.d0,2*32000.d0,3*34000.d0, 35000.d0,36000.d0, &3*37000.d0/ c Maximum of marriage credit data crmax1/ 261.d0, 268.d0,276.d0,285.d0,290.d0,296.d0,303.d0, &313.d0,325.d0,332.d0,2*347.d0,352.d0,361.d0,370.d0,376.d0,382.d0, &384.d0/ mst = data(2) c 1999 - marriage credit - non refundable crmar = 0. c total earned income,taxable pensions,taxable SSB,self-employment inc c and farm income less the self-employment tax deduction earn = 0. if(law.eq.1999.and.mst.eq.2) then c 1999 "earned income" as wages and SE income earn = min(data(85),data(86))+.5*( & max(0.0d0,data(21))+max(0.0d0,data(17))-.5*data(43)) else if(law.ge.2000.and.mst.eq.2) then c 2000+ expansion to include taxable pension and SS income c total earned income,taxable pensions,taxable SSB,self-employment inc c and farm income less the self-employment tax deduction earn = min(data(85),data(86))+.5*(data(20)+data(72)+comnew(79)+ & max(0.0d0,data(21))+max(0.0d0,data(17))-.5*data(43)) endif c for 1999+ if(law.ge.1999.and.mst.eq.2) then c one personal exemption and 1/2 of the married-joint stded xl10 = exem(law) + zbrack(2,law)/2 c computed taxable income of spouse B xl11 = max(0.0d0,earn - xl10) c the tax for computed taxable income of Spouse B c using the rate schedule for SINGLE call mnrate(1,xl11,fedtax,law,x1,rt,data) c computed taxable income of spouse A xl15 = max(0.0d0,taxinc - xl11) c the tax for computed taxable income of Spouse A c using the rate schedule for SINGLE call mnrate(1,xl15,fedtax,law,x2,rt,data) c Marriage credit eamb = eam(law) cel1 = ceil(law) statm = statax if(taxinc.lt.cel1.or.earn.lt.eamb) statm = 0. crmar = min(crmax1(law),max(0.0d0,statm-(x1+x2))) endif return end subroutine mnrate(mst,taxinc,fedtax,law,statax,rate,data) implicit double precision (A-H,O-Z) dimension data(255) dimension surtax(1977:1983) dimension tab87s(2,4), tab87j(2,4), tab87h(2,4) dimension tab88s(2,4), tab88j(2,4), tab88h(2,4) dimension tab91s(2,3), tab91j(2,3), tab91h(2,3) dimension tab99s(2,3), tab99j(2,3), tab99h(2,3) dimension tab00s(2,3), tab00j(2,3), tab00h(2,3), & aif00(2000:2012),aif13(2013:2017) dimension tab13s(2,4), tab13j(2,4), tab13h(2,4) dimension tabs(2,3), tabj(2,3), tabh(2,3) dimension tab77(2,13), aif(1977:1998) dimension tb85am(2,9),tb85bm(2,16),tb85as(2,11),tb85bs(2,11) integer filer data surtax/ 5* 1.0d0, 1.070d0, 1.10d0/ data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ data aif00/ & 1.0d0, 1.032d0, 1.065d0, 1.082d0 , 1.106d0 , & 1.132d0, 1.167d0, 1.213d0, 1.2407d0, 1.2936d0, & 1.2959d0, 1.315d0, 1.34696d0/ data aif / & 2* 1.0d0, 1.1011d0, 1.196d0, 1.306d0, & 1.332d0, 1.342d0 , 1.379d0, 1.0d0 , & 1.037d0, 5*1.0d0, 1.051d0, 1.085d0, & 1.118d0, 1.1471d0, 1.18d0 , 1.212d0, & 1.238d0/ data tab77/ & 500.0d0, 1.6d0, 1000.0d0, 2.2d0, 2000.0d0, 3.5d0, & 3000.0d0, 5.8d0, 4000.0d0, 7.3d0, 5000.0d0, 8.8d0, & 7000.0d0, 10.2d0, 9000.0d0, 11.5d0,12500.0d0, 12.8d0, & 20000.0d0, 14.0d0, 27500.0d0, 15.0d0,40000.0d0, .0d0, & 1.e20, .0d0/ data tb85bm/ & 875.0d0, 1.5d0, 1750.0d0, 2.0d0, 3500.0d0, 2.9d0, & 5375.0d0, 4.8d0, 7000.0d0, 5.9d0, 7125.0d0, 6.1d0, & 8875.0d0, 7.2d0, 12375.0d0, 8.3d0,14000.0d0, 9.3d0, & 16000.0d0, 10.0d0, 21500.0d0, 11.0d0,22125.0d0, 11.3d0, & 25500.0d0, 12.3d0, 28500.0d0, 12.6d0,31750.0d0, 13.7d0, & 1.e20, 14.0d0/ data tb85am/ & 1200.0d0, 1.7d0, 1700.0d0, 2.1d0, 2700.0d0, 2.3d0, & 5600.0d0, 3.3d0, 9100.0d0, 5.3d0, 12600.0d0, 6.8d0, & 17800.0d0, 8.5d0, 30800.0d0, 9.3d0, 1.e20, 9.9d0/ data tb85bs/ & 700.0d0, 1.3d0, 1400.0d0, 1.9d0, 2800.0d0, 3.2d0, & 4300.0d0, 5.4d0, 5700.0d0, 6.9d0, 7100.0d0, 8.4d0, & 9900.0d0, 9.8d0, 12800.0d0, 11.1d0, 15400.0d0,12.4d0, & 19400.0d0, 13.6d0, 1.e20, 14.0d0/ data tb85as/ & 300.0d0, 1.0d0, 600.0d0, 1.6d0, 900.0d0, 1.6d0, & 1300.0d0, 2.1d0, 2000.0d0, 2.7d0, 2800.0d0, 3.7d0, & 4300.0d0, 4.5d0, 6400.0d0, 6.1d0, 9400.0d0, 7.5d0, & 16200.0d0, 9.3d0, 1.e20, 9.9d0/ data tab87s/ & 3000.0d0, 4.0d0, 7500.0d0, 6.0d0, 16000.0d0, 8.0d0, & 1.e20, 9.0d0/ data tab87j/ & 4000.0d0, 4.0d0, 11000.0d0, 6.0d0, 21000.0d0, 8.0d0, & 1.e20, 9.0d0/ data tab87h/3500.d0, 4.d0,9250.d0,6.d0,18500.d0,8.d0,1.e20,9.d0/ data tab88s/13000.d0,6.d0,42800.d0,8.d0,93000.d0,8.5d0,1.e20,9.d0/ data tab88j/19000.d0,6.d0,75500.d0,8.d0,165000.d0,8.5d0, & 1.e20,9.d0/ data tab88h/ & 16000.0d0, 6.0d0, 64300.0d0, 8.0d0, 135000.0d0, 8.5d0, & 1.e20, 9.0d0/ data tab91s/ & 13700.0d0, 6.0d0, 45000.0d0, 8.0d0, 1.e20, 8.5d0/ data tab91j/ & 20000.0d0, 6.0d0, 79120.0d0, 8.0d0, 1.e20, 8.5d0/ data tab91h/ & 16800.0d0, 6.0d0, 67390.0d0, 8.0d0, 1.e20, 8.5d0/ data tabs/ & 0.0d0, 6.0d0, 0.0d0, 8.0d0, 1.e20, 8.5d0/ data tabj/ & 0.0d0, 6.0d0, 0.0d0, 8.0d0, 1.e20, 8.5d0/ data tabh/ & 0.0d0, 6.0d0, 0.0d0, 8.0d0, 1.e20, 8.5d0/ data tab99s/ & 17250.0d0, 5.5d0, 56680.0d0, 7.25d0, 1.e20, 8.0d0/ data tab99j/ & 25220.0d0, 5.5d0,100200.0d0, 7.25d0, 1.e20, 8.0d0/ data tab99h/ & 21240.0d0, 5.5d0, 85350.0d0, 7.25d0, 1.e20, 8.0d0/ data tab00s/ & 17570.0d0, 5.35d0, 57710.0d0, 7.05d0, 1.e20, 7.85d0/ data tab00h/ & 21630.0d0, 5.35d0, 86910.0d0, 7.05d0, 1.e20, 7.85d0/ data tab00j/ & 25680.0d0, 5.35d0, 102030.0d0, 7.05d0, 1.e20, 7.85d0/ c 2013: a new income tax rate of 9.85% data tab13s/ & 24210.0d0, 5.35d0, 79730.0d0, 7.05d0,150000.0d0, 7.85d0, & 1.e20, 9.85d0/ data tab13h/ & 29880.0d0, 5.35d0, 120070.0d0, 7.05d0,200000.0d0, 7.85d0, & 1.e20, 9.85d0/ data tab13j/ & 35480.0d0, 5.35d0, 140960.0d0, 7.05d0,250000.0d0, 7.85d0, & 1.e20, 9.85d0/ c regular tax. until 1985 a single schedule with separate c accounting for husbands and wives. in 1985 joint filing is c established and the federal income tax deduction is made c optional. c c top brackets vary from year to year before 1985 c if(law.eq.1977) then do 10 i=12,13 tab77(2,i)=15.0 10 continue else if(law.eq.1978.or.law.eq.1979) then tab77(2,12)=16.0 tab77(2,13)=17.0 else if(law.ge.1980.and.law.le.1984) then do 20 i=12,13 tab77(2,i)=16.0 20 continue endif sep = data(3) if(mst.eq.1.or.mst.eq.3.or.mst.eq.6)filer=1 if(mst.eq.2.or.mst.eq.5)filer=2 if(mst.eq.4.or.mst.eq.7)filer=3 if(law.le.1984) then call look(tab77,taxinc,13,n,statax,aif(law),0.0d0,rt,data) rate=rt else if(law.eq.1985.or.law.eq.1986) then txinca=taxinc txincb=max(0.0d0,taxinc-fedtax) c1=aif(law) if(filer.eq.1.or.filer.eq.3) then call look(tb85as,txinca,11,n,taxa,c1,0.0d0,rta,data) call look(tb85bs,txincb,11,n,taxb,c1,0.0d0,rtb,data) else if(filer.eq.2) then call look(tb85am,txinca,9,n,taxa,c1,0.0d0,rta,data) call look(tb85bm,txincb,16,n,taxb,c1,0.0d0,rtb,data) endif if(taxa.lt.taxb) then taxinc=txinca statax=taxa rate=rta else taxinc=txincb statax=taxb rate=rtb endif else if(law.eq.1987) then if(filer.eq.1) & call look(tab87s,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) if(filer.eq.2) & call look(tab87j,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) if(filer.eq.3) & call look(tab87h,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) rate=rt else if(law.ge.1988.and.law.le.1990) then if(filer.eq.1) & call look(tab88s,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) if(filer.eq.2) & call look(tab88j,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) if(filer.eq.3) & call look(tab88h,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) rate=rt else if(law.ge.1991.and.law.le.1998) then do 30 i=1,2 tabs(1,i)=aif(law)*tab91s(1,i) tabj(1,i)=aif(law)*tab91j(1,i) tabh(1,i)=aif(law)*tab91h(1,i) 30 continue if(filer.eq.1) & call look(tabs,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) if(filer.eq.2) & call look(tabj,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) if(filer.eq.3) & call look(tabh,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) rate=rt else if(law.eq.1999) then if(mst.eq.1) & call look(tab99s,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.2.or.sep.eq.2) then taxy = taxinc*sep call look(tab99j,taxy,3,n,statax,1.0d00,0.0d0,rt,data) statax = statax/sep endif if(mst.eq.4.or.mst.eq.7) & call look(tab99h,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) rate=rt else if(law.ge.2000.and.law.le.2012) then if(mst.eq.1) & call look(tab00s,taxinc,3,n,statax,aif00(law),0.0d0,rt,data) if(mst.eq.2.or.sep.eq.2) then taxy = taxinc*sep call look(tab00j,taxy,3,n,statax,aif00(law),0.0d0,rt,data) statax = statax/sep endif if(mst.eq.4.or.mst.eq.7) & call look(tab00h,taxinc,3,n,statax,aif00(law),0.0d0,rt,data) rate=rt else if(law.ge.2013) then if(mst.eq.1) & call look(tab13s,taxinc,4,n,statax,aif13(law),0.0d0,rt,data) if(filer.eq.2.or.sep.eq.2) then taxy = taxinc*sep call look(tab13j,taxy,4,n,statax,aif13(law),0.0d0,rt,data) statax = statax/sep endif if(filer.eq.3) & call look(tab13h,taxinc,4,n,statax,aif13(law),0.0d0,rt,data) rate=rt endif if(law.le.1983) statax=statax*surtax(law) return end c MISSISSIPPI c state 25 c c Updated through 2016 subroutine mstax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common/times/zitem,ptax,txrate,h dimension data(255),comnew(255) dimension xmp(1977:2016,2),old(1977:2016),dep(1977:2016) dimension aif92(1991:2012),aif13(2013:2017) dimension tab77(2,2),tab83(2,3) integer sep data aif92/ & 1.0d0, 1.0525d0, 1.0845d0, 1.118d0 , 1.147d0 , 1.1795d0, & 1.212d0, 1.2450d0, 1.2660d0, 1.2895d0, 1.3295d0, 1.3730d0, & 1.395d0, 1.4270d0, 1.4595d0, 1.5050d0, 1.5640d0, 1.5995d0, & 1.668d0,2*1.6955d0, 1.7365d0/ data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ data xmp/ & 2* 4500.0d0,2*5250.0d0,36*6000.0d0, & 2* 6500.0d0,2*8000.0d0,17*9500.0d0,10000.0d0,11000.0d0, & 17*12000.0d0/ data old/ & 2*750.0d0, 38*1500.0d0/ data dep/ & 2*750.0d0, 38*1500.0d0/ data tab77/ & 5000.0d0, 3.0d0, 1.e20, 4.0d0/ data tab83/ & 5000.0d0, 3.0d0,10000.0d0, 4.0d0,1.e20, 5.0d0/ rt=0. sep = data(3) mst = data(2) phas92=100000./data(3) if(law.ge.1992.and.law.le.2012) & phas92=100000.*aif92(law)/data(3) if(law.ge.2013) & phas92 = aif13(law)*250000*filing(mst,1.,1.2,1.1,.6) c AGI halfse =.5*data(43) if(law.eq.2011.or.law.eq.2012) then c 2011 and 2012 have 5.65% instead of 7.65% if(data(43).le.14204.) then halfse = .5751*data(43) else halfse = .5*data(43) + 1067 endif endif agi=comnew(2)+divexc(data,comnew,law)+ halfse c Generally, retirement income, pensions, annuities are not subject to MS Income tax c if recipient has met the retirement plan requirements. c Early distributions are not considered retirement income and may be subject to tax. retiry = 0. if(data(9).gt.0) retiry = data(20) + data(72) c retiry = data(20) + data(72) if(law.le.1978) retiry = retiry + comnew(84) if(law.le.1989) then agi=agi-min(retiry,5000.*data(7)) else if(law.ge.1990.and.law.le.1993) then agi=agi-min(retiry,6000.*data(7)) else if(law.ge.1994) then agi=agi-retiry endif if(law.le.1978) agi=agi+data(62)-data(23)+data(26) if(law.le.1979) agi=agi+comnew(12)+comnew(14)+data(30) agi = agi - data(22) if(law.ge.1982.and.law.le.1986) agi=agi+comnew(32) c SS benefits and pensions are not taxable in MS if(law.ge.1984)agi=agi-comnew(79) c Exemptions if(mst.ne.1) then exemp = (xmp(law,2))/data(3) if(mst.eq.4.or.mst.eq.7)exemp = 8000. else exemp = xmp(law,1) endif exemp = exemp+(data(8)*dep(law))+((data(9)+data(10))*old(law)) c Standard deduction txp = data(7) if(law.le.1978)stded = min(750.*txp,.15*max(0.0d0,agi)) if(law.eq.1979)stded = min(1500.*txp,.15*max(0.0d0,agi)) if(law.ge.1980)then stded = 2300. if(mst.ne.1) stded = 3400./data(3) if(law.eq.1998.and.(mst.eq.2.or.sep.eq.2)) & stded = 4200./data(3) if(law.ge.1999.and.(mst.eq.2.or.sep.eq.2)) & stded = 4600./data(3) endif c Itemized Deduction c State Income Taxes have not been deductible on MS itemized deductions Sched c since 1992 if(law.lt.1991) then xitded = comnew(30) else xitded = max(0.d0,comnew(30)-data(50)) if(agi.gt.phas92.and.comnew(30).gt.0) & xitded = max(0.d0,comnew(30)-comnew(34) - & (data(50) - data(50)*comnew(34)/comnew(30))) endif if(law.le.1978) then taxded = data(55)+data(52) contri = data(58)+data(59)+data(60)-(.2*max(0.0d0,agi)) edical = comnew(20)-max(data(47)+data(48)+data(49)-2000.,0.0d0) xitded = max(0.d0,xitded-taxded-contri-edical) endif c Tax Calculation ided = data(4) if(ided.eq.-2.and.law.eq.1999) xitded=0 deduc=max(stded,xitded) taxinc=max(agi-deduc-exemp,0.0d0) if(law.le.1982) &call look(tab77,taxinc,2,n,statax,1.0d00,0.0d0,rt,data) if(law.eq.1983) &call look(tab83,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) if(law.ge.1984) &call look(tab83,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.2.and.agi.gt.0) then c for separate returns , filed combined agih = min(agi,max(data(85),data(86)) + (agi-data(11))/2.) agiw = agi - agih exemph=exemp*agih/agi exempw=exemp-exemph taxyh1 = max(agih-exemph,0.0d0) taxyw1 = max(agiw-exempw,0.0d0) deducw = min(taxyw1,deduc*agiw/agi) deduch = deduc-deducw taxyh=max(0.0d0,taxyh1-deduch) taxyw=max(0.0d0,taxyw1-deducw) if(law.le.1982) then call look2(tab77,taxyh,2,n,taxh,1.0d00,0.0d0,rt,data) call look2(tab77,taxyw,2,n,taxw,1.0d00,0.0d0,rt,data) else if(law.eq.1983) then call look2(tab83,taxyh,3,n,taxh,1.0d00,0.0d0,rt,data) call look2(tab83,taxyw,3,n,taxw,1.0d00,0.0d0,rt,data) else if(law.ge.1984) then call look2(tab83,taxyh,3,n,taxh,1.0d00,0.0d0,rt,data) call look2(tab83,taxyw,3,n,taxw,1.0d00,0.0d0,rt,data) endif statax = min(statax,taxh+taxw) endif return end c MISSOURI c State 26 c c Status: Updated through 2016 subroutine motax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ &hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common/times/zitem,ptax,txrate,h dimension data(255), comnew(255) dimension aif92(1991:2012),aif13(2013:2017) dimension ymax(1977:2016),pmax(1977:2016),ss(1977:2016), & addm (1977:2016),perc(2007:2016),ssmax(2007:2016) double precision motab (2,10),magi integer sep data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ data perc/.2d0,.35d0,.5d0,.65d0,.8d0, 5*1.0d0/ data ssmax/ 32500.d0,3*33703.d0,34141.d0,35234.d0, & 35939.d0,36442.d0,2*36976.d0/ data aif92/ & 1.0d0, 1.0525d0, 1.0845d0, 1.118d0, 1.147d0 , & 1.17950d0, 1.2120d0, 1.2450d0, 1.266d0, 1.2895d0, & 1.32950d0, 1.3730d0, 1.3950d0, 1.427d0, 1.4595d0, & 1.5050d0 , 1.5640d0, 1.5995d0, 1.668d0,2*1.6955d0, & 1.7365d0/ data motab / 1000.0d0, 1.50d0, 2000.0d0, 2.0d0 , 3000.0d0, & 2.50d0, 4000.0d0, 3.0d0, 5000.0d0, 3.50d0, 6000.0d0, 4.0d0, & 7000.0d0, 4.50d0, 8000.0d0, 5.0d0, 9000.0d0, 5.50d0, & 1.e20, 6.0d0/ data ss/ & 965.0d0, 1071.0d0, 1404.0d0, 1588.0d0, 1975.0d0, & 2170.0d0, 2391.0d0, 2533.0d0, 2791.0d0, 3003.0d0, & 3132.0d0, 3380.0d0, 3605.0d0, 3925.0d0, 5123.0d0, & 3411.0d0, 3571.0d0, 3757.0d0, 3794.0d0, 3887.0d0, & 4055.0d0, 4241.0d0, 4501.0d0, 4724.0d0, 4985.0d0, & 5264.0d0, 5394.0d0, 5450.0d0, 5580.0d0, 5840.0d0, & 6000.0d0, 6324.0d0,2*6621.6d0, 7575.0d0, 7818.0d0, & 10758.0d0,11082.0d0,2*11669.0d0/ data addm/ 12*500.0d0, 28*2000.0d0/ data ymax/ & 5*8500.0d0, 2*10000.0d0, 11000.0d0, 11500.0d0, & 12000.0d0, 12500.0d0, 13000.0d0, 13500.0d0, & 14000.0d0, 14500.0d0,6*15000.0d0,10*25000.0d0, & 9*27500.0d0/ data pmax/ & 8*500.0d0, 32*750.0d0/ mst=data(2) sep=data(3) rt=0. phas92=100000./sep if(law.ge.1992.and.law.le.2012) & phas92=100000.*aif92(law)/sep if(law.ge.2013) & phas92 = aif13(law)*250000*filing(mst,1.,1.2,1.1,.6) c AGI c almost exactly federal definition of agi agi=comnew(2)-data(22) c Exemptions ns=1 if(mst.eq.2.or.mst.eq.3.or.mst.eq.6)ns=2 if(mst.eq.5.and.data(8).ge.1)ns=3 if(mst.eq.4.or.mst.eq.7)ns=4 exemp=0. if(ns.eq.1.or.ns.eq.2) then if(law.le.1997) then exemp=data(7)*1200. + data(8)*400. else if(law.eq.1998) then exemp=data(7)*1200. + data(8)*1200. else if(law.ge.1999) then exemp=data(7)*2100. + data(8)*1200. endif elseif(ns.eq.3.or.ns.eq.4) then if(law.le.1997) then exemp=2000. + (data(8)*400.) else if(law.eq.1998) then exemp=2000. + data(8)*1200. else if(law.ge.1999) then exemp=3500. + data(8)*1200. endif endif c 2007+ Social Security Exemption phase = 85000. if(mst.eq.2) phase = 100000. if(law.ge.2007.and.comnew(79).gt.0) then excess = max(0.0d0,agi - phase) ssaxmp = max(0.0d0,perc(law)*comnew(79) - excess) exemp = exemp + ssaxmp endif slim = 25000. if(mst.eq.2.or.mst.eq.5.or.mst.eq.3.or.mst.eq.6) & slim = 32000./sep c pension exemp if gov not private pension:assume it is public scred = 0. if(law.ge.1990.and.data(9).gt.0)then magi=agi-comnew(79) c MO AGI less federal taxable SSB and less a phaseout exc = max(0.0d0,magi-phase) c non-taxable ssb ssbnt = data(91)-comnew(79) c Taxable pensions from public sources pension = data(20)+data(72) if(law.le.1998) then c we don't know the proportion for splitting pension income b/w h.& w. c if(magi.le.slim)scred=min(1000.*data(7),pension) if(magi.le.slim)scred=min(1000.d0,pension) else if(law.ge.1999.and.law.le.2006) then if(magi - slim.le.6000.*data(7)) scred=min(6000.d0,pension) else if(law.ge.2007) then if(law.le.2008) then c years 2007 - 2008 xlin9 = min(perc(law)*pension,ssmax(law)) xlin10 = max(0.0d0,xlin9 - ssbnt) xlin11 = min(6000.0d0,pension) xlin12 = max(xlin10,xlin11) scred = max(0.0d0,xlin12 - exc) else if (law.ge.2009.and.law.le.2013) then c years 2009-2013 xlin8 = min(ssmax(law),perc(law)*pension) xlin9 = min(6000.d0,pension) xlin10 = max(xlin8,xlin9) xlin12 = max(0.d0,xlin10 - ssaxmp) scred = max(0.d0,xlin12 - exc) else c years 2014 + xlin7 = min(ssmax(law),pension) xlin9 = max(0.d0,xlin7 - ssaxmp) scred = max(0.d0,xlin9 - exc) endif endif exemp=exemp+scred endif c Standard Deduction stded=comnew(3) c Itemized Deductions if(comnew(26).gt.0.) then c Fica is a deduction for MO xitded=max(0.d0, & comnew(30)+min(socsec(data,law),ss(law)*data(7))-data(50)) c Self-employment tax septx=.5*data(43) if(law.eq.1993)septx=min(11058.*data(7),data(43)) if(law.eq.2011.or.law.eq.2012) then c 2011&2012 has 5.65% instead of 7.65% if(data(43).le.14204.) then septx = .5751*data(43) else septx = .5*data(43) + 1067 endif endif xitded = max(0.d0,xitded - septx) c State Tax Declaration Phaseout stax= data(50) if(law.ge.1993) then xlin4=max(0.0d0,data(49)-.075*comnew(2)) xlin8=data(50)+data(51)+data(46) xlin11=data(53) xlin12=data(56)+data(53)+data(57) xlin16=data(58)+data(59)+data(60) ag = max(0.0d0,comnew(2)) xlin17=max(0.0d0,data(61)-.1*ag) xlin18=data(26) xlin24=max(data(27)+data(63)-.02*ag,0.0d0) xlin25=data(66) xtot=xlin4+xlin8+xlin12+xlin16+xlin17+xlin18+xlin24+ & xlin25 xdiff=xtot-xlin4-xlin11-xlin17 if(xdiff.gt.0.) then xdiff2=comnew(2)-phas92 if(xdiff2.gt.0.) then xconst=min(.8*xdiff,.03*xdiff2) xlin26=xtot-xconst xprop=(xdiff-(xtot-xlin26))/xdiff stax=xprop*stax endif endif endif xitded=max(0.d0,xitded - comnew(34) + (data(50)-stax)) ided = data(4) if(law.eq.1999.and.ided.eq.-2) xitded=0 deduc=max(stded,xitded) else deduc = stded endif c extra federal tax deductions for non- and itemezers c subtract other taxes because they are included in comnew(1); c don't want to double count for itemizers fedtax=max(0.0d0,comnew(52)-comnew(53)-comnew(54)-data(34)- & comnew(59)-comnew(81)-comnew(94)) if(law.ge.1994)fedtax=min(fedtax,5000*data(7)) deduc=deduc+fedtax taxinc=max(0.0d0,agi-deduc-exemp) call look(motab,taxinc,10,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.2) then c for separate returns, filed combined agih = max(data(85),data(86)) + (agi-data(11))/2. agiw = agi-agih if(agi.gt.0) then taxyh = taxinc*agih/agi taxyw = taxinc*agiw/agi call look2(motab,taxyh,10,n,taxh,1.0d00,0.0d0,rt,data) call look2(motab,taxyw,10,n,taxw,1.0d00,0.0d0,rt,data) statax= min(statax,taxh+taxw) endif endif if(taxinc.lt.100) statax = 0. c Property tax credit pcred=0. ded = 0. hy1=data(159) c married people have preferences if(mst.eq.2) then if(law.le.2007) hy1 = max(0.0d0,hy1-addm(law)) if(law.ge.2008.and.data(51).gt.0.) hy1 = max(0.0d0,hy1-4000.) if(law.ge.2008.and.data(160).gt.0.)hy1 = max(0.0d0,hy1-addm(law)) endif if(law.le.1997) then number = 45 base = 4300. elseif(law.ge.1998.and.law.le.2007) then number = 40 base = 13000. else if(law.ge.2008) then number = 45 base = 14300. endif if(law.ge.2008.and.data(51).gt.0.) then c owners have preferences since 2008 ymax(law) = 30000. pmax(law) = 1100. number = 54 endif c ptax=min(data(51)+.2*data(160),pmax(law)) if(data(9).gt.0..and.hy1.lt.ymax(law).and.ptax.gt.0) then if(hy1.le.base) then pcred = pmax(law) else do 70 i=1,number if(law.ge.1998) then base = base + 300 else base = base + 200 endif if(i.eq.number) base = ymax(law) if(base.le.hy1) then ded = hy1 * .0625*(i+1)/100 pcred = max(0.0d0,pmax(law) - ded) endif 70 continue endif endif if(law.le.1978) pcred=min(pcred,statax) credit = pcred c changed for new accounting of prop tax statax = statax-credit return end c MONTANA c State 27 c Updated through 2016 subroutine mttax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common/times/zitem,ptax,txrate,h dimension data(255),comnew(255),ptab(2,6) dimension aif(1977:2004),xmp(1977:2016),surtax(1977:2016),ccr(3) dimension tab(2,10),st(1977:2016) dimension tabs(9,1990:2004) dimension tab05(2,7),tab06(2,7),tab07(2,7),tab08(2,7),tab09(2,7) & ,tab10(2,7),tab11(2,7),tab12(2,7),tab13(2,7),tab14(2,7), & tab16(2,7) &,aifret(2010:2016) dimension aif92(1991:2012),tabred(2,12),aif13(2013:2017) double precision minst(1996:2016) integer sep data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ data aifret/ & 1.01111d0, 1.04444d0, 1.06388889d0, 1.083d0,2*1.106d0, & 1.1306d0/ data tabred / & 1999.d0, 0.d0 , 2999.d0, .006d0, 3999.d0, .016d0, & 4999.d0, .024d0, 5999.d0, .028d0, 6999.d0, .032d0, & 7999.d0, .035d0, 8999.d0, .039d0, 9999.d0, .042d0, & 10999.d0, .045d0, 11999.d0, .048d0, 1.e20, .05d0/ data tab05 / & 2300.0d0, 1.0d0, 4100.0d0, 2.0d0, 6200.0d0, 3.0d0, & 8400.0d0, 4.0d0, 10800.0d0, 5.0d0,13900.0d0, 6.0d0, & 1.e20, 6.9d0/ data tab06 / & 2400.0d0, 1.0d0, 4300.0d0, 2.0d0, 6500.0d0, 3.0d0, & 8800.0d0, 4.0d0, 11300.0d0, 5.0d0,14600.0d0, 6.0d0, & 1.e20, 6.9d0/ data tab07 / & 2500.0d0, 1.0d0, 4400.0d0, 2.0d0, 6600.0d0, 3.0d0, & 9000.0d0, 4.0d0, 11600.0d0, 5.0d0,14900.0d0, 6.0d0, & 1.e20, 6.9d0/ data tab08 / & 2600.0d0, 1.0d0, 4600.0d0, 2.0d0, 7000.0d0, 3.0d0, & 9500.0d0, 4.0d0, 12200.0d0, 5.0d0,15600.0d0, 6.0d0, & 1.e20, 6.9d0/ data tab09 / & 2600.0d0, 1.0d0, 4500.0d0, 2.0d0, 6900.0d0, 3.0d0, & 9300.0d0, 4.0d0, 12000.0d0, 5.0d0,15400.0d0, 6.0d0, & 1.e20, 6.9d0/ data tab10 / & 2600.0d0, 1.0d0, 4600.0d0, 2.0d0, 6900.0d0, 3.0d0, & 9400.0d0, 4.0d0, 12100.0d0, 5.0d0,15600.0d0, 6.0d0, & 1.e20, 6.9d0/ data tab11 / & 2700.0d0, 1.0d0, 4700.0d0, 2.0d0, 7200.0d0, 3.0d0, & 9700.0d0, 4.0d0, 12500.0d0, 5.0d0,16000.0d0, 6.0d0, & 1.e20, 6.9d0/ data tab12 / & 2700.0d0, 1.0d0, 4800.0d0, 2.0d0, 7300.0d0, 3.0d0, & 9900.0d0, 4.0d0, 12700.0d0, 5.0d0,16400.0d0, 6.0d0, & 1.e20, 6.9d0/ data tab13 / & 2800.0d0, 1.0d0, 4900.0d0, 2.0d0, 7400.0d0, 3.0d0, & 10100.0d0, 4.0d0, 13000.0d0, 5.0d0,16700.0d0, 6.0d0, & 1.e20, 6.9d0/ data tab14 / & 2800.0d0, 1.0d0, 5000.0d0, 2.0d0, 7600.0d0, 3.0d0, & 10300.0d0, 4.0d0, 13300.0d0, 5.0d0,17100.0d0, 6.0d0, & 1.e20, 6.9d0/ data tab16 / & 2900.0d0, 1.0d0, 5100.0d0, 2.0d0, 7800.0d0, 3.0d0, & 10500.0d0, 4.0d0, 13500.0d0, 5.0d0,17400.0d0, 6.0d0, & 1.e20, 6.9d0/ data aif92/ & 1.0d0, 1.0525d0, 1.0845d0, 1.118d0 , 1.147d0 , 1.1795d0, & 1.212d0, 1.2450d0, 1.2660d0, 1.2895d0, 1.3295d0, 1.3730d0, & 1.395d0, 1.4270d0, 1.4595d0, 1.5050d0, 1.5640d0, 1.5995d0, & 1.668d0,2*1.6955d0, 1.7365d0/ data tab / & 1000.0d0, 2.0d0, 2000.0d0, 3.0d0, 4000.0d0, 4.0d0, & 6000.0d0, 5.0d0, 8000.0d0, 6.0d0,10000.0d0, 7.0d0, & 14000.0d0, 8.0d0, 20000.0d0, 9.0d0,35000.0d0, 10.0d0, & 1.e20, 11.0d0/ data tabs/ & 1600.0d0, 3100.0d0, 6300.0d0, 9400.0d0, 12600.0d0, & 15700.0d0, 22000.0d0, 31400.0d0, 55000.0d0, & 1600.0d0, 3300.0d0, 6600.0d0, 9900.0d0, 13200.0d0, & 16400.0d0, 23000.0d0, 32900.0d0, 57600.0d0, & 1700.0d0, 3400.0d0, 6800.0d0, 10200.0d0, 13600.0d0, & 17000.0d0, 23700.0d0, 33900.0d0, 59400.0d0, & 1700.0d0, 3500.0d0, 7000.0d0, 10500.0d0, 14000.0d0, & 17500.0d0, 24400.0d0, 34900.0d0, 61100.0d0, & 1800.0d0, 3600.0d0, 7200.0d0, 10700.0d0, 14300.0d0, & 17900.0d0, 25100.0d0, 35800.0d0, 62700.0d0, & 1800.0d0, 3700.0d0, 7400.0d0, 11100.0d0, 14800.0d0, & 18400.0d0, 25800.0d0, 36900.0d0, 64600.0d0, & 1900.0d0, 3800.0d0, 7600.0d0, 11400.0d0, 15200.0d0, & 19000.0d0, 26500.0d0, 37900.0d0, 66400.0d0, & 1900.0d0, 3900.0d0, 7800.0d0, 11600.0d0, 15500.0d0, & 19400.0d0, 27200.0d0, 38800.0d0, 67900.0d0, & 2000.0d0, 3900.0d0, 7900.0d0, 11800.0d0, 15800.0d0, & 19700.0d0, 27600.0d0, 39400.0d0, 69000.0d0, & 2000.0d0, 4000.0d0, 8000.0d0, 12100.0d0, 16100.0d0, & 20100.0d0, 28200.0d0, 40200.0d0, 70400.0d0, & 2100.0d0, 4200.0d0, 8300.0d0, 12500.0d0, 16700.0d0, & 20800.0d0, 29200.0d0, 41700.0d0, 73000.0d0, & 2200.0d0, 4300.0d0, 8600.0d0, 12900.0d0, 17200.0d0, & 21500.0d0, 30200.0d0, 43100.0d0, 75400.0d0, & 2200.0d0, 4400.0d0, 8700.0d0, 13100.0d0, 17400.0d0, & 21800.0d0, 30500.0d0, 43500.0d0, 76200.0d0, & 2200.0d0, 4400.0d0, 8900.0d0, 13300.0d0, 17800.0d0, & 22200.0d0, 31100.0d0, 44500.0d0, 77800.0d0, & 2300.0d0, 4600.0d0, 9200.0d0, 13800.0d0, 18400.0d0, & 22900.0d0, 32100.0d0, 45900.0d0, 80300.0d0/ data xmp/ & 2*650.0d0, 1050.0d0, 1250.0d0, 752.0d0, 940.0d0, & 960.0d0, 1000.0d0, 1040.0d0, 1060.0d0, 1100.0d0, & 1140.0d0, 1200.0d0, 1260.0d0, 1320.0d0, 1360.0d0, & 1400.0d0, 1430.0d0, 1480.0d0, 1520.0d0, 1550.0d0, & 1580.0d0, 1610.0d0, 1670.0d0, 1720.0d0, 1740.0d0, & 1780.0d0, 1840.0d0, 1900.0d0, 1980.0d0, 2040.0d0, & 2140.0d0, 2110.0d0, 2130.0d0, 2190.0d0, 2240.0d0, & 2280.0d0,2*2330.0d0, 2380.0d0/ data st/ & 2*500.0d0,2*1000.0d0, 1640.0d0, 1760.0d0, 1800.0d0, & 1880.0d0, 1950.0d0, 1990.0d0, 2060.0d0, 2140.0d0, & 2250.0d0, 2360.0d0, 2470.0d0, 2540.0d0, 2620.0d0, & 2770.0d0, 2840.0d0, 2910.0d0, 2960.0d0, 3020.0d0, & 3130.0d0, 3230.0d0, 3260.0d0, 3330.0d0, 3440.0d0, & 3560.0d0, 3710.0d0, 3810.0d0, 4010.0d0, 3950.0d0, & 3990.0d0,2*4110.0d0, 4200.0d0, 4270.0d0,2*4370.0d0, & 4460.0d0/ data minst/ & 2*1260.0d0, 1310.0d0, 1340.0d0, 1390.0d0, 1430.0d0, & 1450.0d0, 1480.0d0, 1530.0d0, 1580.0d0, 1650.0d0, & 1690.0d0, 1780.0d0, 1750.0d0, 1770.0d0, 1820.0d0, & 1860.0d0, 1900.0d0,2*1940.0d0,1980.0d0/ data ptab/ & 35000.d0, 1.d0, 37500.d0, .4d0, 40000.d0, .3d0, & 42500.d0, .2d0, 44999.d0, .1d0, 1.e20,0.d0/ data aif/ & 4*1.0d0, 1.1d0 , 1.17d0, 1.2d0, 1.25d0, 2*1.3d0, & 1.37d0, 1.43d0, 1.50d0, 15*1.0d0/ data surtax/ & 4*1.1d0, 6*1.0d0 , 2*1.1d0, 1.0d0,1.05d0,1.0d0, & 1.023d0, 1.047d0,23*1.0d0/ data ccr/2400.0d0,3600.0d0,4800.0d0/ c indexing covers brackets,exemptions and standard deduction. rt=0. mst=data(2) sep=data(3) phas92=100000./sep if(law.ge.1992.and.law.le.2012) & phas92=100000.*aif92(law)/sep if(law.ge.2013) & phas92 = aif13(law)*250000*filing(mst,1.,1.2,1.1,.6) c AGI agi = comnew(2) c Reductions of Income c State refund agi = agi-data(22) c Reduction of Income : 40% of capital gains(an installment sale(s) only) if(law.ge.1987.and.law.le.2002) agi = agi-.4*max(.0d0,comnew(6)) c Adjustments decreasing income c each taxpayer can deduct up to r360 of annuity, pension and so on. if(law.ge.1981.and.law.le.1986)agi=agi-min(360.0d0,data(72)) c For aged people there is an exclusion up to $800 of interest income excint = 0. if(law.ge.1981) excint=min(data(14),800*data(9)) agi = agi - excint c Exempt Retirement Income c The 1991 legislature changed the taxability of all retirement income if(law.ge.1991.and.data(9).gt.0) then retexc = 0. retmax = min(3600.0d0,data(20)+data(72)) agiret = 30000. delta = 1800*data(7) if(law.ge.2010) then retmax = min(3600*data(9)*aifret(law),data(20)+data(72)) delta = delta * aifret(law) agiret = agiret * aifret(law) endif if(comnew(2).lt.agiret + delta) then if(comnew(2).lt.agiret) then retexc = retmax else retexc = max(0.0d0,retmax-2*(comnew(2) - agiret)) endif endif agi = max(0.0d0,agi - retexc) endif c Unemployment benefits are not taxable to Montana if(law.ge.1984)agi = agi-data(82) c Additions to Income c Filing separately returns can't claim the marriage deduction. c So this federal deduction becomes an addition to the Montana AGI if(law.ge.1983.and.law.le.1986.and.sep.eq.2) agi = agi+comnew(32) c Capital Loss for filing separately if(law.ge.1984.and.sep.eq.2.and.comnew(5).lt.0.) then caplss = max(-1500.,comnew(5)) agi = agi + caplss endif c social security benefits are taxed on a different agi base ssagi=0. ssb = data(91) if(law.ge.1984.and.ssb.gt.0) then ssbase = .5*ssb + comnew(65) xlin6 = comnew(17)+data(82)+data(22) if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then ssexcl=25000. xlin10 = 9000. else ssexcl = 32000/sep xlin10 = 12000/sep endif if(mst.ne.2) then xlin7 = max(0.0d0,ssbase - xlin6) xlin9 = max(0.0d0,xlin7 - ssexcl) xlin11 = max(0.0d0,xlin9 - xlin10) xlin12 = min(xlin9, xlin10) xlin13 = .5*xlin12 xlin14 = min(.5*ssb,xlin13) xlin15 = .85*xlin11 xlin16 = xlin14+xlin15 xlin17 = .85*ssb ssagi = min(xlin16,xlin17) else ssbaseh = .25*ssb+ data(85) + (comnew(65)-data(11))/2 ssbasew = ssbase - ssbaseh xlh7 = max(.0d0,ssbaseh - xlin6/2) xlw7 = max(.0d0,ssbasew - xlin6/2) xlh9 = max(.0d0,xlh7 - ssexcl/2) xlw9 = max(.0d0,xlw7 - ssexcl/2) xlh11 = max(.0d0,xlh9 - xlin10/2) xlw11 = max(.0d0,xlw9 - xlin10/2) xlh12 = min(xlh9, xlin10/2) xlw12 = min(xlw9, xlin10/2) xlh13 = .5*xlh12 xlw13 = .5*xlw12 xlh14 = min(.25*ssb,xlh13) xlw14 = min(.25*ssb,xlw13) xlh15 = .85*xlh11 xlw15 = .85*xlw11 xlh16 = xlh14+xlh15 xlw16 = xlw14+xlw15 ssagih = min(xlh16,.85*ssb/2) ssagiw = min(xlw16,.85*ssb/2) ssagi = ssagih + ssagiw endif endif agi=agi-comnew(79)+ssagi c Standard Deduction c indexed to inflation, but not in the same way as the brackets txp = data(7) if(mst.eq.4.or.mst.eq.7) txp = 2 if(law.le.1978) stded = min(500.*txp,.1*max(.0d0,agi)) if(law.eq.1979.or.law.eq.1980) & stded=min(1000.*txp,.15*max(.0d0,agi)) if(law.ge.1981) stded = min(st(law)*txp,.2*max(.0d0,agi)) if(law.ge.1996) stded = max(minst(law)*txp,stded) c Itemized Deduction xitded=max(0.d0,comnew(30)-data(50)) if(law.le.2004) then xitded=xitded+max(.0d0,comnew(1)) else c 2005+ - Federal Income Tax Deduction Limitation if(law.ne.2008) & xitded=xitded+min(5000.*data(7),max(0.0d0,comnew(1))) c 2008 is different because of Federal Economic Stimulus Package if(law.eq.2008) & xitded=xitded+min(5000.*data(7), & max(0.0d0,comnew(1)-600*data(7)-300*data(8))) endif if(agi.gt.phas92.and.law.ge.1991) then xitemp = comnew(30)-data(50) reduce = min(.8*xitemp,.03*(agi-phas92)) if(law.eq.2006.or.law.eq.2007) reduce = 2*reduce/3 if(law.eq.2008.or.law.eq.2009) reduce = reduce/3 if(law.eq.2010) reduce = 0 xitded = xitded-reduce endif c child care expense goes under itemized deduction ich=0 chexp=0. if(data(8).gt.0) then ich=twn(0.+data(8),1.0d0,3.0d0) chexp=min(data(64),ccr(ich)) chexp=max(0.0d0,chexp-.5*max(0.0d0,agi-18000.)) endif xitded=xitded+chexp ided = data(4) if(ided.eq.-2.and.law.eq.1999) xitded=0 deduc=max(stded,xitded) c Tax Calculation c blindness and age exemptions apply to all years exemp=(data(7)+data(8)+data(9)+data(10))*xmp(law) taxinc=max(0.0d0,agi-deduc-exemp) if(law.ge.1990.and.law.le.2004) then do 1000 i=1,9 1000 tab(1,i)=tabs(i,law) endif if(law.le.2004) then call look(tab,taxinc,10,n,statax,aif(law),0.0d0,rt,data) else if (law.eq.2005) then call look(tab05,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if (law.eq.2006) then call look(tab06,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if (law.eq.2007) then call look(tab07,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if (law.eq.2008) then call look(tab08,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if (law.eq.2009) then call look(tab09,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if (law.eq.2010) then call look(tab10,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if (law.eq.2011) then call look(tab11,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if (law.eq.2012) then call look(tab12,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if (law.eq.2013) then call look(tab13,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if (law.ge.2014.and.law.le.2015) then call look(tab14,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if (law.ge.2016) then call look(tab16,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) endif if(mst.eq.2) then c for separate returns , filed combined c agih = max(data(85),data(86))+ (agi-ssagi-data(11))/2 + ssagih c agiw = agi-agih agih = max(data(85),data(86)) + (agi-data(11))/2. agiw = agi-agih stdedw = 0 stdedh = stded if(law.le.1978) then stdedh= min(500.0d0,.1*max(.0d0,agih)) stdedw= min(500.0d0,.1*max(.0d0,agiw)) else if(law.eq.1979.or.law.eq.1980) then stdedh=min(1000.0d0,.15*max(.0d0,agih)) stdedw=min(1000.0d0,.15*max(.0d0,agiw)) else if(law.ge.1981) then stdh = min(st(law),.2*max(.0d0,agih)) stdw = min(st(law),.2*max(.0d0,agiw)) if(law.ge.1996) then stdh = max(minst(law),stdh) stdw = max(minst(law),stdw) endif stded = stdh + stdw stdedh = stdh stdedw = stdw endif xitdh=0. xitdw=0. if(xitded.gt.0.and.agi.gt.0) then c xitdh= xitded*agih/agi c xitdw= xitded*agiw/agi xitdh= .5*xitded xitdw= .5*xitded endif dedh=stdedh dedw=stdedw if(xitded.gt.stded) then dedh=xitdh dedw=xitdw endif exempw=xmp(law) if(data(9).gt.0.0d0) exempw=2*xmp(law) exemph=exemp-exempw c if(agi.gt.0) then c exemph=exemp*agih/agi c exempw=exemp*agiw/agi c endif taxyh=max(0.0d0,agih-dedh-exemph) taxyw=max(0.0d0,agiw-dedw-exempw) if(law.le.2004) then call look2(tab,taxyh,10,n,taxh,aif(law),0.0d0,rt,data) call look2(tab,taxyw,10,n,taxw,aif(law),0.0d0,rt,data) else if (law.eq.2005) then call look2(tab05,taxyh,7,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab05,taxyw,7,n,taxw,1.0d0,0.0d0,rt,data) else if (law.eq.2006) then call look2(tab06,taxyh,7,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab06,taxyw,7,n,taxw,1.0d0,0.0d0,rt,data) else if (law.eq.2007) then call look2(tab07,taxyh,7,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab07,taxyw,7,n,taxw,1.0d0,0.0d0,rt,data) else if (law.eq.2008) then call look2(tab08,taxyh,7,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab08,taxyw,7,n,taxw,1.0d0,0.0d0,rt,data) else if (law.eq.2009) then call look2(tab09,taxyh,7,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab09,taxyw,7,n,taxw,1.0d0,0.0d0,rt,data) else if (law.eq.2010) then call look2(tab10,taxyh,7,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab10,taxyw,7,n,taxw,1.0d0,0.0d0,rt,data) else if (law.eq.2011) then call look2(tab11,taxyh,7,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab11,taxyw,7,n,taxw,1.0d0,0.0d0,rt,data) else if (law.eq.2012) then call look2(tab12,taxyh,7,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab12,taxyw,7,n,taxw,1.0d0,0.0d0,rt,data) else if (law.eq.2013) then call look2(tab13,taxyh,7,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab13,taxyw,7,n,taxw,1.0d0,0.0d0,rt,data) else if (law.ge.2014.and.law.le.2015) then call look2(tab14,taxyh,7,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab14,taxyw,7,n,taxw,1.0d0,0.0d0,rt,data) else if (law.ge.2016) then call look2(tab16,taxyh,7,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab16,taxyw,7,n,taxw,1.0d0,0.0d0,rt,data) endif statax=min(statax,taxh+taxw) endif statax=statax*surtax(law) c Credits c Elderly Homeowner/Renter Credit if(law.eq.1981) then ptax=max(data(51),.15*data(160)) else ptax=data(51)+.15*data(160) endif pcred=0. hy1 = 0. if(data(9).gt.0) then if(law.ge.1981.and.law.lt.1983) then pcred=min(max(ptax-hy*tablki(ptab,6,hy,data),0.0d0),150.0d0) elseif(law.ge.1983) then if(law.le.1997) then hy1 = max(0.d0,hy-4000.d0) else hy1 = max(0.d0,hy-6300.d0) endif c prc1 -- Household Income Reduction Table prc1 = tablki(tabred,12,hy1,data) hynet = prc1*hy1 if(law.le.1994) then pcred = min(400.d0,max(0.d0,ptax - hynet)) else pcred = min(1000.d0,max(0.d0,ptax - hynet)) c if hy>=35000,a person doesn't qualify for elderly/renter credit in 1998 if(law.eq.1998.and.hy.ge.35000) pcred = 0. c prc2 -- Credit Multiplier Table 1999+ prc2 = tablki(ptab,6,hy,data) c if hy>=45000,a person doesn't qualify for elderly/renter credit in 1999+ if(law.ge.1999) pcred = prc2*pcred endif endif endif c investment credit recapture if(law.le.1982)crinv=.2*data(33) if(law.ge.1983)crinv=.05*data(33) c energy credit ecred=data(38) c 2005+ - Capital Gains Credit non-refundable cgcred = 0. if(law.ge.2005.and.law.le.2006) cgcred = .01*max(0.0d0,comnew(6)) if(law.ge.2007) cgcred = .02*max(0.0d0,comnew(6)) c total non refundable credits credit=crinv+ecred+cgcred c Total tax after credits statax=max(0.0d0,statax-credit) c 2007 Homeowner Income Tax credit for Property Taxes (refundable) howcrd = 0. if(law.eq.2007.and.data(51).gt.0) howcrd = 140. c total credit credit = credit + pcred + howcrd c changed for new accounting of property tax credit c property tax credit is refundable statax = statax-pcred-howcrd c if(statax.lt.1.) statax=0. return end c State 28 c NEBRASKA c c Updated through 2016 subroutine netax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(100) dimension rate(1977:1986),cred(1977:2016) dimension xmp(1987:1992),arate(1977:2013) dimension tabs(2,4), tabm(2,4), tabh(2,4), tabj(2,4) dimension tab87s(2,4), tab87m(2,4), tab87h(2,4), tab87j(2,4) dimension tab89s(2,4), tab89m(2,4), tab89h(2,4), tab89j(2,4) dimension tab90s(2,4), tab90m(2,4), tab90h(2,4), tab90j(2,4) dimension tab91s(2,4), tab91m(2,4), tab91h(2,4), tab91j(2,4) dimension tab93s(2,4),tab93j(2,4),tab93h(2,4) dimension tab98s(2,4),tab98j(2,4),tab98h(2,4) dimension tab03s(2,4),tab03j(2,4),tab03h(2,4) dimension tab06s(2,4),tab06j(2,4),tab06h(2,4) dimension tab07s(2,4),tab07j(2,4),tab07h(2,4) dimension tab13s(2,4),tab13j(2,4),tab13h(2,4) dimension tab14s(2,4),tab14j(2,4),tab14h(2,4) c dimension sabj(2,4),sabh(2,4),sabs(2,4) dimension sab93j(4),sab93h(4),sab93s(4) dimension sab94j(4),sab94h(4),sab94s(4) dimension sab95j(4),sab95h(4),sab95s(4) dimension sab96j(4),sab96h(4),sab96s(4) dimension sab97j(4),sab97h(4),sab97s(4) dimension sab98j(4),sab98h(4),sab98s(4) dimension sab99j(4),sab99h(4),sab99s(4) dimension sab00j(4),sab00h(4),sab00s(4) dimension sab01j(4),sab01h(4),sab01s(4) dimension sab02j(4),sab02h(4),sab02s(4) dimension sab03j(4),sab03h(4),sab03s(4) dimension sab04j(4),sab04h(4),sab04s(4) dimension sab05j(4),sab05h(4),sab05s(4) dimension sab06j(4),sab06h(4),sab06s(4) dimension sab07j(4),sab07h(4),sab07s(4) dimension sab08j(4),sab08h(4),sab08s(4) dimension sab09j(4),sab09h(4),sab09s(4) dimension sab10j(4),sab10h(4),sab10s(4) dimension sab11j(4),sab11h(4),sab11s(4) dimension sab12j(4),sab12h(4),sab12s(4) dimension sab13j(4),sab13h(4),sab13s(4) dimension aif92(1992:2012),aif13(2013:2017),aif14(2014:2016) data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ data aif14/1.0d0,1.016d0 ,1.02d0/ data aif92/1.0525d0, 1.0845d0, 1.118d0, 1.147d0, & 1.1795d0, 1.212d0, 1.245d0, 1.266d0, 1.2895d0, & 1.3295d0, 1.373d0, 1.395d0, 1.427d0, 1.4595d0, & 1.505d0 , 1.564d0, 1.5995d0, 1.668d0,2*1.6955d0, & 1.7365d0/ data rate /.18d0,.16d0,.18d0,2*.15d0,.18d0,.2d0,.19d0,.2d0 ,.19d0/ c The add-on minimum tax and the AMT should be recomputed for all c taxable years beginning after c December 31, 1978 and continuing through tax year 2013. data arate/10*.0d0,3*.2205d0,.2401d0,2*.259d0,21*.296d0/ data cred/3*20.d0, 3*28.d0, 21.d0, 9*.0d0, 65.d0, 2*69.d0, & 72.d0, 86.d0, 88.d0, 89.d0, 91.d0, 94.d0, & 97.d0, 99.d0, 101.d0, 103.d0, 106.d0, 111.d0, & 113.d0,2*118.d0, 120.d0, 123.d0, 126.d0, 128.d0, & 130.d0, 131.d0/ c the fractions below are multiplied by a primary rate, contained c in the adj array c tab - for years 1988-1992 c state taxes review vol.49 No.50 c February 9, 1998 c data tab87j/3000.d0,2.d0,28000.d0,3.15d0,45000.d0,5.d0,1.e20, & 5.9d0/ data tab87m/1500.d0,2.d0,14000.d0,3.15d0,22500.d0,5.0d0,1.e20, & 5.9d0/ data tab87s/1800.d0,2.d0,16800.d0,3.15d0,27000.d0,5.d0,1.e20, & 5.9d0/ data tab87h/2500.d0,2.d0,23000.d0,3.15d0,38000.d0,5.d0,1.e20, & 5.9d0/ data tab89j/3000.d0,2.d0,28000.d0,3.1d0,45000.d0,4.8d0,1.e20, & 5.9d0/ data tab89m/1500.d0,2.d0,14000.d0,3.1d0,22500.d0,4.8d0,1.e20, & 5.9d0/ data tab89s/1800.d0,2.d0,16800.d0,3.1d0,27000.d0,4.8d0,1.e20, & 5.9d0/ data tab89h/2500.d0,2.d0,23000.d0,3.1d0,38000.d0,4.8d0,1.e20, & 5.9d0/ data tab90j/3000.d0,2.2d0,28000.d0,3.36d0,45000.d0,5.21d0, & 1.e20,6.41d0/ data tab90m/1500.d0,2.2d0,14000.d0,3.36d0,22500.d0,5.21d0, & 1.e20, 6.41d0/ data tab90s/1800.d0,2.2d0,16800.d0,3.36d0,27000.d0,5.21d0, & 1.e20, 6.41d0/ data tab90h/2500.d0,2.2d0,23000.d0,3.36d0,38000.d0,5.21d0, & 1.e20, 6.41d0/ data tab91j/3000.d0,2.37d0,28000.d0,3.63d0,45000.d0,5.62d0, & 1.e20, 6.92d0/ data tab91m/1500.d0,2.37d0,14000.d0,3.63d0,22500.d0,5.62d0, & 1.e20, 6.92d0/ data tab91s/1800.d0,2.37d0,16800.d0,3.63d0,27000.d0,5.62d0, & 1.e20, 6.92d0/ data tab91h/2500.d0,2.37d0,23000.d0,3.63d0,38000.d0,5.62d0, & 1.e20, 6.92d0/ data tab93s/2400.d0,2.62d0,17000.d0,3.65d0,26500.d0,5.24d0, & 1.e20, 6.99d0/ data tab93j/4000.d0,2.62d0,30000.d0,3.65d0,46750.d0,5.24d0, & 1.e20, 6.99d0/ data tab93h/3800.d0,2.62d0,24100.d0,3.65d0,35000.d0,5.24d0, & 1.e20, 6.99d0/ data tab98s/2400.d0,2.51d0,17000.d0,3.49d0,26500.d0,5.01d0, & 1.e20, 6.68d0/ data tab98j/4000.d0,2.51d0,30000.d0,3.49d0,46750.d0,5.01d0, & 1.e20, 6.68d0/ data tab98h/3800.d0,2.51d0,24000.d0,3.49d0,35000.d0,5.01d0, & 1.e20, 6.68d0/ data tab03s/2400.d0,2.56d0,17000.d0,3.57d0,26500.d0,5.12d0, & 1.e20, 6.84d0/ data tab03j/4000.d0,2.56d0,30000.d0,3.57d0,46750.d0,5.12d0, & 1.e20, 6.84d0/ data tab03h/3800.d0,2.56d0,24000.d0,3.57d0,35000.d0,5.12d0, & 1.e20, 6.84d0/ data tab06s/2400.d0,2.56d0,17500.d0,3.57d0,27000.d0,5.12d0, & 1.e20, 6.84d0/ data tab06j/4000.d0,2.56d0,31000.d0,3.57d0,50000.d0,5.12d0, & 1.e20, 6.840d0/ data tab06h/3800.d0,2.56d0,25000.d0,3.57d0,35000.d0,5.12d0, & 1.e20, 6.84d0/ data tab07s/2400.d0,2.56d0,17500.d0,3.57d0,27000.d0,5.12d0, & 1.e20, 6.84d0/ data tab07j/4800.d0,2.56d0,35000.d0,3.57d0,54000.d0,5.12d0, & 1.e20, 6.84d0/ data tab07h/4500.d0,2.56d0,28000.d0,3.57d0,40000.d0,5.12d0, & 1.e20, 6.84d0/ data tab13s/2400.d0,2.46d0,17500.d0,3.51d0,27000.d0,5.01d0, & 1.e20, 6.84d0/ data tab13j/4800.d0,2.46d0,35000.d0,3.51d0,54000.d0,5.01d0, & 1.e20, 6.84d0/ data tab13h/4500.d0,2.46d0,28000.d0,3.51d0,40000.d0,5.01d0, & 1.e20, 6.84d0/ data tab14s/3000.d0,2.46d0,18000.d0,3.51d0,29000.d0,5.01d0, & 1.e20, 6.84d0/ data tab14j/6000.d0,2.46d0,36000.d0,3.51d0,58000.d0,5.01d0, & 1.e20, 6.84d0/ data tab14h/5600.d0,2.46d0,28800.d0,3.51d0,43000.d0,5.01d0, & 1.e20, 6.84d0/ c data sab93s/108450.0d0, 132450.0d0, 278450.0d0,373450.0d0/ data sab93j/108450.0d0, 148450.0d0, 408450.0d0,575950.0d0/ data sab93h/108450.0d0, 146450.0d0, 348450.0d0,458450.0d0/ c data sab94s/111800.0d0, 135800.0d0, 281800.0d0,376800.0d0/ data sab94j/111800.0d0, 151800.0d0, 411800.0d0,579300.0d0/ data sab94h/111800.0d0, 149800.0d0, 351800.0d0,461800.0d0/ c data sab95s/114700.0d0, 138700.0d0, 284700.0d0,379700.0d0/ data sab95j/114700.0d0, 154700.0d0, 414700.0d0,582200.0d0/ data sab95h/114700.0d0, 152700.0d0, 354700.0d0,464700.0d0/ c data sab96s/117950.0d0, 141950.0d0, 297950.0d0,382950.0d0/ data sab96j/117950.0d0, 157950.0d0, 417950.0d0,585450.0d0/ data sab96h/117950.0d0, 155950.0d0, 357950.0d0,467950.0d0/ c data sab97s/121200.0d0, 145200.0d0, 291200.0d0,386200.0d0/ data sab97j/121200.0d0, 161200.0d0, 421200.0d0,575950.0d0/ data sab97h/121200.0d0, 159200.0d0, 361200.0d0,471200.0d0/ c data sab98s/124500.0d0, 148500.0d0, 294500.0d0,389500.0d0/ data sab98j/124500.0d0, 164500.0d0, 424500.0d0,592000.0d0/ data sab98h/124500.0d0, 162500.0d0, 364500.0d0,474500.0d0/ c data sab99s/126600.0d0, 150600.0d0, 296600.0d0,391600.0d0/ data sab99j/126600.0d0, 166600.0d0, 426600.0d0,594100.0d0/ data sab99h/126600.0d0, 164600.0d0, 366600.0d0,476600.0d0/ c data sab00s/128950.0d0, 152950.0d0, 298950.0d0,393950.0d0/ data sab00j/128950.0d0, 168950.0d0, 428950.0d0,596450.0d0/ data sab00h/128950.0d0, 166950.0d0, 368950.0d0,478950.0d0/ c data sab01s/132950.0d0, 156950.0d0, 302950.0d0,397950.0d0/ data sab01j/132950.0d0, 172950.0d0, 432950.0d0,600450.0d0/ data sab01h/132950.0d0, 170950.0d0, 372950.0d0,482950.0d0/ c data sab02s/137300.0d0, 161300.0d0, 307300.0d0,402300.0d0/ data sab02j/137300.0d0, 177300.0d0, 437300.0d0,604800.0d0/ data sab02h/137300.0d0, 175300.0d0, 377300.0d0,487300.0d0/ c data sab03s/139500.0d0, 163500.0d0, 309500.0d0,404500.0d0/ data sab03j/139500.0d0, 179500.0d0, 439500.0d0,607000.0d0/ data sab03h/139500.0d0, 177500.0d0, 379500.0d0,489500.0d0/ c data sab04s/142700.0d0, 166700.0d0, 312700.0d0,407700.0d0/ data sab04j/142700.0d0, 182700.0d0, 442700.0d0,610700.0d0/ data sab04h/142700.0d0, 180700.0d0, 382700.0d0,492700.0d0/ c data sab05s/145950.0d0, 169950.0d0, 315950.0d0,410950.0d0/ data sab05j/145950.0d0, 185950.0d0, 445950.0d0,613450.0d0/ data sab05h/145950.0d0, 183950.0d0, 385950.0d0,495950.0d0/ c data sab06s/150500.0d0, 174500.0d0, 325500.0d0,420500.0d0/ data sab06j/150500.0d0, 190500.0d0, 460500.0d0,650500.0d0/ data sab06h/150500.0d0, 188500.0d0, 400500.0d0,500500.0d0/ c data sab07s/156400.0d0, 180400.0d0, 331400.0d0,426400.0d0/ data sab07j/156400.0d0, 204400.0d0, 506400.0d0,696400.0d0/ data sab07h/156400.0d0, 201400.0d0, 436400.0d0,556400.0d0/ c data sab08s/159950.0d0, 183950.0d0, 334950.0d0,429950.0d0/ data sab08j/159950.0d0, 207950.0d0, 509950.0d0,699950.0d0/ data sab08h/159950.0d0, 204950.0d0, 439950.0d0,559950.0d0/ c data sab09s/166800.0d0, 190800.0d0, 341800.0d0,436800.0d0/ data sab09j/166800.0d0, 214800.0d0, 516800.0d0,706800.0d0/ data sab09h/166800.0d0, 211800.0d0, 446800.0d0,566800.0d0/ c data sab10s/167100.0d0, 191100.0d0, 342100.0d0,437100.0d0/ data sab10j/167100.0d0, 215100.0d0, 517100.0d0,707100.0d0/ data sab10h/167100.0d0, 212100.0d0, 447100.0d0,567100.0d0/ c data sab11s/169550.0d0, 193550.0d0, 344550.0d0,439550.0d0/ data sab11j/169550.0d0, 217550.0d0, 519550.0d0,709550.0d0/ data sab11h/169550.0d0, 214550.0d0, 449550.0d0,569550.0d0/ c data sab12s/173650.0d0, 197650.0d0, 348650.0d0,443650.0d0/ data sab12j/173650.0d0, 221650.0d0, 523650.0d0,713650.0d0/ data sab12h/173650.0d0, 218650.0d0, 453650.0d0,573650.0d0/ c data sab13s/250000.0d0, 274000.0d0, 425000.0d0,520000.0d0/ data sab13j/300000.0d0, 348000.0d0, 650000.0d0,840000.0d0/ data sab13h/275000.0d0, 320000.0d0, 555000.0d0,675000.0d0/ c data xmp/ & 1100.0d0, 1130.0d0, 1180.0d0,1230.0d0, 1290.0d0, 1360.0d0/ c--------------------------------------- sabs(2,1) = 0. sabj(2,1) = 0. sabh(2,1) = 0. if(law.ge.1993.and.law.le.1996) then sabs(2,2) = .437 sabs(2,3) = .334 sabs(2,4) = .175 sabj(2,2) = .437 sabj(2,3) = .334 sabj(2,4) = .175 sabh(2,2) = .437 sabh(2,3) = .334 sabh(2,4) = .175 else if (law.ge.1997.and.law.le.2002) then sabs(2,2) = .417 sabs(2,3) = .319 sabs(2,4) = .167 sabj(2,2) = .417 sabj(2,3) = .319 sabj(2,4) = .167 sabh(2,2) = .417 sabh(2,3) = .319 sabh(2,4) = .167 else if (law.ge.2003.and.law.le.2012) then sabs(2,2) = .428 sabs(2,3) = .327 sabs(2,4) = .172 sabj(2,2) = .428 sabj(2,3) = .327 sabj(2,4) = .172 sabh(2,2) = .428 sabh(2,3) = .327 sabh(2,4) = .172 else if (law.ge.2013) then sabs(2,2) = .438 sabs(2,3) = .333 sabs(2,4) = .183 sabj(2,2) = .438 sabj(2,3) = .333 sabj(2,4) = .183 sabh(2,2) = .438 sabh(2,3) = .333 sabh(2,4) = .183 endif if(law.eq.1993) then do 1993 j=1,4 sabs(1,j)=sab93s(j) sabj(1,j)=sab93j(j) sabh(1,j)=sab93h(j) 1993 continue endif if(law.eq.1994) then do 1994 j=1,4 sabs(1,j)=sab94s(j) sabj(1,j)=sab94j(j) sabh(1,j)=sab94h(j) 1994 continue endif if(law.eq.1995) then do 1995 j=1,4 sabs(1,j)=sab95s(j) sabj(1,j)=sab95j(j) sabh(1,j)=sab95h(j) 1995 continue endif if(law.eq.1996) then do 1996 j=1,4 sabs(1,j)=sab96s(j) sabj(1,j)=sab96j(j) sabh(1,j)=sab96h(j) 1996 continue endif if(law.eq.1997) then do 1997 j=1,4 sabs(1,j)=sab97s(j) sabj(1,j)=sab97j(j) sabh(1,j)=sab97h(j) 1997 continue endif if(law.eq.1998) then do 1998 j=1,4 sabs(1,j)=sab98s(j) sabj(1,j)=sab98j(j) sabh(1,j)=sab98h(j) 1998 continue endif if(law.eq.1999) then do 1999 j=1,4 sabs(1,j)=sab99s(j) sabj(1,j)=sab99j(j) sabh(1,j)=sab99h(j) 1999 continue endif if(law.eq.2000) then do 2000 j=1,4 sabs(1,j)=sab00s(j) sabj(1,j)=sab00j(j) sabh(1,j)=sab00h(j) 2000 continue endif if(law.eq.2001) then do 2001 j=1,4 sabs(1,j)=sab01s(j) sabj(1,j)=sab01j(j) sabh(1,j)=sab01h(j) 2001 continue endif if(law.eq.2002) then do 2002 j=1,4 sabs(1,j)=sab02s(j) sabj(1,j)=sab02j(j) sabh(1,j)=sab02h(j) 2002 continue endif if(law.eq.2003) then do 2003 j=1,4 sabs(1,j)=sab03s(j) sabj(1,j)=sab03j(j) sabh(1,j)=sab03h(j) 2003 continue endif if(law.eq.2004) then do 2004 j=1,4 sabs(1,j)=sab04s(j) sabj(1,j)=sab04j(j) sabh(1,j)=sab04h(j) 2004 continue endif if(law.eq.2005) then do 2005 j=1,4 sabs(1,j)=sab05s(j) sabj(1,j)=sab05j(j) sabh(1,j)=sab05h(j) 2005 continue endif if(law.eq.2006) then do 2006 j=1,4 sabs(1,j)=sab06s(j) sabj(1,j)=sab06j(j) sabh(1,j)=sab06h(j) 2006 continue endif if(law.eq.2007) then do 2007 j=1,4 sabs(1,j)=sab07s(j) sabj(1,j)=sab07j(j) sabh(1,j)=sab07h(j) 2007 continue endif if(law.eq.2008) then do 2008 j=1,4 sabs(1,j)=sab08s(j) sabj(1,j)=sab08j(j) sabh(1,j)=sab08h(j) 2008 continue endif if(law.eq.2009) then do 2009 j=1,4 sabs(1,j)=sab09s(j) sabj(1,j)=sab09j(j) sabh(1,j)=sab09h(j) 2009 continue endif if(law.eq.2010) then do 2010 j=1,4 sabs(1,j)=sab10s(j) sabj(1,j)=sab10j(j) sabh(1,j)=sab10h(j) 2010 continue endif if(law.eq.2011) then do 2011 j=1,4 sabs(1,j)=sab11s(j) sabj(1,j)=sab11j(j) sabh(1,j)=sab11h(j) 2011 continue endif c 2012 --- if(law.eq.2012) then do 2012 j=1,4 sabs(1,j)=sab12s(j) sabj(1,j)=sab12j(j) sabh(1,j)=sab12h(j) 2012 continue endif c 2013+ --- if(law.ge.2013) then do 2013 j=1,4 sabs(1,j)=sab13s(j)*aif13(law) sabj(1,j)=sab13j(j)*aif13(law) sabh(1,j)=sab13h(j)*aif13(law) 2013 continue endif c----------------------------------------------- credit=0. mst = data(2) rt=0. sep=data(3) phas92=100000./data(3) if(law.ge.1992.and.law.le.2012) & phas92=100000.*aif92(law)/data(3) if(law.ge.2013) & phas92 = aif13(law)*250000*filing(mst,1.,1.2,1.1,.6) c tax before crdt if(law.le.1986) then fedtax=max(comnew(77),0.0d0) statax=max(0.0d0,(rate(law)*fedtax)) rt=rate(law)*comnew(72)/100. else agi=comnew(2) if(law.ge.1988) agi=agi-data(22) if(law.ge.2015.and.comnew(79).gt.0) then if((mst.eq.2.and.comnew(2).le.58000).or. & (mst.ne.2.and.comnew(2).le.43000)) agi = agi - comnew(79) endif xitded = abs(comnew(24)-data(50))*comnew(26) if(agi.gt.phas92.and.law.ge.1991) then xitemp = max(0.0d0,comnew(30)-data(50)) if(xitemp.gt.0) then xlin6 = .8*xitemp xlin9 = agi-phas92 if(comnew(23).gt.0) then xlin11 = comnew(23)/xitemp xlin12 = 1 - xlin11 xlin13 = .03*xlin11 xlin14 = .1*xlin12 xlin15 = xlin13 + xlin14 xlin16 = xlin15 * xlin9 else xlin16 = .1*xlin9 endif reduce = min(xlin6,xlin16) if(law.eq.2006.or.law.eq.2007) reduce = 2*reduce/3 if(law.eq.2008.or.law.eq.2009) reduce = reduce/3 if(law.eq.2010) reduce = 0 xitded = xitemp-reduce else xitded = 0. endif endif stded = comnew(3) c std deduction phaseout see instructions p.10,1993 c state inc tax refunds c deduc,state&loc tax flag itmzd c zero bracket amt if(law.ge.1993) then diff=max(0.0d0,comnew(2)-phas92) stded=max(0.0d0,comnew(3)-.1*diff) c 2003-2006 diff in fed std and NE std if(mst.eq.2.or.mst.eq.5.or.mst.eq.3.or.mst.eq.6) then if(law.eq.2003) stded=max(0.0d0,7950/data(3)-.1*diff) if(law.eq.2004) stded=max(0.0d0,8140/data(3)-.1*diff) if(law.eq.2005) stded=max(0.0d0,8320/data(3)-.1*diff) if(law.eq.2006) stded=max(0.0d0,8580/data(3)-.1*diff) endif if(mst.eq.1.and.law.eq.2005)stded=max(0.0d0,4980-.1*diff) if(mst.eq.1.and.law.eq.2006)stded=max(0.0d0,5130-.1*diff) endif c if(law.eq.1987)stded=stded-10. if(law.ge.2008.and.law.le.2009.and.data(51).gt.0) stded = & comnew(3) - min(data(51),data(7)*500) c exemps if(law.gt.1987) deduc=max(xitded,stded) if(law.eq.1987) deduc = max(0.0d0,comnew(24)-data(50)-stded) exemp = 0. if(law.ge.1987.and.law.le.1992) exemp = comnew(68)*xmp(law) taxinc=max(0.0d0,agi - exemp - deduc) if(law.le.1992) then if (law.eq.1987) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then taxy = max(0.0d0,taxinc-2600.) else if(mst.eq.2) then taxy = max(0.0d0,taxinc-3800.) else taxy = max(0.0d0,taxinc-1900.) endif endif if (law.eq.1987.or.law.eq.1988) then do 1987 i=1,4 do 1987 j=1,2 tabs(j,i)=tab87s(j,i) tabm(j,i)=tab87m(j,i) tabj(j,i)=tab87j(j,i) tabh(j,i)=tab87h(j,i) 1987 continue endif if (law.eq.1989) then do 1989 i=1,4 do 1989 j=1,2 tabs(j,i)=tab89s(j,i) tabm(j,i)=tab89m(j,i) tabj(j,i)=tab89j(j,i) tabh(j,i)=tab89h(j,i) 1989 continue endif if (law.eq.1990) then do 1990 i=1,4 do 1990 j=1,2 tabs(j,i)=tab90s(j,i) tabm(j,i)=tab90m(j,i) tabj(j,i)=tab90j(j,i) tabh(j,i)=tab90h(j,i) 1990 continue endif if (law.eq.1991.or.law.eq.1992) then do 1991 i=1,4 do 1991 j=1,2 tabs(j,i)=tab91s(j,i) tabm(j,i)=tab91m(j,i) tabj(j,i)=tab91j(j,i) tabh(j,i)=tab91h(j,i) 1991 continue endif if(law.gt.1987) then if(mst.eq.1) then call look(tabs,taxinc,4,n,statax,1.0d0,0.0d0,rt,data) else if(mst.eq.2) then call look(tabj,taxinc,4,n,statax,1.0d0,0.0d0,rt,data) else if(mst.eq.3.or.mst.eq.6) then call look(tabm,taxinc,4,n,statax,1.0d0,0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.5.or.mst.eq.7) then call look(tabh,taxinc,4,n,statax,1.0d0,0.0d0,rt,data) endif else if(law.eq.1987) then if(mst.eq.1) then call look(tabs,taxy,4,n,statax,1.0d0,0.0d0,rt,data) else if(mst.eq.2) then call look(tabj,taxy,4,n,statax,1.0d0,0.0d0,rt,data) else if(mst.eq.3.or.mst.eq.6) then call look(tabm,taxy,4,n,statax,1.0d0,0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.5.or.mst.eq.7) then call look(tabh,taxy,4,n,statax,1.0d0,0.0d0,rt,data) endif endif else dagi=comnew(2) if(law.ge.1993.and.law.le.1996) then do 1 i=1,4 do 1 j=1,2 tabs(j,i) = tab93s(j,i) tabj(j,i) = tab93j(j,i) 1 tabh(j,i) = tab93h(j,i) else if(law.ge.1997.and.law.le.2002) then do 2 i=1,4 do 2 j=1,2 tabs(j,i) = tab98s(j,i) tabj(j,i) = tab98j(j,i) 2 tabh(j,i) = tab98h(j,i) else if(law.ge.2003.and.law.le.2005) then do 3 i=1,4 do 3 j=1,2 tabs(j,i) = tab03s(j,i) tabj(j,i) = tab03j(j,i) 3 tabh(j,i) = tab03h(j,i) else if(law.eq.2006) then do 4 i=1,4 do 4 j=1,2 tabs(j,i) = tab06s(j,i) tabj(j,i) = tab06j(j,i) 4 tabh(j,i) = tab06h(j,i) else if(law.ge.2007.and.law.le.2012) then do 5 i=1,4 do 5 j=1,2 tabs(j,i) = tab07s(j,i) tabj(j,i) = tab07j(j,i) 5 tabh(j,i) = tab07h(j,i) else if(law.eq.2013) then do 6 i=1,4 do 6 j=1,2 tabs(j,i) = tab13s(j,i) tabj(j,i) = tab13j(j,i) 6 tabh(j,i) = tab13h(j,i) else if(law.ge.2014) then do 7 i=1,4 tabs(1,i) = tab14s(1,i)*aif14(law) tabj(1,i) = tab14j(1,i)*aif14(law) 7 tabh(1,i) = tab14h(1,i)*aif14(law) do 8 i=1,4 tabs(2,i) = tab14s(2,i) tabj(2,i) = tab14j(2,i) 8 tabh(2,i) = tab14h(2,i) endif if(mst.eq.1) then call look(tabs,taxinc,4,n,statax,1.0d0,0.0d0,rt,data) if(dagi.gt.phas92) then if(taxinc.ge.46750) then call look(sabs,dagi,4,n,surtx,1.0d00,0.0d0,surrt,data) statax=statax+surtx else if(taxinc.lt..1*(comnew(2)-phas92)) & statax = rt*taxinc endif endif else if(mst.eq.2.or.mst.eq.3.or.mst.eq.6) then if(mst.ne.2) then taxy=taxinc*2 dagi=comnew(2)*2 call look(tabj,taxy,4,n,stax,1.0d0,0.0d0,rt,data) statax = stax/2 if(dagi.gt.phas92) then if(taxinc.ge.46750) then call look(sabj,dagi,4,n,srtx,1.0d00,0.0d0,surrt,data) statax=statax+srtx/2 else if(taxinc.lt..1*(comnew(2)-phas92)) & statax = rt*taxinc endif endif else call look(tabj,taxinc,4,n,statax,1.0d0,0.0d0,rt,data) if(dagi.gt.phas92) then if(taxinc.ge.46750) then call look(sabj,dagi,4,n,surtx,1.0d00,0.0d0,surrt,data) statax=statax+surtx else if(taxinc.lt..1*(comnew(2)-phas92)) & statax = rt*taxinc endif endif endif else call look(tabh,taxinc,4,n,statax,1.0d0,0.0d0,rt,data) if(dagi.gt.phas92) then if(taxinc.ge.46750) then call look(sabh,dagi,4,n,surtx,1.0d00,0.0d0,surrt,data) statax=statax+surtx else if(taxinc.lt..1*(comnew(2)-phas92)) & statax = rt*taxinc endif endif endif endif endif c Nebraska Personal Credit stxcr = 0. if(law.le.1992) then stxcr=cred(law)*(data(7)+data(8)) elseif(law.ge.1993) then if(law.eq.1993) & agdiff=max(0.0d0,comnew(2)-filing(mst,54000.,90000., & 75000.,45000.)) if (law.eq.1994) & agdiff=max(0.0d0,comnew(2)-filing(mst,56000.,93000., & 78000.,46500.)) if (law.eq.1995) & agdiff=max(0.0d0,comnew(2)-filing(mst,58000.,96000., & 80000.,48000.)) if (law.eq.1996) & agdiff=max(0.0d0,comnew(2)-filing(mst,59000.,98000., & 82000.,49000.)) if(law.eq.1997) & agdiff=max(0.0d0,comnew(2)-filing(mst,61000.,101000., & 84000.,50500.)) if(law.eq.1998) & agdiff=max(0.0d0,comnew(2)-filing(mst,62000.,104000., & 87000.,52000.)) if(law.eq.1999) & agdiff=max(0.0d0,comnew(2)-filing(mst,64000.,106000., & 88000.,53000.)) if(law.eq.2000) & agdiff=max(0.0d0,comnew(2)-filing(mst,65000.,107000., & 90000.,53500.)) if(law.eq.2001) & agdiff=max(0.0d0,comnew(2)-filing(mst,67000.,111000., & 92000.,55500.)) if(law.eq.2002) & agdiff=max(0.0d0,comnew(2)-filing(mst,69000.,114000., & 95000.,57000.)) if(law.eq.2003) & agdiff=max(0.0d0,comnew(2)-filing(mst,70000.,116000., & 97000.,58000.)) if(law.eq.2004) & agdiff=max(0.0d0,comnew(2)-filing(mst,72000.,119000., & 99000.,59500.)) if(law.eq.2005) & agdiff=max(0.0d0,comnew(2)-filing(mst,73000.,122000., & 101000.,61000.)) c Personal Exemption credit for 2006 will no longer be phased out c at higher incomes if(law.ge.2006) agdiff = 0. xcred=max(0.0d0,cred(law)-5*(agdiff/(5000./sep))) stxcr=xcred*comnew(68) endif ocred=0. c elderly credit if(law.ge.1981.and.law.le.1988) then ocred=comnew(54)*.5 else if(law.ge.1989) then ocred=comnew(54) endif c res energy credit ecred=0. if(law.ge.1982.and.law.le.1987)ecred=data(38) c non-refundable credits credit=stxcr+ecred+ocred c child care credit nonrefundable until 1998 chcr=0. chcref = 0. if(law.ge.1989) chcr=.25*comnew(53) c refundable child care expenses credit after 1998 if(law.ge.1998.and.comnew(2).le.29000) then chr = .01*(100.-max(comnew(2)/100 - 220.,0.0d0)) chcref = chr*comnew(53) if(chcref.gt.0) chcr = 0. endif if(law.lt.1998.or.comnew(2).gt.29000) credit=credit+chcr c no change 2/13/91 c some credits can not exceed state tax, other can amt = 0. if(law.le.2013) amt=arate(law)*(comnew(70)+data(42)) statax=statax+amt statax=max(statax-credit,0.0d0) c Federal tax liability worksheet (statax after non-ref credits) c next line was added on 06.02.2017 statax = min(comnew(52)+comnew(70),statax) c 2006 a Nebraska Earned Income Credit - refundable earncr = 0. if(law.eq.2006) earncr = .08*comnew(59) if(law.ge.2007) earncr = .1*comnew(59) statax=statax - chcref - earncr if(law.ge.1998.and.comnew(2).le.29000) credit = credit+chcref credit = credit + earncr c only for comparison -- should be the last line before return if(chcref.gt.0) chcr = chcref return end c NEW HAMPSHIRE c State 30 c c Updated through 2016 subroutine nhtax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(100),comnew(100) agi = data(12)+data(14) stded = 0. if(law.ge.1995) then exemp = data(7)*2400.+(data(9)+data(10))*1200. else if(law.ge.1981.and.law.le.1994) then exemp = (data(7)+data(9)+data(10))*1200. else exemp = (data(7)+data(9)+data(10))*600. endif taxinc = max(agi-stded-exemp,0.0d0) rt=.05 statax = taxinc * rt pcred = 0. chcr = 0. credit = 0. comnew(1) = comnew(1) return end c NEW JERSEY c State 31 c c Updated though 2016 subroutine njtax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt c different rates apply for commutrs to penn or ny dimension tab(2,3),tabown(2,3) &,tabs91(2,5),tabm91(2,6) &,tabs04(2,6),tabm04(2,7) &,tabs09(2,8),tabm09(2,9) dimension excl99(7),excl00(7),excl01(7),excl02(7),excl03(7) dimension data(255), comnew(255), rat94s(5), rat94m(6) dimension rat95s(5), rat95m(6), rat96s(5), rat96m(6) dimension dedmin(1996:2016),procen(1996:2016),amount(1996:2016) dimension eicrt(2000:2016) data eicrt/.1d0,.15d0,.175d0,5*.2d0,.225d0,.25d0,5*.2d0,.3d0, & .35d0/ data rat94s/1.9d0,2.375d0,4.75d0 ,6.175d0,6.65d0/ data rat94m/1.9d0,2.375d0,3.325d0,4.75d0 ,6.175d0,6.65d0/ data rat95s/1.7d0,2.125d0,4.25d0 ,6.013d0,6.580d0/ data rat95m/1.7d0,2.125d0,2.975d0,4.25d0 ,6.013d0,6.58d0/ data rat96s/1.4d0,1.75d0 ,3.5d0 ,5.525d0,6.37d0/ data rat96m/1.4d0,1.75d0 ,2.45d0 ,3.5d0 ,5.525d0,6.37d0/ data tab/20000.d0,2.0d0,50000.d0,2.5d0,1.e20, .0d0/ data tabs91/20000.d0,2.d0,35000.d0,2.5d0,40000.d0,5.d0, &75000.d0,6.5d0,1.e20,7.d0/ data tabm91/ & 20000.0d0, 2.0d0 , 50000.0d0 , 2.5d0 , 70000.0d0, 3.5d0, & 80000.0d0, 5.0d0 , 150000.0d0 , 6.5d0, 1.e20, 7.0d0/ data tabs04/ & 20000.0d0, 1.4d0 , 35000.0d0, 1.75d0, 40000.0d0, 3.5d0, & 75000.0d0, 5.525d0, 500000.0d0, 6.37d0, 1.e20, 8.97d0/ data tabm04/ & 20000.0d0, 1.4d0 , 50000.0d0 , 1.75d0 , 70000.0d0, 2.45d0, & 80000.0d0, 3.5d0 , 150000.0d0 , 5.525d0,500000.0d0, 6.37d0, & 1.e20, 8.97d0/ c 2009 data tabs09/ & 20000.0d0, 1.4d0 , 35000.0d0 , 1.75d0 , 40000.0d0, 3.5d0, & 75000.0d0, 5.525d0, 400000.0d0 , 6.37d0 ,500000.0d0, 8.0d0, & 1000000.0d0,10.25d0 , 1.e20,10.75d0/ data tabm09/ & 20000.0d0, 1.4d0 , 50000.0d0 , 1.75d0 , 70000.0d0, 2.45d0, & 80000.0d0, 3.5d0 , 150000.0d0 , 5.525d0,400000.0d0, 6.37d0, & 500000.0d0, 8.0d0 ,1000000.0d0 ,10.25d0 , 1.e20,10.75d0/ data tabown/ & 20000.0d0, 3250.0d0, 50000.0d0, 2600.0d0, 1.e20, 1857.0d0/ data excl99/ & 7500.0d0, 10000.0d0, 5000.0d0, 2*7500.0d0, 5000.0d0, & 7500.0d0/ data excl00/ & 9375.0d0, 12500.0d0, 6250.0d0, 2*9375.0d0, 6250.0d0, & 9375.0d0/ data excl01/ & 11250.0d0, 15000.0d0, 7500.0d0,2*11250.0d0, 7500.0d0, & 11250.0d0/ data excl02/ & 13125.0d0, 17500.0d0, 8750.0d0,2*13125.0d0, 8750.0d0, & 13125.0d0/ data excl03/15000.d0,20000.d0,10000.d0,2*15000.d0,10000.d0, & 15000.d0/ data dedmin/2500.d0,5625.d0,19*10000.d0/ data procen/.5d0,.75d0,19* 1.0d0/ data amount/25.d0,37.5d0,19*50.d0/ rt = 0. mst = data(2) sep = data(3) rescr = 0. rded = 0. pded = 0. ptax = data(51) + .18 * data(160) c rates for years through 1990 if(law.le.1982) then tab(2,3)=2.5 else if(law.ge.1983) then tab(2,3)=3.5 endif c rate for years 1994 and on if(law.eq.1994) then do 1 i=1,5 1 tabs91(2,i)=rat94s(i) do 2 i=1,6 2 tabm91(2,i)=rat94m(i) else if(law.eq.1995) then do 3 i=1,5 3 tabs91(2,i)=rat95s(i) do 4 i=1,6 4 tabm91(2,i)=rat95m(i) else if(law.ge.1996.and.law.le.2003) then do 5 i=1,5 5 tabs91(2,i)=rat96s(i) do 6 i=1,6 6 tabm91(2,i)=rat96m(i) endif c AGI subrac=comnew(78)+comnew(79)+data(62) agi=data(11)+data(12)+data(14)+max(0.0d0,data(17))+data(18)+ & data(19)+ data(23)+data(24)+max(0.0d0,comnew(6))+ & max(0.0d0,comnew(8))+data(20)+data(72)+data(27)+ & max(0.0d0,data(21)) if(law.lt.1992) agi = agi + subrac ti = agi if(data(9).gt.0.or.data(10).gt.0) then c pnsion and retirement income exclusion pnsion=data(20)+data(72) retiry=data(11)+data(17)+data(75) deduct = 0. c Pension Exclusion if(law.le.1999) then deduct=excl99(mst) else if(law.eq.2000) then deduct=excl00(mst) else if(law.eq.2001) then deduct=excl01(mst) else if(law.eq.2002) then deduct=excl02(mst) else if(law.ge.2003.and.law.le.2004) then deduct=excl03(mst) else if(law.ge.2005.and.hy.le.100000) then c Effective for taxable years 2005+ limits for Pension Exclusion and c Other Retirement Income Exclusion to taxpayers with income $100,000 and less deduct=excl03(mst) endif c if(mst.eq.2.or.sep.eq.2) deduct = (4*deduct)/(3*sep) agi=agi-twn(pnsion,0.0d0,deduct) c Other Retirement Income Exclusion xtra = max(0.0d0,deduct-pnsion) if(retiry.le.3000.) agi = agi - min(xtra,max(0.0d0,agi)) c Special Exclusion if(law.ge.2005.and.data(20)+data(72).gt.0.d0.and. & data(91).lt.1.and.ti.le.100000.d0) then if(mst.eq.2.or.mst.eq.3.or.mst.eq.6) then spmax = 3000.d0 else spmax = 6000.d0 endif agi = agi - min(data(20)+data(72),spmax) endif endif c NJ doesn't have special treatment of capital gains agi = agi -comnew(6) + comnew(5) c No Tax Status if(law.le.1993.and.agi.le.3000./data(3)) then statax=0. taxinc = 0. go to 1000 else if(law.ge.1994.and.law.le.1996.and.agi.lt.7500./data(3)) then statax=0. taxinc = 0. go to 1000 else if(law.ge.1997.and.law.le.1998.and.agi.le.7500./data(3)) then statax=0. taxinc = 0. go to 1000 else if(law.eq.1999.and.agi.le.10000./data(3)) then statax=0. taxinc = 0. go to 1000 else if(law.eq.2000) then if(mst.eq.1.and.agi.le.10000) then statax=0. taxinc = 0. go to 1000 else if(mst.ne.1.and.agi.le.15000/data(3))then statax=0. taxinc = 0. go to 1000 endif else if(law.ge.2001) then nts = data(7) if (mst.eq.4.or.mst.eq.7) nts=2 if(agi.le.10000. * nts) then statax=0. taxinc = 0. go to 1000 endif endif c Exemptions if(law.le.1990)exemp=(data(7)+data(8)+data(9)+data(10))*1000. if(law.ge.1991) & exemp=(data(7)+data(9)+data(10))*1000.+data(8)*1500. c Only medical expenses in excess of 2% of income may be deducted edical=max(0.0d0,(data(47)+data(48)+data(49)-.02*max(0.0d0,agi))) taxinc=max(0.0d0,agi-exemp-edical) c Property tax deduction/credit if(law.ge.1985.and.law.le.1989.and.agi.gt.3000/sep) then floor=tablki(tabown,3,taxinc,data)/sep rded=xif(data(160).gt.0.,max(floor*.54,.18*data(160))) & *renter(data,comnew) pded=xif(data(51).gt.0.,max(floor, data(51))) c new homestead property tax rebate implement 1990, c but does not offset income tax xtra=pded+rded-taxinc if(xtra.gt.0) rescr=.02*xtra endif taxinc=max(0.0d0,taxinc-rded-pded) c State Tax Calculation if(law.le.1990) then call look(tab,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1991.and.law.le.2003) then if(mst.eq.2.or.mst.eq.4.or.mst.eq.7.or.mst.eq.5)then call look(tabm91,taxinc,6,n,statax,1.0d00,0.0d0,rt,data) else call look(tabs91,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) endif else if(law.ge.2004) then if(law.ne.2009) then if(mst.eq.2.or.mst.eq.4.or.mst.eq.7.or.mst.eq.5)then call look(tabm04,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) else call look(tabs04,taxinc,6,n,statax,1.0d00,0.0d0,rt,data) endif else if (law.eq.2009) then if(mst.eq.2.or.mst.eq.4.or.mst.eq.7.or.mst.eq.5)then call look(tabm09,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) else call look(tabs09,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) endif endif endif 1000 rebate = 0. pcred=0. c Residental Property Tax Credit if(law.le.1984) then if(data(160).gt.0) then pcred=65. if(data(9).gt.0.or.data(10).gt.0) pcred = pcred + 35. endif else if(law.ge.1985.and.law.le.1989) then if(agi.le.3000./sep) then if(data(160).gt.0.) pcred=35. if(data(51).gt.0.) pcred=65. endif c 1990 + Homestead Property Tax Rebate else if((law.ge.1990.and.law.le.2003).or. & (law.ge.2004.and.data(160).gt.0.and.data(51).lt.1)) then c Taxpayers age 65 and over and/or totally or permanently disabled if(data(9)+data(10).gt.0) then reb = max(0.0d0,ptax - .05 * agi) if(data(51).gt.0) then if(agi.le.35000) then rebate = max(150.0d0,min(500.0d0,reb))/sep if(law.ge.2001) rebate=max(150.0d0,min(775.0d0,reb))/sep else if(agi.gt.35000.and.agi.le.70000.) then if(mst.eq.2.or.mst.eq.4.or.mst.eq.7.or.mst.eq.5) then rebate = max(150.0d0,min(500.0d0,reb))/sep if(law.ge.2001)rebate=max(150.0d0,min(775.0d0,reb))/sep else rebate = 150./sep endif else if(agi.gt.70000.and.agi.le.100000.) then rebate = 100./sep endif else if(data(160).gt.0.) then if(agi.le.35000.) then rebate = max(65.0d0,min(500.0d0,reb))/sep if(law.ge.2001) rebate=max(100.0d0,min(775.0d0,reb))/sep else if(agi.gt.35000.and.agi.le.70000.) then if(mst.eq.2.or.mst.eq.4.or.mst.eq.7.or.mst.eq.5) then rebate = max(65.0d0,min(500.0d0,reb))/sep if(law.ge.2001) rebate = 100./sep else rebate = 65./sep if(law.ge.2001) rebate = 100./sep endif else if(agi.gt.70000.and.agi.le.100000.) then if(law.le.1998) then rebate = 35./sep else if (law.eq.1999) then rebate = 40./sep else if(law.eq.2000) then rebate = 60./sep else if(law.ge.2001.and.law.le.2003) then rebate =100./sep else if(law.ge.2004) then rebate =150./sep endif endif endif else if(data(9)+data(10).lt.1.) then c Taxpayers under age 65 and not totally and permanently disabled if(data(51).gt.0.and.agi.lt.40000) rebate = 90./sep if(data(160).gt.0) then if(law.le.1998.and.agi.lt.40000) rebate = 30./sep if(law.eq.1999.and.agi.lt.100000) rebate = 40./sep if(law.eq.2000.and.agi.lt.100000) rebate = 60./sep if(law.ge.2001..and.law.le.2003.and.agi.lt.100000) & rebate = 100./sep if(law.ge.2004) rebate = 150./sep endif endif endif c c New in 1996+ Prop. Tax Deduct/Credit which allows either to deduct c a portion of prop.taxes or rent or to take a credit against their c income tax due. c if(law.ge.1996.and.data(51).gt.2) then pded =min(dedmin(law)/sep,procen(law)*ptax) exemp=(data(7)+data(9)+data(10))*1000.+data(8)*1500. edical=max(0.0d0, & (data(47)+data(48)+data(49)-.02*max(0.0d0,agi))) taxpr = max(0.0d0,agi-exemp-edical-pded) if(law.le.2003) then if(mst.eq.4.or.mst.eq.2)then call look(tabm91,taxpr,6,n,statpr,1.0d00,0.0d0,rt,data) else call look(tabs91,taxpr,5,n,statpr,1.0d00,0.0d0,rt,data) endif else if(law.ge.2004) then if(law.ne.2009) then if(mst.eq.2.or.mst.eq.4)then call look(tabm04,taxpr,7,n,statpr,1.0d00,0.0d0,rt,data) else call look(tabs04,taxpr,6,n,statpr,1.0d00,0.0d0,rt,data) endif else if(law.eq.2009) then if(mst.eq.2.or.mst.eq.4)then call look(tabm09,taxpr,9,n,statpr,1.0d00,0.0d0,rt,data) else call look(tabs09,taxpr,8,n,statpr,1.0d00,0.0d0,rt,data) endif endif endif if((statax-statpr).ge.amount(law)/sep) then taxinc = taxpr statax = statpr else if(data(51)+data(160).gt.0.and.taxinc.gt.0) & pcred = amount(law)/sep endif endif c changed 2/13/91 for new accounting of pcred credit=rescr+pcred statax=max(0.0d0,statax-credit) statax = statax - rebate c Earned Income Credit since 2000 earncr = 0. if(agi.le.20000.and.data(8).gt.0.and.law.ge.2000.and.law.le.2006) & earncr = eicrt(law)*comnew(59) if(law.ge.2007) earncr = eicrt(law)*comnew(59) statax = statax - earncr credit = credit + earncr + rebate c statax < 0. means you have got a rebate in 1990 - 1995 return end c NEW MEXICO c State 32 c c Updated through 2016 subroutine nmtax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common/temp/count dimension data(255), comnew(255) dimension food(1977:1989),exlow(2,2006:2016) double precision low77(0:6,19),low81(0:6,21),low94(0:6,23), & low98(0:6,24),l77(2,19), l81(2,21) , l94(2,23), l98(2,24), & med,medexp,modagi dimension adf(1977:1994), tabs(2,19), tabm(2,19), tabsp(2,19) dimension proptb(2,17),xmp(1977:1999),amed(1977:1994) dimension tab77m(2,19),tb77sp(2,19),tab77s(2,19) dimension tab87m(2,7), tab87s(2,7), tab87h(2,7) dimension eldm85(2,7), eldm87(2,9), elds85(2,7), elds87(2,9) dimension eldp85(2,7), eldp87(2,9), std86(1:7) dimension std90(1:7), tab94m(2,7), tab94s(2,8), tab94h(2,7) dimension tab95m(2,9), tab95s(2,10), tab95h(2,8),tab95e(2,8) dimension tab96m(2,8), tab98m(2,8), tab98s(2,10), tab98h(2,8) dimension tab03m(2,7), tab03s(2,10), tab03h(2,6) dimension tab04m(2,5), tab04s(2,6), tab04h(2,5) dimension tab05m(2,4), tab05s(2,4), tab05h(2,4) dimension tab06m(2,4), tab06s(2,4) dimension tab08m(2,4), tab08s(2,4) dimension foods(2,4) , foodm(2,4),chlim(1981:2016) data exlow/27110.0d0,40667.0d0, 7 36667.0d0,55000.0d0, 8 36667.0d0,55000.0d0, 9 36667.0d0,55000.0d0, 9 36667.0d0,55000.0d0, 1 36667.0d0,55000.0d0, 2 36667.0d0,55000.0d0, 3 36667.0d0,55000.0d0, 4 36667.0d0,55000.0d0, 5 36667.0d0,55000.0d0, 6 36667.0d0,55000.0d0/ data tab77m/ 2000.0d0, 0.80d0, 4000.0d0, 1.0d0, 6000.0d0, & 1.40d0, 8000.0d0, 1.80d0, & 10000.0d0, 2.20d0, 12000.0d0, 2.60d0, 14000.0d0, 3.0d0, & 16000.0d0, 3.50d0, 20000.0d0, 4.0d0, & 24000.0d0, 4.50d0, 28000.0d0, 5.0d0, 32000.0d0, 5.50d0, & 36000.0d0, 6.0d0, 40000.0d0, 6.50d0, & 50000.0d0, 7.0d0, 70000.0d0, 7.50d0,100000.0d0, 8.0d0, & 200000.0d0, 8.50d0, 1.e20, 9.0d0/ data tab77s/ 1000.0d0, 0.80d0, 2000.0d0, 0.80d0, & 3000.0d0, 0.90d0, 4000.0d0, 1.10d0, & 5000.0d0, 1.30d0, 6000.0d0, 1.50d0, 7000.0d0, 1.80d0, & 8000.0d0, 2.30d0, 10000.0d0, 2.90d0, & 12000.0d0, 3.50d0, 14000.0d0, 4.20d0, 16000.0d0, 4.90d0, & 18000.0d0, 5.60d0, 20000.0d0, 6.30d0, & 25000.0d0, 7.0d0, 35000.0d0, 7.50d0, 50000.0d0, 8.0d0, & 100000.0d0, 8.50d0, 1.e20, 9.0d0/ data tb77sp/ 1000.0d0, .80d0, 2000.0d0, 1.0d0, 3000.0d0, & 1.40d0, 4000.0d0, 1.80d0, & 5000.0d0, 2.20d0, 6000.0d0, 2.60d0, 7000.0d0, 3.0d0, & 8000.0d0, 3.50d0, 10000.0d0, 4.0d0, & 12000.0d0, 4.50d0, 14000.0d0, 5.0d0, 16000.0d0, 5.50d0, & 18000.0d0, 6.0d0, 20000.0d0, 6.50d0, & 25000.0d0, 7.0d0, 35000.0d0, 7.50d0, 50000.0d0, 8.0d0, & 100000.0d0, 8.50d0, 1.e20, 9.0d0/ data tabm/ & 2000.0d0, .0d0, 4000.0d0, .0d0, 6000.0d0, .0d0, & 8000.0d0, .0d0, 10000.0d0, .0d0, 12000.0d0, .0d0, & 14000.0d0, .0d0, 16000.0d0, .0d0, 20000.0d0, .0d0, & 24000.0d0, .0d0, 28000.0d0, .0d0, 32000.0d0, .0d0, & 36000.0d0, .0d0, 40000.0d0, .0d0, 50000.0d0, .0d0, & 70000.0d0, .0d0,100000.0d0, .0d0,200000.0d0, .0d0, & 1.e20, .0d0/ data tabs/ & 1000.0d0, .0d0, 2000.0d0, .0d0, 3000.0d0, .0d0, & 4000.0d0, .0d0, 5000.0d0, .0d0, 6000.0d0, .0d0, & 7000.0d0, .0d0, 8000.0d0, .0d0, 10000.0d0, .0d0, & 12000.0d0, .0d0, 14000.0d0, .0d0, 16000.0d0, .0d0, & 18000.0d0, .0d0, 20000.0d0, .0d0, 25000.0d0, .0d0, & 35000.0d0, .0d0, 50000.0d0, .0d0,100000.0d0, .0d0, & 1.e20, .0d0/ data tabsp/ & 1000.0d0, .0d0, 2000.0d0, .0d0, 3000.0d0, .0d0, & 4000.0d0, .0d0, 5000.0d0, .0d0, 6000.0d0, .0d0, & 7000.0d0, .0d0, 8000.0d0, .0d0, 10000.0d0, .0d0, & 12000.0d0, .0d0, 14000.0d0, .0d0, 16000.0d0, .0d0, & 18000.0d0, .0d0, 20000.0d0, .0d0, 25000.0d0, .0d0, & 35000.0d0, .0d0, 50000.0d0, .0d0,100000.0d0, .0d0, & 1.e20, .0d0/ data tab87m/ & 8000.0d0, 2.4d0, 16000.0d0, 3.8d0, 24000.0d0, 4.8d0, & 36000.0d0, 5.9d0, 48000.0d0, 6.9d0, 64000.0d0, 7.7d0, & 1.e20, 8.5d0/ data tab87h/ & 5200.0d0, 1.8d0, 10400.0d0, 3.0d0, 18000.0d0, 4.5d0, & 28000.0d0, 5.8d0, 40000.0d0, 6.9d0, 52000.0d0, 7.7d0, & 1.e20, 8.5d0/ data tab87s/ & 5200.0d0, 1.8d0, 10400.0d0, 3.0d0, 15600.0d0, 4.5d0, & 23400.0d0, 5.8d0, 31200.0d0, 6.9d0, 41600.0d0, 7.7d0, & 1.e20, 8.5d0/ data tab94m/ & 8000.0d0, 2.2d0, 16100.0d0, 3.2d0, 24000.0d0, 4.7d0, & 36000.0d0, 6.0d0, 48100.0d0, 7.1d0, 64000.0d0, 7.9d0, & 1.e20, 8.5d0/ data tab94s/ & 5500.0d0, 1.7d0, 6000.0d0, 2.8d0, 11000.0d0, 3.0d0, & 16000.0d0, 4.7d0, 27000.0d0, 6.0d0, 31200.0d0, 7.1d0, & 41600.0d0, 7.9d0, 1.e20, 8.5d0/ data tab94h/ & 7000.0d0, 1.7d0, 14000.0d0, 3.2d0, 20000.0d0, 4.7d0, & 33000.0d0, 6.0d0, 48100.0d0, 7.1d0, 64000.0d0, 7.9d0, & 1.e20, 8.5d0/ c rates for 95-97 for single and head of households are the same data tab95s/ & 5000.0d0, 1.7d0, 6000.0d0, 2.5d0, 10000.0d0, 3.2d0, & 11000.0d0, 3.3d0, 15000.0d0, 4.7d0, 16000.0d0, 4.8d0, & 26000.0d0, 6.0d0, 42000.0d0, 7.1d0, 65000.0d0, 7.9d0, & 1.e20, 8.5d0/ data tab95h/ & 7000.0d0, 1.7d0, 8000.0d0, 3.1d0, 14000.0d0, 3.2d0, & 20000.0d0, 4.7d0, 33000.0d0, 6.0d0, 56000.0d0, 7.1d0, & 83000.0d0, 7.9d0, 1.e20, 8.5d0/ data tab95m/ & 7000.0d0, 2.0d0, 8000.0d0, 2.3d0, 16000.0d0, 3.2d0, & 23000.0d0, 4.7d0, 24000.0d0, 4.8d0, 40000.0d0, 6.0d0, & 56000.0d0, 7.1d0, 88000.0d0, 7.9d0, 1.e20, 8.5d0/ data tab95e/ & 3000.0d0, 2.2d0, 4000.0d0, 2.3d0, 8000.0d0, 3.2d0, & 12000.0d0, 4.7d0, 20000.0d0, 6.0d0,32000.0d0, 7.1d0, & 50000.0d0, 7.9d0, 1.e20, 8.5d0/ data tab96m/ & 7000.0d0, 1.7d0, 8000.0d0, 1.8d0, 16000.0d0, 3.2d0, & 24000.0d0, 4.7d0, 40000.0d0, 6.0d0, 64000.0d0, 7.1d0, & 100000.0d0, 7.9d0, 1.e20, 8.5d0/ data tab98s/ & 5000.0d0, 1.7d0, 6000.0d0, 2.5d0, 10000.0d0, 3.2d0, & 11000.0d0, 3.3d0, 15000.0d0, 4.7d0, 16000.0d0, 4.8d0, & 26000.0d0, 6.0d0, 42000.0d0, 7.1d0, 65000.0d0, 7.9d0, & 1.e20, 8.2d0/ data tab03s/ & 1000.0d0, 1.6d0, 5000.0d0, 1.7d0, 6000.0d0, 2.4d0, & 11000.0d0, 3.2d0, 12000.0d0, 4.6d0,16000.0d0, 4.7d0, & 26000.0d0, 6.0d0, 27000.0d0, 7.0d0,42000.0d0, 7.1d0, & 1.e20, 7.7d0/ data tab04s/ & 5000.0d0, 1.7d0, 6000.0d0, 2.4d0, 11000.0d0, 3.2d0, & 16000.0d0, 4.7d0, 26000.0d0, 6.0d0, 1.e20, 6.8d0/ data tab05s/ & 5500.0d0, 1.7d0, 11000.0d0, 3.2d0, 16000.0d0, 4.7d0, & 1.e20, 5.7d0/ data tab06s/ & 5500.0d0, 1.7d0, 11000.0d0, 3.2d0, 16000.0d0, 4.7d0, & 1.e20, 5.3d0/ data tab08s/ & 5000.0d0, 1.7d0, 11000.0d0, 3.2d0, 16000.0d0, 4.7d0, & 1.e20, 4.9d0/ data tab98h/ & 7000.0d0, 1.7d0, 8000.0d0, 3.1d0, 14000.0d0, 3.2d0, & 20000.0d0, 4.7d0, 33000.0d0, 6.0d0, 56000.0d0, 7.1d0, & 83000.0d0, 7.9d0, 1.e20, 8.2d0/ data tab03h/ & 7000.0d0, 1.7d0, 14000.0d0, 3.2d0, 20000.0d0, 4.7d0, & 33000.0d0, 6.0d0, 53000.0d0, 7.1d0, 1.e20, 7.7d0/ data tab04h/ & 7000.0d0, 1.7d0, 14000.0d0, 3.2d0, 20000.0d0, 4.7d0, & 33000.0d0, 6.0d0, 1.e20, 6.8d0/ data tab05h/ & 7000.0d0, 1.7d0, 14000.0d0, 3.2d0, 20000.0d0, 4.7d0, & 1.e20, 5.7d0/ data tab98m/ & 7000.0d0, 1.7d0, 8000.0d0, 1.8d0, 16000.0d0, 3.2d0, & 24000.0d0, 4.7d0, 40000.0d0, 6.0d0, 64000.0d0, 7.1d0, & 100000.0d0, 7.9d0, 1.e20, 8.2d0/ data tab03m/ & 7000.0d0, 1.7d0, 8000.0d0, 3.1d0, 16000.0d0, 3.2d0, & 23000.0d0, 4.7d0, 40000.0d0, 6.0d0, 63000.0d0, 7.1d0, & 1.e20, 7.7d0/ data tab04m/ & 8000.0d0, 1.7d0, 16000.0d0, 3.2d0, 24000.0d0, 4.7d0, & 40000.0d0, 6.0d0, 1.e20, 6.8d0/ data tab05m/ & 8000.0d0, 1.7d0, 16000.0d0, 3.2d0, 24000.0d0, 4.70d0, & 1.e20, 5.7d0/ data tab06m/ & 8000.0d0, 1.7d0, 16000.0d0, 3.2d0, 24000.0d0, 4.7d0, & 1.e20, 5.3d0/ data tab08m/ & 8000.0d0, 1.7d0, 16000.0d0, 3.2d0, 24000.0d0, 4.7d0, & 1.e20 , 4.9d0/ data eldm85/ & 30000.0d0, 6000.0d0, 33000.0d0, 5000.0d0, 36000.0d0, 4000.0d0, & 39000.0d0, 3000.0d0, 42000.0d0, 2000.0d0, 45000.0d0, 1000.0d0, & 1.e20, .0d0/ data elds85/ & 18000.0d0, 6000.0d0, 19500.0d0, 5000.0d0, 21000.0d0, 4000.0d0, & 22500.0d0, 3000.0d0, 24000.0d0, 2000.0d0, 25500.0d0, 1000.0d0, & 1.e20, .0d0/ data eldp85/ & 15000.0d0, 6000.0d0, 16500.0d0, 5000.0d0, 18000.0d0, 4000.0d0, & 19500.0d0, 3000.0d0, 21000.0d0, 2000.0d0, 22500.0d0, 1000.0d0, & 1.e20, .0d0/ data eldm87/ & 30000.0d0, 8000.0d0, 33000.0d0, 7000.0d0, 36000.0d0, 6000.0d0, & 39000.0d0, 5000.0d0, 42000.0d0, 4000.0d0, 45000.0d0, 3000.0d0, & 48000.0d0, 2000.0d0, 51000.0d0, 1000.0d0, 1.e20, .0d0/ data elds87/ & 18000.0d0, 8000.0d0, 19500.0d0, 7000.0d0, 21000.0d0, 6000.0d0, & 22500.0d0, 5000.0d0, 24000.0d0, 4000.0d0, 25500.0d0, 3000.0d0, & 27000.0d0, 2000.0d0, 28500.0d0, 1000.0d0, 1.e20, .0d0/ data eldp87/ & 15000.0d0, 8000.0d0, 16500.0d0, 7000.0d0, 18000.0d0, 6000.0d0, & 19500.0d0, 5000.0d0, 21000.0d0, 4000.0d0, 22500.0d0, 3000.0d0, & 24000.0d0, 2000.0d0, 25500.0d0, 1000.0d0, 1.e20, .0d0/ data proptb / & 1000.0d0, 20.0d0, 2000.0d0, 25.0d0, 3000.0d0, 30.0d0, & 4000.0d0, 35.0d0, 5000.0d0, 40.0d0, 6000.0d0, 45.0d0, & 7000.0d0, 50.0d0, 8000.0d0, 55.0d0, 9000.0d0, 60.0d0, & 10000.0d0, 75.0d0,11000.0d0, 90.0d0,12000.0d0,105.0d0, & 13000.0d0,120.0d0,14000.0d0,135.0d0,15000.0d0,150.0d0, & 16000.0d0,180.0d0, 1.e20, 0.0d0/ data low77/ & 501.0d0, 87.0d0,103.0d0,115.0d0,125.0d0,132.0d0,209.0d0, & 1001.0d0,102.0d0,131.0d0,152.0d0,172.0d0,187.0d0,307.0d0, & 1501.0d0, 91.0d0,127.0d0,156.0d0,184.0d0,204.0d0,347.0d0, & 2001.0d0, 68.0d0,111.0d0,146.0d0,183.0d0,209.0d0,362.0d0, & 2501.0d0, 39.0d0, 89.0d0,128.0d0,173.0d0,203.0d0,363.0d0, & 3001.0d0, 10.0d0, 60.0d0,106.0d0,157.0d0,192.0d0,354.0d0, & 3501.0d0, 5.0d0, 29.0d0, 79.0d0,137.0d0,177.0d0,336.0d0, & 4001.0d0, 3.0d0, 5.0d0, 49.0d0,115.0d0,158.0d0,314.0d0, & 4501.0d0, 0.0d0, 4.0d0, 17.0d0, 89.0d0,136.0d0,288.0d0, & 5001.0d0, 0.0d0, 3.0d0, 8.0d0, 62.0d0,113.0d0,255.0d0, & 5501.0d0, 0.0d0, 0.0d0, 4.0d0, 33.0d0, 89.0d0,220.0d0, & 6001.0d0, 0.0d0, 0.0d0, 3.0d0, 13.0d0, 62.0d0,183.0d0, & 6501.0d0, 0.0d0, 0.0d0, 0.0d0, 7.0d0, 34.0d0,143.0d0, & 7001.0d0, 0.0d0, 0.0d0, 0.0d0, 3.0d0, 15.0d0,112.0d0, & 7501.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 8.0d0, 83.0d0, & 8001.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 4.0d0, 52.0d0, & 8501.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 21.0d0, & 9001.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 5.0d0, & 1.e20, .0d0, .0d0, .0d0, .0d0, .0d0, .0d0/ data low81/ & 501.0d0, 105.0d0, 120.0d0, 130.0d0, 140.0d0, 150.0d0, 230.0d0, & 1001.0d0, 130.0d0, 155.0d0, 180.0d0, 205.0d0, 225.0d0, 325.0d0, & 1501.0d0, 120.0d0, 160.0d0, 195.0d0, 230.0d0, 250.0d0, 355.0d0, & 2001.0d0, 110.0d0, 155.0d0, 190.0d0, 235.0d0, 265.0d0, 370.0d0, & 2501.0d0, 80.0d0, 135.0d0, 180.0d0, 225.0d0, 260.0d0, 375.0d0, & 3001.0d0, 50.0d0, 110.0d0, 160.0d0, 215.0d0, 245.0d0, 365.0d0, & 3501.0d0, 30.0d0, 80.0d0, 135.0d0, 200.0d0, 240.0d0, 345.0d0, & 4001.0d0, 20.0d0, 50.0d0, 105.0d0, 185.0d0, 230.0d0, 320.0d0, & 4501.0d0, 10.0d0, 30.0d0, 75.0d0, 160.0d0, 210.0d0, 290.0d0, & 5001.0d0, 5.0d0, 15.0d0, 50.0d0, 135.0d0, 190.0d0, 270.0d0, & 5501.0d0, 0.0d0, 10.0d0, 30.0d0, 115.0d0, 160.0d0, 230.0d0, & 6001.0d0, 0.0d0, 5.0d0, 15.0d0, 80.0d0, 140.0d0, 190.0d0, & 6501.0d0, 0.0d0, 0.0d0, 10.0d0, 50.0d0, 120.0d0, 150.0d0, & 7001.0d0, 0.0d0, 0.0d0, 5.0d0, 35.0d0, 95.0d0, 120.0d0, & 7501.0d0, 0.0d0, 0.0d0, 0.0d0, 25.0d0, 65.0d0, 90.0d0, & 8001.0d0, 3*0.0d0, 15.0d0, 40.0d0, 60.0d0, & 8501.0d0, 3*0.0d0, 5.0d0, 25.0d0, 45.0d0, & 9001.0d0, 4*0.0d0, 15.0d0, 30.0d0, & 9501.0d0, 4*0.0d0, 5.0d0, 20.0d0, & 10001.0d0, 5*0.0d0, 10.0d0, 1.e20,6*0.0d0/ data low94/ & 501.0d0, 120.0d0, 150.0d0, 175.0d0, 200.0d0, 225.0d0, 320.0d0, & 1001.0d0, 135.0d0, 185.0d0, 225.0d0, 265.0d0, 300.0d0, 415.0d0, & 1501.0d0, 135.0d0, 190.0d0, 235.0d0, 290.0d0, 325.0d0, 435.0d0, & 2001.0d0, 135.0d0, 190.0d0, 235.0d0, 290.0d0, 325.0d0, 450.0d0, & 2501.0d0, 135.0d0, 190.0d0, 240.0d0, 290.0d0, 325.0d0, 450.0d0, & 3001.0d0, 135.0d0, 190.0d0, 240.0d0, 290.0d0, 325.0d0, 450.0d0, & 3501.0d0, 135.0d0, 190.0d0, 240.0d0, 290.0d0, 325.0d0, 450.0d0, & 4001.0d0, 135.0d0, 190.0d0, 240.0d0, 300.0d0, 335.0d0, 450.0d0, & 4501.0d0, 135.0d0, 190.0d0, 240.0d0, 300.0d0, 355.0d0, 450.0d0, & 5001.0d0, 115.0d0, 150.0d0, 205.0d0, 300.0d0, 355.0d0, 450.0d0, & 5501.0d0, 95.0d0, 130.0d0, 165.0d0, 260.0d0, 355.0d0, 430.0d0, & 6001.0d0, 75.0d0, 110.0d0, 145.0d0, 220.0d0, 315.0d0, 410.0d0, & 6501.0d0, 55.0d0, 90.0d0, 125.0d0, 180.0d0, 275.0d0, 370.0d0, & 7001.0d0, 35.0d0, 70.0d0, 105.0d0, 140.0d0, 235.0d0, 330.0d0, & 7501.0d0, 15.0d0, 50.0d0, 85.0d0, 120.0d0, 195.0d0, 290.0d0, & 8001.0d0, 10.0d0, 20.0d0, 50.0d0, 80.0d0, 130.0d0, 220.0d0, & 8501.0d0, 10.0d0, 20.0d0, 30.0d0, 60.0d0, 90.0d0, 180.0d0, & 9001.0d0, 10.0d0, 20.0d0, 30.0d0, 40.0d0, 70.0d0, 140.0d0, & 9501.0d0, 10.0d0, 20.0d0, 30.0d0, 40.0d0, 60.0d0, 100.0d0, &10001.0d0, 10.0d0, 20.0d0, 30.0d0, 40.0d0, 50.0d0, 80.0d0, &11501.0d0, 10.0d0, 20.0d0, 30.0d0, 40.0d0, 50.0d0, 60.0d0, &14001.0d0, 5.0d0, 10.0d0, 15.0d0, 20.0d0, 25.0d0, 30.0d0, & 1.e20, 6*0.0d0/ data low98/ & 501.0d0, 120.0d0, 160.0d0, 200.0d0, 240.0d0, 280.0d0, 320.0d0, & 1001.0d0, 135.0d0, 195.0d0, 250.0d0, 310.0d0, 350.0d0, 415.0d0, & 1501.0d0, 135.0d0, 195.0d0, 250.0d0, 310.0d0, 350.0d0, 435.0d0, & 3501.0d0, 135.0d0, 195.0d0, 250.0d0, 310.0d0, 350.0d0, 450.0d0, & 4501.0d0, 135.0d0, 195.0d0, 250.0d0, 310.0d0, 355.0d0, 450.0d0, & 5001.0d0, 125.0d0, 190.0d0, 240.0d0, 305.0d0, 355.0d0, 450.0d0, & 5501.0d0, 115.0d0, 175.0d0, 230.0d0, 295.0d0, 355.0d0, 430.0d0, & 6001.0d0, 105.0d0, 155.0d0, 210.0d0, 260.0d0, 315.0d0, 410.0d0, & 7001.0d0, 90.0d0, 130.0d0, 170.0d0, 220.0d0, 275.0d0, 370.0d0, & 8001.0d0, 80.0d0, 115.0d0, 145.0d0, 180.0d0, 225.0d0, 295.0d0, & 9001.0d0, 70.0d0, 105.0d0, 135.0d0, 170.0d0, 195.0d0, 240.0d0, &10001.0d0, 65.0d0, 95.0d0, 115.0d0, 145.0d0, 175.0d0, 205.0d0, &11001.0d0, 60.0d0, 80.0d0, 100.0d0, 130.0d0, 155.0d0, 185.0d0, &12001.0d0, 55.0d0, 70.0d0, 90.0d0, 110.0d0, 135.0d0, 160.0d0, &14001.0d0, 50.0d0, 65.0d0, 85.0d0, 100.0d0, 115.0d0, 140.0d0, &15001.0d0, 45.0d0, 60.0d0, 75.0d0, 90.0d0, 105.0d0, 120.0d0, &16001.0d0, 40.0d0, 55.0d0, 70.0d0, 85.0d0, 95.0d0, 110.0d0, &17001.0d0, 35.0d0, 50.0d0, 65.0d0, 80.0d0, 85.0d0, 105.0d0, &18001.0d0, 30.0d0, 45.0d0, 60.0d0, 70.0d0, 80.0d0, 95.0d0, &19001.0d0, 25.0d0, 35.0d0, 50.0d0, 60.0d0, 70.0d0, 80.0d0, &20001.0d0, 20.0d0, 30.0d0, 40.0d0, 50.0d0, 60.0d0, 65.0d0, &21001.0d0, 15.0d0, 25.0d0, 30.0d0, 40.0d0, 50.0d0, 55.0d0, &22001.0d0, 10.0d0, 20.0d0, 25.0d0, 35.0d0, 40.0d0, 45.0d0, & 1.e20,6* 0.0d0/ data l77/38*0.0d0/ data l81/42*0.0d0/ data l94/46*0.0d0/ data l98/48*0.0d0/ c data std84/2230.,3400.,1700.,2230.,3400.,1700.,2230./ c data std85/2390.,3540.,1770.,2390.,3540.,1770.,2390./ data std86/3000.0d0,4000.0d0,2000.0d0,3500.0d0,4000.0d0, & 2000.0d0,3500.0d0/ data std90/3250.0d0,5450.0d0,2725.0d0,4750.0d0,5450.0d0, & 2725.0d0,4750.0d0/ data xmp/2*750.0d0,5*1000.0d0,2*0.0d0,4*2000.0d0, & 2050.0d0,9*0.0d0/ data food/2*0.0d0,2*40.0d0,5*45.0d0,4*52.50d0/ data foods/6000.0d0,52.50d0, 9000.0d0,38.0d0,10500.0d0, & 14.0d0,1.e20,0.0d0/ data foodm/9000.0d0,52.50d0,14000.0d0,38.0d0,16000.0d0, & 14.0d0,1.e20,0.0d0/ data amed/4*5.0d0,9*7.50d0,5*0.0d0/ data adf/4*1.0d0,.74410d0,.66410d0,4*.8670d0,8*1.0d0/ data chlim/ & 9*13936.0d0, 15808.0d0, 5*17680.0d0, 18200.0d0, & 20137.0d0,10*21424.0d0, 27248.0d0,8*30160.0d0/ rt=0. mst = data(2) sep = data(3) if(law.le.1986) then do 10 i=1,19 tabs(2,i)=(nint(10.*tab77s(2,i)*adf(law)))/10. tabm(2,i)=(nint(10.*tab77m(2,i)*adf(law)))/10. tabsp(2,i)=(nint(10.*tb77sp(2,i)*adf(law)))/10. 10 continue if(law.ge.1983) then tabs(2,14)=5.6 tabm(2,14)=5.6 tabsp(2,14)=5.6 endif endif c AGI if(mst.eq.1)mstat=1 if(mst.eq.3.or.mst.eq.6)mstat=2 if(mst.eq.2.or.mst.eq.4.or.mst.eq.5.or.mst.eq.7)mstat=3 agi = comnew(2)-data(22) c Social Security Benefits are not taxable in NM 1984-1989 if(law.ge.1984.and.law.le.1989) agi = agi + comnew(79) c Net Capital gains deduction if(comnew(6).gt.0) then if(law.ge.1999.and.law.le.2002)agi=agi-min(comnew(6),1000.0d0) if(law.eq.2003)agi=agi-min(comnew(6),max(1000.0d0,.1*comnew(6))) if(law.eq.2004)agi=agi-min(comnew(6),max(1000.0d0,.2*comnew(6))) if(law.eq.2005)agi=agi-min(comnew(6),max(1000.0d0,.3*comnew(6))) if(law.eq.2006)agi=agi-min(comnew(6),max(1000.0d0,.4*comnew(6))) if(law.ge.2007)agi=agi-min(comnew(6),max(1000.0d0,.5*comnew(6))) endif c Deduction for persons age 65 and older or blind elded = 0. if(data(9)+data(10).gt.0.) then if(law.ge.1981.and.law.le.1984) then elded=6000*data(9) else if(law.eq.1985.or.law.eq.1986) then if(mstat.eq.2)elded=tablki(eldp85,7,agi,data)*data(9) if(mstat.eq.1)elded=tablki(elds85,7,agi,data)*data(9) if(mstat.eq.3)elded=tablki(eldm85,7,agi,data)*data(9) else if(law.ge.1987) then nold=min(data(10)+data(9),data(7)) if(mstat.eq.2)elded=tablki(eldp87,9,agi,data)*nold if(mstat.eq.1)elded=tablki(elds87,9,agi,data)*nold if(mstat.eq.3)elded=tablki(eldm87,9,agi,data)*nold endif endif c itemized Deductions xitded = 0. if(comnew(26).gt.0) then xitded = max(0.d0, & comnew(24) - min(comnew(24)-comnew(3),data(50))) endif c Standard Deduction if(law.le.1985.or.law.ge.1991) then stded=comnew(3) else if(law.ge.1986.and.law.le.1989) then stded=std86(mst) else if(law.eq.1990) then stded=std90(mst) endif if(law.ge.1982.and.law.le.1985)stded=stded+comnew(81) deduc = max(xitded,stded) c Exemptions if(law.eq.1984.or.law.eq.1985.or.law.ge.1991) then exemp=comnew(83) else exemp=xmp(law)*comnew(68) endif c since 2006 low- and middle-income tax exemption (additional) if(law.ge.2006) then if(mst.eq.1) agilow = exlow(1,law) if(mst.ne.1) agilow = exlow(2,law)/sep if(comnew(2).le.agilow) then if(law.eq.2006)phase = filing(mst,16000.,24000.,24000.,12000.) if(law.ge.2007)phase = filing(mst,20000.,30000.,30000.,15000.) perc = filing(mst,.15,.1,.1,.2) exemp = exemp + & comnew(68)*max(0.0d0,2500. - perc*max(0.0d0,comnew(2)-phase)) endif endif if(data(105).gt.0.d0) exemp = 0.d0 c Medical Care Expenses - New in 2000 med = 0. if(law.ge.2000) then if(comnew(26).lt.1.0d0) then medexp=data(47)+data(48)+data(49) else medexp=data(47)+data(48)+data(49)-comnew(20) endif if(medexp.gt.0) then if(mst.eq.4.or.mst.eq.7) then if(agi.lt.20000) med=.25*medexp if(agi.ge.20000.and.agi.lt.50000) med=.15*medexp if(agi.ge.50000) med=.1*medexp else if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then if(agi.lt.15000) med=.25*medexp if(agi.ge.15000.and.agi.lt.35000) med=.15*medexp if(agi.ge.35000) med=.1*medexp else if(agi.lt.30000) med=.25*medexp if(agi.ge.30000.and.agi.lt.70000) med=.15*medexp if(agi.ge.70000) med=.1*medexp endif endif endif c Taxable Income taxinc = max(0.0d0,agi-elded-deduc-exemp-med) c Statax Calculation c before 1986 if(law.le.1986) then if(mstat.eq.1) & call look(tabs,taxinc,19,n,statax,1.0d00,0.0d0,rt,data) if(mstat.eq.2) & call look(tabsp,taxinc,19,n,statax,1.0d00,0.0d0,rt,data) if(mstat.eq.3) & call look(tabm,taxinc,19,n,statax,1.0d00,0.0d0,rt,data) else if(law.le.2005) then c 1986 - 2005 if(mst.eq.2.or.mst.eq.3.or.mst.eq.6)mstat=3 if(mst.eq.4.or.mst.eq.7)mstat=2 if(mst.eq.1)mstat=1 c single if(mstat.eq.1) then if(law.ge.1987.and.law.le.1993) then call look(tab87s,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1994) then call look(tab94s,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1995.and.law.le.1997) then call look(tab95s,taxinc,10,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1998.and.law.le.2002) then call look(tab98s,taxinc,10,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2003) then call look(tab03s,taxinc,10,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2004) then call look(tab04s,taxinc,6,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2005) then call look(tab05s,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) endif c head of household else if(mstat.eq.2) then if(law.ge.1987.and.law.le.1993) then call look(tab87h,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1994) then call look(tab94h,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1995.and.law.le.1997) then call look(tab95h,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1998.and.law.le.2002) then call look(tab98h,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2003) then call look(tab03h,taxinc,6,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2004) then call look(tab04h,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2005) then call look(tab05h,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) endif else c married taxy=taxinc*sep if(law.ge.1987.and.law.le.1993) then call look(tab87m,taxy,7,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1994) then call look(tab94m,taxy,7,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1995) then if(sep.lt.2.)then call look(tab95m,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) else call look(tab95e,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) endif else if(law.eq.1996.or.law.eq.1997) then call look(tab96m,taxy,8,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1998.and.law.le.2002) then call look(tab98m,taxy,8,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2003) then call look(tab03m,taxy,7,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2004) then call look(tab04m,taxy,5,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2005) then call look(tab05m,taxy,4,n,statax,1.0d00,0.0d0,rt,data) endif if(law.ne.1995) statax=statax/sep endif else if (law.ge.2006) then if(mst.eq.1) then if(law.eq.2006.or.law.eq.2007) then call look(tab06s,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.2008) then call look(tab08s,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) endif else taxy = taxinc*sep if(law.eq.2006.or.law.eq.2007) then call look(tab06m,taxy,4,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.2008) then call look(tab08m,taxy,4,n,statax,1.0d00,0.0d0,rt,data) endif statax = statax/sep endif endif c all credits are refundable credit=0. c Low Income Comprehensive Tax Rebate ncred=min(data(7)+data(8)+data(9)+data(10),6.0d0) modagi = data(11)+data(91)+data(82)+max(0.0d0,data(17)) &+max(0.0d0,data(70))+max(0.0d0,data(68))+data(12)+data(14) &+max(0.0d0,data(24))+data(23)+data(20)+data(72)+data(19) c actually starts in 1984? if(law.ge.1985)ncred=min(ncred+data(9)+data(10),6.0d0) ycred=0. if(ncred.gt.0) then if(law.le.1980) then c before 1980 do 15 i=1,19 l77(1,i)=low77(0,i) l77(2,i)=low77(ncred,i) 15 continue ycred = tablki(l77,19,modagi,data) c 1981 - 1993 else if(law.ge.1981.and.law.le.1993) then do 25 i=1,21 l81(1,i) = low81(0,i) l81(2,i) = low81(ncred,i) 25 continue ycred = tablki(l81,21,modagi,data) c 1994 -1997 else if(law.ge.1994.and.law.le.1997) then do 35 i=1,23 l94(1,i) = low94(0,i) l94(2,i) = low94(ncred,i) 35 continue ycred = tablki(l94,23,modagi,data) c 1998+ else do 45 i=1,24 l98(1,i) = low98(0,i) l98(2,i) = low98(ncred,i) 45 continue ycred = tablki(l98,24,modagi,data) endif endif if(data(105).gt.0.d0) ycred = 0.d0 c low income food and medical crdt xtra = 0. if(law.le.1985) then xtra = (food(law)*ncred) + max(amed(law)*ncred,.04*comnew(20)) else if(law.ge.1986.and.law.le.1989) then if(ycred.gt.0.) xtra = (data(7)+data(8))*food(law) else if(law.eq.1990) then if(mst.eq.1) then xtra = tablki(foods,4,data(159),data)*(data(7)+data(8)) else xtra = tablki(foodm,4,data(159)/data(3), & data)*(data(7)+data(8)) endif endif c child day care credit only since 1981 child=0. exp=0. chcr=0. if(law.ge.1981) then if(modagi.lt.chlim(law)) then child = min(data(8),4.0d0) exp = min(.4*data(64),480.*child) chcr = max(0.0d0,min(1200.0d0,exp)-comnew(53)) endif endif c property tax rebate for persons 65 or over c with a Modified AGI of $16k or less pcred=0. if(data(9).gt.0..and.modagi.le.16000.) then pmax=tablki(proptb,17,modagi,data) ptax=data(51)+.06*data(160) pcred=twn(ptax-pmax,0.0d0,250./data(3)) endif c Since 2007 -- Working families tax credit earncr = 0. if(law.eq.2007) earncr = .08*comnew(59) if(law.ge.2008) earncr = .1 *comnew(59) credit = ycred + xtra + chcr + pcred + earncr statax=statax-credit return end c NEW YORK c state 33 c Updated through 2016 subroutine nytax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common/rates/mrate double precision mrate,famded, lowfam(2,9) dimension data(255),comnew(255),aif92(1991:2012) dimension hifam1(2,7), hifam2(2,9), famtab(2,4) c tax rates for NY State Tax dimension tab(2,15), tab86(2,13),chld96(2,12),earate(1994:2016) dimension tab87m(2,8), tab87s(2,8),tab87h(2,8) dimension tab88m(2,7), tab88s(2,7), tab88h(2,7), ptab85(2,8) dimension tab89m(2,5), tab89s(2,5), tab89h(2,5) dimension tab95m(2,4), tab95s(2,7), tab95h(2,4) dimension tab96m(2,5), tab96s(2,5), tab96h(2,5) dimension tab97m(2,5), tab97s(2,5), tab97h(2,5) dimension tab03m(2,6), tab03s(2,6), tab03h(2,6) dimension tab04m(2,7), tab04s(2,7), tab04h(2,7) dimension tab06m(2,5), tab06s(2,5), tab06h(2,5) dimension tab09m(2,7), tab09s(2,7), tab09h(2,7) dimension tab12m(2,8), tab12s(2,8), tab12h(2,8) dimension pmxt78(2,4), emax78(2,4), ptab78(2,4), etab78(2,4) dimension emax81(2,3), ptab81(2,4), etab81(2,5), ptab82(2,5) dimension ed(2001:2016), perc(2001:2016), aif12(2012:2016) double precision max78(2,3),max80(2,4),max81(2,5),max85(2,6), & max86(2,6),old(2,18),young(2,18) dimension stdr(1977:1984),stdmax(1977:1984) dimension stdm(1977:2016),stds(1977:2016),stdh(1977:2016), & stdd(1987:2016) dimension xded(7),xmp(1977:2016) dimension htab1(2,5),htabs(2,7),htabm(2,9),htabd(2,4) integer sep dimension add12(7,2012:2016) data add12/ 2 634.0d0, 934.0d0, 1534.0d0, 467.0d0, 867.0d0,675.0d0,1175.0d0, 3 652.0d0, 961.0d0, 1578.0d0, 480.0d0, 892.0d0,695.0d0,1209.0d0, 4 662.0d0, 976.0d0, 1604.0d0, 487.0d0, 905.0d0,706.0d0,1229.0d0, 5 672.0d0, 991.0d0, 1628.0d0, 494.0d0, 919.0d0,716.0d0,1247.0d0, 6 677.0d0, 998.0d0, 1640.0d0, 497.0d0, 925.0d0,720.0d0,1255.0d0/ data aif12 /1.0d0,1.025d0,1.0375d0, 1.05d0, 1.05625d0/ data perc/ & .25d0, .5d0, .75d0, 13*1.0d0/ data ed/ & 50.0d0,100.0d0,150.0d0 , 13*200.0d0/ data earate/ & .075d0, .1d0, 4 * .2d0, .225d0, .25d0, .275d0, 14*.3d0/ data aif92/ & 1.0d0, 1.0525d0, 1.0845d0, 1.118d0 , 1.147d0 , 1.1795d0, & 1.212d0, 1.2450d0, 1.2660d0, 1.2895d0, 1.3295d0, 1.3730d0, & 1.395d0, 1.4270d0, 1.4595d0, 1.5050d0, 1.5640d0, 1.5995d0, & 1.668d0, 2*1.6955d0, 1.7365d0/ data lowfam/ & 31000.0d0, .0d0, 32000.0d0, 500.0d0, 33000.0d0, 1000.0d0, & 34000.0d0,1500.0d0, 35000.0d0,2000.0d0, 36000.0d0, 2500.0d0, & 37000.0d0, .0d0, 38000.0d0, .0d0, 1.e20, 1.e20/ data hifam1/ & 31000.0d0,3000.0d0, 32000.0d0,2500.0d0, 33000.0d0, 2000.0d0, & 34000.0d0,1500.0d0, 35000.0d0,1000.0d0, 36000.0d0, 500.0d0, & 1.e20, .0d0/ data hifam2/ & 31000.0d0,4000.0d0, 32000.0d0,3500.0d0, 33000.0d0, 3000.0d0, & 34000.0d0,2500.0d0, 35000.0d0,2000.0d0, 36000.0d0, 1500.0d0, & 37000.0d0,1000.0d0, 38000.0d0, 500.0d0, 1.e20, .0d0/ data chld96/ & 10000.0d0, .3d0 , 10400.0d0, .295d0, 10800.0d0, .285d0, & 11200.0d0, .275d0, 11600.0d0, .265d0, 12000.0d0, .255d0, & 12400.0d0, .245d0, 12800.0d0, .235d0, 13200.0d0, .225d0, & 13600.0d0, .215d0, 13999.0d0, .205d0, 1.e20, .2d0/ data tab/ & 1000.0d0, 2.0d0, 3000.0d0, 3.0d0, 5000.0d0, 4.0d0, & 7000.0d0, 5.0d0, 9000.0d0, 6.0d0, 11000.0d0, 7.0d0, & 13000.0d0, 8.0d0, 15000.0d0, 9.0d0, 17000.0d0, 10.0d0, & 19000.0d0, 11.0d0, 21000.0d0, 12.0d0, 23000.0d0, 13.0d0, & 25000.0d0, .0d0, 30000.0d0, .0d0, 1.e20, .0d0/ data tab86/ & 1000.0d0, 2.0d0, 3000.0d0, 3.0d0, 5000.0d0, 4.0d0, & 7000.0d0, 5.0d0, 9000.0d0, 6.0d0, 11000.0d0, 7.0d0, & 13500.0d0, 8.0d0, 16000.0d0, 9.0d0, 18500.0d0, 10.0d0, & 21000.0d0, 11.0d0, 23500.0d0, 12.0d0, 26000.0d0, 13.0d0, & 1.e20, 13.5d0/ c 1987 data tab87m/ & 1700.0d0, 2.0d0, 5000.0d0, 3.0d0, 8300.0d0, 4.0d0, & 11700.0d0, 5.0d0, 15000.0d0, 6.0d0, 18300.0d0, 7.0d0, & 23300.0d0, 8.0d0, 1.e20, 8.5d0/ data tab87s/ & 1000.0d0, 2.0d0, 3000.0d0, 3.0d0, 5000.0d0, 4.0d0, & 7000.0d0, 5.0d0, 9000.0d0, 6.0d0, 11000.0d0, 7.0d0, & 14000.0d0, 8.0d0, 1.e20, 8.5d0/ data tab87h/ & 1300.0d0, 2.0d0, 3400.0d0, 3.0d0, 5600.0d0, 4.0d0, & 7800.0d0, 5.0d0, 10100.0d0, 6.0d0, 12400.0d0, 7.0d0, & 15400.0d0, 8.0d0, 1.e20, 8.5d0/ c 1988 data tab88m/ & 6000.0d0, 3.0d0, 10200.0d0, 4.0d0, 14600.0d0, 5.0d0, & 18800.0d0, 6.0d0, 24800.0d0, 7.0d0, 34000.0d0, 8.0d0, & 1.e20, 8.375d0/ data tab88s/ & 3000.0d0, 3.0d0, 5100.0d0, 4.0d0, 7300.0d0, 5.0d0, & 9400.0d0, 6.0d0, 12400.0d0, 7.0d0, 17000.0d0, 8.0d0, & 1.e20, 8.375d0/ data tab88h/ & 3800.0d0, 3.0d0, 6000.0d0, 4.0d0, 8300.0d0, 5.0d0, & 10500.0d0, 6.0d0, 13600.0d0, 7.0d0, 18300.0d0, 8.0d0, & 1.e20, 8.375d0/ c 1989 data tab89m/ & 11000.0d0, 4.0d0, 16000.0d0, 5.0d0, 22000.0d0, 6.0d0, & 26000.0d0, 7.0d0, 1.e20, 7.875d0/ data tab89s/ & 5500.0d0, 4.0d0, 8000.0d0, 5.0d0, 11000.0d0, 6.0d0, & 13000.0d0, 7.0d0, 1.e20, 7.875d0/ data tab89h/ & 7500.0d0, 4.0d0, 11000.0d0, 5.0d0, 15000.0d0, 6.0d0, & 17000.0d0, 7.0d0, 1.e20, 7.875d0/ c 1995 data tab95m/ & 13000.0d0, 4.6d0, 19000.0d0, 5.6d0, 25000.0d0, 6.6d0, & 1.e20, 7.59375d0/ data tab95s/ & 6000.0d0, 4.6d0, 7000.0d0, 5.1d0, 9000.0d0, 5.5d0, & 10000.0d0, 6.0d0, 12000.0d0, 6.5d0, 13000.0d0, 7.2d0, & 1.e20, 7.59375d0/ data tab95h/ & 10000.0d0, 4.6d0, 14000.0d0, 5.6d0, 19000.0d0, 6.6d0, & 1.e20, 7.59375d0/ c 1996 data tab96m/ & 11000.0d0, 4.0d0, 16000.0d0, 5.0d0, 22000.0d0, 6.0d0, & 26000.0d0, 7.0d0, 1.e20, 7.125d0/ data tab96s/ & 5500.0d0, 4.0d0, 8000.0d0, 5.0d0, 11000.0d0, 6.0d0, & 13000.0d0, 7.0d0, 1.e20, 7.125d0/ data tab96h/ & 7500.0d0, 4.0d0, 11000.0d0, 5.0d0, 15000.0d0, 6.0d0, & 17000.0d0, 7.0d0, 1.e20, 7.125d0/ c 1997 data tab97s/ & 8000.0d0, 4.0d0, 11000.0d0, 4.5d0, 13000.0d0, 5.25d0, & 20000.0d0, 5.9d0, 1.e20, 6.85d0/ data tab97m/ & 16000.0d0, 4.0d0, 22000.0d0, 4.5d0, 26000.0d0, 5.25d0, & 40000.0d0, 5.9d0, 1.e20, 6.85d0/ data tab97h/ & 11000.0d0, 4.0d0, 15000.0d0, 4.5d0, 17000.0d0, 5.25d0, & 30000.0d0, 5.9d0, 1.e20, 6.85d0/ c 2003 data tab03s/ & 8000.0d0, 4.0d0, 11000.0d0, 4.5d0 , 13000.0d0, 5.25d0, & 20000.0d0, 5.9d0, 100000.0d0, 6.85d0, 1.e20, 7.50d0/ data tab03m/ & 16000.0d0, 4.0d0, 22000.0d0, 4.5d0 , 26000.0d0, 5.25d0, & 40000.0d0, 5.9d0, 150000.0d0, 6.85d0, 1.e20, 7.50d0/ data tab03h/ & 11000.0d0, 4.0d0, 15000.0d0, 4.5d0 , 17000.0d0, 5.25d0, & 30000.0d0, 5.9d0, 125000.0d0, 6.85d0, 1.e20, 7.50d0/ c 2004 data tab04s/ & 8000.0d0, 4.0d0, 11000.0d0, 4.5d0 , 13000.0d0, 5.25d0 , & 20000.0d0, 5.9d0, 100000.0d0, 6.85d0,500000.0d0, 7.375d0, & 1.e20, 7.7d0 / data tab04m/ & 16000.0d0, 4.0d0, 22000.0d0, 4.5d0 , 26000.0d0, 5.25d0 , & 40000.0d0, 5.9d0, 150000.0d0, 6.85d0,500000.0d0, 7.375d0, & 1.e20, 7.7d0 / data tab04h/ & 11000.0d0, 4.0d0, 15000.0d0, 4.5d0 , 17000.0d0, 5.25d0 , & 30000.0d0, 5.9d0, 125000.0d0, 6.85d0,500000.0d0, 7.375d0, & 1.e20, 7.7d0 / c 2006 data tab06s/ & 8000.0d0, 4.0d0, 11000.0d0, 4.5d0 , 13000.0d0, 5.25d0 , & 20000.0d0, 5.9d0, 1.e20, 6.85d0/ data tab06m/ & 16000.0d0, 4.0d0, 22000.0d0, 4.5d0 , 26000.0d0, 5.25d0 , & 40000.0d0, 5.9d0, 1.e20, 6.85d0/ data tab06h/ & 11000.0d0, 4.0d0, 15000.0d0, 4.5d0 , 17000.0d0, 5.25d0, & 30000.0d0, 5.9d0, 1.e20, 6.85d0/ c 2009 data tab09m/ & 16000.0d0, 4.0d0, 22000.0d0, 4.5d0 , 26000.0d0, 5.25d0, & 40000.0d0, 5.9d0, 300000.0d0, 6.85d0,500000.0d0, 7.860d0, & 1.e20, 8.97d0/ data tab09s/ & 8000.0d0, 4.0d0, 11000.0d0, 4.5d0 , 13000.0d0, 5.25d0, & 20000.0d0, 5.9d0, 200000.0d0, 6.85d0,500000.0d0, 7.86d0, & 1.e20, 8.97d0/ data tab09h/ & 11000.0d0, 4.0d0, 15000.0d0, 4.5d0 , 17000.0d0, 5.25d0, & 30000.0d0, 5.9d0, 250000.0d0, 6.85d0,500000.0d0, 7.86d0, & 1.e20, 8.97d0/ c 2012 data tab12m/ & 16000.0d0, 4.0d0 , 22000.0d0, 4.5d0 , 26000.0d0, 5.25d0, & 40000.0d0, 5.9d0 , 150000.0d0, 6.45d0,300000.0d0, 6.65d0, & 2000000.0d0, 6.85d0, 1.e20, 8.82d0/ data tab12s/ & 8000.0d0, 4.0d0 , 11000.0d0, 4.5d0 , 13000.0d0, 5.25d0, & 20000.0d0, 5.9d0 , 75000.0d0, 6.45d0,200000.0d0, 6.65d0, & 1000000.0d0, 6.85d0, 1.e20, 8.82d0/ data tab12h/ & 12000.0d0, 4.0d0 , 16500.0d0, 4.5d0 , 19500.0d0, 5.25d0, & 30000.0d0, 5.9d0 , 100000.0d0, 6.45d0,250000.0d0, 6.65d0, & 1500000.0d0, 6.85d0, 1.e20, 8.82d0/ data famtab/ & 1000.0d0, 2.0d0 , 3000.0d0, 3.0d0, 4000.0d0, 4.0d0, & 1.e20,9999.0d0/ data htab1/ & 5000.0d0, 65.0d0 , 6000.0d0,50.0d0, 7000.0d0, 40.0d0, & 25000.0d0, 35.0d0 , 1.e20, .0d0/ data htabs/ & 5000.0d0, 75.0d0 , 6000.0d0,60.0d0, 7000.0d0, 50.0d0, & 20000.0d0, 45.0d0 , 25000.0d0,40.0d0, 28000.0d0, 20.0d0, & 1.e20, .0d0/ data htabm/ & 5000.0d0, 90.0d0 , 6000.0d0,75.0d0, 7000.0d0, 65.0d0, & 20000.0d0, 60.0d0 , 22000.0d0,60.0d0, 25000.0d0, 50.0d0, & 28000.0d0, 40.0d0 , 32000.0d0,20.0d0, 1.e20, .0d0/ data htabd/ & 20000.0d0, 15.0d0 , 25000.0d0,10.0d0, 32000.0d0, 5.0d0, & 1.e20, .0d0/ c not data max78/ & 21000.0d0, .0d0 , 23000.0d0, 1.0d0, 1.e20, 2.0d0/ data max80/ & 19000.0d0, .0d0 , 21000.0d0, 1.0d0, 23000.0d0, 2.0d0, & 1.e20, 3.0d0/ data max81/ & 17000.0d0, .0d0 , 19000.0d0, 1.0d0, 21000.0d0, 2.0d0, & 23000.0d0, 3.0d0 , 1.e20, 4.0d0/ data max85/ & 15000.0d0, .0d0 , 17000.0d0, .5d0, 19000.0d0, 1.5d0, & 21000.0d0, 2.5d0 , 23000.0d0, 3.5d0, 1.e20, 4.25d0/ data max86/ & 16000.0d0, .0d0 , 18500.0d0, .5d0, 21000.0d0, 1.5d0, & 23500.0d0, 2.5d0 , 26000.0d0, 3.5d0, 1.e20, 4.0d0/ data xmp/ & 2*650.0d0, 700.0d0, 2* 750.0d0, 3*800.0d0, & 2*850.0d0, 900.0d0, 29*1000.0d0/ data stdr/.150d0,3*.160d0,4*.170d0/ data stdm/ & 1500.0d0, 3*1900.0d0, 4*2000.0d0, 2750.0d0, 3000.0d0, & 5300.0d0, 8500.0d0, 6*9500.0d0, 10800.0d0, 12350.0d0, & 4*13000.0d0, 13400.0d0, 14200.0d0,3*14600.0d0,7*15000.0d0, & 15400.0d0, 15650.0d0, 15850.0d0, 15950.0d0/ data stds/ & 1000.0d0, 3*1400.0d0, 4*1500.0d0, 2500.0d0, 2600.0d0, & 3600.0d0, 5000.0d0, 6*6000.0d0, 6600.0d0, 7400.0d0, & 16*7500.0d0, 7700.0d0, 7800.0d0, 7900.0d0, 7950.0d0/ data stdh/ & 10*0.0d0, 4600.0d0, 6000.0d0, 6*7000.0d0, 8150.0d0, & 10000.0d0,16*10500.0d0, 10800.0d0, 10950.0d0,11100.0d0, & 11150.0d0/ data stdd/ & 9*2800.0d0, 2900.0d0, 16*3000.0d0, 3050.0d0,3*3100.0d0/ data stdmax/ & 2000.0d0, 3*2400.0d0, 4*2500.0d0/ data pmxt78/ 5400.0d0, 20.0d0, 7200.0d0, 15.0d0, 12000.0d0, & 10.0d0, 1.e20, 0.0d0/ data emax78/7200.0d0, 200.0d0, 10000.0d0, 40.0d0, 12000.0d0, & 15.0d0, 1.e20, 0.0d0/ data ptab78/ 5400.0d0, .050d0, 10000.0d0, .060d0, 12000.0d0, & .070d0, 1.e20,0.d0/ data etab78/3600.0d0, .040d0, 5400.0d0, .050d0, 7200.0d0, & .060d0, 1.e20,0.d0/ data emax81/7200.0d0, 250.0d0, 13500.0d0,100.0d0,1.e20,0.0d0/ data ptab81/ 5400.0d0, .050d0, 10000.0d0, .060d0, 13500.0d0, & .070d0, 1.e20,0.d0/ data etab81/3600.0d0, .040d0, 5400.0d0, .050d0, 7200.0d0, & .060d0, 13500.0d0, .070d0, 1.e20,0.d0/ data ptab82/ 3600.0d0, .040d0, 5400.0d0,.0450d0, 10000.0d0, & .0550d0, 16000.0d0, .0650d0, 1.e20,0.d0/ data ptab85/ & 3000.d0,.035d0, 5000.d0,.04d0, 7000.d0,.045d0, 9000.d0,.05d0, &11000.d0,.055d0,14000.d0,.06d0,18000.d0,.065d0, 1.e20,0.d0/ data xded/ 100000.0d0, 200000.0d0, 100000.0d0,150000.0d0, & 200000.0d0, 100000.0d0,150000.0d0/ data old/ 1001.0d0,375.0d0, 2001.0d0,358.0d0, 3001.0d0,341.0d0, & 4001.0d0,324.0d0, & 5001.0d0,307.0d0, 6001.0d0,290.0d0, 7001.0d0,273.0d0, & 8001.0d0,256.0d0, & 9001.0d0,239.0d0,10001.0d0,222.0d0,11001.0d0,205.0d0, & 12001.0d0,188.0d0, & 13001.0d0,171.0d0,14001.0d0,154.0d0,15001.0d0,137.0d0, & 16001.0d0,120.0d0, & 17001.0d0,103.0d0,18001.0d0, 86.0d0/ data young/ & 1001.0d0, 75.0d0, 2001.0d0, 73.0d0, 3001.0d0, 71.0d0, & 4001.0d0, 69.0d0, 5001.0d0, 67.0d0, 6001.0d0, 65.0d0, & 7001.0d0, 63.0d0, 8001.0d0, 61.0d0, 9001.0d0, 59.0d0, &10001.0d0, 57.0d0,11001.0d0, 55.0d0,12001.0d0, 53.0d0, &13001.0d0, 51.0d0,14001.0d0, 49.0d0,15001.0d0, 47.0d0, &16001.0d0, 45.0d0,17001.0d0, 43.0d0,18001.0d0, 41.0d0/ c The federal disability income exclusion figure in to the NY pnsion c exclusion, but it's not worth calculating since we have no c SOI variable post-84, when rt=0. mst=data(2) sep=data(3) c New York State AGI ---------------- agi=comnew(2)-data(22)-min(data(20)+data(72),data(9)*20000.) if(law.eq.1977) agi=agi+(.2*max(0.0d0,comnew(5))) if(law.ge.1978.and.law.le.1982)agi=agi+(.1*max(0.0d0,comnew(5))) if(law.ge.1984)agi=agi-comnew(79) c Standard Deduction ---------------- if(law.le.1984) then if(mst.eq.1)stded=twn(stdr(law)*agi,stds(law),stdmax(law)) if(mst.ne.1) then stded=twn(stdr(law)*agi,stdm(law),stdmax(law)) stded=stded/sep endif else if(law.ge.1985) then if(mst.eq.1) then stded=stds(law) else if(mst.eq.4.or.mst.eq.7) then stded=stdh(law) else stded=stdm(law)/sep if(law.ge.2001.and.sep.eq.2) stded=6500. endif endif c Standard deductions for dependents if(law.ge.1987.and.data(105).gt.0.0d0) stded = stdd(law) c Itemized Deductions xitded = 0. if(comnew(26).gt.0.and.comnew(30).gt.0) then if(law.le.1990) then xitded = max(0.d0,comnew(24) - data(50)) else xitded = max(0.d0, & (comnew(30) - data(50))*comnew(24)/comnew(30)) endif endif c reduced itemized deducs for high income taxpayers if(law.ge.1988.and.law.le.1990)then reduce = 0. xover = 0. if(agi.gt.100000..and.agi.le.475000) & xover=(twn(agi-xded(mst),0.0d0,50000.0d0))/50000. if(agi.gt.475000.and.agi.le.525000)xover=(agi-475000.)/50000. if(agi.gt.525000)xover=2. if(law.eq.1988)reduce=xover*.1 if(law.ge.1989)reduce=xover*.25 xitded=max(0.0d0,xitded-(xitded*reduce)) endif c phas92=100000./sep c if(law.ge.1992) phas92=100000.*aif92(law)/sep c if(agi.gt.phas92.and.law.ge.1991.) then c reduce = max(0.0d0,comnew(34)-.8*xitded) c xitded = xitded-reduce c endif c Itemized deduction adjustment adjust = 0. if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) phasit=100000. if(mst.eq.4.or.mst.eq.7) phasit=150000. if(mst.eq.2.or.mst.eq.5) phasit=200000. if(agi.gt.100000.and.agi.le.475000) then procen=max(0.0d0,min(50000.0d0,agi-phasit)/50000.) adjust = .25*xitded*procen xitded = max(0.d0,xitded-adjust) else if(agi.gt.475000.and.agi.le.525000) then procen = (agi-475000.)/50000. adjust = .25*xitded*procen xitded = max(0.d0,xitded-adjust) else if(agi.gt.525000) then adjust = .5*xitded xitded = max(0.d0,xitded-adjust) endif deduc=max(stded,xitded) c Exemptions for Dependents ONLY if(law.le.1987) then exemp=comnew(68)*xmp(law) else exemp=data(8)*xmp(law) endif c Taxable Income taxinc=max(0.0d0,agi-deduc-exemp) taxy = taxinc c family adjustment; allows deduction of income taxed at usual rates, c ONLY for 1985-1986 famded = 0. if((mst.eq.2.or.mst.eq.3.or.mst.eq.6).and. &(law.eq.1985.or.law.eq.1986)) then c based on combined income of separate filers if(mst.ne.2)taxy=taxinc*2. if(law.eq.1985) then lowfam(2,7)=1.e20 lowfam(2,8)=1.e20 if(taxy.le.6000) then famded=max(0.0d0,(.5*taxy)-tablki(lowfam,9,agi,data)) else if(taxy.gt.6000.and.taxy.le.36000.) then famded=tablki(hifam1,7,agi,data) endif else if(law.eq.1986) then lowfam(2,7)=1000. lowfam(2,8)=500. if(taxy.le.8000) then famded=max(0.0d0,(.5*taxy)-tablki(lowfam,9,agi,data)) else if(taxy.gt.8000.and.taxy.le.38000.) then famded=tablki(hifam2,9,agi,data) endif endif if(famded.gt.4000) then 91234 write(0,*)'ERROR IN NYTAX, FAM. ADJ. > 4,000' continue endif taxinc=max(0.0d0,taxinc-famded) endif c c Real Property Tax deduction ONLY for1979 and aged c This amount is allowed ONLY if you do not claim the c Real Property Tax Credit reald=0. if(law.eq.1979.and.data(9).gt.0.) then renttx=0. if(data(160).le.300*12)renttx=.25*data(160) ptax=0. c estimated value of property tax to keep home w/in property value limit if(data(51).le.2000)ptax=data(51) ptax=max(renttx,ptax) if(data(159).lt.5400)then reald=0. else if(data(159).ge.5400.and.data(159).lt.7200) then if(ptax.gt.(.06*data(159)))reald=450. else if(data(159).ge.7200.and.data(159).lt.10000) then if(ptax.gt.(.06*data(159)))reald=300. else if(data(159).ge.10000.and.data(159).lt.12000) then if(ptax.gt.(.07*data(159)))reald=250. else if(data(159).ge.12000) then reald=0. endif taxinc=max(0.0d0,taxinc-reald) endif c ------------------ c New York State tax calculation c marital status for tax rates schedules if(mst.eq.1.or.mst.eq.3.or.mst.eq.6)mri=1 if(mst.eq.4.or.mst.eq.7)mri=2 if(mst.eq.2.or.mst.eq.5)mri=3 c The state maximum tax rates were reduced year by year if(law.eq.1977) then tab(2,13)=14. tab(2,14)=15. tab(2,15)=15. else if(law.eq.1978) then tab(2,13)=14. tab(2,14)=14. tab(2,15)=15. else if(law.ge.1979.and.law.le.1984) then tab(2,13)=14. tab(2,14)=14. tab(2,15)=14. else if(law.eq.1985) then tab(2,13)=13.75 tab(2,14)=13.75 tab(2,15)=13.75 else if(law.eq.2005) then tab04s(2,6)=7.25 tab04m(2,6)=7.25 tab04h(2,6)=7.25 endif if(law.le.1985) then call look(tab,taxinc,15,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1986) then call look(tab86,taxinc,13,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1987) then if(mri.eq.1) & call look(tab87s,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.2) & call look(tab87h,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.3) & call look(tab87m,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1988) then if(mri.eq.1) & call look(tab88s,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.2) & call look(tab88h,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.3) & call look(tab88m,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1989.and.law.le.1994) then if(mri.eq.1) & call look(tab89s,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.2) & call look(tab89h,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.3) & call look(tab89m,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1995) then if(mri.eq.1) & call look(tab95s,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.2) & call look(tab95h,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.3) & call look(tab95m,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1996) then if(mri.eq.1) & call look(tab96s,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.2) & call look(tab96h,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.3) & call look(tab96m,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1997.and.law.le.2002) then if(mri.eq.1) & call look(tab97s,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.2) & call look(tab97h,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.3) & call look(tab97m,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2003) then if(mri.eq.1) & call look(tab03s,taxinc,6,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.2) & call look(tab03h,taxinc,6,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.3) & call look(tab03m,taxinc,6,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.2004.and.law.le.2005) then if(mri.eq.1) & call look(tab04s,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.2) & call look(tab04h,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.3) & call look(tab04m,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.2006.and.law.le.2008) then if(mri.eq.1) & call look(tab06s,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.2) & call look(tab06h,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.3) & call look(tab06m,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.2009.and.law.le.2011) then if(mri.eq.1) & call look(tab09s,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.2) & call look(tab09h,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) if(mri.eq.3) & call look(tab09m,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.2012) then if(mri.eq.1) & call look(tab12s,taxinc,8,n,statax,aif12(law),0.0d0,rt,data) if(mri.eq.2) & call look(tab12h,taxinc,8,n,statax,aif12(law),0.0d0,rt,data) if(mri.eq.3) & call look(tab12m,taxinc,8,n,statax,aif12(law),0.0d0,rt,data) endif if(law.ge.1989.and.law.le.2005) then if(agi.gt.100000.and.agi.le.150000) then if(law.le.2002) then statax = statax +(taxinc * rt - statax) *(agi-100000.)/50000. else if((mri.eq.1.and.taxinc.le.100000).or. & (mri.eq.2.and.taxinc.le.125000).or. & mri.eq.3) &statax = statax +(taxinc *.0685 - statax) *(agi-100000.)/50000. if(mri.eq.1.and.taxinc.gt.100000) & statax = statax +397. *(agi-100000.)/50000. if(mri.eq.2.and.taxinc.gt.125000) & statax = statax +563. *(agi-100000.)/50000. endif else if(agi.gt.150000.) then if(law.le.2002) then statax = taxinc *rt else if(agi.le.500000) then c if((mri.eq.1.and.taxinc.le.100000).or. & (mri.eq.2.and.taxinc.le.125000).or. & (mri.eq.3.and.taxinc.le.150000)) statax = taxinc * .0685 c if(mri.eq.1.and.taxinc.gt.100000) & statax = 397.+ statax +(taxinc * .075 - statax-397.) & *min(50000.0d0,agi - 150000.)/50000. if(mri.eq.2.and.taxinc.gt.125000) & statax = 563.+ statax +(taxinc * .075 - statax-563.) & *min(50000.0d0,agi - 150000.)/50000. if(mri.eq.3.and.taxinc.gt.150000) & statax = 794.+ statax +(taxinc * .075 - statax-794.) & *min(50000.0d0,agi - 150000.)/50000. c else statax = taxinc * .077 endif endif endif endif if(law.ge.2006.and.law.le.2008) then if(agi.gt.100000.and.agi.le.150000) then excess = taxinc * rt - statax ratio = min(50000.0d0,agi-100000)/50000 statax = statax + ratio * excess else if(agi.gt.150000) then statax = taxinc * rt endif endif if(law.ge.2009.and.law.le.2011) then if(agi.gt.100000.and.agi.le.150000) then c tax computation worksheet 1 excess = taxinc * .0685 - statax ratio = min(50000.0d0,agi-100000)/50000 statax = statax + ratio * excess else if(agi.gt.150000.and.agi.le.500000) then if(mri.eq.3) then if(taxinc.le.300000) then c tax computation worksheet 2 statax = taxinc * .0685 else c tax computation worksheet 3 excess = taxinc * .0785 - statax - 794 ratio = min(50000.0d0,agi-300000)/50000 statax = statax + ratio * excess + 794 endif else if (mri.eq.1) then if(taxinc.le.200000) then statax = taxinc * .0685 else excess = taxinc * .0785 - statax - 397 ratio = min(50000.0d0,agi-300000)/50000 statax = statax + ratio * excess + 397 endif else if (mri.eq.2) then if(taxinc.le.250000) then statax = taxinc * .0685 else excess = taxinc * .0785 - statax - 563 ratio = min(50000.0d0,agi-300000)/50000 statax = statax + ratio * excess + 563 endif endif else if(agi.gt.500000.and.agi.le.550000) then if(mri.eq.3) then if(taxinc.le.300000) then c tax computation worksheet 4 excess = taxinc * .0897 - statax - 794 ratio = min(50000.0d0,agi-500000)/50000 statax = statax + ratio * excess + 794 else c tax computation worksheet 5 excess = taxinc * .0897 - statax - 3794 ratio = min(50000.0d0,agi-500000)/50000 statax = statax + ratio * excess + 3794 endif else if (mri.eq.1) then if(taxinc.le.200000) then excess = taxinc * .0897 - statax - 397 ratio = min(50000.0d0,agi-500000)/50000 statax = statax + ratio * excess + 397 else excess = taxinc * .0897 - statax - 2397 ratio = min(50000.0d0,agi-200000)/50000 statax = statax + ratio * excess + 2397 endif else if (mri.eq.2) then if(taxinc.le.250000) then excess = taxinc * .0897 - statax - 563 ratio = min(50000.0d0,agi-500000)/50000 statax = statax + ratio * excess + 563 else excess = taxinc * .0897 - statax - 3063 ratio = min(50000.0d0,agi-250000)/50000 statax = statax + ratio * excess + 3063 endif endif else if(agi.gt.550000) then c tax computation worksheet 6 statax = taxinc * .0897 endif endif if(law.ge.2012) then if(mst.eq.2.or.mst.eq.5) then c w/s 1-4 for MARRIED filing jointly if((agi.gt.100000*aif12(law).and.agi.le.2000000*aif12(law)). & and.taxinc.le.150000*aif12(law)) then c tax computation worksheet 1 if(agi.ge.100000*aif12(law)+50000) then statax = taxinc * .0645 else excess = taxinc * .0645 - statax ratio = min(50000.0d0,agi-100000*aif12(law))/50000 statax = statax + ratio * excess endif else if((agi.gt.150000*aif12(law).and.agi.le.2000000*aif12(law)) &.and.(taxinc.gt.150000*aif12(law).and.taxinc.le.300000*aif12(law)) & ) then c tax computation worksheet 2 if(agi.ge.150000*aif12(law)+50000) then statax = taxinc * .0665 else excess = taxinc * .0665 - statax - add12(1,law) ratio = min(50000.0d0,agi-150000*aif12(law))/50000 statax = statax + ratio * excess + add12(1,law) endif else if((agi.gt.300000*aif12(law).and.agi.le.2000000*aif12(law)) & .and.taxinc.gt.300000*aif12(law)) then c tax computation worksheet 3 if(agi.ge.300000*aif12(law)+50000) then statax = taxinc * .0685 else excess = taxinc * .0685 - statax - add12(2,law) ratio = min(50000.0d0,agi-150000)/50000 statax = statax + ratio * excess + add12(2,law) endif else if(agi.gt.2000000*aif12(law)) then c tax computation worksheet 4 if(agi.ge.200000*aif12(law)+50000) then statax = taxinc * .0882 else ratio = min(50000.0d0,agi-150000)/50000 if(taxinc.le.150000*aif12(law)) then excess = taxinc * .0882 - statax - add12(1,law) statax = statax + ratio * excess + add12(1,law) else if(taxinc.gt.150000*aif12(law).and. & taxinc.lt.300000*aif12(law)) then excess = taxinc * .0882 - statax - add12(2,law) statax = statax + ratio * excess + add12(2,law) else if(taxinc.gt.300000*aif12(law)) then excess = taxinc * .0882 - statax - add12(3,law) statax = statax + ratio * excess + add12(3,law) endif endif endif else if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then c w/s 5-7 for Singles and MARRIED filing separately if((agi.gt.100000*aif12(law).and.agi.le.1000000*aif12(law)).and. & taxinc.le.200000*aif12(law)) then c tax computation worksheet 5 if(agi.ge.10000*aif12(law)+50000) then statax = taxinc * .0665 else ratio = min(50000.0d0,agi-100000*aif12(law))/50000 excess = taxinc * .0665 -statax statax = statax + ratio * excess endif else if((agi.gt.200000*aif12(law).and.agi.le.1000000*aif12(law)) & .and.taxinc.gt.200000*aif12(law)) then c tax computation worksheet 6 if(agi.ge.250000) then statax = taxinc * .0685 else ratio = min(50000.0d0,agi-100000*aif12(law))/50000 excess = taxinc * .0685 -statax - add12(4,law) statax = statax + ratio * excess + add12(4,law) endif else if(agi.gt.1000000*aif12(law)) then c tax computation worksheet 7 if(agi.ge.100000*aif12(law) + 500000) then statax = taxinc * .0882 else ratio = min(50000.0d0,agi-100000*aif12(law))/50000 if(taxinc.le.200000*aif12(law)) then excess = taxinc * .0882 -statax - add12(4,law) statax = statax + ratio * excess + add12(4,law) else excess = taxinc * .0882 -statax - add12(5,law) statax = statax + ratio * excess + add12(5,law) endif endif endif else c w/s 8-9 for Head of Households if((agi.gt.100000*aif12(law).and.agi.le.1500000*aif12(law)). & and.taxinc.le.250000*aif12(law)) then c tax computation worksheet 8 if(agi.ge.100000*aif12(law)+50000) then statax = taxinc * .0665 else ratio = min(50000.0d0,agi-100000*aif12(law))/50000 excess = taxinc * .0665 -statax statax = statax + ratio * excess endif else if((agi.gt.250000*aif12(law).and.agi.le.1500000*aif12(law)) & .and.taxinc.gt.250000*aif12(law)) then c tax computation worksheet 9 if(agi.ge.250000*aif12(law)+50000) then statax = taxinc * .0685 else ratio = min(50000.0d0,agi-100000*aif12(law))/50000 excess = taxinc * .0685 -statax - add12(6,law) statax = statax + ratio * excess + add12(6,law) endif else if(agi.gt.1500000*aif12(law)) then c tax computation worksheet 10 if(agi.ge.1500000*aif12(law)+50000) then statax = taxinc * .0882 else ratio = min(50000.0d0,agi-100000*aif12(law))/50000 if(taxinc.le.250000) then excess = taxinc * .0882 -statax - add12(6,law) statax = statax + ratio * excess + add12(6,law) else excess = taxinc * .0882 -statax - add12(7,law) statax = statax + ratio * excess + add12(7,law) endif endif endif endif endif c tax on shifted 'family adjustment' income c The Tax Reform and Reduction Act of 1987 has eliminated the difficult c maximum tax and family adjustment calculations c c Family adjustment ONLY for 1985-1986 and for married people : c joint and separate famtax = 0. if(famded.gt.0) & call look(famtab,famded,4,n,famtax,1.0d00,0.0d0,frt,data) statax = statax + famtax c Maximum Tax on personal service income ONLY for 1978-1986 save = 0. if(law.ge.1978.and.law.le.1986) then c psinc - personal service income psinc = max(data(94),data(11)+data(17)+data(20)+data(72)+ & .3*(data(75)+data(79)-data(80)),0.0d0) psinc = max(0.0d0,psinc-data(26)-comnew(12)-comnew(14)) c percen = 0. if(agi.ne.0) percen = psinc/agi c pstinc - Personal Service Taxable income pstinc=percen*taxy pstinc=max(0.0d0,pstinc-max(data(81),comnew(36))) c subtract the 'extra' tax on personal income over a certain level if(law.eq.1978.or.law.eq.1979) then call look(max78,pstinc,3,n,save,1.0d00,0.0d0,psrt,data) else if(law.eq.1980) then call look(max80,pstinc,4,n,save,1.0d00,0.0d0,psrt,data) else if(law.ge.1981.and.law.le.1984) then call look(max81,pstinc,5,n,save,1.0d00,0.0d0,psrt,data) else if(law.eq.1985) then call look(max85,pstinc,6,n,save,1.0d00,0.0d0,psrt,data) else if(law.eq.1986) then call look(max86,pstinc,5,n,save,1.0d00,0.0d0,psrt,data) endif endif statax = statax - save c 1987-1988 the maximum tax on personl service income is replaced c with an extra tax on unearned income unytax = 0. if(law.eq.1987.and.law.eq.1988) then unearn=data(12)+data(14)+comnew(5)+data(82) c unearned income also includes certain lump sum distributions, but c can't measure if(law.eq.1987)pcent=.03 if(law.eq.1988)pcent=.02 if((agi.lt.200000.and.sep.ne.2).or. & (agi.lt.150000.and.sep.eq.2)) then unytax=(max(0.0d0,(agi - 100000./sep))/100000.)* & pcent*unearn else if((agi.ge.200000.and.sep.ne.2).or. & (agi.ge.150000.and.sep.eq.2)) then unytax=pcent*unearn endif statax = statax + unytax endif c WHO MUST FILE? ------------------------ c before 1986 if((law.le.1985).and. & (agi.le.2500*data(7)*sep.or.agi.le.exemp))statax = 0. c for 1986 if((law.eq.1986).and. & ((mst.ne.1.and.agi.le.8000.0d0).or. & (mst.eq.1.and.agi.le.4000.0d0)).or. & (agi.le.exemp)) statax = 0. c for 1987 if((law.eq.1987).and. & ((mst.eq.1.and.int(data(105)).eq.1.and.agi.le.2800.).or. & (mst.eq.1.and.int(data(105)).ne.1.and.agi.le.3600.).or. & (mst.eq.3..or.mst.eq.6.and.agi.le.2650.0d0).or. & ((mst.eq.2..or.mst.eq.4.or.mst.eq.5).and.agi.le.4000.0d0))) & statax = 0. c for 1988 + if(law.ge.1988) then if(int(data(105)).ne.1.and.agi.le.4000.) statax = 0. if((int(data(105)).eq.1).and. & (((law.ge.1988.and.law.le.1995).and.agi.le.2800.0d0).or. & (law.eq.1996.and.agi.le.2900.0d0).or. & (law.ge.1997.and.agi.le.3000.0d0))) & statax = 0. endif taxbc = statax c CREDITS c household credit: not refundable. hcred=0. fedagi = comnew(2) if(int(data(105)).ne.1) then if(law.ge.1978.and.law.le.1985) then hcred=(tablki(htab1,5,fedagi,data)+xif(law.ge.1982,5.0d0))/sep else if(law.ge.1986) then if(mst.eq.1) then hcred = tablki(htabs,7,fedagi,data) else hcred = (tablki(htabm,9,fedagi,data)+ & (comnew(68) -1)*tablki(htabd,4,fedagi,data))/sep endif endif endif statax = max(0.0d0,statax - hcred) c ENERGY credit - non refundable encred=0. if(law.eq.1984.or.law.eq.1985)encred=min(data(38),2750.0d0) statax = max(0.0d0,statax - encred) c CHILD and Dependent Care is refundable in 1977 only and c beginning with tax year 1996 if(law.eq.1977) chcr=.2*comnew(176) if(law.gt.1977.and.law.le.1995) chcr=min(statax,.2*comnew(176)) if(law.eq.1996) then chcr = comnew(176)*tablki(chld96,12,agi,data) else if(law.eq.1997) then if(agi.le.10000.) then percen = .6 else if(agi.gt.10000.and.agi.lt.14000.) then percen = .595 - .0001*(agi - 10100.) else percen = .2 endif chcr = comnew(176)*percen else if(law.eq.1998) then if(agi.le.17000.) then percen = 1. else if(agi.gt.17000.and.agi.lt.30000.) then percen = .997 - .0000615*(agi - 17100.) else percen = .2 endif chcr = comnew(176)*percen elseif(law.eq.1999) then if(agi.le.35000.) then percen = 1. else if(agi.gt.35000.and.agi.lt.50000.) then percen = .997 - .00005*(agi - 35100.) else percen = .2 endif chcr = comnew(176)*percen elseif(law.ge.2000) then if(agi.le.25000.) then percen = 1.1 else if(agi.gt.25000.and.agi.lt.40000.) then percen = 1.1 - .0000066*(agi - 25000.) else if(agi.ge.40000.and.agi.lt.50000.) then percen = 1. else if(agi.ge.50000.and.agi.lt.65000.) then percen = 1. - .000053*(agi - 50000.) else percen = .2 endif chcr = comnew(176)*percen endif if(law.eq.1977.or.law.ge.1996) then statax = statax - chcr else statax = max(0.0d0,statax - chcr) endif c Real Property Tax Credit - refundable c elderly have bigger deductions. if(law.le.1980) then ptax=.25*data(160)+.5*data(51) else ptax=.25*data(160)+data(51) endif pcred=0.d0 if(law.ge.1978.and.law.le.1980.and.hy.le.12000.d0) then if(law.eq.1979.and.reald.gt.0.d0) then pcred = 0.d0 else if(data(9).lt.1.d0) then pmax=tablki(pmxt78,4,hy,data) pcred=twn(ptax-(hy*tablki(ptab78,4,hy,data)),0.0d0,pmax) else if(data(9).gt.0.d0) then pmax=tablki(emax78,4,hy,data) pcred=twn(ptax-(hy*tablki(etab78,4,hy,data)),0.0d0,pmax) endif endif else if(law.eq.1981.and.hy.le.13500.d0) then if(data(9).lt.1.d0) then pmax=45.d0 pcred=twn(ptax-(hy*tablki(ptab81,4,hy,data)),0.0d0,pmax) else if(data(9).gt.0.d0) then pmax=tablki(emax81,3,hy,data) pcred=twn(ptax-(hy*tablki(etab81,5,hy,data)),0.0d0,pmax) endif else if(law.ge.1982.and.law.le.1984.and.hy.le.16000.d0) then if(data(9).lt.1.d0) then pmax=45.d0 else if(data(9).gt.0.d0) then if(hy.le.7200.d0) then pmax=250.d0 else pmax=100.d0 endif endif pcred=twn(ptax-(hy*tablki(ptab82,5,hy,data)),0.0d0,pmax) else if(law.ge.1985.and.hy.le.18000.d0) then if(data(9).gt.0.d0) pmax=tablki(old,18,hy,data) if(data(9).lt.1.d0) pmax=tablki(young,18,hy,data) pcred = max(0.0d0,ptax-hy*tablki(ptab85,8,hy,data)) if(data(51).gt.0.d0) pcred = min(.25*pcred,pmax) if(data(160).gt.0.d0) pcred = min(.5*pcred,pmax) endif c Schedule B - to be completed by renters if(.25*data(160).gt.350.d0) pcred=0.d0 c New York State earned income credit - refundable earncr = 0. if(law.ge.1994.and.law.le.1995) & earncr = earate(law)*comnew(59) if(law.ge.1996) & earncr = max(0.0d0,earate(law)*comnew(59)-min(hcred,taxbc)) c College Tuition Credit edcred = 0. if(law.ge.2001) then tuit = data(143)+data(144) edcred = min(ed(law),perc(law) * tuit) if(tuit.ge.5000.) edcred = .04* edcred endif c Empire State child credit - refundable c(new in 2006) eschcr = 0.d0 if(law.ge.2006) then if(((mst.eq.2.or.mst.eq.5.or.sep.eq.2). & and.comnew(2).le.110000/sep).or. & ((mst.eq.1.or.mst.eq.4.or.mst.eq.7). & and.comnew(2).le.75000.d0)) & eschcr=max(100*data(8),.33*(comnew(93)+comnew(81))) endif statax = statax - earncr - edcred - eschcr - pcred c Family Tax Relief Credit-refundable-with a dependent under 17 y.o. famref = 0. if((law.ge.2015..and.law.le.2016).and.statax.ge.0.d0.and. &(agi.ge.40000.d0.and.agi.le.300000.d0).and.data(208).gt.0.d0) then famref = 350.d0 statax = statax - famref endif c Total Credits credit = encred+hcred+pcred+earncr+chcr+edcred+eschcr+famref c Other New York State Taxes (for expl,line41 of IT-201 for 1997) c alternative minimum tax: c xtinc- Total New York tax preference items. c there is a difference between 1994 code and 1997 code for 'xtinc' place c this diff gives diff in the results for minimum income tax c ded - specific deduction ded=5000./sep xtinc=max(0.0d0,data(81)+data(83) & +data(88)+data(89)+data(116)-ded-statax) statax=statax+.06*xtinc return end c NORTH CAROLINA c State 34 c c Updated through 2016 subroutine nctax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255) dimension tab77(2,5), tabs89(2,2), tabh89(2,2), tabm89(2,2) dimension tabs91(2,3), tabh91(2,3), tabm91(2,3) dimension tabs01(2,4), tabh01(2,4), tabm01(2,4) dimension tabs07(2,4), tabh07(2,4), tabm07(2,4) dimension tabs08(2,3), tabh08(2,3), tabm08(2,3) dimension xemp(1990:1994),xexemp(1995:2013,2),child(1981:2013) dimension xmp(1977:1993),xmp2(1977:1993),xmpc(1977:1993) dimension ctc95(1995:2016),exem(1987:2013) double precision hcred,wcred,lcred c arrays tab..94 are for the child credit , c rates are the result of the sum rates for kids over 7 years old and c under 7 years old (.22=.13+.09;.195=.115+.08;.17=.10+.07) dimension tabm94(2,3),tabs94(2,3),tabh94(2,3),ch95(4), &chlow(4),chhigh(4),rt14(2014:2016) integer ch data rt14 /.058d0,2*.0575d0/ data exem / & 1900.0d0,1950.0d0,2000.0d0,2050.0d0, 2150.0d0, 2300.0d0, & 2350.0d0,2450.0d0,2500.0d0,2550.0d0, 2650.0d0, 2700.0d0, & 2750.0d0,2800.0d0,2900.0d0,3000.0d0, 3050.0d0, 3100.0d0, & 3200.0d0,3300.0d0,3400.0d0,3500.0d0,2*3650.0d0, 3700.0d0, & 3800.0d0,3900.0d0/ data ctc95 / & 8*60.0d0, 75.0d0, 13* 100.0d0/ data child / & 4*2000.0d0,5*2200.0d0,16*2400.0d0,8*3000.0d0/ data tabm94/ & 25000.0d0, .09d0, 40000.0d0, .08d0, 1.e20, .07d0/ data tabs94/ & 15000.0d0, .09d0, 24000.0d0, .08d0, 1.e20, .07d0/ data tabh94/ & 20000.0d0, .09d0, 32000.0d0, .08d0, 1.e20, .07d0/ data ch95/ & 60000.0d0, 100000.0d0, 80000.0d0, 50000.0d0/ c new in 2014 data chlow /20000.0d0, 40000.0d0, 32000.0d0, 20000.0d0/ data chhigh/50000.0d0, 100000.0d0, 80000.0d0, 50000.0d0/ c data tab77 / & 2000.0d0, 3.0d0, 4000.0d0, 4.0d0, & 6000.0d0, 5.0d0, 10000.0d0, 6.0d0, & 1.e20, 7.0d0 / data tabs89/ & 12750.0d0, 6.0d0, 1.e20, 7.0d0/ data tabh89/ & 17000.0d0, 6.0d0, 1.e20, 7.0d0/ data tabm89/ & 21750.0d0, 6.0d0, 1.e20, 7.0d0/ data tabs91/ & 12750.0d0, 6.0d0, 60000.0d0, 7.0d0, 1.e20, 7.75d0/ data tabh91/ & 17000.0d0, 6.0d0, 80000.0d0, 7.0d0, 1.e20, 7.75d0/ data tabm91/ & 21250.0d0, 6.0d0,100000.0d0, 7.0d0, 1.e20, 7.75d0/ data tabs01/ & 12750.0d0, 6.0d0 , 60000.0d0, 7.0d0, 120000.0d0, 7.75d0, & 1.e20, 8.25d0/ data tabh01/ & 17000.0d0, 6.0d0 , 80000.0d0, 7.0d0, 160000.0d0, 7.75d0, & 1.e20, 8.25d0/ data tabm01/ & 21250.0d0, 6.0d0 ,100000.0d0, 7.0d0, 200000.0d0, 7.75d0, & 1.e20, 8.25d0/ data tabs07/ & 12750.0d0, 6.0d0 , 60000.0d0, 7.0d0, 120000.0d0, 7.75d0, & 1.e20, 8.0d0/ data tabh07/ & 17000.0d0, 6.0d0 , 80000.0d0, 7.0d0, 160000.0d0, 7.75d0, & 1.e20, 8.0d0/ data tabm07/ & 21250.0d0, 6.0d0 ,100000.0d0, 7.0d0, 200000.0d0, 7.75d0, & 1.e20, 8.0d0/ data tabs08/ & 12750.0d0, 6.0d0 , 60000.0d0, 7.0d0, 1.e20, 7.75d0/ data tabh08/ & 17000.0d0, 6.0d0 , 80000.0d0, 7.0d0, 1.e20, 7.75d0/ data tabm08/ & 21250.0d0, 6.0d0 ,100000.0d0, 7.0d0, 1.e20, 7.75d0/ data xmp / 3*2000.0d0, 9*2100.0d0, 5*0.0d0 / data xmp2/ 3*1000.0d0, 9*1100.0d0, 5*0.0d0 / data xmpc/ 3*600.0d0,700.0d0,8*800.0d0, 5*0.0d0/ data xemp/ & 50.0d0, 150.0d0, 300.0d0, 350.0d0, 450.0d0/ data xexemp/ & 250.0d0, 50.0d0, 150.0d0, 200.0d0, 250.0d0, 300.0d0, & 400.0d0, 500.0d0, 550.0d0, 600.0d0, 700.0d0, 800.0d0, & 900.0d0, 1000.0d0,2*1150.0d0, 1200.0d0,2*2500.0d0, & 500.0d0, 550.0d0, 650.0d0, 700.0d0, 750.0d0, 800.0d0, & 900.0d0, 1000.0d0, 1100.0d0,2*1200.0d0, 1300.0d0,1400.0d0, & 1500.0d0,2*1650.0d0, 1700.0d0,2*2000.0d0/ rt=0. mst = data(2) sep = data(3) c AGI agi=comnew(2) if(law.le.1988)agi=agi+ data(62) c Social Security Benefits are not taxable in NC if(law.ge.1984)agi=agi-comnew(79) if(law.le.1986) then agi=agi+max(0.0d0,comnew(5)-comnew(6))+max(0.0d0, & data(12)-comnew(4))+ (data(82)-comnew(78)) if(law.ge.1983.and.law.le.1986)agi=agi+comnew(32) endif if(law.ge.1989) then agi=agi-data(22) c agi=max(0.0d0,agi-min(data(20)+data(72),0.0d0,data(9)*2000.)) endif c need to check this see page 8 1991 form?????? c Inna's answer is that calculations of North Car. taxable income c have nothing to do with agi (06/22/98) if(law.ge.1991) agi=agi-data(56) ch = 0 if(data(8).gt.0.and.data(8).lt.2) ch = 1 if(data(8).gt.1) ch = 2 c STATE TAXES BEFORE 1989 c must divide up income, deductions, etc c before 1989, no joint filing allowed c itemized deductions somewhat different from federal deductions if(law.le.1988) then c no carryover contributions allowed ag = max(0.0d0,agi) char = min((data(58)+data(59)),.15*ag) proper=data(51)+data(53)+data(56) health=data(47)+data(48)+data(49) casu = data(61) if(law.ge.1983) casu = max(0.0d0,data(61)-.1*ag) xitded=char+proper+data(57)+casu+ & data(62)+data(63)+max(health-.05*ag,0.0d0) if(law.le.1978) then xitded=xitded+min(data(64),4800.0d0) else if(law.eq.1979.or.law.eq.1980) then xitded=xitded+min(data(64),ch*2000.) endif if(mst.eq.2) then c calculate proportion of income for husbands and wives first c with the figures given for certain credits; if there is no c information in these, assign arbitrary fraction. yh = min(agi,max(data(85),data(86)) + (agi-data(11))/2.) yw = agi - yh c interest exclusion if(law.ge.1980.and.law.le.1982) then yh=max(0.0d0,yh-min(100.0d0,data(14)/2)) yw=max(0.0d0,yw-min(100.0d0,data(14)/2)) endif c have to figure deductions and exemptions separately xh=.5*xitded xw=.5*xitded eh=xmp2(law) ew=xmp(law) if(data(9).gt.1) then oh=1. ow=1. else if(data(9).gt.0..and.data(9).lt.2.) then oh=1. ow=0. else oh=0. ow=0. endif if(data(10).gt.1.) then bh=1. bw=1. else if(data(10).gt.0..and.data(10).lt.2.) then bh=1. bw=0. else bh=0. bw=0. endif c also divided dependent exemptions ch=nint(data(8)*.5) cw=data(8)-ch eh=eh+((oh+bh)*xmp(law))+(ch*xmpc(law)) ew=ew+((ow+bw)*xmp(law))+(cw*xmpc(law)) if(law.le.1979) then sth=min(.1*yh,500.0d0) stw=min(.1*yw,500.0d0) else if(law.ge.1980.and.law.le.1988) then sth=min(.1*yh,550.0d0) stw=min(.1*yw,550.0d0) endif c husband and wife required to deduct the same way if((xh+xw).gt.(sth+stw))then dedh=xh dedw=xw else dedh=sth dedw=stw endif taxyh=max(0.0d0,yh-dedh-eh) taxyw=max(0.0d0,yw-dedw-ew) call look(tab77,taxyh,5,n,staxh,1.0d00,0.0d0,hrt,data) call look(tab77,taxyw,5,n,staxw,1.0d00,0.0d0,wrt,data) taxinc = taxyh+taxyw statax = staxh + staxw else if(law.ge.1980.and.law.le.1982) agi=(max(0.0d0, & agi-min(100.0d0,data(14)))) if(law.le.1979) then stded=min(.1*max(0.0d0,agi),500.0d0) else stded=min(.1*max(0.0d0,agi),550.0d0) endif deduc=max(stded,xitded) exemp=xmp(law)+(data(9)+data(10))*xmp2(law)+ & (data(8)*xmpc(law)) taxinc=max(0.0d0,agi-deduc-exemp) call look(tab77,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) endif endif c STATE TAXES AFTER 1989 c Standard Deduction c tax (not agi) calculation changes dramatically in 1989 if(law.ge.1989) then if(mst.eq.1) then stded=3000. if(law.eq.2014.or.law.eq.2015) stded=7500. if(law.ge.2016) stded=8250. else if(mst.eq.4.or.mst.eq.7) then stded=4400. if(law.eq.2014.or.law.eq.2015) stded=12000. if(law.ge.2016) stded=13200. else if(law.le.2002) stded=5000./sep if(law.eq.2003) stded=5500./sep if(law.ge.2004.and.law.le.2013) stded=6000./sep if(law.eq.2014.or.law.eq.2015) stded=15000./sep if(law.ge.2016) stded=16500./sep endif c Additions for standard deductions for age 65 or older or blind xndx = 0. if(law.le.2013) & xndx = (data(9)+data(10))*sorm(mst,750.0d0,600.0d0) stded = stded+xndx c Standard deduction for dependents through 2013 if ((law.ge.1994.and.law.le.2013).and.data(105).gt.0.) then eary = comnew(37) if (law.ge.1998.and.law.le.2011) eary = eary + 250 if (law.ge.2012) eary = eary + 300 if(mst.eq.1) then stded = min(stded,max(500.0d0,eary)) else if(mst.eq.4.or.mst.eq.7) then stded = min(stded,max(500.0d0,eary)) else stded = min(stded,max(500.0d0,eary)) endif endif c Itemized Deductions if(law.le.2011) then if(comnew(26).gt.0.) then deduc = min(data(50),max(comnew(24) - stded,0.0d0)) xitded = deduc else deduc = max(comnew(3) - stded,0.0d0) endif else if(law.ge.2012.and.law.le.2013) then if(comnew(26).gt.0) then deduc = comnew(24)-min(data(50),max(comnew(24)-stded,0.0d0)) xitded = deduc else deduc = stded endif else if(law.ge.2014) then c 2014 N.C. itemized deductions are no longer identical to federal itemized deductions c and are subject to certain limitations. xitded = & min(20000.0d0,data(56)+data(51))+data(58)+data(59)+data(60) c New in 2015: N.C. itemized deductions now include medical and dental expenses. if(law.ge.2015) xitded = xitded + comnew(20) deduc = max(stded,xitded) endif c no exemptions until 1990 and 2014+ exemp = 0 if(law.ge.1990.and.law.le.1994) then exemp=comnew(68)*xemp(law) c if(comnew(2).gt.comnew(109))exemp = exemp*(1 - comnew(108)) elseif(law.ge.1995.and.law.le.2013) then c exemptions with federal AGI less than phaseout (Worksheet A) exemp = comnew(68)*xexemp(law,1) c NC phaseout exmphl = filing(mst,60000.,100000.,80000.,50000.) if(comnew(2).gt.exmphl) then c exemptions with federal AGI greater than phaseout (Worksheet B) exemp = comnew(68)*xexemp(law,2) c Federal exemptions before phaseout fedxf = comnew(68) * exem(law) c a taxpayer is required to complete the Deduct for Exempt W/sheet(fed) if(fedxf.gt.comnew(83).and.law.ne.2010) then exemp = xexemp(law,2)*comnew(83)/exem(law) c 2006-2009 only special rule for 1/3 and 2/3 if(law.ge.2006.and.law.le.2009) then if (law.eq.2006) & fedphl = filing(mst,150500.,225750.,188150.,112875.) if(law.eq.2007) & fedphl = filing(mst,156400.,234600.,195500.,117300.) if(law.eq.2008) & fedphl = filing(mst,159950.,239950.,199950.,119975.) if(law.eq.2009) & fedphl = filing(mst,166800.,250200.,208500.,125000.) if(comnew(2).gt.fedphl.and. & comnew(2)-fedphl.le.122500/sep) then if(law.eq.2006.or.law.eq.2007) & exemp = .333*comnew(68)*xexemp(law,2) if(law.eq.2009.or.law.eq.2008) & exemp = .666*comnew(68)*xexemp(law,2) endif endif endif endif endif c deduc - additions to a federal taxable income c because of difference in ded and exp deduc = deduc+exemp c next line is for taxsim exemption amount if(law.le.2011) exemp = comnew(83) - exemp c if federal taxable income is less than zero, a taxpayer c is required to enter negative amount if(comnew(26).gt.0.) then fedinc = comnew(2)-comnew(24)-comnew(83) else fedinc = comnew(2)-comnew(3)-comnew(83) c if(law.eq.2008.and.data(51).gt.0) c &fedinc=comnew(2)-(comnew(3)-min(data(51),500*data(7)))-comnew(83) endif pens = 0. c There are no longer deductions for retirement benefits in 2014+ if(data(20)+data(72).gt.0.and.law.le.2013) then pens = data(7) if(data(9).gt.0) pens = data(9) endif taxinc = max(0.0d0,fedinc + deduc - data(22)-comnew(79) & - min(data(20)+data(72),pens*2000.)) agi = comnew(2)-data(22)-comnew(79)- & min(data(20)+data(72),pens*2000.) c For tax years beginning on or after January 1, 2012 and through December 31,2013, c there is a deduction available for taxpayers who include net business income in federal AGI c as reported on the North Carolina individual income tax return. c The law allows a deduction of up to $50,000 of net business income c included in AGI that is not considered passive under the Internal Revenue Code. c In the case of a married couple filing a joint return where both spouses report a net business income, c the maximum dollar amount applies separately to each spouse's net business income included in AGI, c not to exceed a total of $100,000. adjbus = 0 if (law.eq.2012.or.law.eq.2013) adjbus = & min(data(7)*50000,max(0.0d0,data(17))+max(0.0d0,data(21))) if(law.ge.2012)taxinc = max(0.0d0,comnew(2)-data(22)-comnew(79) & - min(data(20)+data(72),pens*2000.) - adjbus - deduc) if(law.le.1990) then if(mst.eq.2.or.mst.eq.5) then call look(tabm89,taxinc,2,n,statax,1.0d00,-data(2),rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tabh89,taxinc,2,n,statax,1.0d00,0.0d0,rt,data) else if(mst.eq.1) then call look(tabs89,taxinc,2,n,statax,1.0d00,0.0d0,rt,data) else call look(tabm89,taxinc,2,n,statax,1.0d00,-data(2),rt,data) endif else if(law.ge.1991.and.law.le.2000) then if(mst.eq.4.or.mst.eq.7) then call look(tabh91,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) else if(mst.eq.1) then call look(tabs91,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) else tax1 = taxinc * sep call look(tabm91,tax1,3,n,stat1,1.0d00,0.0d0,rt,data) statax = stat1/sep endif else if(law.ge.2001.and.law.le.2006) then if(mst.eq.4.or.mst.eq.7) then call look(tabh01,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) else if(mst.eq.1) then call look(tabs01,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) else tax1 = taxinc * sep call look(tabm01,tax1,4,n,stat1,1.0d00,0.0d0,rt,data) statax = stat1/sep endif else if(law.eq.2007) then if(mst.eq.4.or.mst.eq.7) then call look(tabh07,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) else if(mst.eq.1) then call look(tabs07,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) else tax1 = taxinc * sep call look(tabm07,tax1,4,n,stat1,1.0d00,0.0d0,rt,data) statax = stat1/sep endif else if(law.ge.2008.and.law.le.2013) then if(mst.eq.4.or.mst.eq.7) then call look(tabh08,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) else if(mst.eq.1) then call look(tabs08,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) else tax1 = taxinc * sep call look(tabm08,tax1,3,n,stat1,1.0d00,0.0d0,rt,data) statax = stat1/sep endif else if(law.ge.2014) then c flat 5.8% rate for 2014 and 5.75% rate for 2015 and 2016 statax = rt14(law)*taxinc endif endif c income tax surtax -- 2009-2010 if(law.ge.2009.and.law.le.2010) then if(mst.eq.1) then if(taxinc.gt.60000.and.taxinc.le.150000) statax = 1.02*statax if(taxinc.gt.150000) statax = 1.03*statax else if(mst.eq.4.or.mst.eq.7) then if(taxinc.gt.80000.and.taxinc.le.200000) statax = 1.02*statax if(taxinc.gt.200000) statax = 1.03*statax else if(taxinc.gt.100000/sep.and.taxinc.le.250000/sep) & statax = 1.02*statax if(taxinc.gt.250000/sep) statax = 1.03*statax endif endif c Credits credit = 0. lcred = 0. hcred = 0. wcred = 0. c first credit to be taken, low income credit through 1988. if(law.ge.1986.and.law.le.1988) then if(mst.ne.2)then if(agi.le.5000)lcred=25. if(agi.le.10000.and.agi.gt.5000.)lcred=20. if(agi.le.15000.and.agi.gt.10000.)lcred=15. statax=max(statax-lcred,0.0d0) credit = credit + lcred else if(mst.eq.2)then if(yh.le.5000)hcred=25. if(yh.le.10000.and.yh.gt.5000.)hcred=20. if(yh.le.15000.and.yh.gt.10000.)hcred=15. staxh=max(staxh-hcred,0.0d0) credit = credit + hcred if(yw.le.5000)wcred=25. if(yw.le.10000.and.yw.gt.5000.)wcred=20. if(yw.le.15000.and.yw.gt.10000.)wcred=15. staxw=max(staxw-wcred,0.0d0) credit = credit + wcred endif endif c child care credit c 2014--NC no longer allows a tax credit for child care expenses chcr=0. if(law.ge.1981.and.law.le.1984) then chcr=.07*min(ch*child(law),data(64)) else if(law.ge.1985.and.law.le.1989) then chcr=.07*min(ch*child(law),data(64)) else if(law.ge.1990.and.law.le.2013) then c for 1990 onward for kids under 7 years old % is higher than for kids over 7 c Assume kids are over 7 years old if(law.ge.1990.and.law.le.1993) then chcr = min(ch*child(law),data(64))*.1 else c Credit for Child and Dependent Care Expenses for 1994 - 2013 c for head of household if(mst.eq.4.or.mst.eq.7) then chcr = min(ch*child(law),data(64))* & tablki(tabh94,3,comnew(2),data) c for single else if(mst.eq.1) then chcr = min(ch*child(law),data(64))* & tablki(tabs94,3,comnew(2),data) c for married jointly and separately else chcr = min(ch*child(law),data(64))* & tablki(tabm94,3,comnew(2)*sep,data) endif endif endif statax = max(0.0d0,statax - chcr) credit = credit + chcr c Credit for solar heating, cooling, or hot water systems c This credit was repealed in 1992 if(law.le.1991) then ecred = min(1000.0d0,.25*data(38)) if(law.le.1988.and.mst.eq.2) then if(staxh.gt.staxw)staxh = max(staxh-chcr,0.0d0) if(staxw.ge.staxh)staxw = max(staxw-chcr,0.0d0) if(staxh.gt.staxw)staxh = max(staxh-ecred,0.0d0) if(staxw.ge.staxh)staxw = max(staxw-ecred,0.0d0) statax = staxh+staxw rt = (hrt+wrt)/2. endif statax = max(0.0d0,statax-ecred) credit = credit + ecred endif c Tax Credit for children since 1995 chld = 0. if(law.ge.1995) then ind = int(filing(mst,1.,2.,3.,4.)) if(law.le.2013.and.comnew(2).lt.ch95(ind)) & chld = data(8)*ctc95(law) if(law.ge.2014) then if(comnew(2).le.chlow(ind)) chld = data(208)*125 if(comnew(2).gt.chlow(ind).and.comnew(2).le.chhigh(ind)) & chld = data(208)*ctc95(law) endif statax = max(0.0d0,statax-chld) credit = credit + chld endif c Credit for charitable contributions since 1997 c This credit can be claimed ONLY by taxpayers who claim c the standard deduction on their federal form c Credit for Charitable contributions for those who do not itemize their c deductions no longer in 2014 if((law.ge.1997.and.law.le.2013).and.comnew(26).lt.1.) then contr = max(0.0d0,data(58)+data(59) - .02*comnew(2)) if(law.le.1998) then contr = .0275*contr else contr = .07*contr endif statax = max(0.0d0,statax - contr) credit = credit + contr endif c EITC starting 2008 earncr = 0. if(law.eq.2008) earncr = .035 * comnew(59) if(law.ge.2009.and.law.le.2012) earncr = .05 * comnew(59) if(law.eq.2013) earncr = .045 * comnew(59) c new in 2014 -- no longer State Earned Income Tax Credit statax = statax - earncr credit = credit + earncr return end c NORTH DAKOTA c State 35 c c Updated through 2016 c subroutine ndtax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common/taxpar/dum(3),zbrack(7) common/times/zitem,ptax,txrate,h dimension data(255),comnew(255) dimension tab77(2,7), tab79(2,6), tab83(2,8), tab87(2,8) dimension tab01s(2,5), tab01h(2,5), tab01m(2,5) dimension tab09s(2,5), tab09h(2,5), tab09m(2,5) dimension tab11s(2,5), tab11h(2,5), tab11m(2,5) dimension tab13s(2,5), tab13h(2,5), tab13m(2,5) dimension tab15s(2,5), tab15h(2,5), tab15m(2,5) dimension tab16s(2,5), tab16h(2,5), tab16m(2,5) dimension xmp(1977:1986), alt(1981:2000),aif(2001:2014) dimension crmax(2007:2016),earmax(2007:2016),timax(2007:2016), &ded(2007:2016) double precision medexp data crmax/ & 300.0d0, 305.0d0, 2*280.0d0, 234.0d0, 241.0d0, 198.0d0, & 200.0d0, 185.0d0, 186.0d0/ data earmax/ & 30154.0d0, 30854.0d0, 32212.0d0, 32312.0d0, 32776.0d0, & 33575.0d0, 34494.0d0, 35045.0d0, 35555.0d0, 35705.0d0/ data timax/ & 53254.0d0, 54454.0d0, 56812.0d0, 56912.0d0, 57775.0d0, & 59175.0d0, 60744.0d0, 61950.0d0, 62705.0d0, 63005.0d0/ data ded/ & 8750.0d0, 8950.0d0, 2*9350.0d0, 9500.0d0, 9750.0d0, & 10000.0d0, 10150.0d0, 10300.0d0, 10350.0d0/ data aif/ & 1.0d0, 1.033d0, 1.05d0, 1.073d0, 1.098d0, 1.133d0, & 1.177d0, 1.203d0, 1.0d0 , 1.002d0, 1.0d0 , 1.025d0, & 1.0d0, 1.017d0/ data alt/ & 2*.075d0, 4*.105d0, 14*.14d0/ data xmp/ & 4*750.0d0, 4*1000.0d0, 1040.0d0, 1080.0d0/ data tab77/ & 1000.0d0, 1.0d0 , 3000.0d0, 2.0d0, 5000.0d0, 3.0d0, & 6000.0d0, 3.0d0 , 7000.0d0, 5.0d0, 8000.0d0, 7.5d0, & 1.e20,10.0d0/ data tab79/ & 3000.0d0, 1.0d0 , 5000.0d0, 2.0d0, 8000.0d0, 3.0d0, & 12000.0d0, 4.0d0 , 30000.0d0, 5.0d0, 1.e20, 7.5d0/ data tab83/ & 3000.0d0, 2.0d0 , 5000.0d0, 3.0d0, 8000.0d0, 4.0d0, & 15000.0d0, 5.0d0 , 25000.0d0, 6.0d0, 35000.0d0, 7.0d0, & 50000.0d0, 8.0d0 , 1.e20, 9.0d0/ data tab87/ & 3000.0d0, 2.67d0 , 5000.0d0, 4.0d0, 8000.0d0, 5.33d0, & 15000.0d0, 6.67d0 , 25000.0d0, 8.0d0, 35000.0d0, 9.33d0, & 50000.0d0,10.67d0 , 1.e20, 12.0d0/ data tab01s/ & 27050.0d0, 2.1d0 , 65550.0d0, 3.92d0, 136750.0d0, 4.34d0, & 297350.0d0, 5.04d0 , 1.e20, 5.54d0/ data tab01h/ & 35250.0d0, 2.1d0 , 93650.0d0, 3.92d0, 151650.0d0, 4.34d0, & 297350.0d0, 5.04d0 , 1.e20, 5.54d0/ data tab01m/ & 45200.0d0, 2.1d0 , 109250.0d0, 3.92d0, 166500.0d0, 4.34d0, & 297350.0d0, 5.04d0 , 1.e20, 5.54d0/ data tab09s/ & 33950.0d0, 1.84d0 , 82250.0d0, 3.44d0, 171550.0d0, 3.81d0, & 372950.0d0, 4.42d0 , 1.e20, 4.86d0/ data tab09h/ & 45500.0d0, 1.84d0 , 117450.0d0, 3.44d0, 190200.0d0, 3.81d0, & 372950.0d0, 4.42d0 , 1.e20, 4.86d0/ data tab09m/ & 56750.0d0, 1.84d0 , 137050.0d0, 3.44d0, 208850.0d0, 3.81d0, & 372950.0d0, 4.42d0 , 1.e20, 4.86d0/ data tab11s/ & 34500.0d0, 1.51d0, 83600.0d0, 2.82d0, 174400.0d0, 3.13d0, & 379150.0d0, 3.63d0, 1.e20, 3.99d0/ data tab11h/ & 46250.0d0, 1.51d0,119400.0d0, 2.82d0, 193350.0d0, 3.13d0, & 379150.0d0, 3.63d0, 1.e20, 3.99d0/ data tab11m/ & 57700.0d0, 1.51d0,139350.0d0, 2.82d0, 212300.0d0, 3.13d0, & 379150.0d0, 3.63d0, 1.e20, 3.99d0/ data tab13s/ & 36250.0d0, 1.22d0, 87850.0d0, 2.27d0, 183250.0d0, 2.52d0, & 398350.0d0, 2.93d0, 1.e20, 3.22d0/ data tab13h/ & 48600.0d0, 1.22d0,125450.0d0, 2.27d0, 203150.0d0, 2.52d0, & 398350.0d0, 2.93d0, 1.e20, 3.22d0/ data tab13m/ & 60650.0d0, 1.22d0,146400.0d0, 2.27d0, 223050.0d0, 2.52d0, & 398350.0d0, 2.93d0, 1.e20, 3.22d0/ data tab15s/ & 37450.0d0, 1.1d0 , 90750.0d0, 2.04d0, 189300.0d0, 2.27d0, & 411500.0d0, 2.64d0, 1.e20, 2.9d0/ data tab15h/ & 50200.0d0, 1.1d0 ,129600.0d0, 2.04d0, 209850.0d0, 2.27d0, & 411500.0d0, 2.64d0, 1.e20, 2.9d0/ data tab15m/ & 62600.0d0, 1.1d0 ,151200.0d0, 2.04d0, 230450.0d0, 2.27d0, & 411500.0d0, 2.64d0, 1.e20, 2.9d0/ data tab16s/ & 37650.0d0, 1.1d0 , 91150.0d0, 2.04d0, 190150.0d0, 2.27d0, & 413350.0d0, 2.64d0, 1.e20, 2.9d0/ data tab16h/ & 50400.0d0, 1.1d0 ,130150.0d0, 2.04d0, 210800.0d0, 2.27d0, & 413350.0d0, 2.64d0, 1.e20, 2.9d0/ data tab16m/ & 62900.0d0, 1.1d0 ,151900.0d0, 2.04d0, 231450.0d0, 2.27d0, & 413350.0d0, 2.64d0, 1.e20, 2.9d0/ txp = data(7) mst = data(2) exemp=0 deduc = 0. stded = 0. xitded = 0. earncr = 0. rt=0 c Federal Tax deduction for years =<2000 fded = 0. c pcn = 1 c fded=(max(0.0d0,comnew(1)+data(34)-data(44))) * pcn c if(comnew(2).gt.0.0d0) pcn=twn(agi/comnew(2),0.0d0,1.0d0) if(law.le.2000) & fded = max(0.0d0,comnew(77)-comnew(58)+data(34)+data(39)+data(42) &-comnew(59)+comnew(70)) c fded = max(0.0d0,fded) * pcn c Tax before credits for years 1977-1986 if(law.le.1986) then c AGI agi=comnew(2) if(law.le.1980) then agi = agi + (comnew(7)/6.) - xif(law.eq.1980,data(22)) else if(law.eq.1981.or.law.eq.1982) then agi = agi - data(22) c interest exclusion is in addition to federal int/div excl c can't exclude the same interest twice agi = agi - min(data(14),200.0d0*data(7)) if(law.eq.1982) agi = agi + divexc(data,comnew,law) else if(law.ge.1983) then if(law.eq.1985)agi = agi - comnew(79) agi=agi-data(22)-min(data(14),300.*txp) endif c Itemized Deductions xitded=max(0.0d0, & comnew(24)+data(47)+data(48)+data(49)-comnew(20)) if(law.le.1980) then if(mst.eq.1.or.mst.eq.7.or.mst.eq.4) then stded=twn(.16*agi,1700.0d0,2400.0d0) else stded=twn(.16*agi,2100.0d0,2800.0d0)/data(3) endif else stded=comnew(3) endif c must itemize if federal itemizer if(comnew (26).gt.0.0d0) then deduc = xitded+fded else deduc = max(stded,xitded)+fded endif c Exemptions exemp=comnew(68)*xmp(law) if(mst.eq.2.or.mst.eq.4.or.mst.eq.5.or.mst.eq.7) & exemp = exemp + 300. taxinc = max(0.0d0,agi-deduc-exemp) if(law.eq.1977) then call look(tab77,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1978.and.law.le.1982) then call look(tab79,taxinc,6,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1983.and.law.le.1986) then call look(tab83,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) endif c Tax before credits for years 1987-2000 else if(law.ge.1987.and.law.le.2000) then c Since 1987 Federal Taxable Income has become a base for imputing c North Dakota Taxable Income c c addex - additional exemption amount for Married Filing joint or c Head of household or Qualifying widow. medexp = 0. addex = 0. if(mst.eq.2.or.mst.eq.4.or.mst.eq.5.or.mst.eq.7) addex = 300. if(data(49).gt..075*comnew(2).and.comnew(26).gt.0.0d0) & medexp = data(49) - .075*comnew(2) taxinc = max(0.0d0,comnew(29)+data(50)-fded-addex-medexp) call look(tab87,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) c Tax before credits for years 2001+ else if(law.ge.2001) then c 30% of the excess of net long-term capital gain over a net short-term capital loss c 2013+, it became 40% gshort = data(68) glong = data(70) fullcg = gshort+glong cgltg = 0. if(fullcg.gt.0.) then if(glong.gt.0..and.gshort.ge.0.) cgltg = glong if(glong.gt.0..and.gshort.lt.0.) cgltg = fullcg endif cgltg = cgltg + data(18) if(law.lt.2013) cgexc = .3*max(0.0d0,cgltg) if(law.ge.2013) cgexc = .4*max(0.0d0,cgltg) c Qualified dividends exclusion qdiv = 0. if(law.ge.2009.and.law.le.2012) qdiv = .3*data(176) if(law.ge.2013) qdiv = .4*data(176) taxinc = max(0.0d0,comnew(29) - cgexc - qdiv) if(law.le.2008) then c 2001-8 if(mst.eq.1) then call look(tab01s,taxinc,5,n,statax,aif(law),0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tab01h,taxinc,5,n,statax,aif(law),0.0d0,rt,data) else tax1 = taxinc*data(3) call look(tab01m,tax1,5,n,stat1,aif(law),0.0d0,rt,data) statax = stat1/data(3) endif else if(law.ge.2009.and.law.le.2010) then c 2009-10 if(mst.eq.1) then call look(tab09s,taxinc,5,n,statax,aif(law),0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tab09h,taxinc,5,n,statax,aif(law),0.0d0,rt,data) else tax1 = taxinc *data(3) call look(tab09m,tax1,5,n,stat1,aif(law),0.0d0,rt,data) statax = stat1/data(3) endif else if(law.ge.2011.and.law.le.2012) then c 2011-2 if(mst.eq.1) then call look(tab11s,taxinc,5,n,statax,aif(law),0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tab11h,taxinc,5,n,statax,aif(law),0.0d0,rt,data) else tax1 = taxinc *data(3) call look(tab11m,tax1,5,n,stat1,aif(law),0.0d0,rt,data) statax = stat1/data(3) endif else if(law.ge.2013.and.law.le.2014) then c 2013-4 if(mst.eq.1) then call look(tab13s,taxinc,5,n,statax,aif(law),0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tab13h,taxinc,5,n,statax,aif(law),0.0d0,rt,data) else tax1 = taxinc *data(3) call look(tab13m,tax1,5,n,stat1,aif(law),0.0d0,rt,data) statax = stat1/data(3) endif else if(law.eq.2015) then c 2015 if(mst.eq.1) then call look(tab15s,taxinc,5,n,statax,1.0d0,0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tab15h,taxinc,5,n,statax,1.0d0,0.0d0,rt,data) else tax1 = taxinc *data(3) call look(tab15m,tax1,5,n,stat1,1.0d0,0.0d0,rt,data) statax = stat1/data(3) endif else if(law.eq.2016) then c 2016 if(mst.eq.1) then call look(tab16s,taxinc,5,n,statax,1.0d0,0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tab16h,taxinc,5,n,statax,1.0d0,0.0d0,rt,data) else tax1 = taxinc *data(3) call look(tab16m,tax1,5,n,stat1,1.0d0,0.0d0,rt,data) statax = stat1/data(3) endif endif endif credit = 0 c Contribution Credit contcr = 0. c credit is actually allowed only against educational contributions; c I am assuming rational citizens, if they choose to contribute, c they will see it is profitable to give to education. if(law.le.1999) then contcr = min(.5*(data(58)+data(59)+data(60)),.4*statax) if(law.le.1980)contcr = min(contcr,100.0d0) if(law.ge.1981)contcr = min(contcr,250.0d0) endif statax = max(0.0d0,statax-contcr-(data(38)/3.5)) credit = credit + contcr + (data(38)/3.5) c alternate tax calculation Form 37-S (Short form) 1981-2000 c The majority of taxpayers will benefit by using Form 37-S c if(law.ge.1981.and.law.le.2000) then c fedtax = max(0.0d0,comnew(52))*pcn fedtax = comnew(52) tax2 = alt(law)*fedtax if(tax2.lt.statax) then statax = tax2 rt = alt(law)*comnew(72)/100. endif c "Energy Cost Relief Credit" up to a maximum of r100 only c in 1981 and 1982 costcr = 0. if(law.eq.1981.or.law.eq.1982) costcr=twn(statax,0.0d0,100.0d0) statax = max(0.0d0,statax - costcr) credit = credit + costcr endif c 2007 + Marriage Credit -- non-refundable if(law.ge.2007.and.mst.eq.2) then if(taxinc.gt.timax(law).and.min(data(86),data(85)). & gt.earmax(law)) then taxin3 = max(0.0d0,min(data(85),data(86))-ded(law)) if(law.le.2008) & call look(tab01s,taxin3,5,n,tax3,aif(law),0.0d0,rt3,data) if (law.ge.2009) & call look(tab09s,taxin3,5,n,tax3,1.0d0,0.0d0,rt3,data) taxin4 = max(taxinc - taxin3,0.0d0) if(law.le.2008) & call look(tab01s,taxin4,5,n,tax4,aif(law),0.0d0,rt4,data) if(law.ge.2009) & call look(tab09s,taxin4,5,n,tax4,1.0d0,0.0d0,rt4,data) crdmar = max(0.0d0,tax2 - tax3 -tax4) crdmar = min(crmax(law),crdmar) credit = credit + crdmar statax = max(0.0d0,statax - crdmar) endif endif return end c OHIO c State 36 c c Updated through 2016 c subroutine ohtax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common/times/z,p,txrate,h common/x/ct dimension data(255),comnew(255),tab(2,8),tab77(2,6) dimension tab83(8,8),sentab(2,6),tab93(2,9),tab96(2,9),tab97(2,9) &,tab98(2,9),tab99(2,9),tab00(2,9),tab01(2,9),tab05(2,9),tab06(2,9) &,tab07(2,9),tab08(2,9),tab11(2,9),tab13(2,9),tab16(2,9) &,rt13(9),rt14(9),rt15(9),bus15(2,6) &,pc15(2015:2016),ph15(2015:2016) &,aif(2008:2012),xmp(1977:2016),exmp(2014:2016,2),cred(2005:2016) data pc15/.75d0, 1.d0/ data ph15/187500.d0,250000.d0/ data exmp/ 1 2*2200.0d0, 2250.0d0, 2 2*1950.0d0, 2000.0d0/ data xmp / & 19* 650.0d0, 750.0d0, 850.0d0, 950.0d0, 1050.0d0, 1100.0d0, & 1150.0d0,1200.0d0,1250.0d0,1300.0d0, 1350.0d0, 1400.0d0, & 1450.0d0,1500.0d0,1550.0d0,1600.0d0, 1650.0d0,4*1700.0d0, & 1750.0d0/ data cred /107.0d0,102.0d0,98.0d0,3*93.0d0,6*88.0d0/ data aif /2*1.0d0,1.010d0,1.0d0,1.02d0/ data bus15/5200.0d0, .495d0, 10400.0d0, .990d0, 15650.0d0,1.98d0, & 20900.0d0,2.476d0, 41700.0d0,2.969d0, 1.e20,3.0d0/ data tab77 / & 5000.0d0, .5d0, 10000.0d0, 1.0d0, 15000.0d0, 2.0d0, & 20000.0d0,2.50d0, 40000.0d0, 3.0d0, 1.e20, 3.5d0/ c 1982, 1983, 1984, 1985, 1986, 1987, 1988 data tab83/ & 5000.0d0, .625d0, .9165d0, .95d0, .903d0, .855d0, .751d0, .743d0, &10000.0d0,1.25d0 ,1.833d0 ,1.9d0 ,1.805d0,1.71d0 ,1.502d0,1.486d0, &15000.0d0,2.5d0 ,3.666d0 ,3.8d0 ,3.61d0 ,3.42d0 ,3.004d0,2.972d0, &20000.0d0,3.125d0,4.5825d0,4.75d0,4.513d0,4.275d0,3.755d0,3.715d0, &40000.0d0,3.75d0 ,5.499d0 ,5.7d0 ,5.415d0,5.13d0 ,4.506d0,4.457d0, &80000.0d0,4.375d0,6.4155d0,6.65d0,6.318d0,5.985d0,5.257d0,5.201d0, &100000.0d0, 5.0d0,7.332d0 ,7.6d0 ,7.22d0 ,6.84d0 ,6.008d0,5.943d0, &1.e20, 6.25d0 ,9.165d0 ,9.5d0 ,9.025d0,8.55d0 ,6.9d0 ,6.9d0/ data tab/ & 5000.0d0, 0.0d0, 10000.0d0, 0.0d0, 15000.0d0, 0.0d0, & 20000.0d0, 0.0d0, 40000.0d0, 0.0d0, 80000.0d0, 0.0d0, & 100000.0d0, 0.0d0, 1.e20, 0.0d0/ data tab93/ & 5000.0d0, .0d0 , 10000.0d0, .0d0 , 15000.0d0, .0d0, & 20000.0d0, .0d0 , 40000.0d0, .0d0 , 80000.0d0, .0d0, & 100000.0d0, .0d0 , 200000.0d0, .0d0 , 1.e20, 7.5d0/ data tab96/ & 5000.0d0, .693d0, 10000.0d0, 1.387d0, 15000.0d0, 2.775d0, & 20000.0d0,3.469d0, 40000.0d0, 4.162d0, 80000.0d0, 4.857d0, & 100000.0d0,5.55d0 , 200000.0d0, 6.444d0, 1.e20, 7.004d0/ data tab97/ & 5000.0d0, .713d0, 10000.0d0, 1.426d0, 15000.0d0, 2.853d0, & 20000.0d0,3.566d0, 40000.0d0, 4.279d0, 80000.0d0, 4.993d0, & 100000.0d0,5.706d0, 200000.0d0, 6.624d0, 1.e20, 7.201d0/ data tab98/ & 5000.0d0, .673d0, 10000.0d0, 1.347d0, 15000.0d0, 2.694d0, & 20000.0d0,3.368d0, 40000.0d0, 4.040d0, 80000.0d0, 4.715d0, & 100000.0d0,5.388d0, 200000.0d0, 6.255d0, 1.e20, 6.799d0/ data tab99/ & 5000.0d0, .716d0, 10000.0d0, 1.432d0, 15000.0d0, 2.864d0, & 20000.0d0,3.58d0 , 40000.0d0, 4.295d0, 80000.0d0, 5.012d0, & 100000.0d0,5.727d0, 200000.0d0, 6.65d0 , 1.e20, 7.228d0/ data tab00/ & 5000.0d0, .691d0, 10000.0d0, 1.383d0, 15000.0d0, 2.766d0, & 20000.0d0,3.458d0, 40000.0d0, 4.148d0, 80000.0d0, 4.841d0, & 100000.0d0,5.531d0, 200000.0d0, 6.422d0, 1.e20, 6.980d0/ data tab01/ & 5000.0d0, .743d0, 10000.0d0, 1.486d0, 15000.0d0, 2.972d0, & 20000.0d0,3.715d0, 40000.0d0, 4.457d0, 80000.0d0, 5.201d0, & 100000.0d0,5.943d0, 200000.0d0, 6.9d0 , 1.e20, 7.50d0/ data tab05/ & 5000.0d0, .712d0, 10000.0d0, 1.424d0, 15000.0d0, 2.847d0, & 20000.0d0,3.559d0, 40000.0d0, 4.270d0, 80000.0d0, 4.983d0, & 100000.0d0,5.693d0, 200000.0d0, 6.610d0, 1.e20, 7.185d0/ data tab06/ & 5000.0d0, .681d0, 10000.0d0, 1.361d0, 15000.0d0, 2.722d0, & 20000.0d0,3.403d0, 40000.0d0, 4.083d0, 80000.0d0, 4.764d0, & 100000.0d0,5.444d0, 200000.0d0, 6.32d0 , 1.e20, 6.870d0/ data tab07/ & 5000.0d0, .649d0, 10000.0d0, 1.299d0, 15000.0d0, 2.598d0, & 20000.0d0,3.247d0, 40000.0d0, 3.895d0, 80000.0d0, 4.546d0, & 100000.0d0,5.194d0, 200000.0d0, 6.031d0, 1.e20, 6.555d0/ data tab08/ & 5000.0d0, .618d0, 10000.0d0, 1.236d0, 15000.0d0, 2.473d0, & 20000.0d0,3.091d0, 40000.0d0, 3.708d0, 80000.0d0, 4.327d0, & 100000.0d0,4.945d0, 200000.0d0, 5.741d0, 1.e20, 6.24d0/ data tab11/ & 5100.0d0, .587d0, 10200.0d0, 1.174d0, 15350.0d0, 2.348d0, & 20450.0d0,2.935d0, 40850.0d0, 3.521d0, 81650.0d0, 4.109d0, & 102100.0d0,4.695d0, 204200.0d0, 5.451d0, 1.e20, 5.925d0/ data tab13/ & 5200.0d0, .0d0, 10400.0d0, .0d0, 15650.0d0, .0d0, & 20900.0d0, .0d0, 41700.0d0, .0d0, 83350.0d0, .0d0, & 104250.0d0, .0d0, 208500.0d0, .0d0, 1.e20, .0d0/ data tab16/ & 5200.0d0, .0d0, 10500.0d0, .0d0, 15800.0d0, .0d0, & 21100.0d0, .0d0, 42100.0d0, .0d0, 84200.0d0, .0d0, & 105300.0d0, .0d0, 210600.0d0, .0d0, 1.e20, .0d0/ data rt13/ .537d0, 1.074d0, 2.148d0,2.686d0, 3.222d0, 3.760d0, & 4.296d0, 4.988d0, 5.421d0/ data rt14/ .528d0, 1.057d0, 2.113d0,2.642d0, 3.169d0, 3.698d0, & 4.226d0, 4.906d0, 5.333d0/ data rt15/ .495d0, .990d0, 1.980d0,2.476d0, 2.969d0, 3.4650d0, & 3.960d0, 4.597d0, 4.997d0/ data sentab/500.0d0, 0.0d0, 1500.0d0, 25.0d0, 3000.0d0, & 50.0d0, 5000.0d0, 80.0d0, 8000.0d0, 130.0d0, 1.e20, 200.0d0/ rt=0. mst = data(2) sep = data(3) c AGI agi = comnew(2) c state y tx refunds and disability are always subtracted from agi agi = agi - data(22)-comnew(82) if(law.le.1982.and.data(9).gt.0) then agi=agi-min(data(20)+data(72),4000.0d0) endif if(law.ge.1980) agi = agi-xjobs(data,law) if(law.ge.1984) agi = agi-comnew(79) c For tax year 2015, the business income deduction at 75%, continuing businc = 0. statb = 0. if(law.ge.2015) then busded = pc15(law)*(max(0.0d0,data(17))+max(0.0d0,data(21))) busded = min(busded,ph15(law)/sep) agi = agi - busded businc = max(0.0d0,data(17))+max(0.0d0,data(21)) - busded c taxable business income businc = max(0.0d0,businc) call look(bus15,businc,6,n,statb,1.0d00,0.0d0,rt,data) endif c Exemptions; no deductions if(law.le.1995) then exemp = xmp(law)*(data(7)+data(8)) else if(law.eq.1996) then exemp = xmp(law)*data(7) + 850.*data(8) else if(law.eq.1997) then exemp = xmp(law)*data(7) + 1050.*data(8) else if(law.eq.1998) then exemp = xmp(law)*data(7) + 1050.*data(8) else exema = xmp(law) if(law.ge.2014) then if(agi.le.40000) exema = exmp(law,1) if(agi.gt.40000.and.agi.le.80000) exema = exmp(law,2) endif exemp = exema*(data(7) + data(8)) endif c Taxable Income taxinc = max(0.0d0,agi- businc- exemp) c Low Income Tax Credit 2006 : taxpayers c whose Ohio taxable income is less than or equal $10000 owe no tax statax = 0. if(law.ge.2006.and.taxinc.le.10000) return credit = 0. c Credits from Schedule B regcr=0. c energy credit ecred=0. if(law.le.1985)ecred=min(1000.0d0,data(38)) c income tax credit taxcr = 0 if(law.ge.2005.and.taxinc.le.10000) taxcr = cred(law) c child care credit : updated through 2008 chcr=0. if(law.ge.1989.and.law.le.1992.and.agi.lt.30000.) then chcr = min(comnew(176)*.25,360.0d0) else if(law.ge.1993.and.law.le.1996.and.agi.lt.40000) then if(agi.lt.20000.) then chcr=comnew(176)*.35 else chcr=comnew(176)*.25 endif else if(law.ge.1997.and.agi.lt.40000) then if(agi.lt.20000) then chcr = comnew(176) else chcr = comnew(176)*.25 endif endif c retirement income credit & senior citizen' credit snrcr=0. retcr=0. if(data(9).gt.0.) then if(law.le.1982)snrcr=25. if(law.ge.1983.and.taxinc.le.100000.d0) then snrcr=50. retcr=tablki(sentab,6,data(20)+data(72),data) if(law.ge.1990) retcr=min(200.0d0,retcr) endif endif regcr=ecred+chcr+snrcr+retcr+taxcr credit = regcr c exemption credit - nonrefundable excred = 0. if((law.ge.1983.and.law.le.2012).or. & (law.ge.2013.and.taxinc.lt.30000.0d0)) & excred = 20.*(data(7) + data(8)) credit = credit+excred if(law.ge.1982.and.law.le.1995) then do 20 i=1,8 if(law.eq.1982)tab(2,i)=tab83(2,i) if(law.eq.1983)tab(2,i)=tab83(3,i) if(law.eq.1984)tab(2,i)=tab83(4,i) if(law.eq.1985)tab(2,i)=tab83(5,i) if(law.eq.1986)tab(2,i)=tab83(6,i) if(law.eq.1987)tab(2,i)=tab83(7,i) if(law.ge.1988.and.law.le.1992)tab(2,i)=tab83(8,i) if(law.ge.1993.and.law.le.1995)tab93(2,i)=tab83(8,i) 20 continue endif dedy=0. dedtx=0. y=taxinc if(law.le.1981) then c years before 1982 call look(tab77,taxinc,6,n,statax,1.0d00,0.0d0,rt,data) statax = max(0.0d0,statax-regcr) call ohjoin(data,statax,comnew,law,businc) c 1982 else if(law.eq.1982) then call look(tab,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) statax = max(0.0d0,statax-regcr) call ohjoin(data,statax,comnew,law,businc) c two extra deduction yield different results; must calculate c both ways else if(law.ge.1983.and.law.le.1988) then c 1983 - 1988 c method 1 dedy=350*(data(7)+data(8)) y=max(0.0d0,y-dedy) call look(tab,y,8,n,stax1,1.0d00,0.0d0,rt,data) c dedy=int(dedy*txrate) if(law.eq.1983)stax1 = stax1-regcr if(law.ne.1983)stax1 = max(0.0d0,stax1-regcr) c this is calculated after credits are subtracted call ohjoin(data,statax,comnew,law,businc) statax = stax1 c method 2 dedtx=20.*(data(7)+data(8)) call look(tab,taxinc,8,n,stax2,1.0d00,0.0d0,rt2,data) if(law.eq.1983)stax2 = stax2-regcr-dedtx if(law.ne.1983)stax2 = max(0.0d0,stax2-regcr-dedtx) call ohjoin(data,statax,comnew,law,businc) if(stax2.lt.stax1) then statax = stax2 rt = rt2 endif statax = max(0.0d0,statax - excred) else if(law.ge.1989.and.law.le.1992) then call look(tab,taxinc,8,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1993.and.law.le.1995) then call look(tab93,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1996) then call look(tab96,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1997) then call look(tab97,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1998) then call look(tab98,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1999) then call look(tab99,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2000) then call look(tab00,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.2001.and.law.le.2004) then call look(tab01,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2005) then call look(tab05,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2006) then call look(tab06,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2007) then call look(tab07,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.2008.and.law.le.2010) then call look(tab08,taxinc,9,n,statax,aif(law),0.0d0,rt,data) else if(law.ge.2011.and.law.le.2012) then call look(tab11,taxinc,9,n,statax,aif(law),0.0d0,rt,data) else if(law.ge.2013.and.law.le.2015) then do 2013 i=1,9 if(law.eq.2013) tab13(2,i) = rt13(i) if(law.eq.2014) tab13(2,i) = rt14(i) if(law.eq.2015) tab13(2,i) = rt15(i) 2013 continue call look(tab13,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2016) then do 2016 i=1,9 if(law.eq.2016) tab16(2,i) = rt15(i) 2016 continue call look(tab16,taxinc,9,n,statax,1.0d00,0.0d0,rt,data) endif statax = statax + statb statax = max(0.0d0,statax - regcr) statax = max(0.0d0,statax - excred) c Starting 2013 nonrefundable EITC earncr = 0. if(law.eq.2013) earncr = .05*comnew(59) if(law.ge.2014) earncr = .10*comnew(59) if(taxinc+businc.gt.20000.0d0) earncr = min(earncr,.5*statax) c OH Joint credit c it is important to subtract 'earncr' after 'ohjoin' calculations c (based on TaxACT test in 2015) if(mst.eq.2) call ohjoin(data,statax,comnew,law,businc) statax = max(0.0d0,statax - earncr) endif return end subroutine ohjoin(data,statax,comnew,law,businc) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt real jcred dimension data(255),comnew(255),crtab(2,3),crt83(2,6),crt84(2,4) data crtab/ 10000.,.2,20000.,.12,1.e20,.05/ data crt83/ 10000.,.2,20000.,.16,25000.,.12,50000.,.1, & 75000.,.07,1.e20,.06/ data crt84/ 25000.,.2,50000.,.15,75000.,.1,1.e20,.05/ c in order to receive two-earner joint deduction, each spouse c must have earned income of at least $500. xlind = data(11)+data(23)+data(17)+data(20)+data(72)+ & data(21)+comnew(78)-comnew(17) hagi = data(85) + .5*(xlind-data(11)) wagi = xlind - hagi if(hagi.ge.500.and.wagi.ge.500.and.comnew(37).ge.1000) then if(law.lt.1983)jcred= & max(0.0d0,tablki(crtab,3,taxinc,data)*statax) if(law.eq.1983)jcred= & max(0.0d0,tablki(crt83,6,taxinc,data)*statax) if(law.ge.1984)jcred= & max(0.0d0,tablki(crt84,4,taxinc+businc,data)*statax) if(law.ge.1989)jcred=min(jcred,650.) statax=max(0.0d0,statax-jcred) endif return end c OKLAHOMA c State 37 c c Updated through 2016 subroutine oktax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common/x/ct common/times/z,p,txrate,h dimension data(255),comnew(255),ded(2,2007:2016) double precision fedtax, five dimension & tabs79(2,18),tabm79(2,18), & tabs77(2,7) ,tabh77(2,7) ,tabm77(2,7), & tss90(2,8) ,tmm90(2,8) , & tss99(2,8) ,tmm99(2,8) , & tabs88(2,11),tabm88(2,11), & tabs90(2,11),tabm90(2,11), & ymax(1977:2016), sale(1999:2016,2) dimension tss04(2,8),tmm04(2,8) dimension tss56(2,8),tmm56(2,8) dimension tss07(2,7),tmm07(2,7) dimension tss08(2,7),tmm08(2,7) dimension tss09(2,7),tmm09(2,7) dimension tss12(2,7),tmm12(2,7) dimension tss16(2,6),tmm16(2,6) data ded/ 7 4125.0d0, 2750.0d0, 8 4875.0d0, 3250.0d0, 9 6325.0d0, 4250.0d0, & 8400.0d0, 5700.0d0, 1 8500.0d0, 5800.0d0, 2 8700.0d0, 5950.0d0, 3 8950.0d0, 6100.0d0, 4 9100.0d0, 6200.0d0, 5 9250.0d0, 6300.0d0, 6 9300.0d0, 6300.0d0/ data sale/ 1 15000.d0, 30000.d0, 20000.d0, 15000.d0, 12000.d0, 1 15000.d0,12*20000.d0, 2 20000.d0,2*50000.d0, 30000.d0, 12000.d0, 30000.d0, 2 12*50000.d0/ data tabs77/ & 1000.0d0, .5d0, 2500.0d0, 1.0d0, 3750.0d0, 2.0d0, & 5000.0d0,3.0d0, 6250.0d0, 4.0d0, 7500.0d0, 5.0d0, & 1.e20,6.0d0/ data tabh77/ & 1500.0d0, .5d0, 3750.0d0, 1.0d0, 5625.0d0, 2.0d0, & 7500.0d0,3.0d0, 9375.0d0, 4.0d0,11250.0d0, 5.0d0, & 1.e20,6.0d0/ data tabm77/ & 2000.0d0, .5d0, 5000.0d0, 1.0d0, 7500.0d0, 2.0d0, & 10000.0d0,3.0d0,12500.0d0, 4.0d0,15000.0d0, 5.0d0, & 1.e20,6.0d0/ data tss90/ & 1000.0d0, .5d0, 2500.0d0, 1.0d0, 3750.0d0, 2.0d0, & 4900.0d0,3.0d0, 6200.0d0, 4.0d0, 7700.0d0, 5.0d0, & 10000.0d0,6.0d0, 1.e20, 7.0d0/ data tmm90/ & 2000.0d0, .5d0, 5000.0d0, 1.0d0, 7500.0d0, 2.0d0, & 9800.0d0,3.0d0,12200.0d0, 4.0d0,15000.0d0, 5.0d0, & 21000.0d0,6.0d0, 1.e20, 7.0d0/ data tss99/ & 1000.0d0, .5d0, 2500.0d0, 1.0d0, 3750.0d0, 2.0d0, & 4900.0d0,3.0d0, 6200.0d0, 4.0d0, 7700.0d0, 5.0d0, & 10000.0d0,6.0d0, 1.e20, 6.75d0/ data tss04/ & 1000.0d0, .5d0, 2500.0d0, 1.0d0, 3750.0d0, 2.0d0, & 4900.0d0,3.0d0, 6200.0d0, 4.0d0, 7700.0d0, 5.0d0, & 10000.0d0,6.0d0, 1.e20,7.0d0/ data tss56/ & 1000.0d0, .5d0, 2500.0d0, 1.0d0, 3750.0d0, 2.0d0, & 4900.0d0,3.0d0, 6200.0d0, 4.0d0, 7700.0d0, 5.0d0, & 10000.0d0,6.0d0, 1.e20, 6.65d0/ data tmm99/ & 2000.0d0, .5d0, 5000.0d0, 1.0d0, 7500.0d0, 2.0d0, & 9800.0d0,3.0d0,12200.0d0, 4.0d0,15000.0d0, 5.0d0, & 21000.0d0,6.0d0, 1.e20, 6.75d0/ data tmm04/ & 2000.0d0, .5d0, 5000.0d0, 1.0d0, 7500.0d0, 2.0d0, & 9800.0d0, 3.0d0,12200.0d0, 4.0d0,15000.0d0, 5.0d0, & 21000.0d0, 6.0d0, 1.e20, 7.0d0/ data tmm56/ & 2000.0d0, .5d0, 5000.0d0, 1.0d0, 7500.0d0, 2.0d0, & 9800.0d0,3.0d0,12200.0d0, 4.0d0,15000.0d0, 5.0d0, & 21000.0d0,6.0d0, 1.e20, 6.65d0/ data tss07/ & 1000.0d0, .5d0, 2500.0d0, 1.0d0, 3750.0d0, 2.0d0, & 4900.0d0, 3.0d0, 7200.0d0, 4.0d0, 8700.0d0, 5.0d0, & 1.e20, 6.25d0/ data tss08/ & 1000.0d0, .5d0, 2500.0d0, 1.0d0, 3750.0d0, 2.0d0, & 4900.0d0,3.0d0, 7200.0d0, 4.0d0, 8700.0d0, 5.0d0, & 1.e20,5.65d0/ data tss09/ & 1000.0d0, .5d0, 2500.0d0, 1.0d0, 3750.0d0, 2.0d0, & 4900.0d0,3.0d0, 7200.0d0, 4.0d0, 8700.0d0, 5.0d0, & 1.e20,5.5d0/ data tss12/ & 1000.0d0, .5d0, 2500.0d0, 1.0d0, 3750.0d0, 2.0d0, & 4900.0d0,3.0d0, 7200.0d0, 4.0d0, 8700.0d0, 5.0d0, & 1.e20,5.25d0/ data tss16/ & 1000.0d0, .5d0, 2500.0d0, 1.0d0, 3750.0d0, 2.d0, & 4900.0d0,3.0d0, 7200.0d0, 4.0d0, 1.e20, 5.d0/ data tmm07/ & 2000.0d0, .5d0, 5000.0d0, 1.0d0, 7500.0d0, 2.0d0, & 9800.0d0, 3.0d0,12200.0d0, 4.0d0,15000.0d0, 5.0d0, & 1.e20, 6.25d0/ data tmm08/ & 2000.0d0, .5d0, 5000.0d0, 1.0d0, 7500.0d0, 2.0d0, & 9800.0d0, 3.0d0,12200.0d0, 4.0d0,15000.0d0, 5.0d0, & 1.e20, 5.65d0/ data tmm09/ & 2000.0d0, .5d0, 5000.0d0, 1.0d0, 7500.0d0, 2.0d0, & 9800.0d0,3.0d0,12200.0d0, 4.0d0,15000.0d0, 5.0d0, & 1.e20,5.5d0/ data tmm12/ & 2000.0d0, .5d0, 5000.0d0, 1.0d0, 7500.0d0, 2.0d0, & 9800.0d0,3.0d0,12200.0d0, 4.0d0,15000.0d0, 5.0d0, & 1.e20,5.25d0/ data tmm16/ & 2000.0d0, .5d0, 5000.0d0, 1.0d0, 7500.0d0, 2.d0, & 9800.0d0,3.0d0,12200.0d0, 4.0d0, 1.e20, 5.d0/ data tabs79/ & 1000.0d0, .5d0, 2500.0d0, 1.0d0, 3750.0d0, 2.0d0, & 5000.0d0, 3.0d0, 6250.0d0, 4.0d0, 7500.0d0, 5.0d0, & 9250.0d0, 6.0d0,11250.0d0, 7.0d0,13250.0d0, 8.0d0, & 15250.0d0, 9.0d0,17500.0d0,10.0d0,21000.0d0,11.0d0, & 27000.0d0,12.0d0,33000.0d0,13.0d0,39000.0d0,14.0d0, & 43000.0d0,15.0d0,49000.0d0,16.0d0, 1.e20,17.0d0/ data tabm79/ & 2000.0d0, .5d0, 5000.0d0, 1.0d0, 7500.0d0, 2.0d0, & 9000.0d0, 3.0d0,10500.0d0, 4.0d0,12000.0d0, 5.0d0, & 13500.0d0, 6.0d0,15000.0d0, 7.0d0,17000.0d0, 8.0d0, & 23000.0d0, 9.0d0,29000.0d0,10.0d0,38000.0d0,11.0d0, & 48000.0d0,12.0d0,58000.0d0,13.0d0,69000.0d0,14.0d0, & 81000.0d0,15.0d0,94000.0d0,16.0d0, 1.e20,17.0d0/ data tabs88/ & 1000.0d0, .5d0, 2500.0d0, 1.0d0, 3750.0d0, 2.0d0, & 5000.0d0, 3.0d0, 6250.0d0, 4.0d0, 7500.0d0, 5.0d0, & 9250.0d0, 6.0d0,11250.0d0, 7.0d0,13250.0d0, 8.0d0, & 15250.0d0, 9.0d0, 1.e20,10.0d0/ data tabm88/ & 2000.0d0, .5d0, 5000.0d0, 1.0d0, 7500.0d0, 2.0d0, & 9000.0d0, 3.0d0,10500.0d0, 4.0d0,12000.0d0, 5.0d0, & 13500.0d0, 6.0d0,15000.0d0, 7.0d0,17000.0d0, 8.0d0, & 23000.0d0, 9.0d0, 1.e20,10.0d0/ data tabs90/ & 1000.0d0, .5d0, 2500.0d0, 1.0d0, 3750.0d0, 2.0d0, & 4900.0d0, 3.0d0, 6100.0d0, 4.0d0, 7500.0d0, 5.0d0, & 9000.0d0, 6.0d0,10500.0d0, 7.0d0,12500.0d0, 8.0d0, & 16000.0d0, 9.0d0, 1.e20,10.0d0/ data tabm90/ & 2000.0d0, .5d0, 5000.0d0, 1.0d0, 7500.0d0, 2.0d0, & 8900.0d0, 3.0d0,10400.0d0, 4.0d0,12000.0d0, 5.0d0, & 13250.0d0, 6.0d0,15000.0d0, 7.0d0,18000.0d0, 8.0d0, & 24000.0d0, 9.0d0, 1.e20,10.0d0/ data ymax/ & 3*6600.0d0, 4*7200.0d0, 5*8500.0d0, 8*10000.0d0,20*12000.0d0/ mst = data(2) rt=0. c AGI agi=comnew(2)+divexc(data,comnew,law) c Comments for interest and dividend deduction are given after c testing Taxcut and DC test c if(law.le.1987) then c agi=agi-twn(data(12)+data(14),0.0d0,100*data(7)) c elseif(law.ge.1988) then c agi=agi-twn(data(14),0.0d0,100*data(7)) c endif if(law.ge.1978)agi=agi-min(100.*data(7),data(65)) if(law.ge.1981.and.law.le.1986)agi=agi-comnew(81) c Social Security Benefits are not taxable Oklahoma if(law.ge.1985)agi=agi-comnew(79) c Private Pension/Retirement exclusion penmax = 0. n7 = data(7) if(data(20)+data(72).gt.0.) then if(law.le.2006.and.agi.le.25000.*data(9)) then if(law.le.1998) penmax = 2200.*data(9) if(law.gt.1998.and.law.le.1999) penmax = 3300.*data(9) if(law.eq.2000) penmax = 4400.*data(9) if(law.ge.2001.and.law.le.2004) penmax = 5500.*data(9) if(law.eq.2005) penmax = 7500.*data(9) if(law.ge.2006) penmax =10000.*data(9) else if(law.eq.2007) then if((n7.eq.1.and.agi.le.50000).or.(n7.eq.2.and.agi.le.100000)) & penmax =10000.*data(9) else if(law.eq.2008) then if((n7.eq.1.and.agi.le.62500).or.(n7.eq.2.and.agi.le.125000)) & penmax =10000.*data(9) else if(law.eq.2009) then if(agi.le.100000*n7) penmax = 10000.*data(9) else if(law.ge.2010) then penmax = 10000.*n7 endif agi = max(agi-min(penmax,data(20)+data(72)),0.0d0) endif c 2005+ capital gain deduction if(law.ge.2005) agi = agi - max(0.0d0,comnew(6)) c 2009 unemployment compensation is taxed in full if(law.eq.2009) agi = agi - comnew(78) + data(82) c Exemptions if(law.le.1981) then exemp=(data(7)+data(8)+data(9)+data(10))*750. elseif(law.ge.1982.and.law.le.1986) then exemp=(data(7)+data(8)+data(9)+data(10))*1000. elseif(law.ge.1987) then exemp=(data(7)+data(8)+data(10))*1000. old=0. if((mst.eq.2.or.mst.eq.3.or.mst.eq.5.or.mst.eq.6).and. & comnew(2).le.25000/data(3)) old=1. if(mst.eq.1.and.comnew(2).le.15000) old=1. if((mst.eq.4.or.mst.eq.7).and.comnew(2).le.19000)old=1. exemp = exemp + (data(9)*old*1000.) endif c Federal Tax deduction fedtax=0. if(law.le.1978) then five=max(0.0d0,comnew(1)-500.) if(five.gt.0.) then fedtax=500. + (five*.05) else fedtax=max(0.0d0,comnew(52)) endif fedtax=min(fedtax,1700.0d0) elseif(law.ge.1979.and.law.le.2005) then c fedtax=max(0.0d0,comnew(52)-data(43)+data(34)) fedtax = max(0.0d0,comnew(1)) endif c Deductions if(law.le.2005) then stded=twn(.15*agi,(1000./data(3)),(2000/data(3))) elseif(law.eq.2006) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then stded = 2000. else stded = 3000. endif elseif(law.ge.2007) then if(mst.eq.4.or.mst.eq.7) then stded = ded(1,law) else stded = ded(2,law)*data(7) endif endif perc1 = 1. perc2 = 1. c New in 2006: a second tax table has been eliminated if(law.le.2005) then xitded = (comnew(30)-comnew(34))*comnew(26) deduc=max(xitded,stded) taxya=max(0.0d0,agi-perc1*(deduc+exemp)) if(comnew(2).gt.0) perc2 = min(1.0d0,max(0.0d0,agi/comnew(2))) taxyb=max(0.0d0,taxya-perc2*fedtax) if(law.le.1978) then taxinc=taxyb if(mst.eq.2.or.mst.eq.5) then call look(tabm77,taxyb,7,n,statax,1.0d00,0.0d0,rt,data) elseif(mst.eq.4.or.mst.eq.7) then call look(tabh77,taxyb,7,n,statax,1.0d00,0.0d0,rt,data) else call look(tabs77,taxyb,7,n,statax,1.0d00,0.0d0,rt,data) endif elseif(law.ge.1979.and.law.le.1987) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then call look(tabs77,taxya,7,n,stax1,1.0d00,0.0d0,rt,data) call look(tabs79,taxyb,18,n,stax2,1.0d00,0.0d0,rt2,data) else call look(tabm77,taxya,7,n,stax1,1.0d00,0.0d0,rt,data) call look(tabm79,taxyb,18,n,stax2,1.0d00,0.0d0,rt2,data) endif if(stax2.lt.stax1) then statax = stax2 taxinc=taxyb rt=rt2 else taxinc=taxya statax = stax1 endif elseif(law.ge.1988.and.law.le.1989) then if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then call look(tabs77,taxya,7,n,stax1,1.0d00,0.0d0,rt,data) call look(tabs88,taxyb,11,n,stax2,1.0d00,0.0d0,rt2,data) else call look(tabm77,taxya,7,n,stax1,1.0d00,0.0d0,rt,data) call look(tabm88,taxyb,11,n,stax2,1.0d00,0.0d0,rt2,data) endif if(stax2.lt.stax1) then statax = stax2 taxinc=taxyb rt=rt2 else taxinc=taxya statax = stax1 endif else if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then if(law.le.1998) then call look(tss90,taxya,8,n,stax1,1.0d00,0.0d0,rt,data) elseif (law.ge.1999.and.law.le.2002) then call look(tss99,taxya,8,n,stax1,1.0d00,0.0d0,rt,data) elseif (law.eq.2004) then call look(tss04,taxya,8,n,stax1,1.0d00,0.0d0,rt,data) else if(law.eq.2003.or.law.eq.2005.or.law.eq.2006) then call look(tss56,taxya,8,n,stax1,1.0d00,0.0d0,rt,data) endif call look(tabs90,taxyb,11,n,stax2,1.0d00,0.0d0,rt2,data) else if(law.le.1998) then call look(tmm90,taxya,8,n,stax1,1.0d00,0.0d0,rt,data) else if(law.ge.1999.and.law.le.2002) then call look(tmm99,taxya,8,n,stax1,1.0d00,0.0d0,rt,data) else if(law.eq.2004) then call look(tmm04,taxya,8,n,stax1,1.0d00,0.0d0,rt,data) else if(law.eq.2003.or.law.eq.2005.or.law.eq.2006) then call look(tmm56,taxya,8,n,stax1,1.0d00,0.0d0,rt,data) endif call look(tabm90,taxyb,11,n,stax2,1.0d00,0.0d0,rt2,data) endif if(stax2.lt.stax1) then rt=rt2 taxinc=taxyb statax = stax2 else taxinc=taxya statax = stax1 endif endif else if (law.ge.2006) then xitded = comnew(24) if(law.le.2015) then deduc = max(stded,xitded) else deduc = stded if(comnew(26).gt.0.d0.and.comnew(30).gt.0.d0) then c 2016+ Federal itemized deductions must be adjusted by adding back c "state and local sales or income taxes" to arrive at Oklahoma itemized deductions. xitded = comnew(24) if(data(50).gt.0) xitded = max(0.d0,xitded - & (data(50) - data(50)*comnew(34)/comnew(30))) deduc = xitded endif endif taxinc = 0. if(comnew(2).gt.0) taxinc=max(0.0d0,agi-deduc-exemp) c taxinc=max(0.0d0,agi-(deduc+exemp)*agi/comnew(2)) if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) then if(law.eq.2006)then call look(tss56,taxinc,8,n,statax,1.0d0,0.0d0,rt,data) else if(law.eq.2007) then call look(tss07,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if(law.eq.2008) then call look(tss08,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2009.and.law.le.2011) then call look(tss09,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2012.and.law.le.2015) then call look(tss12,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2016) then call look(tss16,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) endif else if(law.eq.2006)then call look(tmm56,taxinc,8,n,statax,1.0d0,0.0d0,rt,data) else if(law.eq.2007) then call look(tmm07,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if(law.eq.2008) then call look(tmm08,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2009.and.law.le.2011) then call look(tmm09,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2012.and.law.le.2015) then call look(tmm12,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2016) then call look(tmm16,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) endif endif endif c Credits c Child Care Credit 2008+(child care/child tax credit) chcr=0. if(law.le.2007) then chcr=.2*perc2*min(comnew(53),max(0.0d0,comnew(52)-data(34))) else if(law.ge.2008.and.comnew(2).le.100000.and. & comnew(2).gt.0.and.agi.ge.0)then perc = min(1.d0,agi/comnew(2)) c chcare the credit for child care expenses allowed by the IRS chcare = min(comnew(53),max(0.0d0,comnew(52)-data(34))) c chtax the child tax credit allowed by the IRS chtax = min(comnew(81)+comnew(93), & max(0.0d0,comnew(52)-data(34)-comnew(53))+comnew(93)) chcr = max(.2*chcare,.05*chtax)*perc endif c Solar Energy Credit c what about solar energy credit? c only one Form 508 for 1995 and instrcns for this credit in the booklet 1990. ecred = 0. if(law.le.1994) then ecred = min(3500.0d0,.35*data(38)) elseif(law.ge.1995) then ecred = min(7500.0d0,.3*min(25000.0d0,data(38))) endif c Credit for property tax relief pcred=0. c OK total gross household income includes federal EIC hhy = hy + comnew(59) if(hhy.lt.ymax(law).and.(data(9).gt.0.or.data(10).gt.0)) & pcred=min(max(0.0d0,data(51)-.01*hhy),200.0d0) c EITC - allowed in 2002 earncr = 0 if(law.ge.2002.and.comnew(2).gt.0) & earncr=.05*comnew(59)*agi/comnew(2) c Sales tax credit for those who have agi<12000. scred = 0. if(((law.ge.1990.and.law.le.1998).or.law.eq.2003) & .and.hy.lt.12000) scred = 40.* (data(7)+data(8)) num = 1 if(data(8).gt.0.or.data(9).gt.0.or.data(10).gt.0) num = 2 if((law.ge.1999.and.law.le.2002).or.law.ge.2004) then if(num.eq.1) then if(data(159).le.sale(law,num)) scred = 40.* data(7) else if(data(159).le.sale(law,num)) scred = 40.* (data(7)+data(8)) endif endif credit = chcr + ecred + pcred + scred +earncr if(law.le.2015) then statax = max(0.0d0,statax-chcr-ecred)-pcred-scred-earncr else c 2016+ earncr is non-refundable statax = max(0.0d0,statax-chcr-ecred-earncr)-pcred-scred endif return end c OREGON c State 38 c c Updated through 2016 subroutine ortax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt common/temp/count dimension data(255),comnew(255), aif92(1991:2012),child(1989:2016) dimension tabm77(2,7),tabm82(2,7),tabm87(2,3),tabmin(2,5) dimension tabs77(2,7),tabs82(2,7),tabs87(2,3) dimension tab05(2,3),tab09(2,5),tab12(2,4) dimension tab95m(2),tab95s(2),tab00m(2),tab00s(2) dimension tab94m(2),tab94s(2) dimension tab96m(2),tab96s(2),tab97m(2),tab97s(2) dimension tab98m(2),tab98s(2),tab99m(2),tab99s(2) dimension tab01m(2),tab01s(2) dimension tabs(2,3),tabm(2,3) dimension wfei(1997:2015),wfdiv(1997:2015) dimension xmp(1977:1982),fed(1977:2016),xcred(1983:2016), &xcrmin(2007:2012) dimension surtax(1977:2016),old(1:7) dimension stand(1:7), stand02(1:7),aifst(2002:2016) dimension unex(1:7), care(2,1:7),aif13(2013:2017),t12(2,2011:2016) &,t05(2,2004:2007),t09(2,2008:2010),tm13(3,2013:2016) dimension fam97(8,6),aifam(1997:2015),fam(2,7), & povert(8,2016:2016),perc16(23,2) integer sep,qual,sing data povert/ 6 11800.d0,16020.d0,20160.d0,24300.d0,28440.d0,32580.d0,36730.d0, 6 40890.d0/ data perc16/ 1 .00d0, .10d0, .20d0, .30d0, .40d0, .50d0, .60d0, .70d0, .80d0, 1 .90d0,1.10d0,1.20d0,1.30d0,1.40d0,1.50d0,1.60d0,2.00d0,2.10d0, 1 2.20d0,2.30d0,2.40d0,2.60d0,3.00d0, 2 .05d0, .05d0, .10d0, .20d0, .30d0, .35d0, .40d0, .45d0, .50d0, 2 .55d0, .50d0, .45d0, .39d0, .33d0, .28d0, .25d0, .22d0, .20d0, 2 .15d0, .10d0, .05d0, .04d0, .00d0/ data t12/ 1 3150.0d0,7950.0d0, 2 3250.0d0,8150.0d0, 3 3300.0d0,8250.0d0, 4 3350.0d0,8400.0d0, 5 3350.0d0,8400.0d0, 6 3350.0d0,8450.0d0/ data tm13/ 3 6500.0d0,16300.0d0,250000.d0, 4 6700.0d0,16800.0d0,250000.d0, 5 6700.0d0,16800.0d0,250000.d0, 6 6700.0d0,16900.0d0,250000.d0/ data t09/ 8 3050.0d0,7600.0d0, 9 3050.0d0,7650.0d0, 1 3100.0d0,7750.0d0/ data t05/ 4 2600.0d0,6500.0d0, 5 2600.0d0,6500.0d0, 6 2750.0d0,6850.0d0, 7 2850.0d0,7150.0d0/ data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ data child/ & 14*2400.0d0,14*3000.0d0/ data aifst/ & 1.0d0, 1.02d0 , 1.05d0 , 1.08d0 , 1.122d0, 1.1128d0, & 1.1370d0, 1.1860d0, 1.189d0, 1.2073d0, 1.235d0, 1.2683d0, & 1.2900d0, 1.3079d0, 1.3140243d0/ data wfei/ & 2*6000.0d0, 6150.0d0, 6300.0d0, 6550.0d0, 6500.0d0, & 6600.0d0, 6750.0d0, 6900.0d0, 7100.0d0,2*7550.0d0, & 7850.0d0, 7900.0d0, 8000.0d0, 8200.0d0, 8400.0d0, & 8550.0d0, 8700.0d0/ data wfdiv/ & 2200.0d0, 2300.0d0, 2350.0d0, 2400.0d0, 2450.0d0, & 2550.0d0, 2600.0d0, 2650.0d0, 2700.0d0, 2800.0d0, & 2*2950.0d0,2*3100.0d0, 3150.0d0, 3200.0d0, 3300.0d0, & 3350.0d0, 3400.0d0/ data aif92/ & 1.0d0, 1.0525d0, 1.0845d0, 1.118d0 , 1.147d0 , 1.1795d0, & 1.2120d0, 1.2450d0, 1.2660d0, 1.2895d0, 1.3295d0, 1.3730d0, & 1.3950d0, 1.4270d0, 1.4595d0, 1.505d0 , 1.564d0 , 1.5995d0, & 1.6680d0,2*1.6955d0, 1.7365d0/ data aifam/ & 1.0d0, 1.025d0 , 1.044d0 , 1.06d0 , 1.45d0 , 1.50d0 , & 1.52d0, 1.570d0 , 1.620d0 , 1.654d0, 1.7215d0, 1.755d0, & 2*1.827d0, 1.840d0 , 1.886d0 , 1.916d0, 1.97d0 , 2.003d0/ data tabm77/ & 1000.0d0, 4.0d0, 2000.0d0, 5.0d0, 4000.0d0, 6.0d0, & 6000.0d0, 7.0d0, 8000.0d0, 8.0d0,10000.0d0, 9.0d0, & 1.e20, 10.0d0/ data tabs77/ & 500.0d0, 4.0d0, 1000.0d0, 5.0d0, 2000.0d0, 6.0d0, & 3000.0d0, 7.0d0, 4000.0d0, 8.0d0, 5000.0d0, 9.0d0, & 1.e20, 10.0d0/ data tabm82/ & 1000.0d0, 4.2d0, 2000.0d0, 5.3d0, 4000.0d0, 6.5d0, & 6000.0d0, 7.6d0, 8000.0d0, 8.7d0, 10000.0d0, 9.8d0, & 1.e20, 10.8d0/ data tabs82/ & 500.0d0, 4.2d0, 1000.0d0, 5.3d0, 2000.0d0, 6.5d0, & 3000.0d0, 7.6d0, 4000.0d0, 8.7d0, 5000.0d0, 9.8d0, & 1.e20, 10.8d0/ c 2004-2008 data tab05/ & 0.0d0, 5.0d0, 0.0d0, 7.0d0, 1.e20, 9.0d0/ c 2009 data tab09/ & 0.0d0, 5.0d0, 0.0d0, 7.0d0, 125000.0d0, 9.0d0, & 250000.0d0,10.8d0, 1.e20, 11.0d0/ c 2012 data tab12/ & 0.0d0, 5.0d0, 0.0d0, 7.0d0, 125000.0d0, 9.0d0, & 1.e20, 9.9d0/ data tabm87/ & 4200.0d0, 5.0d0, 10300.0d0, 7.0d0, 1.e20, 9.0d0/ data tabs87/ & 2000.0d0, 5.0d0, 5000.0d0, 7.0d0, 1.e20, 9.0d0/ data tab94m/ 3900.0d0, 10600.0d0/ data tab94s/ 1800.0d0, 5500.0d0/ data tab95m/ 4300.0d0, 10800.0d0/ data tab95s/ 2150.0d0, 5450.0d0/ data tab96m/ 4400.0d0, 11100.0d0/ data tab96s/ 2250.0d0, 5550.0d0/ data tab97m/ 4500.0d0, 11400.0d0/ data tab97s/ 2350.0d0, 5850.0d0/ data tab98m/ 4600.0d0, 11600.0d0/ data tab98s/ 2400.0d0, 5900.0d0/ data tab99m/ 4700.0d0, 11700.0d0/ data tab99s/ 2400.0d0, 5950.0d0/ data tab00m/ 4800.0d0, 11900.0d0/ data tab00s/ 2400.0d0, 6050.0d0/ data tab01m/ 5000.0d0, 12600.0d0/ data tab01s/ 2500.0d0, 6400.0d0/ c 1 2 3 4 5 6 7 8 data fam97/ & 11850.0d0,15900.0d0,20000.0d0,24100.0d0,28150.0d0,32250.0d0, 1 36300.0d0,40400.0d0, & 12600.0d0,17000.0d0,21350.0d0,25700.0d0,30000.0d0,34400.0d0, 2 38750.0d0,43100.0d0, & 13400.0d0,18050.0d0,22650.0d0,27300.0d0,31900.0d0,36550.0d0, 3 41150.0d0,45800.0d0, & 14200.0d0,19100.0d0,24000.0d0,28900.0d0,33800.0d0,38700.0d0, 4 43600.0d0,48450.0d0, & 15000.0d0,20150.0d0,25340.0d0,30500.0d0,35650.0d0,40850.0d0, 5 46000.0d0,51150.0d0, & 15800.0d0,21200.0d0,26650.0d0,32100.0d0,37550.0d0,43000.0d0, 6 48400.0d0,53850.0d0/ data fam/ & .0d0, .4d0 , .0d0, .36d0, .0d0, .32d0, .0d0, .24d0, & .0d0, .16d0, .0d0, .08d0, 1.e20, .0d0/ data tabmin/ & 5000.0d0, 1.0d0, 7000.0d0, 1.5d0, 9000.0d0, 2.0d0, & 12000.0d0, 2.5d0, 1.e20, 3.0d0/ data xmp /2*750.0d0,4*1000.0d0/ data fed / & 2*5000.0d0, 8*7000.0d0, 15*3000.0d0, 3250.0d0, 3500.0d0, & 4000.0d0, 4500.0d0, 5000.0d0, 5500.0d0, 5600.0d0, & 2*5850.0d0, 5950.0d0, 6100.0d0, 6250.0d0, 6350.0d0, & 6450.0d0, 6500.0d0/ data xcred/ & 4*85.0d0, 86.0d0, 89.0d0, 94.0d0, 98.0d0, 104.0d0, & 109.0d0, 113.0d0, 116.0d0, 120.0d0, 124.0d0, 128.0d0, & 132.0d0, 134.0d0, 139.0d0, 142.0d0, 145.0d0, 147.0d0, & 151.0d0, 154.0d0, 159.0d0, 165.0d0, 169.0d0, 176.0d0, & 177.0d0, 179.0d0, 183.0d0, 188.0d0, 191.0d0, 194.0d0, & 195.0d0/ data xcrmin/ 55.0d0, 56.0d0,2*58.0d0,59.0d0,60.0d0/ data surtax/8*1.0d0,.9230d0,1.0d00,.8340d0,1.0d0, & 3*.9020d0,25*1.0d0/ data unex/20000.0d0, 25000.0d0, 3*20000.0d0, 0.0d0, 20000.0d0/ data stand/1800.0d0, 3000.0d0, 1500.0d0, 2640.0d0, 3000.0d0, & 1500.0d0, 2640.0d0/ data stand02/ & 1640.0d0, 3280.0d0, 1640.0d0, 2640.0d0, 3280.0d0, 1640.0d0, & 2640.0d0/ data old/ 1200.0d0, 2*1000.0d0, 1200.0d0, 2*1000.0d0,1200.0d0/ data care/ 5000.0d0, .30d0, 10000.0d0, .150d0, 15000.0d0, & .080d0, 25000.0d0, .060d0, & 35000.0d0, .050d0, 45000.0d0, .040d0, 1.e20, 0.0d0/ c c indexing never went into effect. rt = 0. sing = 0 sep = data(3) mst = data(2) ided = data(4) if(mst.eq.1.or.mst.eq.3.or.mst.eq.6)sing = 1 phas92=100000./data(3) if(law.ge.1992.and.law.le.2012) & phas92=100000.*aif92(law)/data(3) if(law.ge.2013) & phas92 = aif13(law)*250000*filing(mst,1.,1.2,1.1,.6) c AGI agi=comnew(2) - data(22) if(law.ge.1982.and.law.le.1986) then agi=agi+comnew(32) agi=agi-max(0.0d0,min((comnew(4)+data(14)),100.*data(7))) endif c code follows different federal laws if(law.ge.1981.and.law.le.1984) then unx=unex(mst) untax=min(.5*max(agi-unx,0.0d0),data(82)) agi=agi+comnew(78)-untax endif c Social Security Benefits are not taxable in Oregon if(law.ge.1984) agi=agi-comnew(79) agi=max(agi,0.0d0) c federal tax deduction fedtax= max(0.0d0,comnew(52)-data(44)-comnew(58)) if(ided.eq.-2.and.law.eq.1997) fedtax=max(0.0d0,comnew(52)) if(law.ge.1980)fedtax=fedtax+data(34) if(law.ge.1981)fedtax=fedtax+data(42) c The tax rebates (economic stimulus payments) from the IRS may reduce c 2008 federal tax subtraction. if(law.eq.2008) fedtax = & max(0.0d0,fedtax - 600*data(7) - 300*data(8)) c 2009-2010 please use Making work pay credit fedtax = max(0.0d0,fedtax - comnew(94)) fedtax=twn(fedtax,0.0d0,fed(law)/sep) c Standard Deduction if(law.le.1986) then stded=twn(.13*agi,1050.0d0/sep,1500.0d0/sep) else if(law.ge.1987.and.law.le.2001) then stded=stand(mst)+((data(9)+data(10))*old(mst)) if(data(7).lt.1.)stded=500.0d0 else if(law.ge.2002) then stded=stand02(mst)*aifst(law)+((data(9)+data(10))*old(mst)) if(law.le.2003.and.data(7).lt.1.) then stded=max(750.0d0,comnew(37)+250.0d0) else if(law.ge.2004.and.data(7).lt.1.) then stded=max(800.0d0,comnew(37)+250.0d0) endif endif c State Tax Declaration Phaseout if(law.le.2003) then tx=data(50) else tx = max(data(52),data(50)) endif if(law.ge.1991) then ag = max(0.0d0,comnew(2)) xlin4=max(0.0d0,data(49)-.075*ag) xlin8=tx+data(51)+data(46) xlin11=data(53) xlin12=data(56)+data(53)+data(57) xlin16=data(58)+data(59)+data(60) xlin17=max(0.0d0,data(61)-.1*ag) xlin18=data(26) xlin24=max(data(27)+data(63)-.02*ag,0.0d0) xlin25=data(66) xtot=xlin4+xlin8+xlin12+xlin16+xlin17+xlin18+xlin24+ & xlin25 xdiff=xtot-xlin4-xlin11-xlin17 if(xdiff.gt.0.) then xdiff2=comnew(2) - phas92 if(xdiff2.gt.0.) then xconst=min(.8*xdiff,.03*xdiff2) xlin26=xtot-xconst xprop=(xdiff-(xtot-xlin26))/xdiff tx=xprop*tx endif endif endif xitded=max(0.0d0,comnew(30) -comnew(34)- tx) c Itemized Deductions for old people if(law.ge.1992.and.data(9).gt.0) then xitded=max(0.0d0,comnew(30)-comnew(34)-comnew(20)+ & min(data(47)+data(48)+data(49),.075d0*comnew(2))) endif if(ided.eq.-2.and.law.eq.1999) xitded=0. c next line is for dctest c if(agi.le.25000) xitded=0 c deduc=max(stded,xitded) exemp = 0. if(law.le.1982) exemp=comnew(68)*xmp(law) taxinc=max(0.0d0,agi-deduc-exemp-fedtax) if(law.ge.1994) then do 20 i=1,2 do 20 j=1,3 tabm(i,j)=tabm87(i,j) 20 tabs(i,j)=tabs87(i,j) if(law.eq.1994) then do 40 i=1,2 tabm(1,i)=tab94m(i) 40 tabs(1,i)=tab94s(i) endif if(law.eq.1995) then do 50 i=1,2 tabm(1,i)=tab95m(i) 50 tabs(1,i)=tab95s(i) endif if(law.eq.1996) then do 60 i=1,2 tabm(1,i)=tab96m(i) 60 tabs(1,i)=tab96s(i) endif if(law.eq.1997) then do 70 i=1,2 tabm(1,i)=tab97m(i) 70 tabs(1,i)=tab97s(i) endif if(law.eq.1998) then do 80 i=1,2 tabm(1,i)=tab98m(i) 80 tabs(1,i)=tab98s(i) endif if(law.eq.1999) then do 90 i=1,2 tabm(1,i)=tab99m(i) 90 tabs(1,i)=tab99s(i) endif if(law.eq.2000) then do 100 i=1,2 tabm(1,i)=tab00m(i) 100 tabs(1,i)=tab00s(i) endif if(law.ge.2001.and.law.le.2003) then do 101 i=1,2 tabm(1,i)=tab01m(i) 101 tabs(1,i)=tab01s(i) endif endif num = 2 if(sing.eq.1) num = 1 if (law.le.1981) then if(sing.eq.0) & call look(tabm77,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) if(sing.eq.1) & call look(tabs77,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1982.and.law.le.1986) then if(sing.eq.0) & call look(tabm82,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) if(sing.eq.1) & call look(tabs82,taxinc,7,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1987.and.law.le.1993) then if(sing.eq.0) & call look(tabm87,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) if(sing.eq.1) & call look(tabs87,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1994.and.law.le.2003) then if(sing.eq.0) & call look(tabm,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) if(sing.eq.1) & call look(tabs,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.2004.and.law.lt.2008) then do 2005 i=1,2 2005 tab05(1,i) = t05(i,law) taxy = taxinc/num call look(tab05,taxy,3,n,statx,1.0d00,0.0d0,rt,data) statax = num * statx else if(law.ge.2008.and.law.lt.2011) then do 2009 i=1,2 2009 tab09(1,i) = t09(i,law) taxy = taxinc/num call look(tab09,taxy,5,n,statx,1.0d00,0.0d0,rt,data) statax = num * statx else if(law.ge.2011.and.law.le.2012) then do 2012 i=1,2 2012 tab12(1,i) = t12(i,law) taxy = taxinc/num call look(tab12,taxy,4,n,statx,1.0d00,0.0d0,rt,data) statax = num * statx else if(law.ge.2013) then do 2013 i=1,2 2013 tab12(1,i) = t12(i,law) c For filing single or married/RDP filing separately if(mst.eq.1.or.mst.eq.3.or.mst.eq.6) & call look(tab12,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.2.or.mst.eq.4.or.mst.eq.5.or.mst.eq.7) then c For filing jointly, hoh, or qualifying widow with dependent child do 2014 i=1,3 2014 tab12(1,i) = tm13(i,law) call look(tab12,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) endif endif altax=0. if(law.le.1986) then prefs=comnew(36) qual=0 if(prefs.gt.10000/sep) qual=1 if(agi.gt.20000./sep.and.prefs.gt.3000./sep)qual=1 if(qual.eq.1) & call look(tabmin,prefs,5,n,altax,1.0d00,0.0d0,art,data) endif statax=statax+altax statax=max(0.0d0,statax) txp=data(7) ecred = 0. chcr = 0. if(law.le.1978) then ecred=.15*comnew(32) chcr=.4*comnew(53) else if(law.ge.1979.and.law.lt.1987) then taxmax=max(0.0d0,comnew(1)-comnew(58)) ecred=min(.15*taxmax,.15*comnew(32)) chcr=min(.4*taxmax,.4*comnew(53)) else if(law.ge.1987.and.law.le.2015) then c child and dependent care credit expired as of January 1, 2016 ecred=.4*comnew(54) if(law.eq.1987.or.law.eq.1988) then chcr=.4*comnew(53) else if(comnew(53).gt.0) then y=max(0.0d0,comnew(29)) chcr=tablki(care,7,y,data)* & min(comnew(37),min(data(64),min(2.0d0,data(8))*child(law))) endif endif endif rcred = 0. if(law.ge.1991.and.data(9).gt.0) then if(agi.le.(22500.*txp)) then rcred=.09*(min(data(20)+data(72),max(0.0d0,max((7500.*txp)- & comnew(84),0.0d0)-max(data(159)-(15000.*txp),0.0d0)))) endif if(law.eq.1994.and.comnew(84).gt.(7500.*txp))rcred=0. endif polit=0. if(law.ge.1978.and.law.le.1986) then polit=min(.5*comnew(25),25.*data(7)) else if(law.ge.1987) then polit=min(data(35),50.*data(7)) endif altcr=min(data(38),1000.0d0) c Exemption Credit gcred = 0. ngcred = txp if(mst.eq.4.or.mst.eq.7.or.mst.eq.5) ngcred = 2 if((law.ge.1983.and.law.le.2012).or.(law.ge.2013.and. & comnew(2).le.100000*ngcred)) gcred = xcred(law)*comnew(68) c Exemption Credit Phaseout since 2007 and through 2012 if(law.ge.2007.and.law.le.2012) then phasa = aif92(law) * 100000 if(mst.eq.4.or.mst.eq.7) then phasa = 1.25 * phasa else if(mst.eq.2.or.mst.eq.5.or.sep.eq.2) then phasa = 1.5 * phasa/sep endif if(comnew(2).gt.phasa) then c Minimum credit gcrmin = xcrmin(law) * comnew(68) nl4 = int((comnew(2) - phasa)/(2500./sep) + 1) xl5 = nl4 * 0.02 gcred = max(gcrmin,gcred * (1-xl5)) endif endif c Earned Income Credit (non-refundable, since 2006 is refundable) earncr = 0. if (law.ge.1997.and.law.le.2007) earncr = .05*comnew(59) if (law.ge.2008.and.law.le.2013) earncr = .06*comnew(59) if (law.ge.2014) earncr = .08*comnew(59) c Working Family Child Care Credit(refundable) numhh = max(1.0d0,min(8.0d0,comnew(68))) c WFC expired as of January 1, 2016 famcr = 0. if(law.ge.1997.and.law.le.2015.and.sep.eq.1) then if(comnew(37).ge.wfei(law).and. & data(12)+data(14)+max(0.0d0,comnew(6)).lt.wfdiv(law)) then do 1 i=1,6 fam(1,i) = 0. if(law.ge.1997) fam(1,i) = fam97(numhh,i)*aifam(law) 1 continue famcr = data(64) * tablki(fam,7,comnew(2),data) endif endif c WFHDC is a new refundable credit in 2016 wfhdc = 0. if(law.ge.2016.and.numhh.gt.1.0d0) then ncccr = min(data(8),2.0d0) expens = min(data(64),12000.0d0*ncccr) expens = min(expens,comnew(37)) if(mst.eq.2) &expens = max(0.0d0,min(expens,data(85),data(86))) pov = povert(numhh,law) base = max(comnew(2),agi) base = max(0.0d0,base) do 111 k=1,21 if(base.gt.perc16(k,1)*pov.and.base.le.perc16(k+1,1)*pov) then wfhdc = perc16(k,2)*expens perc = perc16(k,2) endif 111 continue endif if(law.le.2005) then credit=polit+ecred+chcr+altcr+gcred+rcred+earncr else credit=polit+ecred+chcr+altcr+gcred+rcred endif statax=max(0.0d0,statax-credit) statax=statax-famcr-wfhdc credit = credit + famcr + wfhdc if(law.ge.2006) then statax = statax - earncr credit = credit + earncr endif if(statax.gt.0) statax=statax*surtax(law) return end c PENNSYLVANIA c State 39 c Updated through 2016 c subroutine patax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255) dimension rate(1977:2016) data rate/ & .02d0,5*.022d0 , .0245d0, .024d0,.0235d0, .0216d0,4*.021d0, & .026d0, .0295d0,11*.0280d0,13*.0307d0/ rt=rate(law) mst = data(2) nkid = data(8) c AGI c no capital losses allowed c PA allows a full pension income exclusion c data(20) and data(72) are excluded from AGI for seniors agi=data(11)+data(12)+data(14)+data(17)+max(0.0d0,data(18))+ & max(0.0d0,data(19))+max(0.0d0,comnew(5))+comnew(8)+ & max(0.0d0,data(21))+max(0.0d0,data(24)) if(data(9).eq.0) agi = agi + data(20) + data(72) c law allows deduction of emp bus exp for all years; TAXSIM c variable does not begin until 1979 if(law.ge.1979)agi=agi-data(27) if(law.ge.1982)agi=agi-data(26) taxinc=max(0.0d0,agi) statax = taxinc * rt c Forgiveness Credit eligy=taxinc+data(23) c Can't determine if there are two earners in the family; count c the spouse as a dependent, figuring if he/she weren't, the couple c would still derive financial benefit by filing separately. if(law.le.1994) then ntxp = data(7)-1 dep1 = 0. dep2 = 0. if(ntxp.eq.0)then if(nkid.eq.1) then dep1 = 1. dep2 = 0. else if(nkid.ge.2) then dep1 = 1. dep2 = nkid-1. endif else if(ntxp.gt.0) then dep1 = 1. dep2 = nkid endif else if(law.ge.1995) then dep1 = data(7) dep2 = nkid endif c Determine if filer is independent if(law.le.1986) then allow=3000.+(dep1*1200.)+(dep2*750.) else if(law.eq.1987) then allow=4500.+(dep1*1500.)+(dep2*1000.) else if(law.ge.1988.and.law.le.1993) then allow=6300.+(dep1*1500.)+(dep2*1000.) else if(law.eq.1994) then if(mst.ne.2) then allow=6300.+3000.*data(8) else c Joint claim for tax forgiveness allow=9300.+3000.*data(8) endif else if(law.ge.1995.and.law.le.1996) then allow = 6300.+(dep1-1+dep2)*3000. else if(law.eq.1997) then allow = 6300.*dep1+dep2*4000. else if(law.eq.1998) then if(mst.ne.2) then allow = 6500.*(dep1+min(1.0d0,dep2))+max(0.0d0,dep2-1)*6000. else allow = 6500.*dep1+dep2*6000. endif else if(law.eq.1999) then allow = 6500.*(dep1+dep2) elseif(law.eq.2000) then allow = 6500.*dep1+7500.*dep2 elseif(law.eq.2001) then allow = 6500.*dep1+8500.*dep2 elseif(law.ge.2002.and.law.le.2003) then allow = 6500.*dep1+9000.*dep2 elseif(law.ge.2004) then allow = 6500.*dep1+9500.*dep2 endif remain= max(0.0d0,eligy-allow) if(law.le.1997) then perc = max(0.0d0,1. -remain/1000.) else perc = max(0.0d0,1. -remain/2500.) endif credit = statax * perc statax = statax - credit return end c RHODE ISLAND c State 40 c c Updated through 2016 subroutine ritax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255),rate(1977:2000),aif(2002:2016) dimension tabs77(2,6),tabm77(2,5),tabs84(2,6),tabm84(2,5) dimension tabs88(2,5),tabm88(2,5),tabs99(2,5),tabm99(2,5) dimension tabs98(2,5),tabm98(2,5),tabs97(2,5),tabm97(2,5) dimension tab01s(2,5),tab01h(2,5),tab01m(2,5) dimension tab02s(2,5),tab02h(2,5),tab02m(2,5) dimension tab11(2,3) dimension stnds(2003:2016),stndm(2003:2016),stndh(2003:2016) dimension stndd(2003:2010),olds(2003:2010),oldm(2003:2010), & ptr(1977:2016) dimension eicpr(2003:2017),phase(3,2003:2010),excl(3,2003:2010) dimension brack(3,2003:2009),flrate(2006:2010),xmp(2011:2016) double precision ltg data xmp/3500.0d0,3650.0d0,3750.0d0, 3800.0d0, 3850.0d0,3900.0d0/ data flrate/.08d0,.075d0,.07d0,.065d0,.06d0/ data phase/ 3 112500.0d0,150000.0d0,112500.0d0, 4 112500.0d0,150000.0d0,112500.0d0, 5 115050.0d0,153450.0d0,115050.0d0, 6 118850.0d0,158200.0d0,118850.0d0, 7 123250.0d0,164350.0d0,123250.0d0, 8 126100.0d0,168150.0d0,126100.0d0, 9 131450.0d0,175300.0d0,131450.0d0, & 131700.0d0,175650.0d0,131700.0d0 / data brack/ 3 28400.0d0, 47450.0d0, 38050.0d0, 4 29050.0d0, 48500.0d0, 38900.0d0, 5 29700.0d0, 49650.0d0, 39800.0d0, 6 30650.0d0, 51200.0d0, 41050.0d0, 7 31850.0d0, 53150.0d0, 42650.0d0, 8 32550.0d0, 54400.0d0, 43650.0d0, 9 33950.0d0, 56700.0d0, 45500.0d0/ data excl / 3 35750.0d0,49000.0d0,35750.0d0, 4 35750.0d0,49000.0d0,35750.0d0, 5 36550.0d0,50100.0d0,36550.0d0, 6 37700.0d0,51650.0d0,37700.0d0, 7 39150.0d0,53700.0d0,39150.0d0, 8 40050.0d0,54900.0d0,40050.0d0, 9 41750.0d0,57250.0d0,41750.0d0, & 41850.0d0,57350.0d0,41850.0d0/ data eicpr/ & 2*.05d0, .1d0, 9*.15d0,.1d0,.125d0,.15d0/ data stnds/ & 4750.0d0, 4850.0d0, 5000.0d0, 5150.0d0, 5350.0d0, & 5450.0d0,2*5700.0d0, 7500.0d0, 7800.0d0, 8000.0d0, & 8100.0d0, 8275.0d0, 8300.0d0/ data stndh/ & 7000.0d0, 7150.0d0, 7300.0d0, 7550.0d0, 7850.0d0, & 8000.0d0, 8350.0d0, 8400.0d0, 11250.0d0, 11700.0d0, & 12000.0d0, 12200.0d0, 12400.0d0, 12450.0d0/ data stndm/ & 7950.0d0, 8150.0d0, 8300.0d0, 8600.0d0, 8900.0d0, & 9100.0d0, 9500.0d0, 9550.0d0, 15000.0d0, 15600.0d0, & 16000.0d0, 16250.0d0, 16550.0d0, 16600.0d0/ data stndd/ & 750.0d0, 2*800.0d0, 2*850.0d0, 900.0d0,2*950.0d0/ data olds / & 1150.0d0, 1200.0d0,2*1250.0d0,1300.0d0, 1350.0d0, & 2*1400.0d0/ data oldm / & 2*950.0d0,2*1000.0d0,2*1050.0d0,2*1100.0d0/ data aif/ & 1.0d0, 1.016d0, 1.0385d0, 1.063d0, 1.0966d0, & 1.138d0, 1.165d0, 1.2147d0, 1.216d0, 1.0d0, & 1.039d0, 1.066d0, 1.084d0 , 1.101d0, 1.1063636d0/ data ptr/ & 2*150.d0, 5*175.d0, 13*200.d0, 9*250.d0, 8*300.d0, & 305.d0, 320.d0, 335.d0/ data rate/ & 4*.19d0, .1924d0, .219d0 , .2675d0, .255d0, .2315d0, & .2221d0, .2346d0,4*.2296d0,6*.2750d0, .270d0, .2650d0, & .260d0/ data tabs77/ & 1000.0d0, .03d0, 1500.0d0, .04d0, 2000.0d0, .05d0, & 2500.0d0, .06d0, 8000.0d0, .07d0, 1.e20, .0d0/ data tabm77/ & 1500.0d0, .03d0, 2000.0d0, .04d0, 2500.0d0, .05d0, & 8000.0d0, .06d0, 1.e20, .0d0/ data tabs84/ & 1200.0d0, .03d0, 2000.0d0, .04d0, 2500.0d0, .05d0, & 3000.0d0, .06d0, 11000.0d0, .07d0, 1.e20, .0d0/ data tabm84/ & 2000.0d0, .03d0, 2500.0d0, .04d0, 3000.0d0, .05d0, & 12500.0d0, .06d0, 1.e20, .0d0/ data tabs88/ & 4000.0d0, .03d0, 6000.0d0, .04d0, 8000.0d0, .05d0, & 12500.0d0, .06d0, 1.e20, .0d0/ data tabm88/ & 4000.0d0, .03d0, 6000.0d0, .04d0, 11000.0d0, .05d0, & 12500.0d0, .06d0, 1.e20, .0d0/ data tabs97/ & 4000.0d0, .03d0, 6000.0d0, .04d0, 8000.0d0, .05d0, & 18000.0d0, .06d0, 1.e20, .0d0/ data tabm97/ & 4000.0d0, .03d0, 6000.0d0, .04d0, 11000.0d0, .05d0, & 18000.0d0, .06d0, 1.e20, .0d0/ data tabs98/ & 6000.0d0, .03d0, 9000.0d0, .04d0, 12000.0d0, .05d0, & 25000.0d0, .06d0, 1.e20, .0d0/ data tabm98/ & 6000.0d0, .03d0, 9000.0d0, .04d0, 15000.0d0, .05d0, & 25000.0d0, .06d0, 1.e20, .0d0/ data tabs99/ 6000.d0,.03d0,9000.d0,.04d0,12000.d0,.05d0, & 30000.d0,.06d0, 1.e20,0.d0/ data tabm99/ 6000.d0,.03d0,9000.d0,.04d0,15000.0d0,.05d0, & 30000.d0,.06d0, 1.e20,0.d0/ data tab01s/ & 27050.0d0,3.825d0, 65550.0d0,7.14d0 , 136750.0d0,7.905d0, & 297350.0d0,9.180d0, 1.e20,10.098d0/ data tab01h/ & 36250.0d0,3.825d0, 93650.0d0,7.14d0 , 151650.0d0,7.905d0, & 297350.0d0,9.18d0 , 1.e20,10.098d0/ data tab01m/ & 45200.0d0,3.825d0, 109250.0d0,7.14d0 , 166500.0d0,7.905d0, & 297350.0d0,9.18d0 , 1.e20,10.098d0/ data tab02s/ & 27950.0d0,3.750d0, 67700.0d0,7.0d0 , 141250.0d0,7.75d0, & 307050.0d0,9.0d0 , 1.e20,9.9d0/ data tab02h/ & 37450.0d0,3.750d0, 96700.0d0,7.0d0 , 156600.0d0,7.75d0, & 307050.0d0,9.0d0 , 1.e20,9.90d0/ data tab02m/ 46700.d0,3.75d0,112850.d0,7.d0,171950.d0,7.75d0, & 307050.d0,9.0d0 , 1.e20,9.9d0/ data tab11/55000.d0,3.75d0,125000.d0,4.75d0,1.e20, 5.99d0/ mst=data(2) nfile=filing(mst,1.,2.,3.,2.) sep = data(3) agi=comnew(2) c 2009 unemployment compensation is taxed in full if(law.eq.2009) agi = agi - comnew(78) + data(82) earncr = 0. ltg = max(0.0d0,comnew(6)) if(law.le.2000) then rt=rate(law)*comnew(72)/100. c tax before credits less foreign tax credit, credit for child and dependent c care expenses, credit for elderly, earned income credit if(law.ge.1986) then c RI allows EITC in 1986 fedtax=max(0.0d0,comnew(52)- & data(34)-comnew(53)-comnew(54)-comnew(59)) else fedtax=max(0.0d0,comnew(52)- & data(34)-comnew(53)-comnew(54)) endif statax=rate(law) * fedtax else if(law.ge.2001.and.law.le.2010) then if(law.le.2002) then taxinc = comnew(29) else if(mst.eq.1) then stded = stnds(law) + (data(9)+data(10))*olds(law) elseif(mst.eq.4.or.mst.eq.7) then stded = stndh(law) + (data(9)+data(10))*olds(law) else stded = stndm(law) + (data(9)+data(10))*oldm(law) endif if(data(105).gt.0.0d0) then stded=min(stded,max(stndd(law),comnew(37)+250.)) endif xitded = max(0.d0,comnew(30)-comnew(34)) deduc = max(stded,xitded) taxinc = max(0.0d0,agi-deduc-comnew(83)) endif if(mst.eq.1) then if(law.eq.2001) then call look(tab01s,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) else if (law.ge.2002.and.law.le.2010) then call look(tab02s,taxinc,5,n,statax,aif(law),0.0d0,rt,data) endif else if(mst.eq.4.or.mst.eq.7) then if(law.eq.2001) then call look(tab01h,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) else if (law.ge.2002.and.law.le.2010) then call look(tab02h,taxinc,5,n,statax,aif(law),0.0d0,rt,data) endif else taxy1= taxinc*sep if(law.eq.2001) then call look(tab01m,taxy1,5,n,tax1,1.0d00,0.0d0,rt,data) else if (law.ge.2002.and.law.le.2010) then call look(tab02m,taxy1,5,n,tax1,aif(law),0.0d0,rt,data) endif statax = tax1/sep endif c Schedule D Tax Worksheet c 2001 and 2002 no code for tax computation c using maximum capital gains rates because of complexity if(ltg.gt.0.and.law.ge.2003.and.law.le.2009) then taxnon = max(0.0d0,taxinc - ltg) if(mst.eq.1) then call look(tab02s,taxnon,5,n,stanon,aif(law),0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tab02h,taxnon,5,n,stanon,aif(law),0.0d0,rt,data) else taxn1 = taxnon*sep call look(tab02m,taxn1,5,n,staxn1,aif(law),0.0d0,rt,data) stanon = staxn1/sep endif br = min(taxinc,brack(nfile,law)/sep) taxbr = min(taxnon,br) taxy25 = br - taxbr tax25 = .025*taxy25 taxy50 = min(ltg,taxinc)-taxy25 tax50 = .05*taxy50 taxscd = stanon + tax25 + tax50 statax = min(taxscd,statax) endif else if(law.ge.2011) then c 2011 changes: fewer tax brackets, c a decrease in the top marginal income tax rate c higher standard deduction mounts for most taxpayers c the elimination of using federal itemized deductions c the elimination of additional st ded schedules if(mst.eq.1) then stded = stnds(law) elseif(mst.eq.4.or.mst.eq.7) then stded = stndh(law) else stded = stndm(law) endif exemp = comnew(68)*xmp(law) phas11s = 175000*aif(law) phas11f = 195000*aif(law) if(agi.gt.phas11f) then stded = 0. exemp = 0. else if(agi.gt.phas11s.and.agi.le.phas11f) then perc = 1 xincr = 5000*aif(law) number = int((agi-phas11s)/xincr + 1) if(number.eq.1) perc = .8 if(number.eq.2) perc = .6 if(number.eq.3) perc = .4 if(number.eq.4) perc = .2 c perc = max(0.0d0,(10.0d0-2.0d0*number)/10.0d0) stded = perc*stded exemp = perc*exemp endif deduc = stded c 2016 : modification for taxable Social Security DECREASING federal AGI c 2016 RI Schedule M line 1u if(law.ge.2016.and.comnew(79).gt.0.d0.and.data(9).gt.0.d0) then if(mst.ne.2) then agi = agi - comnew(79) else if(data(9).gt.1.d0) agi = agi - comnew(79) if(data(9).eq.1.d0) agi = agi - .5*comnew(79) endif endif taxinc = max(0.0d0,agi-deduc-exemp) call look(tab11,taxinc,3,n,statax,aif(law),0.0d0,rt,data) endif c Rhode Island Alternative Minimum tax starts in 2001; c 2011 -- the elimination of AMT altax=0. if((law.ge.2001.and.law.le.2002).and.comnew(70).gt.0.0d0) & altax=max(0.0d0,.25*comnew(70)-statax+.25*data(34)) if(law.ge.2003.and.law.le.2010) then exclnt = max(0.0d0, excl(nfile,law)/sep - & .25*max(0.0d0,comnew(69) - phase(nfile,law)/sep)) c Number of lines based on Form RI-6251 for the year 2003 alminy = max(0.0d0,comnew(69) - exclnt) if(ltg.lt.1) then if(alminy.lt.175000/sep) then xline4 = .065*alminy else xline4 = max(0.0d0,.07*alminy - 875/sep) endif xline8 = max(0.0d0,xline4 - .25*data(164)) xline13 = max(0.0d0,statax - .25*data(34)) altax = max(0.0d0,xline8 - xline13 - statax) else almnon = max(0.0d0,alminy - ltg) if(almnon.lt.175000/sep) then amtnon = .065*almnon else amtnon = max(0.0d0,.07*almnon - 875/sep) endif altax = max(0.0d0,amtnon + tax25 + tax50 - statax) endif endif statax=statax+altax c since 2006 RI Alternative Flat Tax c 2011 - the elimination of Alternative flat tax method if(law.ge.2006.and.law.le.2010) then fltax = flrate(law)*max(0.0d0,comnew(2)) statax = min(statax,fltax) endif c Credits crinv=.5*data(33) ecred=twn(.5*data(38),0.0d0,1000.0d0) pcred=0. ptax=0. frac=0. c credit for child and dependent care expenses if(law.ge.2001) then chcr = .25*min(comnew(53),max(0.d0,comnew(52)-data(34))) statax = max(0.d0,statax - chcr) endif c property tax relief credit if(data(9).gt.0.) then ptax = data(51)+data(160)*.2 if(data(7).gt.1..or. data(8).gt.0.) then if(law.le.1983.and.hy.lt.8000.) then frac = tablki(tabm77,5,hy,data) else if(law.ge.1984.and.law.le.1987.and.hy.lt.12500.) then frac = tablki(tabm84,5,hy,data) else if(law.ge.1988.and.law.le.1996.and.hy.lt.12500.) then frac = tablki(tabm88,5,hy,data) else if(law.eq.1997.and.hy.lt.18000.) then frac = tablki(tabm97,5,hy,data) else if(law.eq.1998.and.hy.le.25000.) then frac = tablki(tabm98,5,hy,data) else if(law.ge.1999.and.hy.lt.30000.) then frac = tablki(tabm99,5,hy,data) endif else if(data(7).lt.2..and.data(7).gt.0..and.data(8).lt.1.) then if(law.le.1983.and.hy.lt.8000) then frac = tablki(tabs77,6,hy,data) else if(law.ge.1984.and.law.le.1987.and.hy.lt.11000.) then frac = tablki(tabs84,6,hy,data) else if(law.ge.1988.and.law.le.1996.and.hy.lt.12500.) then frac = tablki(tabs88,5,hy,data) else if(law.eq.1997.and.hy.lt.18000.) then frac = tablki(tabs97,5,hy,data) else if(law.eq.1998.and.hy.lt.25000.) then frac = tablki(tabs98,5,hy,data) else if(law.ge.1999.and.hy.lt.30000.) then frac = tablki(tabs99,5,hy,data) endif endif if(frac.gt.0.0d0) pcred=twn(ptax-frac*hy,0.0d0,ptr(law)) endif if(statax.ge.100)statax=twn(statax-crinv,100.0d0,statax) statax=max(0.0d0,statax-ecred) c refunds allowed c changed 2/13/91; property tax accounting c RI Earned Income Credit 2001-2002 - nonrefundable if(law.eq.2001) earncr=.255*comnew(59) if(law.eq.2002) earncr=.25*comnew(59) if(law.le.2002) statax = max(0.0d0,statax-pcred-earncr) c 2003-2014, non-ref + refundable part of earncr if(law.ge.2003) then if(law.le.2014) then earnon = min(statax,.25*comnew(59)) earref = eicpr(law)* (.25*comnew(59)-earnon) earncr = earnon + earref else c 2015 refundable earncr = eicpr(law)*comnew(59) endif statax = statax - earncr - pcred endif if(law.ge.1986.and.law.le.2000) then fed = max(0.0d0,comnew(52)-data(34)-comnew(53)-comnew(54)) if(fed.gt.comnew(59)) then earncr = rate(law)*comnew(59) else earncr = rate(law)*fed endif endif credit = pcred + ecred + crinv + earncr return end c SOUTH CAROLINA c State 41 c Updated through 2016 subroutine sctax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255),aif92(1991:2012),aif13(2013:2017) dimension tab(2,6),tab85s(2,11),tab85j(2,7) dimension tab87(2,5),exs(1985:1986),exj(1985:1986) dimension aif(1977:2000), gas(1977:1981),tab95(2,6) &,tab03(2,6),aif02(2002:2016),tab01(2,10) dimension tab90(2,6) dimension pnsion(1977:2016),pns65(1993:2016),char(1977:1984) double precision irales,keoles integer sep data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ data aif02/ & .9625d0, 2*1.d0, 1.025d0, 1.054d0, 1.0708d0, 1.0958d0, & 1.1125d0,1.1417d0, 1.15d0 , 1.167d0, 1.1875d0,2*1.2d0, & 1.21666d0/ data aif92/1.d0, & 1.0525d0, 1.0845d0, 1.118d0, 1.147d0 , 1.1795d0, & 1.212d0 , 1.245d0 , 1.266d0, 1.2895d0, 1.3295d0, & 1.373d0 , 1.395d0 , 1.427d0, 1.4595d0, 1.505d0 , & 1.564d0 , 1.5995d0, 1.668d0,2*1.6955d0,1.7365d0/ data tab/ 2000.0d0, 2.0d0, 4000.0d0, 3.0d0, 6000.0d0,4.0d0, & 8000.0d0, 5.0d0, 10000.0d0, 6.0d0, 1.e20,7.0d0/ data tab85s/ & 1600.0d0, 2.0d0 , 2600.0d0, 2.5d0, 3600.0d0, 3.0d0, & 4600.0d0, 3.6d0 , 5600.0d0, 4.0d0, 6600.0d0, 4.6d0, & 7600.0d0, 5.0d0 , 8600.0d0, 5.5d0, 9600.0d0, 6.0d0, & 10600.0d0, 6.4d0 , 1.e20, 7.0d0/ data tab85j/ & 2000.0d0, 2.0d0 , 4000.0d0, 3.0d0, 6000.0d0, 4.0d0, & 8000.0d0, 5.0d0 ,10000.0d0, 6.0d0,12000.0d0, 6.6d0, & 1.e20, 7.0d0/ data tab87/ & 4000.0d0, 3.0d0 , 6000.0d0, 4.0d0, 8000.0d0, 5.0d0, & 10000.0d0, 6.0d0 , 1.e20, 7.0d0/ data tab90/ & 2030.0d0, 2.75d0, 4060.0d0, 3.0d0, 6090.0d0, 4.0d0, & 8120.0d0, 5.0d0 , 10150.0d0, 6.0d0, 1.e20, 7.0d0/ data tab95/ & 2000.0d0, 2.5d0 , 4000.0d0, 3.0d0, 6000.0d0, 4.0d0, & 8000.0d0, 5.0d0 , 10000.0d0, 6.0d0, 1.e20, 7.0d0/ data tab01/ & 2000.0d0, 2.5d0 , 3000.0d0, 2.8d0, 4000.0d0, 3.0d0, & 5000.0d0, 3.2d0 , 6000.0d0, 4.0d0, 7000.0d0, 4.1d0, & 9000.0d0, 4.8d0 , 11000.0d0, 5.7d0,13000.0d0, 6.55d0, & 1.e20, 7.0d0/ data tab03/ & 2400.0d0, .0d0 , 4800.0d0, 3.0d0, 7200.0d0, 4.0d0, & 9600.0d0, 5.0d0 , 12000.0d0, 6.0d0, 1.e20, 7.0d0/ data pnsion/6*0.0d0, 2*1200.0d0, 2100.0d0, 31*3000.0d0/ data pns65 /24*10000.0d0/ data char/6*.3d0,.2d0,.1d0/ data aif/7*1.0d0,1.009d0,6*1.0d0,5*1.111d0,1.125d0,1.14d0, & 3*1.155d0/ data gas/3*78.0d0,91.0d0,101.0d0/ data exs/2400.0d0,2550.0d0/ data exj/3550.0d0,3700.0d0/ c c brackets, deductions and exemptions are indexed. c mst = data(2) sep = data(3) rt=0. phas92=100000./data(3) if(law.ge.1992.and.law.le.2012) & phas92=100000.*aif92(law)/data(3) if(law.ge.2013) & phas92 = aif13(law)*250000*filing(mst,1.,1.2,1.1,.6) c AGI if(law.le.1984) then agi=comnew(2)+divexc(data,comnew,law)+max(0.0d0,data(82)- & comnew(78)) call sccg(cg,data) agi=agi-max(0.0d0,comnew(6))+max(0.0d0,cg) if(law.ge.1980)agi=agi-twn(data(38)*1.4,0.0d0,1000.0d0) if(law.eq.1982) then agi=agi+irales(data,comnew,1980)+keoles(data,comnew,1980) endif if(law.ge.1982)agi=agi-twn(data(12)+data(14),0.0d0,200.*data(7)) else if(law.ge.1985) then agi=comnew(29) agi=agi-xjobs(data,law) endif agi=agi-data(22) c 2009 unemployment compensation is taxed in full if(law.eq.2009) agi = agi - comnew(78) + data(82) if(law.ge.1979)agi=agi-disab(data,comnew,law) c retirement exclusion retded = 0. if(law.ge.1983.and.law.le.1992) & retded = twn(data(20)+data(72),0.0d0,pnsion(law) *data(7)) c ???Since 1993 the algorithm must be : c 1. if you take up to r3000 exclusion before 65+ you can c claim this exclusion for the rest of your life c 2. if you take up to r1000 exclusion at 65+.You didn't take c retirement exclusions before the age of 65. if(law.ge.1993) then if(data(9).lt.1.) then retded = twn(data(20)+data(72),0.0d0,pnsion(law) *data(7)) else if(data(9).gt.0.) then retded = twn(data(20)+data(72),0.0d0,pns65(law)*data(7)) if(data(9).lt.2.and.data(9).gt.0.and.mst.eq.2) & retded = twn(data(20)+data(72),0.0d0,pns65(law)+pnsion(law)) endif endif c Age 65 and older deduction since 1997 if(data(9).gt.0) then if (law.ge.1997.and.law.le.1998) retded=11500*data(9) if (law.ge.1999) retded = 15000.* data(9) endif agi = agi - retded c Social Security amount if taxed by Federal if(law.ge.1984) agi=agi-comnew(79) if(law.le.1983.and.data(9).gt.0) then if(data(8).gt.0) then if(agi.le.4000) return else if(agi.le.2800) return endif endif if(law.le.1984) then ag=max(0.0d0,agi) stded=min(.1*ag*aif(law),aif(law)*500.*data(7)) xitded=max(0.d0,comnew(30)-comnew(34)-comnew(20)-data(50)) jlaw=1980 call nlaw(data,jlaw) fedtax=comnew(1) call nlaw(data,law) xitded=max(0.d0,xitded-data(60)+twn(fedtax,0.0d0,500.*data(7))) c assume 10,000 miles driven per taxpayer if(law.le.1981) xitded=xitded + (gas(law)*data(7)) ed=data(47)+data(48)+data(49) if(law.le.1982)xitded=xitded+max(0.0d0,ed-ag*.05) if(law.ge.1983)xitded=xitded+max(0.0d0,ed-ag*.03) contr=data(58)+data(59) clim=char(law)*ag if(contr.gt.clim)xitded=max(0.d0,xitded-(contr-clim)) chcr=min(data(64),((min(data(8),3.0d0)*1200.)+1200.)) chcr=max(chcr-max(0.0d0,.5*(agi-18000.)),0.0d0) xitded=xitded+chcr deduc=max(stded,xitded) c Exemptions exemp = comnew(68)*aif(law)*800. if(mst.eq.4.or.mst.eq.7)exemp=exemp+aif(law)*800. if(mst.eq.5.and.data(8).gt.0)exemp=exemp+aif(law)*800. taxinc = max(0.0d0,agi - deduc - exemp) call look(tab,taxinc,6,n,statax,aif(law),0.0d0,rt,data) foodcr=0. if(law.eq.1984)foodcr=(data(8)+data(7))*12.5 statax=statax-foodcr credit = foodcr else if(law.ge.1985) then tx = 0. c if you deducted state and local income taxes while itemizing c on your federal return , you are required to add all or part of c this amount if(comnew(26).gt.0.) then tx = data(50) xtot = comnew(24) if(law.ge.1991) then if(comnew(2).gt.phas92.and.comnew(30).gt.0) & tx=data(50)-comnew(34)*data(50)/comnew(30) tx = min(tx,xtot-comnew(3)) endif endif c Net gain on assets held two or more years has been allowed subtraction c since 1990 : 14% in 1990, 29% in 1991-1994 and 44% since 1995 dedgan = 0. if(law.eq.1990) then dedgan = .14 * max(0.0d0,(data(70)- data(88))) else if(law.ge.1991.and.law.le.1994) then dedgan = .29 * max(0.0d0,(data(70)-data(88))) if(law.ge.1993) dedgan = max(0.0d0,dedgan -.29*data(83)) else if(law.ge.1995) then dedgan = .44 * max(0.0d0,(data(70)-data(88) -data(83))) endif c Married filers claiming standard deduction in 2003 c For 2003, this adjustment is necessary due to c a federal law change not adopted by South Carolina add = 0. if(law.eq.2003.and.comnew(26).lt.1..and.(mst.eq.2.or.sep.eq.2)) & then add = min(comnew(3),max(comnew(2)-comnew(83),0d0)) add = max(0.0d0,add-7950)/sep endif c if(law.ge.2008.and.data(51).gt.0)add = min(500*data(7),data(51)) taxinc=max(0.0d0,agi + tx - dedgan + add) if(law.eq.1985.or.law.eq.1986) then if(mst.eq.1) then taxinc = max(0.0d0,taxinc - exs(law)) call look(tab85s,taxinc,11,n,statax,1.0d0,0.0d0,rt,data) else taxinc = max(0.0d0,taxinc - exj(law)/sep) call look(tab85j,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) endif else if(law.ge.1987.and.law.le.1989) then call look(tab87,taxinc,5,n,statax,aif(law),0.0d0,rt,data) else if(law.eq.1990) then call look(tab90,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.1991.and.law.le.2000) then call look(tab95,taxinc,6,n,statax,aif(law),0.0d0,rt,data) else if(law.eq.2001) then call look(tab01,taxinc,10,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2002) then call look(tab03,taxinc,6,n,statax,aif02(law),0.0d0,rt,data) endif c CREDITS !!! c Child and dependent care Credit chcr = 0. nccp = min(data(8),2.0d0) if(sep.eq.1) then if (law.le.1986) then chcr = .07*min(2000.d0*nccp,data(64)) else if(law.ge.1987.and.law.le.2001) then chcr = .07*min(2400.d0*nccp,data(64)) else if(law.eq.2002) then chcr = min(168.d0*nccp,.07*min(3000.d0*nccp,data(64))) else if(law.ge.2003) then chcr = min(210.d0*nccp,.07*min(3000.d0*nccp,data(64))) endif endif c Elderly Credit eldcr = 0. if(law.le.1994) eldcr = min(.2*data(32),300.0d0) c Energy Credit ecred = 0. if(law.le.1986) ecred = data(38)*1.4 c Two wage earner Credit (married couple) twocrd = 0. if(law.ge.1987.and.mst.eq.2) then c earnls = min(max(data(85),data(86))+data(17), c & min(data(86),data(85))) busnes = max(0.0d0,data(17))-.5*data(43)+max(0.0d0,data(21)) husb = data(85) + .5*busnes wife = data(86) + .5*busnes earnls = min(husb,wife) twocrd = .007*twn(earnls,0.0d0,30000.0d0) endif c Total non-refundable credits credit = chcr + ecred + twocrd + eldcr statax = max(0.0d0,statax-credit) endif return end c c no carryovers are allowed; I didn't include the carryover here c because people who had filed sc returns the previous year c would not have a carryover this year subroutine sccg(cg,data) implicit double precision (A-H,O-Z) dimension data(255) double precision lterm lterm=.5*data(70) cg=lterm+data(68) return end c TENNESSEE c State 43 c Updated through 2016 c we assume all dividends from out of state. subroutine tntax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255) c This line is in here to avoid unused variable error c if(comnew(2).lt.-65435.876) then c 91234 write(*,*) 'unused var' c continue c endif rt=.06 if(law.ge.2016) rt = .05 mst = data(2) agi = data(12)+data(14) c Calculating Taxinc if(law.le.1985) then taxinc=data(12)+data(14) statax=rt*taxinc if((mst.ne.2.and.data(9).gt.0.and.data(159).le.6000).or. & (mst.eq.2.and.data(9).gt.0.and.data(159).le.10000).or. & (data(10).gt.0).or.(taxinc.le.(25*data(7))))statax=0. else if(law.ge.1986) then exemp = 1250*data(7) taxinc=max(0.0d0,data(12)+data(14)-exemp) c if int/div income is received jointly by a blind person and a sighted spouse, c only one-half(1/2) of the jointly received income will be exempt from tax. c The sighted person is entitled to only a $1,250 exemption on a jointly return if(mst.eq.2.and.data(10).lt.2.0d0.and.data(10).gt.0.0d0) then exemp = 1250 taxinc=max(0.0d0,(data(12)+data(14))/2-exemp) endif statax=taxinc* rt if(law.le.1999) then if((mst.ne.2.and.data(9).gt.0.and.data(159).lt.9000).or. & (mst.eq.2.and.data(9).gt.0.and.data(159).lt.15000)) & statax=0. else if((mst.ne.2.and.data(9).gt.0.and.data(159).lt.16200) & .or.(mst.eq.2.and.data(9).gt.0.and.data(159).lt.27000)) & statax=0. endif if(data(10).gt.0.)then c A person who is legally blind is completely exempt from the tax if(mst.ne.2) statax=0. if(mst.eq.2.and.data(10).lt.2.0d0)statax=0. endif endif return end c UTAH c State 45 c Updated through 2016 subroutine uttax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255),aif92(1991:2007) dimension tabs(2,7),tabm(2,6),tab82(2,6),tab88(2,6),tabm88(2,6) dimension tab96(2,6),tabm96(2,6),tab97(2,6),tabm97(2,6) dimension tab01(2,6),tabm01(2,6) dimension tab06(2,6),tabm06(2,6),aif08(2008:2016) dimension pnsion(1977:2007,2),percen(1977:2007) data aif08/1.0d0,1.0426d0,1.0446d0,1.06d0,1.0857d0,1.114d0, & 1.1325d0,1.1504d0,1.1556111d0/ data aif92/ & 1.0d0, 1.0525d0, 1.0845d0, 1.118d0 , 1.1470d0, 1.1795d0, & 1.212d0, 1.245d0 , 1.2660d0, 1.2895d0, 1.3295d0, 1.373d0 , & 1.395d0, 1.427d0 , 1.4595d0, 1.5050d0, 1.5640d0/ data tabs / & 750.0d0, 2.25d0, 1500.0d0, 3.25d0, 2250.0d0, 4.25d0, & 3000.0d0, 5.25d0, 3750.0d0, 6.25d0, 4500.0d0, 7.250d0, & 1.e20, 7.75d0 / data tab82/ & 750.0d0, 2.75d0, 1500.0d0, 3.75d0, 2250.0d0, 4.75d0, & 3000.0d0, 5.75d0, 3750.0d0, 6.75d0, 1.e20, 7.75d0/ data tabm/ & 1500.0d0, 2.75d0, 3000.0d0, 3.75d0, 4500.0d0, 4.75d0, & 6000.0d0, 5.75d0, 7500.0d0, 6.75d0, 1.e20, 7.75d0/ data tab88/ & 750.0d0, 2.55d0, 1500.0d0, 3.5d0 , 2250.0d0, 4.4d0, & 3000.0d0, 5.35d0, 3750.0d0, 6.25d0, 1.e20, 7.2d0/ data tabm88/ & 1500.0d0, 2.55d0, 3000.0d0, 3.5d0 , 4500.0d0, 4.4d0, & 6000.0d0, 5.35d0, 7500.0d0, 6.25d0, 1.e20, 7.2d0/ data tab96/ & 750.0d0, 2.55d0, 1500.0d0, 3.5d0 , 2250.0d0, 4.4d0, & 3000.0d0, 5.35d0, 3750.0d0, 6.0d0 , 1.e20, 7.0d0/ data tabm96/ & 1500.0d0, 2.55d0, 3000.0d0, 3.5d0 , 4500.0d0, 4.4d0, & 6000.0d0, 5.35d0, 7500.0d0, 6.0d0 , 1.e20, 7.0d0/ data tab97/ & 750.0d0, 2.3d0 , 1500.0d0, 3.3d0 , 2250.0d0, 4.2d0, & 3000.0d0, 5.2d0 , 3750.0d0, 6.0d0 , 1.e20, 7.0d0/ data tabm97/ & 1500.0d0, 2.3d0 , 3000.0d0, 3.3d0 , 4500.0d0, 4.2d0, & 6000.0d0, 5.2d0 , 7500.0d0, 6.0d0 , 1.e20, 7.0d0/ data tab01/ & 863.0d0, 2.3d0 , 1726.0d0, 3.3d0 , 2588.0d0, 4.2d0, & 3450.0d0, 5.2d0 , 4313.0d0, 6.0d0 , 1.e20, 7.0d0/ data tabm01/ & 1726.0d0, 2.3d0 , 3450.0d0, 3.3d0 , 5176.0d0, 4.2d0, & 6900.0d0, 5.2d0 , 8626.0d0, 6.0d0 , 1.e20, 7.0d0/ data tab06/ & 1000.0d0, 2.3d0 , 2000.0d0, 3.3d0 , 3000.0d0, 4.2d0, & 4000.0d0, 5.2d0 , 5500.0d0, 6.0d0 , 1.e20, 6.98d0/ data tabm06/ & 2000.0d0, 2.3d0 , 4000.0d0, 3.3d0 , 6000.0d0, 4.2d0, & 8000.0d0, 5.2d0 , 11000.0d0, 6.0d0 , 1.e20, 6.980d0/ data pnsion/ & 10*4800.0d0,2500.0d0,20*4800.0d0,10*6000.0d0,3600.0d0,6000.0d0, & 19*7500.0d0/ data percen/10*1.0d0, .0d0, .33d0,19*.5d0/ rt=0. sep = data(3) mst = data(2) deduc = 0. phas92=100000./data(3) if(law.ge.1992.and.law.le.2007) & phas92=100000.*aif92(law)/data(3) c Algorithm mirors structure on actual tax form agi=comnew(2) c Exemptions if(law.lt.1987) then exemp = 750*comnew(68) else exemp = comnew(83)*.75 endif if (law.le.2007) then c Deductions xitded=max(0.0d0,comnew(24)*comnew(26)-data(50)) if(law.le.1986) then stded=twn(.15*agi,1300./data(3),2000/data(3))* & (xif(law.gt.1980,-comnew(26)) + 1.) else if(comnew(26).gt.0.0d0) then stded=0 else stded=comnew(3) endif endif deduc=max(xitded,stded) c Federal Tax deduction fedtax=max(0.0d0,comnew(70)+data(42)+data(39)+comnew(52)- & comnew(58))*percen(law) c State Tax refund included in Federal Income stref=data(22) c Retirement income deduction retded = 0. nold = data(9) divren = data(12)+data(14)+data(73) retinc = data(20)+data(72)+comnew(79)+divren*min(1.0d0,data(9)) if(law.ge.1988) then if(mst.eq.1.or.mst.eq.5) then phase = 25000. else phase = 32000./sep endif ret = max(0.0d0,comnew(2) - phase) if(nold.eq.0.and.retinc.gt.0) then c if a taxpayer or both a taxpayer and his wife are under the age 65, c they are eligible for retirement income deduction only if they have c qualifying income quainc = min(retinc,pnsion(law,1)) retded = max(0.0d0,-.5*ret + data(7)*quainc) else if(nold.eq.1) then retded = max(0.0d0,-.5*ret + pnsion(law,2)) else if(nold.eq.2) then retded = max(0.0d0,-.5*ret + 2*pnsion(law,2)) endif c I can't distinguish if one of the spouses is 65 and older and c another one is under 65 with a qualifying income. So I got only c a case when one spouse is 65 and older and another without c qualifying income else divren = data(12)+data(14)+data(73) retinc = data(20)+data(72)+comnew(79)+ & divren*min(1.0d0,data(9)) if(nold.eq.0) then retded=twn(retinc,0.0d0,data(7)*pnsion(law,1)) else if(nold.eq.1) then retded=twn(retinc,0.0d0,pnsion(law,2)+(data(7)-1) & *pnsion(law,1)) else retded=twn(retinc,0.0d0,data(7)*pnsion(law,2)) endif endif c State Tax Declaration Phaseout tx=0 if(xitded.gt.stded) then if(law.ge.1993) then ag=max(0.0d0,comnew(2)) xlin4=max(0.0d0,data(49)-.075*ag) xlin8=data(50)+data(51)+data(46) xlin11=data(53) xlin12=data(56)+data(53)+data(57) xlin16=data(58)+data(59)+data(60) xlin17=max(0.0d0,data(61)-.1*ag) xlin18=data(26) xlin24=max(data(27)+data(63)-.02*ag,0.0d0) xlin25=data(66) xtot=xlin4+xlin8+xlin12+xlin16+xlin17+xlin18+xlin24+ & xlin25 xdiff=xtot-xlin4-xlin11-xlin17 if(xdiff.gt.0.) then xdiff2=comnew(2)-phas92 if(xdiff2.gt.0.) then xconst=min(.8*xdiff,.03*xdiff2) xlin26=xtot-xconst xprop=(xdiff-(xtot-xlin26))/xdiff tx=data(50) - xprop*data(50) endif endif endif endif taxinc=max(0.0d0,agi-retded-stref-fedtax-exemp-deduc+tx) if(mst.eq.2.or.mst.eq.4.or.mst.eq.7.or.mst.eq.5) then if(law.lt.1988) then call look(tabm,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.1988.and.law.le.1995) then call look(tabm88,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else if(law.eq.1996) then call look(tabm96,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.1997.and.law.le.2000) then call look(tabm97,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2001.and.law.le.2005) then call look(tabm01,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2006.and.law.le.2007) then call look(tabm06,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) endif else if(law.lt.1982) then call look(tabs,taxinc,7,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.1982.and.law.le.1987) then call look(tab82,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.1988.and.law.le.1995) then call look(tab88,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else if(law.eq.1996) then call look(tab96,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.1997.and.law.le.2000) then call look(tab97,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2001.and.law.le.2005) then call look(tab01,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else if(law.ge.2006.and.law.le.2007) then call look(tab06,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) endif endif c 2007 alternative single rate tax if(law.eq.2007) then stax = max(0.0d0,agi - stref)*.0535 statax = min(stax,statax) endif c Non-refudable Credits c Credit for energy systems installation encr=0. if(law.ge.1980.and.law.le.1985) then encr = twn(data(38)*.6,0.0d0,1000.0d0) else if(law.ge.1986) then encr = twn(data(38)*1.4,0.0d0,1500.0d0) endif statax = max(0.0d0,statax-encr) xcred=0. if(law.eq.1988.and.statax.le.80) & xcred=twn(.125*statax,0.0d0,10.0d0) statax = max(0.0d0,statax-xcred) credit=encr+xcred c 2008 Utah individual tax law changed. The dual tax calculation system no longer applies else if(law.ge.2008) then taxinc = max(0.0d0,agi-data(22)) rt = .05 statax = rt * taxinc c Taxpayer tax credit -- nonrefundable deduc = comnew(3) if(comnew(26).gt.0.) deduc = max(0.0d0,comnew(24) - data(50)) if(mst.eq.4.or.mst.eq.7) then ded = 18000.*aif08(law) else ded = 12000.*aif08(law)*data(7) endif credtx = max(0.0d0,.06*(exemp + deduc) - & .013*max(0.d0,taxinc - ded)) retcrd = 0. if(data(9).gt.0) then crdmax = 450 * data(9) if(mst.eq.1) then phase = 25000. else phase = 32000./sep endif phsout = max(0.0d0,agi - phase)*.025 retcrd = max(0.0d0,crdmax - phsout) endif credit = credtx + retcrd statax = max(0.0d0,statax - credit) endif return end c c VERMONT c State 46 c Updated through 2016 c sales and use tax credit not implemented c subroutine vttax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255),crlw82(11,2),crlw77(11,2) double precision lowcr dimension yl(1986:2016),young(2000:2016),aif(2002:2008) dimension tab77(2,7),rate(1977:2000),ntab(1977:2016),tab85(2,9) dimension tab87(2,4), tab86(2,5), phone(1986:2016), tab91(2,3) dimension tab95(2,4), tab01s(2,5), tab01h(2,5),tab01m(2,5) dimension tab98(2,4), tab02s(2,5), tab02h(2,5),tab02m(2,5) &,tab09s(2,5), tab09h(2,5),tab09m(2,5) &,tab10s(2,5), tab10h(2,5),tab10m(2,5) dimension aif10(2010:2016) dimension tab06(2,3) data aif10/1.0d0,1.015d0, 1.04d0, 1.066d0, 1.085d0, 1.1015d0, & 1.107d0/ data aif / 1.0d0,1.016d0, 1.04d0,1.0630d0,1.09660d0, & 1.1395348830d0,1.16457960d0/ data tab77 / & 4000.0d0, .040d0, 8000.0d0, .045d0, 12000.0d0, .05d0, & 16000.0d0, .055d0, 20000.0d0, .060d0, 25000.0d0, .07d0, & 1.e20, .0d0 / data tab85/ & 4000.0d0, .035d0, 8000.0d0, .040d0, 12000.0d0, .045d0, & 16000.0d0, .050d0, 20000.0d0, .055d0, 24000.0d0, .06d0 , & 28000.0d0, .065d0, 32000.0d0, .070d0, 1.e20, .0d0/ data tab86/ & 4000.0d0, .035d0, 8000.0d0, .040d0, 12000.0d0, .045d0, & 32000.0d0, .050d0, 1.e20, .0d0 / data tab87/ & 4000.0d0, .035d0, 8000.0d0, .040d0, 12000.0d0, .045d0, & 1.e20, .050d0/ data tab95/ & 5000.0d0, .035d0, 10000.0d0, .040d0, 15000.0d0, .045d0, & 1.e20, .050d0/ data tab98/ & 5000.0d0, .035d0, 10000.0d0, .040d0, 25000.0d0, .045d0, & 1.e20, .050d0/ data tab06/ & 10000.0d0, .020d0, 25000.0d0, .045d0, 1.e20, .05d0/ data tab01s/ & 27050.0d0, 3.60d0, 65550.0d0,6.720d0,136750.0d0, 7.440d0, & 297350.0d0, 8.64d0, 1.e20,9.50d0/ data tab01h/ & 36250.0d0, 3.60d0, 93650.0d0,6.720d0,151650.0d0, 7.440d0, & 297350.0d0, 8.64d0, 1.e20,9.50d0/ data tab01m/ & 45200.0d0, 3.6d0 , 109250.0d0,6.720d0,166500.0d0, 7.440d0, & 297350.0d0, 8.64d0, 1.e20, 9.50d0/ data tab02s/ & 27950.0d0, 3.6d0, 67700.0d0, 7.20d0 ,141250.0d0, 8.50d0 , & 307050.0d0, 9.0d0, 1.e20 , 9.50d0/ data tab02m/ & 46700.0d0, 3.6d0,112850.0d0, 7.20d0,171950.0d0, 8.50d0 , & 307050.0d0, 9.0d0, 1.e20 , 9.50d0/ data tab02h/ & 37450.0d0, 3.6d0, 96700.0d0, 7.20d0,156600.0d0, 8.50d0 , & 307050.0d0, 9.0d0, 1.e20 , 9.50d0/ data tab09s/ & 33950.0d0, 3.55d0, 82250.0d0,7.0d0, 171550.0d0, 8.250d0, & 372950.0d0, 8.90d0, 1.e20 ,9.4d0/ data tab09m/ & 56700.0d0, 3.55d0,137050.0d0,7.0d0, 208850.0d0, 8.250d0, & 372950.0d0, 8.90d0, 1.e20 ,9.4d0/ data tab09h/ 45500., 3.55,117450.,7. ,190200., 8.25, & 372950., 8.9 , 1.e20 ,9.4/ data tab10s/ 34000., 3.55, 82400.,6.8 ,171850., 7.8, & 373650., 8.8 , 1.e20 ,8.95/ data tab10m/ 56800., 3.55,137300.,6.8 ,209250., 7.8, & 373650., 8.8 , 1.e20 ,8.95/ data tab10h/ 45550., 3.55,117650.,6.8 ,190550., 7.8, & 373650., 8.8 , 1.e20 ,8.95/ c The Vermont legislature reduced each of the income tax rates in c the 2009 session, retroactive to January 1,2009 c rates: 3.55%,7%,8.25%,8.9%,9.4% c brackets: 0.,33950.,82250.,171550.,372950. data rate/ & 2*.25d0,3*.23d0, .24d0, 2*.26d0, 2*.265d0, .258d0, .23d0, & 2*.25d0,3*.28d0,6*.25d0, .24d0 / data ntab/ 6*6, 2*7, 9, 5, 19*4,11*3/ data phone/72.d0,2*86.4d0,9*108.d0,4*126.d0,156.d0,4*162.d0, & 5*156.d0,5*111.d0/ data tab91/3400.d0,28.d0,13100.d0,31.d0,1.e20,34.d0/ data yl/ 4*13000.0d0,14735.0d0,2*15096.0d0,16500.0d0, 17200.0d0, & 17553.0d0,18130.0d0, 18568.0d0,18988.0d0, 19408.0d0, & 19688.0d0,20318.0d0, 20895.0d0,21210.0d0, 21858.0d0, & 22453.0d0,23100.0d0, 23958.0d0,24500.0d0,2*25498.0d0, & 25743.0d0,26478.0d0, 27143.0d0,27528.0d0,2*27898.0d0/ data young/16875.0d0,17415.0d0,17910.0d0,18180.0d0, 18735.0d0, & 19245.0d0,19800.0d0,20535.0d0,21000.0d0,2*21855.0d0, & 22065.0d0,22695.0d0,23265.0d0,23596.0d0,2*23895.0d0/ data crlw82/ 52.0d0, 1.0d0, 68.0d0, .90d0, 84.0d0, .80d0, & 99.0d0, .70d0, 115.0d0, .60d0, 130.0d0, .50d0, & 145.0d0, .40d0, 162.0d0, .30d0, 178.0d0, .20d0, & 195.0d0, .10d0, 1.e20, .0d0/ data crlw77/ 50.0d0, 1.0d0, 65.0d0, .90d0, 80.0d0, .80d0, & 95.0d0, .70d0, 110.0d0, .60d0, 125.0d0, .50d0, & 140.0d0, .40d0, 155.0d0, .30d0, 170.0d0, .20d0, & 185.0d0, .10d0, 1.e20, .0d0/ c mst = data(2) agi = comnew(2) rt = 0. if(law.le.2000) then taxinc = max(0.0d0,comnew(28)+comnew(70)+data(39)+data(42)- & comnew(53)- comnew(54)-data(33)) else taxinc=comnew(29) if(law.ge.2002.and.law.le.2007) & taxinc = max(0.0d0,taxinc - .4*max(0.0d0,comnew(6))) c The capital gains exclusion allowed for tax year 2008 is the smaller of c 40% of the gain or 40% of the Federal taxable income if(law.eq.2008.or.law.eq.2009) taxinc = & max(0.0d0,taxinc - .4*min(max(0.0d0,comnew(6)),comnew(29))) if(law.eq.2010) taxinc = max(0.0d0,taxinc - & min(.4*comnew(29),min(2500.0d0,max(0.0d0,comnew(6))))) if(law.ge.2011) then dflat = min(5000.0d0,max(0.0d0,comnew(6))) c dperc = .4*max(0.0d0,comnew(6)) dperc = 0. dgain = max(dflat,dperc) taxinc = max(0.0d0,taxinc - min(.4*comnew(29),dgain)) endif if(law.ge.2015.and.comnew(26).gt.0) then c 2015+ state income tax addback addd50 = min(comnew(24) - comnew(3),data(50)) taxinc = taxinc + addd50 c 2015+ addback of itemized deductions comnew(177) = comnew(3) addit = max(0.d0, & max(0.0d0,comnew(24) - (comnew(20)+comnew(23)+data(50)))- & 2.5*comnew(177)) taxinc = taxinc + addit endif endif if(law.le.1990.or.(law.ge.1994.and.law.le.2000)) then statax = taxinc*rate(law) rt = rate(law)*comnew(72)/100 else if(law.ge.1991.and.law.le.1993) then call look(tab91,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.2001) then if(mst.eq.1) then call look(tab01s,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tab01h,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) else taxy = taxinc*data(3) call look(tab01m,taxy,4,5,stat,1.0d00,0.0d0,rt,data) statax = stat/data(3) endif else if(law.ge.2002.and.law.le.2008) then if(mst.eq.1) then call look(tab02s,taxinc,5,n,statax,aif(law),0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tab02h,taxinc,5,n,statax,aif(law),0.0d0,rt,data) else taxy = taxinc*data(3) call look(tab02m,taxy,4,5,stat,aif(law),0.0d0,rt,data) statax = stat/data(3) endif else if(law.eq.2009) then if(mst.eq.1) then call look(tab09s,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tab09h,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) else taxy = taxinc*data(3) call look(tab09m,taxy,4,5,stat,1.0d00,0.0d0,rt,data) statax = stat/data(3) endif else if(law.ge.2010) then if(mst.eq.1) then call look(tab10s,taxinc,5,n,statax,aif10(law),0.0d0,rt,data) else if(mst.eq.4.or.mst.eq.7) then call look(tab10h,taxinc,5,n,statax,aif10(law),0.0d0,rt,data) else taxy = taxinc*data(3) call look(tab10m,taxy,4,5,stat,aif10(law),0.0d0,rt,data) statax = stat/data(3) endif endif cNon-refundable credits c Low Income Credit looks as repealed in 1991 lowcr = 0. if((law.le.1990.and.law.ge.1982).and.data(159).le.7000.) then lowcr = statax * tablki(crlw82,11,statax,data) else if(((law.le.1981.and.law.ge.1978).and.data(159).le.7000.). & or.(law.eq.1977.and.data(9).gt.0.and.data(159).lt.6000.))then lowcr = statax * tablki(crlw77,11,statax,data) endif c Students who are Vermont Residents. Maximum credit is $10. c The student himself must be a taxpayer c This credit looks like repealed in 1989 studcr = 0. if(data(105).lt.1.0d0.and.law.le.1988)studcr = min(10.0d0,statax) c Refundable Credits c Homeowner or Renter Refund claim frac = 0. ptax = .2*data(160)+data(51) pcred = 0. if(data(9).gt.0.) then if(law.le.1984) then frac = tablki(tab77,ntab(law),data(159),data) pcred = twn(ptax-frac*data(159),0.0d0,500.0d0) else if(law.eq.1985) then frac = tablki(tab85,ntab(law),data(159),data) pcred = twn(ptax-frac*data(159),0.0d0,750.0d0) else if(law.eq.1986) then frac = tablki(tab86,ntab(law),data(159),data) pcred = twn(ptax-frac*data(159),0.0d0,750.0d0) else if(law.ge.1987.and.law.le.1990) then frac = tablki(tab87,ntab(law),data(159),data) ptax = data(51) + .24*data(160) if(law.le.1989) then pcred = max(ptax-frac*data(159),0.0d0) else if(law.eq.1990)then pcred = twn(ptax-frac*data(159),0.0d0,2000.0d0) if(data(159).ge.60001) pcred = 0. endif else if(law.ge.1991.and.law.le.1994) then frac = tablki(tab87,ntab(law),data(159),data) ptax = data(51) + .20*data(160) pcred = twn(ptax-frac*data(159),0.0d0,1350.0d0) if(data(159).gt.45000.) pcred = 0. else if(law.ge.1995) then c Renter's Rebate Claim ptax = .21*data(160) vthy = data(23)+data(11)+data(12)+data(14)+data(82)+ & max(0.0d0,data(17))+max(0.0d0,comnew(6))+data(20)+data(72)+ & data(91)+max(0.0d0,comnew(8))+max(0.0d0,data(21))+data(22)- & socsec(data,law)+max(0.0d0,data(12)+data(14)-10000) if(law.le.1997) then frac = tablki(tab95,ntab(law),vthy,data) if(vthy.le.44000.) then pcred = twn(ptax-frac*vthy,0.0d0,1500.0d0) else if(vthy.gt.44000..and.vthy.le.47000.)then pcred = 1500.-.5*(vthy-44000.) endif else if(law.le.2005) frac=tablki(tab98,ntab(law),vthy,data) if(law.ge.2006) frac=tablki(tab06,ntab(law),vthy,data) pcred = max(ptax-frac*vthy,0.0d0) endif if(vthy.gt.47000.) pcred = 0. endif endif c old age telephone credit, for young people since 2000 telcr = 0. if(data(9).gt.0) then if(law.ge.1986) then if(data(159).lt.yl(law)) telcr = phone(law) endif else if(law.ge.2000) then if(data(159).lt.young(law)) telcr = phone(law) endif endif c earned income credit earncr = 0. if(law.eq.1988)earncr = .23*comnew(59) if(law.ge.1989.and.law.le.1993)earncr = .28*comnew(59) if(law.ge.1994.and.law.le.1999)earncr = .25*comnew(59) if(law.ge.2000)earncr = .32*comnew(59) chcr = 0. chcref = 0. c chcr -- non-refundable credit base = min(comnew(53),max(0.0d0,comnew(52)-data(34))) chcr = .24* base if(law.ge.2003) then c 2003+ Low-Income Child and dependent care credit (refundable) if((mst.eq.2.and.comnew(2).le.39999.d0).or. & (mst.ne.2.and.comnew(2).le.29999.d0)) chcref = .5 * base if(chcref.gt.0.d0) chcr = 0. endif statax = max(statax-lowcr-studcr-chcr,0.0d0) statax = statax - pcred - earncr - telcr - chcref credit = lowcr + studcr + pcred + telcr + earncr + chcr + chcref c only for Child care credit comparasing to have the amount in /calc/ if(chcref.gt.0) chcr = chcref return end c VIRGINIA c State 47 c Updated through 2016 subroutine vatax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255) double precision tab(2,4), most(1977:2016), socmax(1977:1994) c most(law) has to be updated every year dimension aif92(1991:2012),aif13(2013:2017) dimension oldded(1977:1987), xmp(1977:2016), & vagis(1977:2004),vagim(1977:2004),vagi(2005:2016) dimension cli(2000:2016),cli1(2000:2016) data aif13/1.0d0,1.0168d0,1.033d0,1.0376d0,1.046d0/ data tab /3000.d0,2.d0,5000.d0,3.d0,0.d0,5.d0,1.e20,5.75d0/ data most/10*12000.d0, 14000.d0, 15000.d0, 16000.d0, 27*17000.d0/ data vagis/28*5000.d0/ data vagim/28*4000.d0/ data vagi /3*7000.d0,2*11250.d0,2*11650.d0,5*11950.d0/ data socmax/ & 4952.0d0, 5518.0d0, 6640.0d0, 6864.0d0, 8124.0d0, 9035.0d0, & 8508.0d0, 8436.0d0, 8926.0d0, 9120.0d0, 9468.0d0,10056.0d0, & 10788.0d0,5*11100.0d0/ data oldded/10*400.0d0, 200.0d0/ data cli / & 8350.0d0, 8590.0d0, 8860.0d0, 8980.0d0, 9310.0d0, 9570.0d0, & 9800.0d0,10210.0d0,10400.0d0,2*10830.0d0,10890.0d0,11170.0d0, & 11490.0d0,11670.0d0,11770.0d0, 11880.0d0/ data cli1/ & 2900.0d0, 3020.0d0, 3080.0d0, 3140.0d0, 3180.0d0, 3260.0d0, & 3400.0d0, 3480.0d0, 3600.0d0, 2*3740.0d0, 3820.0d0, 3960.0d0, & 4020.0d0, 4060.0d0,2*4160.d0/ data xmp/ 10*600.0d0, 700.0d0, 17*800.0d0,3*900.0d0,9*930.0d0/ data aif92/ & 1.0d0, 1.0525d0, 1.0845d0, 1.118d0 , 1.147d0 , 1.1795d0, & 1.2120d0, 1.2450d0, 1.2660d0, 1.2895d0, 1.3295d0, 1.3730d0, & 1.3950d0, 1.4270d0, 1.4595d0, 1.505d0 , 1.5640d0, 1.5995d0, & 1.6680d0,2*1.6955d0, 1.7365d0/ rt = 0. statax = 0. mst = data(2) if(law.ge.1991) phas92=100000./data(3) if(law.ge.1992.and.law.le.2012) & phas92=100000.*aif92(law)/data(3) if(law.ge.2013) & phas92 = aif13(law)*250000*filing(mst,1.,1.2,1.1,.6) c AGI agi = comnew(2)-data(22) c Additional deduction of r400 or $200 for each "65 or over" if(law.le.1987) agi = agi-oldded(law)*data(9) c Additional deduction of r200 for "blind" exemption if(law.eq.1987) agi = agi-oldded(law)*data(10) c Two-earner deduction is an addition to Federal AGI if(law.ge.1982.and.law.le.1986)agi = agi+comnew(32) c Social security benefits in AGI - are not taxable in Virginia if(law.ge.1984) agi = agi-comnew(79) c Unemployment Compensation Benefits are not taxable agi = agi - comnew(78) c Who must file if(law.ge.1979.and.law.le.1986) then if(agi.lt.3000) return else if(law.ge.1987.and.law.le.2004) then thres = sorm(mst,5000.0d0,8000.0d0) if(agi.lt.thres/data(3))return else if(law.ge.2005) then thres = 7000.*data(7) if(agi.lt.thres/data(3))return endif c Qualifying Retirement income sutraction for 1989 c Age deduction for 1990 and onward elder = 0. retiry = data(20)+data(72) if(law.ge.1989.and.data(9).ge.1.) then if(law.eq.1989) then if(retiry.le.16000.) then agi = agi-twn(data(20)+data(72),0.0d0,16000.0d0) else if(retiry.ge.16001.and.retiry.le.40000) then agi = agi-twn(((64000-retiry)/6),0.0d0,7992.0d0) endif endif if(law.eq.1990.or.law.eq.1991) & elder = min(comnew(2),12000*data(9)) if(law.eq.1992) elder = min(comnew(2),12472.0d0) if(law.eq.1993.or.law.eq.1994) & elder = min(comnew(2),12944.*data(9)) if(law.eq.1995) elder = min(comnew(2),10000.*data(9)) if(law.ge.1996) elder = min(comnew(2),12000.*data(9)) if(law.ge.2004) then if(mst.ne.2) then ylimit = 50000 else ylimit = 75000 endif penagi = comnew(2)-comnew(79) if(penagi.gt.ylimit) then if (penagi - ylimit.gt.elder) then elder = 0. else elder = elder - (penagi - ylimit) c if(data(9).eq.2) elder = elder/2 endif endif endif c agi = agi+data(43)-elder agi = agi-elder endif c Standard Deductions if(law.le.1986) then stded = twn(.15*agi, 1300./data(3), 2000./data(3)) else if(law.eq.1987) then if(mst.eq.2) then stded = 2000. else stded = 1000. endif else if(law.eq.1988) then if(mst.eq.2) then stded = 2700. else stded = 1350. endif else if(law.ge.1989.and.law.le.2004) then stded = sorm(mst,3000.0d0,5000.0d0/data(3)) else if(law.ge.2005) then stded = 3000.*data(7) endif c Itemized Deducitons sep=data(3) xitded = (comnew(24)-data(50))*comnew(26) c if(law.le.1978)xitded = xitded+(comnew(76)*comnew(26)) ag = max(0.0d0,comnew(2)) if(ag.ge.phas92.and.comnew(26).gt.0)then xlin4 = max(0.0d0,data(49)-.075*ag) xlin8 = data(50)+data(51)+data(46) xlin11 = data(53) xlin12 = data(56)+data(53)+data(57) xlin16 = data(58)+data(59)+data(60) xlin17 = max(0.0d0,data(61)-.1*ag) xlin18 = data(26) xlin24 = max(data(27)+data(63)-.02*ag,0.0d0) xlin25 = data(66) xtot = xlin4+xlin8+xlin12+xlin16+xlin17+xlin18+xlin24+ & xlin25 xdiff = xtot-xlin4-xlin11-xlin17 if(xdiff.gt.0.) then xdiff2 = ag - phas92 if(xdiff2.gt.0.) then xconst = min(.8*xdiff,.03*xdiff2) xlin26 = xtot-xconst xprop = (xdiff-(xtot-xlin26))/xdiff tx = xprop*data(50) xitded = max(0.d0,comnew(24)-tx) endif endif endif c Child and Dependent Care expenses child = 0. if(law.ge.1979.and.law.le.1982) then child = min(data(64),min(data(8),2.0d0)*2000.) else if(law.gt.1982.and.law.le.2002) then child = min(data(64),min(data(8),2.0d0)*2400.) else if(law.gt.2003) then child = min(data(64),min(data(8),2.0d0)*3000.) endif ided = data(4) if(ided.eq.-2.and.law.eq.1999) xitded=0 deduc = max(stded,xitded)+child c Exemptions if(law.le.2004) then exemp = (data(7)+data(8)+data(9)+data(10))*xmp(law) else exemp = (data(7)+data(8))*xmp(law)+(data(9)+data(10))*800. endif c Taxable Income taxinc = max(0.0d0,agi - deduc - exemp) c Calculation of State Tax tab(1,3) = most(law) call look(tab,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.2) then agimod = agi - data(11) agiw = .5*agimod + data(86) agih = agi-agiw endif if(mst.eq.2.and.law.le.1999.and.agi.gt.0) then c for separate returns , filed combined xitdh=0. xitdw=0. if(xitded.gt.0) then c xitdh= xitded*agih/agi xitdw= xitded*agiw/agi xitdh = xitded - xitdw endif c dedh=stded*agih/agi dedw = stded*agiw/agi dedh = stded - dedw c exempw = xmp(law) exempw = exemp*agiw/agi exemph = exemp - exempw if(xitded.gt.stded) then dedh=xitdh dedw=xitdw endif taxyw = max(0.0d0,agiw-dedw-exempw) c taxyh=max(0.0d0,agih-dedh-exemph) taxyh = taxinc - taxyw call look2(tab,taxyh,4,n,taxh,1.0d0,0.0d0,rt,data) call look2(tab,taxyw,4,n,taxw,1.0d0,0.0d0,rt,data) statax=min(statax,taxh+taxw) endif c Virginia AGI filing threshold if(law.le.2004) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then if(agi.le.vagis(law)) statax = 0. else if(agi.le.vagim(law)*data(7)) statax = 0. endif else if(agi.le.vagi(law)*data(7)) statax= 0. endif c CREDITS!!! credit = 0. twocrd = 0. c Spouse Tax Adjustment since 2000 c Taxpayer's and spouse AGI have proportions .696:.304 if(law.ge.2000.and.taxinc.gt.3000.and.mst.eq.2) then othinc = data(12)+data(14)+max(0.0d0,data(17))+comnew(6)+ & data(20)+data(72)+max(0.0d0,comnew(8))+comnew(79)+ & max(0.0d0,data(21))-.5*data(43) wife = data(86) + .5*othinc husb = data(85) + .5*othinc wife = min(wife,husb) c Age deduction agedw = 0. nagew = 0 nbliw = 0 if(data(9).gt.0) then agedw = 12000. nagew = 1 endif if(data(10).gt.0) nbliw = 1 taxy23 = max(0.0d0,wife - agedw -.5*comnew(79)-xmp(law)- & 800*(nagew+nbliw)) taxy24 = max(0.0d0,taxinc - taxy23) taxy25 = taxinc/2 taxy26 = min(taxy23,taxy25) call look(tab,taxy26,4,n,stat26,1.0d00,0.0d0,rt,data) taxy27 = max(taxy24,taxy25) call look(tab,taxy27,4,n,stat27,1.0d00,0.0d0,rt,data) twocrd = min(259.0d0,statax - stat26 - stat27) statax = statax - twocrd endif c -- Old Age Credit was repealed in 1990 ocred = 0. if(law.le.1989) then resid = max(0.0d0,agi-12000) bens = comnew(84) ocred = .05*(max(0.0d0,((socmax(law)*data(9))-bens -resid*2.))) if(law.eq.1989.and.retiry.ge.2000) ocred = 0. endif c -- Energy credit for 1983-1986 encred = 0. if(law.ge.1983.and.law.le.1986) then encred = min(data(38)*.6,1000.0d0) endif crlow = 0. earncr = 0. c Credit for low income individuals since 2000 if(law.ge.2000) then if(agi.le.cli(law)+(data(8)+data(7)-1)*cli1(law)) & crlow = 300.* (data(8)+data(7)) if(law.ge.2006) then earncr = .2*comnew(59) crlow = max(earncr,crlow) endif crlow = min(statax,crlow) statax = statax - crlow endif statax = max(statax - ocred - encred,0.0d0) credit = ocred + encred + twocrd + crlow return end c WEST VIRGINIA c State 49 c c Updated through 2016 c subroutine wvtax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt dimension data(255),comnew(255) c dimension altmin(1977:1998) dimension tab77(2,24),tab83h(2,24),tab83(2,24) dimension tab84(2,17),tab84h(2,18) dimension tab87(2,5) dimension xmp(1977:2016),surtax(1983:1985) &,pbase(2008:2016),pdep(2008:2016) dimension fcp1(2007:2016) dimension fcp2(2007:2016) dimension fcp3(2007:2016) dimension fcp4(2007:2016) dimension fcp5(2007:2016) dimension fcp6(2007:2016) dimension fcp7(2007:2016) dimension fcp8(2007:2016) double precision maxagi data pbase / & 15600.d0, 2*16245.d0, 16335.d0,33510.d0,34470.d0,35010.d0, & 35310.d0, 35640.d0/ data pdep / & 5400.d0, 2*5610.d0, 5730.d0,11880.d0,12060.d0,12180.d0, & 12480.d0, 12420.d0/ data fcp1/10210.0d0,10400.0d0,2*10830.0d0,10890.0d0,11170.0d0, & 11490.0d0,11670.0d0, 11770.0d0,11880.0d0/ data fcp2/13690.0d0,14000.0d0,2*14570.0d0,14710.0d0,15130.0d0, & 15510.0d0,15730.0d0, 15930.0d0,16020.0d0/ data fcp3/17170.0d0,17600.0d0,2*18310.0d0,18530.0d0,19090.0d0, & 19530.0d0,19790.0d0, 20090.0d0,20160.0d0/ data fcp4/20650.0d0,21200.0d0,2*22050.0d0,22350.0d0,23050.0d0, & 23550.0d0,23850.0d0, 24250.0d0,24300.0d0/ data fcp5/24130.0d0,24800.0d0,2*25790.0d0,28170.0d0,27010.0d0, & 27570.0d0,27910.0d0, 28410.0d0,28440.0d0/ data fcp6/27610.0d0,28400.0d0,2*29530.0d0,29990.0d0,30970.0d0, & 31590.0d0,31970.0d0, 32570.0d0,32580.0d0/ data fcp7/31090.0d0,32000.0d0,2*33270.0d0,33810.0d0,34930.0d0, & 35610.0d0,36030.0d0,2*36730.0d0/ data fcp8/34570.0d0,35600.0d0,2*37010.0d0,37630.0d0,38890.0d0, & 39630.0d0,40090.0d0,2*40890.0d0/ data tab77/ & 2000.0d0, 2.10d0, 4000.0d0, 2.3d0, 6000.0d0, 2.8d0, 2 8000.0d0, 3.20d0, 10000.0d0, 3.5d0, 12000.0d0, 4.0d0, 3 14000.0d0, 4.60d0, 16000.0d0, 4.9d0, 18000.0d0, 5.3d0, 4 20000.0d0, 5.40d0, 22000.0d0, 6.0d0, 26000.0d0, 6.1d0, 5 32000.0d0, 6.50d0, 38000.0d0, 6.8d0, 44000.0d0, 7.2d0, 6 50000.0d0, 7.50d0, 60000.0d0, 7.9d0, 70000.0d0, 8.2d0, 7 80000.0d0, 8.60d0, 90000.0d0, 8.8d0,100000.0d0, 9.1d0, 8 150000.0d0, 9.30d0, 200000.0d0, 9.5d0, 1.e20, 9.6d0 / data tab83/ & 2000.0d0, 2.10d0 , 4000.0d0, 2.3d0 , 6000.0d0, 2.80d0, & 8000.0d0, 3.20d0 , 10000.0d0, 3.5d0 , 12000.0d0, 4.00d0, & 14000.0d0, 5.12d0 , 16000.0d0, 5.65d0 , 18000.0d0, 6.42d0, & 20000.0d0, 6.90d0 , 22000.0d0, 7.65d0 , 26000.0d0, 8.42d0, & 32000.0d0, 9.50d0 , 38000.0d0, 10.40d0 , 44000.0d0,11.25d0, & 50000.0d0, 11.55d0 , 60000.0d0, 11.65d0 , 70000.0d0,11.80d0, & 80000.0d0, 11.90d0 , 90000.0d0, 11.95d0 ,100000.0d0,12.02d0, & 150000.0d0, 12.025d0,200000.0d0, 12.125d0, 1.e20,12.15d0/ data tab83h/ 7 2000.0d0, 2.10d0 , 4000.0d0, 2.30d0 , 6000.0d0, 2.80d0, & 8000.0d0, 3.20d0 , 10000.0d0, 3.50d0 , 12000.0d0, 3.85d0, & 14000.0d0, 4.67d0 , 16000.0d0, 5.20d0 , 18000.0d0, 5.90d0, & 20000.0d0, 6.30d0 , 22000.0d0, 7.05d0 , 26000.0d0, 7.67d0, & 32000.0d0, 8.75d0 , 38000.0d0, 9.50d0 , 44000.0d0,10.35d0, & 50000.0d0,10.57d0 , 60000.0d0, 10.67d0 , 70000.0d0,10.82d0, & 80000.0d0,11.90d0 , 90000.0d0, 11.95d0 ,100000.0d0,12.02d0, & 150000.0d0,12.025d0, 200000.0d0, 12.125d0, 1.e20,12.15d0/ data tab84/ & 2000.0d0, 2.10d0 , 4000.0d0, 2.30d0 , 6000.0d0, 2.8d0, & 8000.0d0, 3.20d0 , 10000.0d0, 3.50d0 , 12000.0d0, 4.0d0, & 14000.0d0, 5.30d0 , 16000.0d0, 5.90d0 , 18000.0d0, 6.8d0, & 20000.0d0, 7.40d0 , 22000.0d0, 8.20d0 , 26000.0d0, 9.2d0, & 32000.0d0,10.50d0 , 38000.0d0, 11.60d0 , 44000.0d0,12.6d0, & 60000.0d0,12.90d0 , 1.e20, 13.0d0/ data tab84h/ & 2000.0d0, 2.10d0 , 4000.0d0, 2.30d0 , 6000.0d0, 2.8d0, & 8000.0d0, 3.20d0 , 10000.0d0, 3.50d0 ,12000.0d0, 3.8d0, & 14000.0d0, 4.70d0 , 16000.0d0, 5.30d0 ,18000.0d0, 6.1d0, & 20000.0d0, 6.60d0 , 22000.0d0, 7.40d0 ,26000.0d0, 8.2d0, & 32000.0d0, 9.50d0 , 38000.0d0, 10.40d0 ,44000.0d0,11.4d0, & 60000.0d0,11.60d0 , 70000.0d0, 11.70d0 , 1.e20,13.0d0/ data tab87/ & 10000.0d0, 3.0d0 , 25000.0d0, 4.0d0 ,40000.0d0, 4.5d0, & 60000.0d0, 6.0d0 , 1.e20, 6.5d0/ data xmp /6*600.0d0,700.0d0,3*800.0d0,30*2000.0d0/ data surtax/ 1.090d0, 1.120d0, 1.060d0/ c data altmin/6*.0d0, .1875d0, 15*.25d0/ mst = data(2) sep = data(3) rt = 0. c AGI agi = comnew(2) c 2earner deduc if(law.ge.1982.and.law.le.1986)agi = agi+comnew(32) c State Income Tax Refund if(law.ge.1984)agi = agi-data(22) c ssagi are exempt from state income tax 1984-1986 years only if(law.ge.1984.and.law.le.1986)agi = agi-comnew(79) c Senior citizen or disability deduction oldded = 0. nold = data(9) ti = comnew(65) + comnew(79) if(nold.eq.1) then oldded = min(comnew(65),8000.0d0) c Married couple and only one person is elderly if(mst.eq.2) then c Consider ssagi is for wife ti50c = 0. tiw = .5*(ti-data(85)-comnew(79))+comnew(79)+data(20) ti50a = tiw + data(86) - ti50c ti50b = 8000. ti50d = max(0.0d0,ti50b - ti50c) oldded = min(ti50a,ti50d) endif else if (nold.eq.2) then ti50c = 0. timod = ti - data(11) ti50ah = .5*timod + data(85)- ti50c ti50aw = .5*timod + data(86)- ti50c ti50b = 8000. ti50d = max(0.0d0,ti50b - ti50c) oldded =min(ti50ah,ti50d) + min(ti50aw,ti50d) endif c disable people if(nold.eq.0.and.comnew(79).gt.0.and. & (law.le.1983.and.law.ge.1987)) then if(mst.ne.2) then oldded = min(agi,8000.0d0) else agimod = agi - data(11) - comnew(79) agih = .5*agimod + data(85) + .5*comnew(79) agiw = .5*agimod + data(86) + .5*comnew(79) oldded = min(agih,8000.0d0)+min(agiw,8000.0d0) endif endif agi = max(0.0d0,agi - oldded) c The standard deduction as well as all itemized deductions have c been eliminated since 1987 c -- Standard Deduction if(law.le.1986) then stded = min(.1*max(0.0d0,agi), 1000.0d0) else if(law.ge.1987) then stded=0. endif c -- Itemized Deductions if(law.le.1986) then c deduc,other stat&loc tax ,flad for itmzd deduc xitded=(comnew(24)-data(55))*comnew(26) else if(law.ge.1987) then xitded=0. endif deduc =max(stded,xitded) c -- c Exemptions exemp = comnew(68)*xmp(law) if(law.ge.1987.and.mst.eq.5) exemp = exemp + xmp(law) if(law.ge.1987.and.data(105).gt.0.0d0)exemp=500. c Taxable Income taxinc = max(0.0d0,agi - deduc - exemp) c Low Income Earned Income Exclusion - NEW in 1997 if(law.ge.1997.and.comnew(2).le.10000./data(3)) & taxinc = max(0.0d0,taxinc - min(10000./data(3),comnew(37))) c State Tax Calculation taxy = taxinc if(mst.eq.2.or.mst.eq.5)taxy=taxinc/2. if(law.le.1982) then call look(tab77,taxy,24,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.2.or.mst.eq.5)statax=statax*2. else if(law.eq.1983) then if(mst.ne.4.and.mst.ne.7) then call look(tab83,taxy,24,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.2.or.mst.eq.5)statax=statax*2. else if(mst.eq.4.or.mst.eq.7) then call look(tab83h,taxy,24,n,statax,1.0d00,0.0d0,rt,data) endif else if(law.ge.1984.and.law.le.1986) then if(mst.ne.4.and.mst.ne.7) then call look(tab84,taxy,17,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.2.or.mst.eq.5)statax=statax*2. else if(mst.eq.4.or.mst.eq.7) then call look(tab84h,taxy,17,n,statax,1.0d00,0.0d0,rt,data) endif else if(law.ge.1987) then taxy=taxinc*data(3) call look(tab87,taxy,5,n,stat,1.0d00,0.0d0,rt,data) statax = stat/data(3) endif c-- Surtax -- if(law.ge.1983.and.law.le.1985) then if(taxinc.gt.10000.*data(7)) statax=surtax(law)*statax endif credit=0. pcred =0. famcrd =0. c Family Tax Credit is a new credit in 2007 if(statax.gt.0.and.law.ge.2007) then nexemp = comnew(68) if(nexemp.eq.1) fcp = fcp1(law)/sep if(nexemp.eq.2) fcp = fcp2(law)/sep if(nexemp.eq.3) fcp = fcp3(law)/sep if(nexemp.eq.4) fcp = fcp4(law)/sep if(nexemp.eq.5) fcp = fcp5(law)/sep if(nexemp.eq.6) fcp = fcp6(law)/sep if(nexemp.eq.7) fcp = fcp7(law)/sep if(nexemp.ge.8) fcp = fcp8(law)/sep if(agi.le.fcp) then if(law.eq.2007)famcrd = .5*statax if(law.ge.2008)famcrd = statax endif if(law.eq.2007.and.agi.gt.fcp) then perc = .01*max(0.0d0,50-5*(agi-fcp)/(300/sep)) famcrd = perc * statax else if(law.ge.2008.and.agi.gt.fcp) then perc = .01*max(0.0d0,100-10*(agi-fcp)/(300/sep)) nperc = perc*10 famcrd = nperc * statax/10 endif statax = max(0.d0,statax - famcrd) endif c 2008+ Homestead Excess Property tax credit (refundable) if(law.ge.2008) then xlin4 = comnew(2) + data(91) - comnew(79) pagi = pbase(law)+data(8)*pdep(law) if(mst.eq.2) pagi = pagi + pdep(law) if(comnew(2).lt.pagi) & pcred = min(1000.0d0,max(0.0d0,data(51) - .04*xlin4)) endif statax = statax - pcred credit = credit + famcrd + pcred return end c WISCONSIN c State 50 c c Updated through 2016 subroutine witax(data,comnew,statax,law) implicit double precision (A-H,O-Z) common/calc/ & hy,rent,agi,exemp,stded,xitded,taxinc,pcred,chcr,earncr,credit,rt real inrst dimension data(255),comnew(255) c tab names denote /S ingle or M arried/,/# of people over 65/, c and the /year/ double precision s077(8,11),s177(5,14) double precision m077(9,17),m177(5,21),m277(9,17) dimension s079(3,10),s179(3,14) double precision m079(3,12),m179(3,15),m279(3,19),lowinc dimension dept77(2,7), dept79(2,9), aif(1980:1985), &chexp(2011:2016),tuiexp(1998:2016),aiftui(1998:2016) double precision ltg(1977:2016),iratax dimension ex(2000:2016),exold(2000:2016),aif01(2001:2004) c real farmreg(2,9), farmsep(2,9) dimension tabj87(2,3),tabp87(2,3),tabs87(2,3) dimension tabj98(2,3),tabp98(2,3),tabs98(2,3),aif98(1998:1999) dimension tab77(2,15),tab79(2,8) dimension tabj86(2,4),tabp86(2,4),tabs86(2,4) dimension tab(2,8), tb2(2,26) dimension tab00s(2,5), tab00j(2,5),tab00n(2,5) dimension tab01s(2,4), tab01j(2,5),tab01n(2,5) dimension tab05s(2,4), tab05j(2,4) dimension tab06s(2,4), tab06j(2,4) dimension tab07s(2,6), tab07j(2,6) dimension tab08s(2,5), tab08j(2,5) dimension tab09s(2,5), tab09j(2,5) dimension tab13s(2,4), tab13j(2,4) dimension tab14s(2,4), tab14j(2,4),aif14(2014:2016) dimension reach(1986:2016), teach(1986:2016), rmax(1986:2016) dimension aifst(2000:2016),alms(1987:2016),almm(1987:2016) data tuiexp/7*3000.0d0,4244.0d0,4536.0d0,4843.0d0,5114.0d0, & 2*6000.0d0,6185.0d0,6543.0d0,6943.0d0,6940.0d0,2*6943.0d0/ data aiftui/15*1.0d0,1.017d0,1.0324d0,1.05d0,1.052d0/ data chexp/750.0d0,1500.0d0,2250.0d0,3*3000.0d0/ data aif98/1.0d0,1.016d0/ data aif14/1.0d0,1.017d0,1.019d0/ c Standard deduction table data aifst/ & 1.0d0, 1.03d0, 1.062d0, 1.082d0, 1.104d0, 1.134d0, & 1.175d0, 1.22d0, 1.244d0, 1.311d0, 1.292d0, 1.307d0, & 1.355d0, 1.37d0, 1.4d0 , 1.4236d0,1.4264d0 / data aif01/ 1.d0, 1.0677d0,1.0867d0,1.1105d0/ data ex /600.d0,16*700.d0/ data exold/200.d0,16*250.d0/ data tab77/ & 1000.0d0, 3.10d0, 2000.0d0, 3.40d0, 3000.0d0, 3.60d0, & 4000.0d0, 4.80d0, 5000.0d0, 5.40d0, 6000.0d0, 5.90d0, & 7000.0d0, 6.50d0, 8000.0d0, 7.60d0, 9000.0d0, 8.20d0, & 10000.0d0, 8.80d0, 11000.0d0, 9.30d0, 12000.0d0, 9.90d0, & 13000.0d0, 10.50d0, 14000.0d0, 11.10d0, 1.e20, 11.40d0/ data tab79/ & 3000.0d0, 3.40d0, 6000.0d0, 5.20d0, 9000.0d0, 7.00d0, & 12000.0d0, 8.20d0, 15000.0d0, 8.70d0, 20000.0d0, 9.10d0, & 40000.0d0, 9.50d0, 1.e20, 10.00d0/ data tab/ &0.d0,3.4d0,0.d0,5.2d0,0.d0,7.0d0,0.d0,8.2d0,0.d0,8.7d0,0.d0,9.1d0, &0.d0,9.5d0,0.d0,10.d0/ data tabj86/ & 10000.0d0, 5.00d0, 20000.0d0, 6.600d0, 40000.0d0, 7.50d0, & 1.e20, 7.90d0/ data tabp86/ & 5000.0d0, 5.00d0, 10000.0d0, 6.600d0, 20000.0d0, 7.50d0, & 1.e20, 7.90d0/ data tabs86/ & 7500.0d0, 5.00d0, 15000.0d0, 6.600d0, 30000.0d0, 7.50d0, & 1.e20, 7.90d0/ data tabj87/ & 10000.0d0, 4.90d0, 20000.0d0, 6.550d0, 1.e20, 6.930d0/ data tabp87/ & 5000.0d0, 4.90d0, 10000.0d0, 6.550d0, 1.e20, 6.930d0/ data tabs87/ & 7500.0d0, 4.90d0, 15000.0d0, 6.550d0, 1.e20, 6.930d0/ data tabj98/ & 10000.0d0, 4.77d0, 20000.0d0, 6.370d0, 1.e20, 6.770d0/ data tabp98/ & 5000.0d0, 4.77d0, 10000.0d0, 6.370d0, 1.e20, 6.770d0/ data tabs98/ & 7500.0d0, 4.77d0, 15000.0d0, 6.370d0, 1.e20, 6.770d0/ data tab00s/ & 5000.0d0, 4.73d0, 8000.0d0, 4.90d0 , 16000.0d0,6.350d0, & 116891.0d0, 6.55d0, 1.e20, 6.75d0/ data tab00j/ & 5000.0d0, 4.73d0, 11000.0d0, 4.85d0 , 21000.0d0,6.350d0, & 155851.0d0, 6.55d0, 1.e20, 6.75d0/ data tab00n/ & 5000.0d0, 4.73d0, 6000.0d0, 5.90d0 , 11000.0d0,6.350d0, & 77925.5d0, 6.55d0, 1.e20, 6.75d0/ data tab01s/ & 8000.0d0, 4.60d0, 16000.0d0, 6.20d0 , 116330.0d0, 6.50d0, & 1.e20, 6.75d0/ data tab01j/ & 10000.0d0, 4.60d0, 11000.0d0, 5.10d0 , 22000.0d0, 6.20d0, & 155100.0d0, 6.50d0, 1.e20, 6.75d0/ data tab01n/ & 5000.0d0, 4.60d0, 6000.0d0, 5.70d0 , 11000.0d0, 6.20d0, & 77550.0d0, 6.50d0, 1.e20, 6.75d0/ data tab05s/ & 8000.0d0, 4.60d0, 18000.0d0, 6.15d0, 132580.0d0, 6.50d0, & 1.e20, 6.75d0/ data tab05j/ & 12000.0d0, 4.60d0, 24000.0d0, 6.15d0, 176770.0d0, 6.50d0, & 1.e20, 6.75d0/ c data tab06s/ & 9000.0d0, 4.60d0, 19000.0d0, 6.150d0, 137410.0d0, 6.50d0, & 1.e20, 6.75d0/ data tab06j/ & 12000.0d0, 4.60d0, 24000.0d0, 6.150d0, 183210.0d0, 6.50d0, & 1.e20, 6.75d0/ c data tab07s/ & 1000.0d0, 4.40d0, 9000.0d0, 4.60d0 , 11000.0d0, 5.30d0, & 19000.0d0, 6.15d0,142650.0d0, 6.50d0 , 1.e20, 6.75d0/ data tab07j/ & 1000.0d0, 4.40d0, 12000.0d0, 4.60d0 , 13000.0d0, 5.0d0, & 25000.0d0, 6.15d0,190210.0d0, 6.50d0 , 1.e20, 6.75d0/ c data tab08s/ & 1000.0d0, 4.40d0, 10000.0d0, 4.60d0 , 19000.0d0, 6.150d0, & 145460.0d0, 6.50d0, 1.e20, 6.75d0/ data tab08j/ & 1000.0d0, 4.40d0, 13000.0d0, 4.60d0 , 27000.0d0, 6.150d0, & 193950.0d0, 6.50d0, 1.e20, 6.75d0/ data tab09s/ & 10220.0d0, 4.60d0, 20440.0d0, 6.150d0, 153280.0d0, 6.50d0, & 225000.0d0, 6.75d0, 1.e20, 7.750d0/ data tab09j/ & 13300.0d0, 4.60d0, 27000.0d0, 6.150d0, 199300.0d0, 6.50d0, & 292500.0d0, 6.75d0, 1.e20, 7.750d0/ data tab13s/ & 10750.0d0, 4.40d0, 21490.0d0, 5.840d0, 236600.0d0, 6.27d0, & 1.e20, 7.650d0/ data tab13j/ & 14330.0d0, 4.40d0, 28650.0d0, 5.840d0, 315460.0d0, 6.27d0, & 1.e20, 7.650d0/ data tab14s/ & 10910.0d0, 4.0d0, 21820.0d0, 5.840d0, 240190.0d0, 6.27d0, & 1.e20, 7.650d0/ data tab14j/ & 14540.0d0, 4.0d0, 29090.0d0, 5.840d0, 320250.0d0, 6.27d0, & 1.e20, 7.650d0/ c data dept77/ & 5000.0d0, 800.0d0, 6000.0d0, 700.0d0, 7000.0d0, 600.0d0, & 8000.0d0, 500.0d0, 9000.0d0, 400.0d0, 9669.0d0, 300.0d0, & 1.e20, 0.0d0/ data dept79/ & 5000.0d0, 800.0d0, 6000.0d0, 700.0d0, 7000.0d0, 600.0d0, & 8000.0d0, 500.0d0, 9000.0d0, 400.0d0,10000.0d0, 300.0d0, & 11000.0d0, 200.0d0,12000.0d0, 100.0d0, 1.e20, 0.0d0/ data s077/ 1 3200.0d0, 2600.0d0, 6*3200.0d0, 2 3300.0d0, 2500.0d0, 6*3300.0d0, 3 3400.0d0, 2200.0d0, 3000.0d0, 5*3400.0d0, 4 3500.0d0, 1900.0d0, 2700.0d0, 5*3500.0d0, 5 3600.0d0, 1550.0d0, 2350.0d0, 3150.0d0, 4*3600.0d0, 6 5000.0d0, 1300.0d0, 2100.0d0, 2900.0d0, 3700.0d0, 4500.0d0, & 2*5000.0d0, 7 6000.0d0, 1300.0d0, 2000.0d0, 2700.0d0, 3400.0d0, 4100.0d0, & 4800.0d0, 5500.0d0, 8 7000.0d0, 1300.0d0, 1900.0d0, 2500.0d0, 3100.0d0, 3700.0d0, & 4300.0d0, 4900.0d0, 9 8000.0d0, 1300.0d0, 1800.0d0, 2300.0d0, 2800.0d0, 3300.0d0, & 3800.0d0, 4300.0d0, & 8667.0d0, 1300.0d0, 1700.0d0, 2100.0d0, 2500.0d0, 2900.0d0, & 3300.0d0, 3700.0d0, 1 1.e20,7*-3000.0d0/ data s177/ 4200.0d0, 3450.0d0, 4200.0d0, 4200.0d0, 4200.0d0, & 4300.0d0, 3350.0d0, 4150.0d0, 4300.0d0, 4300.0d0, & 4400.0d0, 3000.0d0, 3800.0d0, 4400.0d0, 4400.0d0, & 4500.0d0, 2650.0d0, 3450.0d0, 4250.0d0, 4500.0d0, & 4600.0d0, 2350.0d0, 3150.0d0, 3950.0d0, 4600.0d0, & 4700.0d0, 2050.0d0, 2850.0d0, 3650.0d0, 4450.0d0, & 4800.0d0, 1700.0d0, 2500.0d0, 3300.0d0, 4100.0d0, & 4900.0d0, 1500.0d0, 2300.0d0, 3100.0d0, 3900.0d0, & 5000.0d0, 1300.0d0, 2100.0d0, 2900.0d0, 3700.0d0, & 6000.0d0, 1300.0d0, 2000.0d0, 2700.0d0, 3400.0d0, & 7000.0d0, 1300.0d0, 1900.0d0, 2500.0d0, 3100.0d0, & 8000.0d0, 1300.0d0, 1800.0d0, 2300.0d0, 2800.0d0, & 8667.0d0, 1300.0d0, 1700.0d0, 2100.0d0, 2500.0d0, & 1.e20,-3000.0d0,-3000.0d0,-3000.0d0,-3000.0d0/ data m077/ 1 5200.0d0, 4000.0d0, 4700.0d0, 6*5200.0d0, 2 5300.0d0, 3900.0d0, 7*5300.0d0, 3 5400.0d0, 2*3600.0d0, 4300.0d0, 5000.0d0, 4*5400.0d0, 4 5500.0d0, 3300.0d0, 4000.0d0, 4700.0d0, 5400.0d0, 4*5500.0d0, 5 5600.0d0, 3000.0d0, 3700.0d0, 4400.0d0, 5100.0d0, 4*5600.0d0, 6 5700.0d0, 2750.0d0, 3450.0d0, 4150.0d0, 4850.0d0, 5550.0d0, & 3*5700.0d0, 7 5800.0d0, 2500.0d0, 3200.0d0, 3900.0d0, 4600.0d0, 5300.0d0, & 3*5800.0d0, 8 5900.0d0, 2300.0d0, 3000.0d0, 3700.0d0, 4400.0d0, 5100.0d0, & 5800.0d0, 2*5900.0d0, 9 6000.0d0, 2100.0d0, 2800.0d0, 3500.0d0, 4200.0d0, 4900.0d0, & 5600.0d0, 2*6000.0d0, & 6100.0d0, 1900.0d0, 2500.0d0, 3100.0d0, 3700.0d0, 4300.0d0, & 4900.0d0, 5500.0d0, 6100.0d0, 1 6200.0d0, 1700.0d0, 2300.0d0, 2900.0d0, 3500.0d0, 4100.0d0, & 4700.0d0, 5300.0d0, 5900.0d0, 2 6300.0d0, 1550.0d0, 2150.0d0, 2750.0d0, 3350.0d0, 3950.0d0, & 4550.0d0, 5150.0d0, 5750.0d0, 3 6400.0d0, 1350.0d0, 1950.0d0, 2550.0d0, 3150.0d0, 3750.0d0, & 4350.0d0, 4950.0d0, 5550.0d0, 4 7000.0d0, 1300.0d0, 1900.0d0, 2500.0d0, 3100.0d0, 3700.0d0, & 4300.0d0, 4900.0d0, 5500.0d0, 5 8000.0d0, 1300.0d0, 1800.0d0, 2300.0d0, 2800.0d0, 3300.0d0, & 3800.0d0, 4300.0d0, 4800.0d0, 6 8667.0d0, 1300.0d0, 1700.0d0, 2100.0d0, 2500.0d0, 2900.0d0, & 3300.0d0, 3700.0d0, 4100.0d0, 7 1.e20, 8* -3000.0d0/ data m177/ 6200.0d0, 4800.0d0, 5400.0d0, 6000.0d0, 6200.0d0, & 6300.0d0, 4750.0d0, 5350.0d0, 5950.0d0, 6300.0d0, & 6400.0d0, 4450.0d0, 5050.0d0, 5650.0d0, 6250.0d0, & 6500.0d0, 4150.0d0, 4750.0d0, 5350.0d0, 5950.0d0, & 6600.0d0, 3850.0d0, 4450.0d0, 5050.0d0, 5650.0d0, & 6700.0d0, 3600.0d0, 4200.0d0, 4800.0d0, 5400.0d0, & 6800.0d0, 3350.0d0, 3950.0d0, 4550.0d0, 5150.0d0, & 6900.0d0, 3150.0d0, 3750.0d0, 4350.0d0, 4950.0d0, & 7000.0d0, 2950.0d0, 3550.0d0, 4150.0d0, 4750.0d0, & 7100.0d0, 2800.0d0, 3300.0d0, 3800.0d0, 4300.0d0, & 7200.0d0, 2600.0d0, 3100.0d0, 3600.0d0, 4100.0d0, & 7300.0d0, 2450.0d0, 2950.0d0, 3450.0d0, 3950.0d0, & 7400.0d0, 2250.0d0, 2750.0d0, 3250.0d0, 3750.0d0, & 7500.0d0, 2100.0d0, 2600.0d0, 3100.0d0, 3600.0d0, & 7600.0d0, 1950.0d0, 2450.0d0, 2950.0d0, 3450.0d0, & 7700.0d0, 1750.0d0, 2250.0d0, 2750.0d0, 3250.0d0, & 7800.0d0, 1600.0d0, 2100.0d0, 2600.0d0, 3100.0d0, & 7900.0d0, 1450.0d0, 1950.0d0, 2450.0d0, 2950.0d0, & 8000.0d0, 1300.0d0, 1800.0d0, 2300.0d0, 2800.0d0, & 8677.0d0, 1300.0d0, 1700.0d0, 2100.0d0, 2500.0d0, & 1.e20 ,4*-3000.0d0/ data m277/ 1 7300.0d0, 5600.0d0, 6100.0d0, 6600.0d0, 7100.0d0,4*7300.0d0, 2 7500.0d0, 4950.0d0, 5450.0d0, 5950.0d0, 6450.0d0, 6950.0d0, & 7450.0d0, 7500.0d0, 7500.0d0, 3 7700.0d0, 4450.0d0, 4950.0d0, 5450.0d0, 5950.0d0, 6450.0d0, & 6950.0d0, 7450.0d0, 7700.0d0, 4 7900.0d0, 4050.0d0, 4550.0d0, 5050.0d0, 5550.0d0, 6050.0d0, & 6550.0d0, 7050.0d0, 7550.0d0, 5 8100.0d0, 3650.0d0, 4050.0d0, 4450.0d0, 4850.0d0, 5250.0d0, & 5650.0d0, 6050.0d0, 6450.0d0, 6 8300.0d0, 3300.0d0, 3700.0d0, 4100.0d0, 4500.0d0, 4900.0d0, & 5300.0d0, 5700.0d0, 6100.0d0, 7 8500.0d0, 2950.0d0, 3350.0d0, 3750.0d0, 4150.0d0, 4550.0d0, & 4950.0d0, 5350.0d0, 5750.0d0, 8 8700.0d0, 2600.0d0, 3000.0d0, 3400.0d0, 3800.0d0, 4200.0d0, & 4600.0d0, 5000.0d0, 5400.0d0, 9 8800.0d0, 2450.0d0, 2850.0d0, 3250.0d0, 3650.0d0, 4050.0d0, & 4450.0d0, 4850.0d0, 5250.0d0, & 8900.0d0, 2300.0d0, 2700.0d0, 3100.0d0, 3500.0d0, 3900.0d0, & 4300.0d0, 4700.0d0, 5100.0d0, 1 9000.0d0, 2150.0d0, 2550.0d0, 2950.0d0, 3350.0d0, 3750.0d0, & 4150.0d0, 4550.0d0, 4950.0d0, 2 9100.0d0, 2000.0d0, 2300.0d0, 2600.0d0, 2900.0d0, 3200.0d0, & 3500.0d0, 3800.0d0, 4100.0d0, 3 9300.0d0, 1800.0d0, 2100.0d0, 2400.0d0, 2700.0d0, 3000.0d0, & 3300.0d0, 3600.0d0, 3900.0d0, 4 9400.0d0, 1700.0d0, 2000.0d0, 2300.0d0, 2600.0d0, 2900.0d0, & 3200.0d0, 3500.0d0, 3800.0d0, 5 9500.0d0, 1550.0d0, 1850.0d0, 2150.0d0, 2450.0d0, 2750.0d0, & 3050.0d0, 3350.0d0, 3650.0d0, 6 9670.0d0, 1450.0d0, 1750.0d0, 2050.0d0, 2350.0d0, 2650.0d0, & 2950.0d0, 3250.0d0, 3550.0d0, 7 1.e20,8*-3000./ data s079/3200.0d0, 2600.0d0, 3400.0d0, & 3300.0d0, 2500.0d0, 3300.0d0, & 5000.0d0, 2300.0d0, 3100.0d0, & 6000.0d0, 2300.0d0, 3000.0d0, & 7000.0d0, 2300.0d0, 2900.0d0, & 8000.0d0, 2300.0d0, 2800.0d0, & 9000.0d0, 2300.0d0, 2700.0d0, & 11000.0d0, 2300.0d0, 2500.0d0, & 12000.0d0, 2300.0d0, 2400.0d0, & 1.e20, 2300.0d0, 2300.0d0/ data s179/4200.0d0, 3450.0d0, 4250.0d0, & 4300.0d0, 3350.0d0, 4150.0d0, & 4400.0d0, 3000.0d0, 3800.0d0, & 4500.0d0, 2650.0d0, 3450.0d0, & 4600.0d0, 2350.0d0, 3150.0d0, & 5000.0d0, 2300.0d0, 3100.0d0, & 6000.0d0, 2300.0d0, 3000.0d0, & 7000.0d0, 2300.0d0, 2900.0d0, & 8000.0d0, 2300.0d0, 2800.0d0, & 9000.0d0, 2300.0d0, 2700.0d0, & 10000.0d0, 2300.0d0, 2600.0d0, & 11000.0d0, 2300.0d0, 2500.0d0, & 12000.0d0, 2300.0d0, 2400.0d0, & 1.e20, 2300.0d0, 2300.0d0/ data m079/5000.0d0, 4000.0d0, 4800.0d0, & 5200.0d0, 4000.0d0, 4700.0d0, & 5300.0d0, 3900.0d0, 4600.0d0, & 5400.0d0, 3600.0d0, 4300.0d0, & 6000.0d0, 3400.0d0, 4100.0d0, & 7000.0d0, 3400.0d0, 4000.0d0, & 8000.0d0, 3400.0d0, 3900.0d0, & 9000.0d0, 3400.0d0, 3800.0d0, & 10000.0d0, 3400.0d0, 3700.0d0, & 11000.0d0, 3400.0d0, 3600.0d0, & 12000.0d0, 3400.0d0, 3500.0d0, & 1.e20, 3400.0d0, 3400.0d0/ data m179/5000.0d0, 4800.0d0, 5600.0d0, & 6000.0d0, 4800.0d0, 5500.0d0, & 6200.0d0, 4800.0d0, 5400.0d0, & 6300.0d0, 4750.0d0, 5350.0d0, & 6400.0d0, 4450.0d0, 5050.0d0, & 6500.0d0, 4150.0d0, 4750.0d0, & 6600.0d0, 3850.0d0, 4450.0d0, & 6700.0d0, 3600.0d0, 4200.0d0, & 7000.0d0, 3400.0d0, 4000.0d0, & 8000.0d0, 3400.0d0, 3900.0d0, & 9000.0d0, 3400.0d0, 3800.0d0, & 10000.0d0, 3400.0d0, 3700.0d0, & 11000.0d0, 3400.0d0, 3600.0d0, & 12000.0d0, 3400.0d0, 3500.0d0, & 1.e20, 3400.0d0, 3400.0d0/ data m279/5000.0d0, 5700.0d0, 6500.0d0, & 6000.0d0, 5700.0d0, 6400.0d0, & 7000.0d0, 5700.0d0, 6300.0d0, & 7200.0d0, 5700.0d0, 6200.0d0, & 7300.0d0, 5600.0d0, 6100.0d0, & 7400.0d0, 5300.0d0, 5800.0d0, & 7500.0d0, 4950.0d0, 5450.0d0, & 7600.0d0, 4650.0d0, 5150.0d0, & 7700.0d0, 4450.0d0, 4950.0d0, & 7800.0d0, 4200.0d0, 4700.0d0, & 7900.0d0, 4050.0d0, 4500.0d0, & 8000.0d0, 3850.0d0, 4350.0d0, & 8100.0d0, 3650.0d0, 4050.0d0, & 8200.0d0, 3450.0d0, 3850.0d0, & 9000.0d0, 3400.0d0, 3800.0d0, & 10000.0d0, 3400.0d0, 3700.0d0, & 11000.0d0, 3400.0d0, 3600.0d0, & 12000.0d0, 3400.0d0, 3500.0d0, & 1.e20, 3400.0d0, 3400.0d0/ data aif/ 1.10d0, 1.20d0, 4*1.30d0 / data ltg/.5d0, 4*.6d0, .4d0, .2d0, 3*.0d0, 22*-.6d0,8*-.7d0/ data rmax/ 158.0d0, 138.0d0, 170.0d0, 9*200.0d0, & 350.0d0,.0d0,17*300.0d0/ data teach/ .785d0, .69d0, .85d0, 9*1.0d0,1.4d0,.0d0,17*3.0d0/ data reach/1.58, 1.38, 1.7, 9*2.,2.8,0.,17*2.4/ c data farmreg/ 55000., 1.e20, 75000., 22000., 100000., 17500., c & 150000., 15000., 200000., 12500., 250000., 10000., c & 300000., 7500., 400000., 5000., 1.e20, 0./ c data farmsep/ 27500., 1.e20, 37500., 10000., 50000., 8750., c & 75000., 7500., 100000., 6250., 125000., 5000., c & 150000., 3750., 200000., 2500., 1.e20, 0./ c data requ/ 9*3200., 14*5200., c & 9*5200., 7200., 5*7560., 8*8900., c & 9*1000., 500., 11*510.,2*524./ data tb2/ 52*0.0d0/ data alms /9*30000.0d0,6*33750.0d0,3*35750.0d0,40250.0d0, &11*33750.0d0/ data almm /9*40000.0d0,6*45000.0d0,3*49000.0d0,58000.0d0, &11*45000.0d0/ mst=data(2) mar=sorm(mst,1.0d0,2.0d0) sep=data(3) c c only brackets are indexed. for 1987 on standard deduction also. c if(law.ge.1980.and.law.le.1985) then do 20 i=1,8 tab(1,i)=tab79(1,i)*aif(law) 20 continue endif rt=0. c AGI agi=comnew(2) txp=data(7) c different capital loss rules if(comnew(5).le.0.0d0) then if(law.le.1981) then c capital losses are deductable in full (vs.50% for fed) up c to r1,000 per taxpayer if(data(68).lt.0.0d0) then if(data(70).gt.(-2000*txp).and.data(70).lt.0.0d0) then caplss=max(data(70),-1000*txp) agi=agi + min(caplss-.5*data(70),0.0d0) endif else if(data(68).ge.0.0d0) then xnet=data(70)+data(68) if(xnet.gt.(-2000*txp).and.xnet.lt.0.0d0)then caplss=max(xnet,-1000*txp) agi=agi + min(caplss-(.5*xnet),0.0d0) endif endif else if(law.ge.1987) then caplss = abs(comnew(6)) ag = max(0.0d0,agi) closswi = min(caplss,500.0d0,ag) agi = agi + caplss - closswi endif else if(comnew(5).gt.0.0d0) then c long term gains taxable in full before 1982 if(law.le.1981) then agi = agi + comnew(7) else if(law.eq.1982) then agi = agi + 2*comnew(7)/3 else if(law.eq.1983) then agi = agi + comnew(7)/3 else if(law.ge.1987) then capgn = min(comnew(5),data(70)) capded = ltg(law) * capgn agi = agi - (comnew(5) + capded) endif endif c State Income Tax Refund if(law.ge.1980)agi=agi-data(22) c Two-earner deduction in Federal AGI - an addition for Wisconsin AGI if(law.ge.1982.and.law.le.1986)agi=agi+comnew(32) c Social Security benefits in AGI are not taxable for 1984,1985 if(law.ge.1986.and.law.le.2007.and.data(91).gt.0) & agi = agi - max(0.0d0,comnew(79)-data(91)/2) c New for 2008: Social Security benefits are not taxable in WI if(law.ge.2008) agi = agi - comnew(79) c Unemployment compensation phas = 0. if(mst.eq.2.or.mst.eq.5) phas = 18000. if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) phas = 12000. if(data(82).gt.0) agi = agi - data(82) + & min(data(82),.5*max(0.0d0,comnew(2)-phas-comnew(79)-data(22))) c new in 1998 Tuition Expenses subtraction if(law.ge.1998.and.(data(143).gt.0.or.data(144).gt.0)) then tuided = min(tuiexp(law)*data(110),data(143) + data(144)) tuiph = 50000.*aiftui(law) if(mst.eq.2.or.mst.eq.3.or.mst.eq.6) & tuiph = 80000.*aiftui(law)/sep if(comnew(2).gt.tuiph) tuided = & tuided - tuided*(comnew(2)-tuiph)/(10000*aiftui(law)*data(7)) agi = agi - tuided endif c new in 2011 Child Care Expenses subtraction if(law.ge.2011.and.comnew(53).gt.0) then ncccr = min(data(8),2.0d0) if(data(207).gt.0) ncccr = min(data(207),2.0d0) child = min(data(64),chexp(law)*ncccr) if(mst.eq.2) child = max(0.0d0,min(child,data(85),data(86))) agi = agi - child endif c Standard Deduction if(law.le.1978)depadd=tablki(dept77,7,agi,data) if(law.ge.1979)depadd=tablki(dept79,9,agi,data) if(law.le.1978) then c for years before 1978 stded=twn(.15*agi,0.0d0,2000.0d0)+depadd else if(law.ge.1979.and.law.le.1985) then c for years 1979 - 1985 c get stded from low inc tables stded=0. else if(law.ge.1986.and.law.le.1999) then c for years 1986+ if(mar.eq.1) then c for single, widowed and head of household if(agi.le.7500.) then stded = 5200. if(law.eq.1999) stded = 5280. else stded = max(0.0d0,5170.-(agi-7500.)*.12) if(law.eq.1999) stded = max(0.0d0,5280.-(agi-7500.)*.12) endif if(law.ge.1994.and.(mst.eq.4.or.mst.eq.7)) then c A new "head of household" filing status is available in 1994+ if(agi.le.7500.) then stded = 7040. if(law.eq.1999) stded = 7150. elseif (agi.gt.7500..and.agi.le.25000.) then stded = max(0.0d0,6984.-(agi-7500.)*.225) if(law.eq.1999)stded = max(0.0d0,7121.-(agi-7500.)*.225) else stded = max(0.0d0,3070.-(agi-25000.)*.12) if(law.eq.1999)stded = max(0.0d0,3181.-(agi-25000.)*.12) endif endif endif if(mar.eq.2) then if(mst.eq.2) then c for married jointly if(law.eq.1986) then c for year 1986 only if(agi.le.10000.) then stded = 7200. else stded=max(0.0d0,7173.-(agi-10000.)*.128) endif elseif(law.eq.1987) then c for year 1987 only if(agi.le.10000.) then stded = 7560. else stded=max(0.0d0,7529.-(agi-10000.)*.125) endif elseif(law.ge.1988) then c for years 1988+ if(agi.le.10000.) then stded = 8900. if(law.eq.1999) stded = 9040. else stded=max(0.0d0,8851.-(agi-10000.)*.1978) if(law.eq.1999)stded=max(0.0d0,9022.-(agi-10000.)*.1978) endif endif endif if(mst.ne.2) then c for married separately if(law.eq.1986) then c for year 1986 only if(agi.le.4750.) then stded = 3420. elseif(agi.gt.4750.and.agi.le.5500) then stded = max(0.0d0,3407.-(agi-4750.)*.053) else stded=max(0.0d0,3367.-(agi-5500.)*.11) endif else if(law.eq.1987) then c for year 1987 only if(agi.le.4750.) then stded = 3590. elseif(agi.gt.4750.and.agi.le.5500) then stded = max(0.0d0,3574.-(agi-4750.)*.092) else stded=max(0.0d0,3528.-(agi-5500.)*.125) endif elseif(law.ge.1988.and.law.le.1998) then c for years 1988-98 if(agi.le.4750.) then stded = 4230. elseif(agi.gt.4750.and.agi.le.5500) then stded = max(0.0d0,4205.-(agi-5000.)*.148) else stded=max(0.0d0,4131.-(agi-5500.)*.198) endif elseif(law.eq.1999) then c for year 1999 separate filing if(agi.le.4830.) then stded = 4300. elseif(agi.gt.4830.and.agi.le.5500) then stded = max(0.0d0,4283.-(agi-4830.)*.132) else stded=max(0.0d0,4283.-(agi-5500.)*.1978) endif endif endif endif else if(law.ge.2000) then c for year 2000 coeff = aifst(law) if(mst.eq.1) then c for single b = 10500*coeff if(agi.le.b) then stded = 7200*coeff else stded = max(0.0d0,7200*coeff-(agi-b)*.12) endif else if(mst.eq.4.or.mst.eq.7) then c for head of household b = 10500*coeff c = 30500*coeff if(agi.le.b) then stded = 9300*coeff else if (agi.gt.b.and.agi.le.c) then stded = max(0.0d0,9300*coeff-(agi-b)*.238) else stded = max(0.0d0,4826*coeff-(agi-c)*.12) endif else if(mst.eq.2.or.mst.eq.5) then c for married jointly if(law.le.2015) then if(agi.lt.14500*coeff) then stded = 12970*coeff else if(agi.ge.14500*coeff.and.agi.lt.16500*coeff) then stded = 12970*coeff - (agi - 14500*coeff)*.166 else if(agi.ge.16500*coeff.and.agi.lt.80148*coeff) then stded = max(0.0d0, & 12638*coeff-.19775*max(0.d0,agi - 16500*coeff)) endif else if(law.ge.2016) then c The standard deduction is increased for married persons jointly and sep 2016 if(agi.lt.15100*coeff) then stded = 13327*coeff else if(agi.ge.15100*coeff.and.agi.lt.82360*coeff) then stded = 13327*coeff - (agi - 15100*coeff)*.1977 else stded = 0 endif endif else c for married separately if(law.le.2015) then b = 6920*coeff c = 8000*coeff if(agi.le.b) then stded = 6160*coeff elseif(agi.gt.b.and.agi.le.c) then stded = max(0.0d0,6160*coeff-(agi-b)*.156) else stded = max(0.0d0,4996*coeff-(agi-c)*.198) endif else if(law.ge.2016) then b = 7109*coeff c = 39260*coeff if(agi.le.b) then stded = 6331*coeff else if(agi.gt.b.and.agi.le.c) then stded = max(0.0d0,6330*coeff-(agi-b)*.195) else stded= 0 endif endif endif endif c low income allowance only before 1986 lowinc=0. nold=data(9) idep=data(8)+2. if(law.le.1978)depadd=tablki(dept77,7,agi,data) if(law.ge.1979)depadd=tablki(dept79,9,agi,data) if(law.le.1978) then if(mar.eq.1.and.nold.eq.0) then lowinc=witab(s077,tb2,8,11,agi,idep,depadd) else if(mar.eq.1.and.nold.eq.1) then lowinc=witab(s177,tb2,5,14,agi,idep,depadd) else if(mar.eq.2.and.nold.eq.0) then lowinc=witab(m077,tb2,9,17,agi,idep,depadd) else if(mar.eq.2.and.nold.eq.1) then lowinc=witab(m177,tb2,5,21,agi,idep,depadd) else if(mar.eq.2.and.nold.eq.2) then lowinc=witab(m277,tb2,9,17,agi,idep,depadd) endif else if(law.ge.1979.and.law.le.1985) then if(mar.eq.1.and.nold.eq.0) then lowinc=witab(s079,tb2,3,10,agi,idep,depadd) else if(mar.eq.1.and.nold.eq.1) then lowinc=witab(s179,tb2,3,14,agi,idep,depadd) else if(mar.eq.2.and.nold.eq.0) then lowinc=witab(m079,tb2,3,12,agi,idep,depadd) else if(mar.eq.2.and.nold.eq.1) then lowinc=witab(m179,tb2,3,15,agi,idep,depadd) else if(mar.eq.2.and.nold.eq.2) then lowinc=witab(m279,tb2,3,19,agi,idep,depadd) endif endif stded=max(stded,lowinc) c Itemized Deductions c become credit after 1986 inrst=data(56)+data(57) contr=data(58)+data(59)+data(60) if(law.le.1985) then xitded=comnew(30) c if(law.le.1983)xitded=xitded+comnew(76) if(law.ge.1979.and.law.le.1985) then xitded=xitded+min(data(65),100.*txp) xitded=max(0.d0,xitded-data(50)-data(51)-data(52)-data(55)) endif else if(law.ge.1986) then health=comnew(20) xitded=health+contr+inrst if(law.ge.1987)xitded=xitded+data(26)+ & max(0.0d0,data(63)-.02*comnew(2))+data(66) endif xitded = max(0.0d0,xitded) if(law.le.1985) then deduc = max(xitded,stded) taxinc = max(0.0d0,agi-deduc) else if(law.ge.1986) then taxinc = max(0.0d0,agi-stded) endif c Deduction for Exemptions since 2000 exemp = 0. if(law.ge.2000) exemp=ex(law)*(data(8)+data(7)) &+exold(law)*(data(9)+data(10)) taxinc=max(taxinc-exemp,0.0d0) c joint filing not allowed pre-86 if(law.le.1978) then call look(tab77,taxinc,15,n,statax,1.0d00,-data(2),rt,data) else if(law.ge.1979.and.law.le.1985) then call look(tab,taxinc,8,n,statax,1.0d00,-data(2),rt,data) else if(law.eq.1986) then if(mst.eq.2) & call look(tabj86,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.3.or.mst.eq.4) & call look(tabp86,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) if(mar.eq.1) & call look(tabs86,taxinc,4,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.1987.and.law.le.1997) then if(mst.eq.2) & call look(tabj87,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.3.or.mst.eq.6) & call look(tabp87,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) if(mar.eq.1) & call look(tabs87,taxinc,3,n,statax,1.0d00,0.0d0,rt,data) else if(law.eq.1998.or.law.eq.1999) then if(mst.eq.2) & call look(tabj98,taxinc,3,n,statax,aif98(law),0.0d0,rt,data) if(mst.eq.3.or.mst.eq.6) & call look(tabp98,taxinc,3,n,statax,aif98(law),0.0d0,rt,data) if(mar.eq.1) & call look(tabs98,taxinc,3,n,statax,aif98(law),0.0d0,rt,data) else if(law.eq.2000) then if(mst.eq.2) & call look(tab00j,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.3.or.mst.eq.6) & call look(tab00n,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) & call look(tab00s,taxinc,5,n,statax,1.0d00,0.0d0,rt,data) else if(law.ge.2001.and.law.le.2004) then if(mst.eq.2) & call look(tab01j,taxinc,5,n,statax,aif01(law),0.0d0,rt,data) if(mst.eq.3.or.mst.eq.6) & call look(tab01n,taxinc,5,n,statax,aif01(law),0.0d0,rt,data) if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) & call look(tab01s,taxinc,4,n,statax,aif01(law),0.0d0,rt,data) else if(law.eq.2005) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then call look(tab05s,taxinc,4,n,statax,1.0d0,0.0d0,rt,data) else taxy = taxinc/data(3) call look(tab05j,taxy,4,n,statax,1.0d0,0.0d0,rt,data) statax = statax*data(3) endif else if(law.eq.2006) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then call look(tab06s,taxinc,4,n,statax,1.0d0,0.0d0,rt,data) else taxy = taxinc/data(3) call look(tab06j,taxy,4,n,statax,1.0d0,0.0d0,rt,data) statax = statax*data(3) endif else if(law.eq.2007) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then call look(tab07s,taxinc,6,n,statax,1.0d0,0.0d0,rt,data) else taxy = taxinc/data(3) call look(tab07j,taxy,6,n,statax,1.0d0,0.0d0,rt,data) statax = statax*data(3) endif else if(law.eq.2008) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then call look(tab08s,taxinc,5,n,statax,1.0d0,0.0d0,rt,data) else taxy = taxinc/data(3) call look(tab08j,taxy,5,n,statax,1.0d0,0.0d0,rt,data) statax = statax*data(3) endif else if(law.ge.2009.and.law.le.2012) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then call look(tab09s,taxinc,5,n,statax,1.0d0,0.0d0,rt,data) else taxy = taxinc/data(3) call look(tab09j,taxy,5,n,statax,1.0d0,0.0d0,rt,data) statax = statax*data(3) endif else if(law.eq.2013) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then call look(tab13s,taxinc,4,n,statax,1.0d0,0.0d0,rt,data) else taxy = taxinc/data(3) call look(tab13j,taxy,4,n,statax,1.0d0,0.0d0,rt,data) statax = statax*data(3) endif else if(law.ge.2014) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then call look(tab14s,taxinc,4,n,statax,aif14(law),0.0d0,rt,data) else taxy = taxinc/data(3) call look(tab14j,taxy,4,n,statax,aif14(law),0.0d0,rt,data) statax = statax*data(3) endif endif if(law.eq.1979)statax=statax-min(statax*.16,900.0d0) c 10% surtax in 1983 if(law.eq.1983)statax=statax*1.1 c Credits c non-refundable credits, taken pre-amnt, ira tax c 1. Personal exemption credits before year 2000. exempc = 0. if(law.le.1985) then exempc=(20.*txp) + (5*data(9)) + (20*data(8)) if(mst.eq.4.or.mst.eq.7) exempc = exempc + 20. elseif(law.le.1996) then exempc=(25*data(9)) + (50*data(8)) elseif(law.le.1999) then exempc = 50.*data(8) if(data(9).gt.0.0d0) then if(mst.eq.1.or.mst.eq.4.or.mst.eq.7) then if(data(159).le.30000) exempc = exempc + 25. if(data(159).gt.30000.and.data(159).le.31000) & exempc = exempc + 25 - .025*(data(159)-30000) elseif(mst.eq.2) then if(data(159).le.40000) exempc = exempc + 25.*data(9) if(data(159).gt.40000..and.data(159).le.41000.) & exempc = exempc + 25.*data(9) - .025*(data(159)-40000.) else if(data(159).le.20000.) exempc = exempc + 25. if(data(159).gt.20000..and.data(159).le.21000.) & exempc = exempc + 25. - .025*(data(159)-20000.) endif endif endif c 2. Wisconsin Itemized deduction credit since 1986 xcred = 0. ided = data(4) if(law.eq.1999.and.ided.eq.-2) xitded=0 if(law.ge.1986) xcred = .05*max(0.0d0,xitded - stded) c 3. School Property Tax Credit c The School property tax/rent credit is not available in 1999 rcred=0. tcred=0. if(law.eq.1978) then if(data(160).gt.0.0d0) then rcred = 40. else tcred = twn(.1*data(51),40.0d0,100.0d0) endif elseif(law.ge.1979.and.law.le.1982) then if(data(160).gt.0.)rcred=.024*data(160) tcred=.12*data(51) else if(law.ge.1983.and.law.le.1985) then if(data(160).gt.0.d0)rcred=.02*data(160) tcred=.1*data(51) else if((law.ge.1986.and.law.le.1998).or.law.ge.2000) then c For 2000+numbers are given if Heat Is Included in Rent cmax=rmax(law)/sep rstep=reach(law) if(data(160).gt.0.0d0) & rcred=trent(100.0d0,rstep,0.0d0,1.0d00,1,data(160),cmax) tstep=teach(law) if(law.le.1999) then tcred=trent(25.0d0,tstep,0.0d0,1.0d00,1,data(51),cmax) else if(law.ge.2000) then tcred=trent(25.0d0,tstep,0.0d0,2.0d00,1,data(51),cmax) endif endif rcred=rcred*renter(data,comnew) c 4. Child and Dependent Care Credit only for 1984 - 1985 chcr = 0. if(law.eq.1984.or.law.eq.1985) chcr=.3*comnew(53) c 5. Working Families Tax Credit depends on WAGI. New in 1998. wcred = 0. if(law.ge.1998.and.data(105).lt.1.0d0) then if(agi.le.9000.*data(7)) then wcred = statax elseif ((agi.le.10000..and.mst.ne.2).or. & (agi.le.19000..and.mst.eq.2)) then if(mst.eq.2) then eline7 = 19.-.001*agi else eline7 = 10.-.001*agi endif wcred = eline7*max(0.0d0,statax -exempc-xcred-tcred-rcred) endif endif c 6. Earned Income Credit earncr = 0. c 1984-1985 Wisconsin EIC - 30% of federal EIC ieic = data(8) if(law.eq.1984.or.law.eq.1985) then earncr=.3*comnew(59) c for 1989-1993 % depends on number of children elseif(law.ge.1989) then c the number of qualifying children = 1 earned=comnew(37) if(ieic.eq.1) then if(law.ge.1989.and.law.le.1993) then earncr=.05*comnew(59) c Only in 1994 Schedule EICW exists. else if(law.eq.1994) then earncr = max(0.0d0,min(.012*earned,92.0d0)) if (agi.gt.12570.or.earned.gt.12570) & earncr= max(0.0d0,earncr-.008*(max(agi,earned)-12570)) if (mst.eq.3.or.mst.eq.6.or.data(105).gt.0.0d0)earncr=0. elseif(law.ge.1995) then earncr=.04*comnew(59) endif elseif(ieic.eq.2) then c the number of qualifying children = 2 if(law.ge.1989.and.law.le.1993) then earncr=.25*comnew(59) elseif(law.eq.1994) then earncr = max(0.0d0,min(.063*earned,499.0d0)) if (agi.gt.12570.or.earned.gt.12570) & earncr= max(0.0d0,earncr-.045*(max(agi,earned)-12570)) if(mst.eq.3.or.mst.eq.6.or.data(105).gt.0.0d0)earncr=0. elseif(law.eq.1995) then earncr=.16*comnew(59) elseif(law.ge.1996.and.law.le.2010) then earncr=.14*comnew(59) elseif(law.ge.2011) then earncr=.11*comnew(59) endif elseif(ieic.ge.3) then c the number of qualifying children = 3 and more if(law.ge.1989.and.law.le.1993) then earncr=.75*comnew(59) elseif(law.eq.1994) then earncr = max(0.0d0,min(.188*earned,1496.0d0)) if (agi.gt.12570.or.earned.gt.12570) & earncr= max(0.0d0,earncr-.134*(max(agi,earned)-12570)) if (mst.eq.3.or.mst.eq.6.or.data(105).gt.0.0d0)earncr=0. elseif(law.eq.1995) then earncr=.50*comnew(59) elseif(law.ge.1996.and.law.le.2010) then earncr=.43*comnew(59) else earncr=.34*comnew(59) endif endif endif credit = xcred+exempc+earncr+chcr+rcred+tcred+wcred c for years before 1989 EIC was non-refudable if(law.le.1988) statax = max(0.0d0,statax-credit) if(law.ge.1989) & statax = max(0.0d0,statax-exempc-xcred-rcred-tcred-wcred) c Additional Taxes c alternative minimum tax amt=0. if(law.ge.1981.and.law.le.1985.and.xitded.gt.10000) then xtra=(contr+inrst+data(66)-(.6*max(0.0d0,agi))) xtra=max(0.0d0,xtra) amt=max(0.0d0,(data(81)+comnew(7)+data(18))+xtra-10000.)*.05 else if(law.eq.1986) then amt=max(0.0d0,.55*comnew(70)) else if(law.ge.1987) then alminy=comnew(69)-data(22)-comnew(79) c unemployment compensation subtraction if(data(82).gt.0) alminy = alminy - data(82) + & min(data(82),.5*max(0.0d0,comnew(2)-phas-comnew(79)-data(22))) c capital gain subtraction if(data(68).ge.0.) then alminy = alminy +(ltg(law)*max(data(70),0.0d0)) else if(data(68).lt.0) then alminy = alminy +(ltg(law)*max(data(70)+data(68),0.0d0)) endif if(law.eq.1989)phsout = .25*max(0.0d0,alminy-(155000./sep)) if(mar.eq.1) then if(law.ne.1989)phsout = .25*max(0.0d0,alminy-112500.) alminy=alminy-max(0.0d0,alms(law)-phsout) else if(mar.eq.2) then if(law.ne.1989)phsout = .25*max(0.0d0,alminy-(150000./sep)) alminy=alminy-max(0.0d0,almm(law)/data(3)-phsout) endif c amt -tentative minimum tax amt = max(0.0d0,alminy*.065 - statax) statax = statax + amt endif c 7. Married couple Credit when both spouses are employed since 1986 c still non-refundable twocrd=0. if(mst.eq.2) then earh = max(0.0d0,data(85)+.5*data(17)+.5*data(21)) earw = max(0.0d0,data(86)+.5*data(17)+.5*data(21)) earmin = min(earh,earw) if(law.ge.1986.and.law.le.1988) then twocrd = .025*min(18000.0d0,earmin) else if(law.ge.1989.and.law.le.1997) then twocrd = .02*min(15000.0d0,earmin) else if(law.eq.1998) then twocrd = .0217*min(14010.0d0,earmin) else if(law.eq.1999) then twocrd = .025*min(14000.0d0,earmin) else if(law.eq.2000) then twocrd = .0275*min(16000.0d0,earmin) else if(law.ge.2001) then twocrd = .03*min(16000.0d0,earmin) endif credit = credit + twocrd statax = max(0.0d0,statax-twocrd) endif c alternative minimum tax amt = max(0.0d0,amt - statax) statax = statax+amt c IRA, other retirement plans, MSA's penalties iratax=0.0d0 if(law.ge.1984) iratax = .33*data(42) statax = statax+iratax c filing requirements Who must file? c if(mst.ne.2.and.mst.ne.3.and.mst.ne.6) then c if(hy.lt.(requ(law,1) + requ(law,3)*data(9)))statax=0. c return c else c if(hy.lt.(requ(law,2) + requ(law,3)*data(9)))statax=0. c return c endif c Refundable Credits c 9. Wisconsin Homestead Credit pcred=0. tablea = 0. if(law.eq.1977.or.law.eq.1978) then if(data(159).le.9300.0d0) then c for year 1977,1978 ptax = min(800.0d0,data(51) + data(160)/4) if(data(159).gt.4000)tablea = (data(159)-4000)*.15 tableb = max(0.0d0,ptax - tablea) if(tableb.gt.0.and.tableb.le.15) then pcred = tableb*.667 else if(tableb.gt.15) then pcred = tableb *0.8 endif endif else if(law.ge.1979.and.law.le.1982) then if(data(159).le.14000.0d0) then c for year 1979-1982 ptax = min(1000.0d0,data(51) + data(160)/4) if(data(159).gt.5000.) tablea = (data(159)-5000)*.111 tableb = max(0.0d0,ptax - tablea) if(tableb.gt.0.and.tableb.le.15) then pcred = tableb*.667 else if(tableb.gt.15) then pcred = tableb *0.8 endif endif else if(law.eq.1983.and.data(159).le.15500.0d0) then c for year 1983 ptax = min(1100.0d0,data(51) + data(160)/5) if(data(159).gt.7000) tablea = (data(159)-7000)*.1294 tableb = max(0.0d0,ptax - tablea) if(tableb.gt.0..and.tableb.le.10.) then pcred = tableb*1.1 elseif (tableb.le.10.) then pcred = tableb *0.8 endif elseif(law.ge.1984.and.law.le.1988.and.data(159).le.16500.0d0)then c for years 1984-1988 ptax = min(1200.0d0,data(51) + data(160)/4) if(data(159).gt.7400.) tablea = (data(159)-7400)*.13167 tableb = max(0.0d0,ptax - tablea) if(tableb.gt.0..and.tableb.le.10.) then pcred = tableb*1.1 elseif(tableb.gt.10.) then pcred = tableb *0.8 endif else if(law.ge.1989.and.law.le.1990) then c for year 1989-1990 hymod = max(0.0d0,data(159) - 250*data(8)) if(hymod.le.18000.0d0) then ptax = min(1350.0d0,data(51) + data(160)/4) if(hymod.gt.8000.) tablea = (hy-8000.)*.135 tableb = max(0.0d0,ptax - tablea) if(tableb.gt.0..and.tableb.le.10.0d0) then pcred = tableb*1.1 elseif (tableb.gt.10.) then pcred = tableb *0.8 endif endif else if(law.ge.1991) then c for years 1991+ hymod = max(0.0d0,hy - 250.*data(8)) if((law.le.1998.and.hymod.le.19154.0d0).or. & (law.eq.1999.and.hymod.le.20290.0d0).or. & (law.ge.2000.and.hymod.le.24500.0d0)) then ptax = data(51) + data(160)/4 pmax = 1450. if(law.ge.2010) pmax = 1460. ptax = min(pmax,ptax) if(law.le.1998) tablea = max(0.0d0,hymod-8000.)*.13 if(law.eq.1999) tablea = max(0.0d0,hymod-8000.)*.1177 if(law.eq.2000) tablea = max(0.0d0,hymod-8000.)*.0877 if(law.eq.2001) tablea = max(0.0d0,hymod-8000.)*.08855 if(law.eq.2002) tablea = max(0.0d0,hymod-8000.)*.08565 if(law.ge.2003.and.law.le.2009) & tablea = max(0.0d0,hymod-8000.)*.08788 if(law.ge.2010) tablea = max(0.0d0,hymod-8060.)*.08785 tableb = max(0.0d0,ptax - tablea) if(tableb.gt.0.0d0.and.tableb.le.10.0d0) then pcred = tableb*1.1 elseif(tableb.gt.10.) then pcred = tableb *0.8 endif endif endif credit = credit + pcred statax = statax - pcred c EIC becomes refundable in 1989 onward if(law.ge.1989) statax = statax-earncr return end c double precision function witab(tab,tab2,m,n,y,ndx,depadd) implicit double precision(a-h,o-z) dimension tab2(2,n), tab(m,n) do 20 i=1,n tab2(1,i)=tab(1,i) 20 continue plus=max(0,ndx-m) if(ndx.le.m) then do 22 i=1,n tab2(2,i)=tab(ndx,i) 22 continue elseif(ndx.gt.m) then do 24 i=1,n tab2(2,i)=tab(m,i) 24 continue endif do 30 j=1,n num=j if(y.le.tab2(1,j)) go to 40 witab=0. 30 continue 40 witab=tab2(2,num)+(plus*depadd) return end README.SRC 0000660 0004364 0000001 00000002534 12666412323 011222 0 ustar taxsim bin This zip file contains the fortran 77 source for the TAXSIM program and several documentation files: taxsim9.for taxsim-cmd.html taxsim-local.html README.SRC It can be compiled on most systems with: f77 taxsim9.for -o taxsim9 but the output executable file must be copied to a place in the executable path. In windows, c:\windows is such a place. It is not absolutely standard fortran - to convert to pure f77, comment out the open statements and call to date and time in the main routine and fix the leading zeros in format statements 200 and 201 in subroutine "out". None of these are essential for operation and Gnu (and most other) fortran compilers accept all of them. Command line usage of taxsim is described by taxsim-cmd.html. Stata usage is described by taxsim-local.html. Note that the normal way to access taxsim from is via the network to our computer in Cambridge, while this distribution describes a way to do the calculation locally on your computer. This is ordinarily suggested only when confidentiality requires it, or datasets are very large. The source distribution contains a call to the date routine and will stop working a year or so after downloading. At that point you should probably get a newer version, but you could just modify the source and recompile. Daniel Feenberg 617-863-0343 (google voice) feenberg@nber.org taxsim-cmd.html 0000664 0004364 0000001 00000004176 12666411757 012672 0 ustar taxsim bin
TAXSIM Version 9 is available to selected users as a windows or Unix executable on application to Daniel Feenberg (feenberg@nber.org).
Copy the taxsim9.exe executable into c:\windows, or some other directory in the executable path. If your computer is guarded by a zealous IT staff, you may need their help to make this happen. On a Unix system the application name will be taxsim9, and it can be placed anywhere in the executable path.
You will need a file in the same format described at for uploading on the Taxsim web page. If that file is called "taxpayr.raw" then you can run taxsim with: c:\taxsim9 taxpayr.raw >taxpayr.out and the results will appear in taxpayr.out. The output variables are also documented on the page referred to above.
If the default marginal tax rate calculation or level of detail is not to your liking, it is possible to change either with arguments to the taxsim9.exe command. In the lists below, the arguments are in bold.
The choices for the marginal tax calculation are:
The choices for detail are:
An example of taxpayr.raw:
1 1989 13 3 1 0 30000 0 0 0 0 0 0 0 0 0 2000 0 1 0 -1000 0 1 1989 13 3 1 0 20000 0 0 0 0 0 0 0 0 0 2000 0 1 0 -1000 0
Will provide detailed results and calculate the marginal rate for long term capital gains for two individuals whose characteristics are provided when taxsim9 is invoked with:
taxsim9 long detail taxpayr.raw
If no input file is given, input is taken from the standard input. All keyword arguments are reserved, and should not be used as the input filename.
Daniel Feenberg
NBER
617-863-0343
taxsim-local.html 0000664 0004364 0000001 00000005325 12666411772 013213 0 ustar taxsim bin
Some users of taxsim have confidential data, and wish to run on their local computer rather than use the cloud service. For this reason we offer source or executable code to selected users. The fortran code is the same as that running on the taxsimftp.nber.org server. The .ado file that calls this code removes the network access feature, and runs the calculator locally. The taxsim9src.zip and taxsim9exe.zip archives contain taxsim9.for or taxsim9.exe taxsimlocal.ado taxsim-local.html You can compile the source on most systems with: f77 taxsim9.for -o taxsim9.exe or similar. The code is bog-standard Fortran 77 except for the call to date_and_time, which may be modified or deleted if necessary. The taxsimlocal.ado file is provided as a replacement for taxsim9.ado. It has exactly the same features and you may use the taxsim9.hlp file for documentation. The only difference is that it is indifferent to option local - calculation is always local. You will want to save the taxsim9.exe file to a directory in your system's executable path. The default path for Windows XP, Vista and Windows 7 includes: c:\windows among other directories so that is a good place to put taxsim9.exe. If your system has security policies such that you can not write to that directory you will probably need assistance from your local IT department, although there may be another directory that is writable in your path, if you can locate it. As a last resort, you can modify the taxsimlocal.ado file to run from your home directory. Search in the file for "! taxsim9" and replace that filename with the full pathname. You will also need to put the taxsimlocal9.ado file where stata can find it. You probably have an ado directory in your home directory. You might want to move taxsimlocal.ado and taxsim9.hlp to c:\ado if you want all users of the computer to have access. You can rename taxsimlocal.ado, but you must modify the program statement in the ado file to match. An easy test for the correct placement of the files is to run a very simple taxsim job, such as: set obs 1 gen year=1970 gen mstat=2 gen ltcg=100000 taxsimlocal,replace list and confirm that fiitax is 16700.04. If you don't get that answer, something is wrong. This particular test will also detect a broken taxsim9 file that was available briefly. log using taxsim9, text set trace on taxsimlocal,debug and email the logfile to me. The most common error I see is a failure to place the taxsim9.exe file in the executable path, often that path is secured from user additions. You can check this with: where taxsim9.exe from a windows command line. Daniel Feenberg 617-863-0343 (Google Voice) feenberg@nber.orgsas-windows.html 0000664 0004364 0000001 00000001467 12666412007 013067 0 ustar taxsim bin
Chris Zogby suggests using the "pipe" option in SAS to make using taxsim quite easy. Here is an example that presumes taxsim9.exe and the