crftlvl.f

Go to the documentation of this file.

      subroutine crftlvl
c
c     detemine the atmospheric levels that bracket the aircraft height
c     also,  compute the direct flux at the aircraft altidue
c
c***********************************************************************
c
      implicit real*8 (a-h,o-z)
      include 'common_all.cmn'
c
      real*8 buffx(1000)
c
c**********************************************************************
c
c     check if the aircraft height is less than ht(1)
c
      if(hcrft.gt.ht(1) .or. hcrft.le.ht(nolyr+1))then
c       write(6,100)hcrft
100     format('aircraft height is out of bound',0pf7.1,' km')
      endif
c
      lvlcrft=1
      if(icrft.eq.1)then
         do i=1,nolyr
            if(hcrft.le.ht(i) .and. hcrft.gt.ht(i+1))then
               lvlcrft=i
            endif
         enddo
      endif
c
c     find the atmospheric pressure and total optical thickness at
c     the aircraft height
c
      buffx(1)=0.0d0
      do i=1,nolyr
         buffx(i+1)=buffx(i)+dtot(i)
      enddo
      plg1=dlog(pl(lvlcrft))
      plg2=dlog(pl(lvlcrft+1))
      plc1=pl(lvlcrft)
      plc2=pl(lvlcrft+1)
      ht1=ht(lvlcrft)
      ht2=ht(lvlcrft+1)
      tcrft1=buffx(lvlcrft)
      tcrft2=buffx(lvlcrft+1)
c
      call xntpln(hcrft,ht1,ht2,plg1,plg2,plgc)
      pcrft=dexp(plgc)
      call xntpln(pcrft,plc1,plc2,tcrft1,tcrft2,taucrft)
c        
c     compute the direct flux at the aircraft altidue
c
      crftdirf=amuo*dexp(-taucrft)
c
      return
      end
c***********************************************************************