subroutine abscheck(wpf,opf,dopf,bpf,dbpf,bf1,bf2,npf,ntau)   
        implicit double precision (a-h,o-z) 
        include "parameters.dat"
        dimension wpf(nd2),opf(nd1,nd2),dopf(nd1,nd2),bpf(nd1,nd2)
     &  ,dbpf(nd1,nd2),bf1(nd2),bf2(nd2)
	character*16 fname 



c   	write(*,*)'in absck,first,npf=',npf
c  	do k = 1,350
c   	  write(*,*)'in absck,first,opf(1,k)=',opf(1,k),k 
c   	end do

c          -------------------------------------------------------
c           pathological case 1: zero absorption in middle of atm
c           add absorption coefficients  from next bin into
c           problem bin
c          -------------------------------------------------------
	k = 0
	do while(k .lt. npf )
	  k = k + 1

	  do nn = 1,ntau
	     j = 0
	     wsum = wpf(k)
	     do while(opf(nn,k) .eq. zero)
	       j = j + 1
               wsum = wsum + wpf(k+j)
               bf1(k)=(bf1(k)*wpf(k) + bf1(k+j)*wpf(k+j))/wsum
               bf2(k)=(bf2(k)*wpf(k) + bf2(k+j)*wpf(k+j))/wsum
	       do n = 1,ntau 
	         opf(n,k) = (opf(n,k)*wpf(k)+opf(n,k+j)*wpf(k+j))/wsum
                 dopf(n,k)=(dopf(n,k)*wpf(k)+wpf(k+j)*dopf(n,k+j))/wsum
                 bpf(n,k)=(bpf(n,k)*wpf(k)+wpf(k+j)*bpf(n,k+j))/wsum
                 dbpf(n,k)=(dbpf(n,k)*wpf(k)+wpf(k+j)*dbpf(n,k+j))/wsum
	       end do 
	       wpf(k) = wsum
             end do
	     npf = npf -j 
	    
c             -----------------------------------------------------
c                            shift indices down by j
c             -----------------------------------------------------
	    if (j .ne. 0) then 
             do m = k+1, npf 
                 wpf(m) = wpf(m+j)
                 bf1(m) = bf1(m+j)
                 bf2(m) = bf2(m+j)
	       do n = 1,ntau 
                 opf(n,m) = opf(n,m+j)
                 dopf(n,m) = dopf(n,m+j)
                 bpf(n,m) = bpf(n,m+j)
                 dbpf(n,m) = dbpf(n,m+j)
	       end do 
             end do
	    end if 

	  end do

        end do


c   	write(*,*)'in absck,finally,npf=',npf
c  	do k = 1,350
c   	  write(*,*)'in absck,last,opf(1,k)=',opf(1,k),k 
c   	end do

        return
        end