subroutine uvheatA(rh,prs,col,den,ntau,swave,sflx,crs,nwav,ht)

        implicit double precision (a-h,o-z)
        include "parameters.dat"

        dimension col(nd1,0:4), den(nd1,0:4), swave(nd5),sflx(nd5)
     &   , crs(nd5,0:3),ht(nd1),prs(nd1),eff(nd1)
     &   , pres(200),effp(200)


        do jt = 1, ntau
           ht(jt) = zero
        end do

        efac = 1.d8*hc/rh/rh

        open(unit=50,file='uvheatb.dat',status='old')
           read(unit=50,fmt=*) ndat
           do n = 1, ndat
              read(unit=50,fmt=*) pres(n),effp(n)
           end do
        close(unit=50)

        do jt = 1, ntau 
           if(prs(jt) .gt. pres(ndat)) then
             eff(jt) = half
           else
             eff(jt) = fintrp(pres,effp,ndat,prs)
           end if    
        end do

        do jw = 1, nwav
           ergs = half*efac*sflx(jw)/swave(jw)
           do js = 0, 3

              do jt = 1, ntau
                 opp = den(jt,js)*crs(jw,js)
                 tau = col(jt,js)*crs(jw,js)
c                 if(swave(jw) .gt. 1000.d0) then
                 ht(jt)=ht(jt)+ergs*eff(jt)*den(jt,js)*crs(jw,js)
     &            *en(2,tau)
c                 else
c                 ht(jt)=ht(jt)+two*fac*eff(jt)*den(jt,js)*crs(jw,js)*en(2,tau)
c                 end if
              end do

           end do
        end do

        return
        end