subroutine absorbk(im,nlortz,wlortz,efc,wav,str,eng,wid,nlines
     &   ,otol,rmass,wstart,wend,wdel,wstep,wdopref,opp0,tbase
     &   ,tmp,prs,clm,ntau,wpf,opf,dopf,nopf,bpf,dbpf,bf1,bf2)

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

c       -------------------------------------------------------------
c                        Input arrays
c       -------------------------------------------------------------
        dimension wav(nd4),str(nd4),eng(nd4),wid(nd4),tmp(nd1)
     &   ,prs(nd1),clm(nd1)

c       -------------------------------------------------------------
c                          Output arrays
c       -------------------------------------------------------------
        dimension wpf(nd2), opf(nd1,nd2), dopf(nd1,nd2), bpf(nd1,nd2)
     &   , dbpf(nd1,nd2), bf1(nd2), bf2(nd2)

        nopf = 0
        wlast = wstart
        do while(wlast .lt. wend)

           wnext = dmin1(wlast + wdel,wend)
           wmid = half*(wlast + wnext)
           nmax = nd2 - nopf

           call dsmt(im,nlortz,wlortz,efc,otol,rmass,wlast,wnext
     &      ,wmid,wstep,wav,str,eng,wid,nlines,tmp,prs,clm,ntau
     &      ,nmax,wpf(nopf+1),opf(1,nopf+1),dopf(1,nopf+1),npp)

c           write(unit=*,fmt='(f9.4,2x,i4)') wmid,nopf+npp

           do k = nopf+1, nopf+npp
              do n = 1, ntau
                 bpf(n,k) = bplanck(wmid,tmp(n))
                 dbpf(n,k) = bpf(n,k)*dplanck(wmid,tmp(n))/tmp(n)
              end do
              bf1(k) = bplanck(wmid,tbase)
              bf2(k) = zero
           end do

           wlast = wnext
           nopf = nopf + npp

           if(nopf .gt. nd2) then
              write(unit=*,fmt=*) ' Too many frequency bins '
              stop 
           end if

        end do

        return
        end

cdddddddddddddddddddddddddddddddddddddddddddd
c            nopf = 1
c            wpf(1) = wend - wstart
c            wmid = half*(wstart+wend)
c            do n = 1, ntau
c               opf(n,1) = 1.d-17
c               dopf(n,1) = 0.d0
c            end do 
c            do n = 1, ntau
c               bpf(n,1) = bplanck(wmid,tmp(n))
c               dbpf(n,1) = bpf(n,1)*dplanck(wmid,tmp(n))/tmp(n)
c            end do
c            bf1(1) = bplanck(wmid,tbase)
c            bf2(1) = zero
cdddddddddddddddddddddddddddddddddddddddddddd