outactfy.f

Go to the documentation of this file.

      subroutine outactfy
c
c     subroutine outactfy outputs the actinic flux at all the levels
c     of the atmosphere (non-lambertian surfaces)
c***********************************************************************
c.....include the common blocks
      implicit real*8 (a-h,o-z)
      include 'common_all.cmn'
      real*8 tma(25),tmb(25),tmc(25),tmfd(25),tmfu(25),tmf1(25,1000)
c***********************************************************************
c
      lsza=bfr1(35)+0.001
      do i=1,lsza,1
         m=msza(i)
         tma(i)=the0in(m)
         tmb(i)=fdirc(m)/pi
         tmc(i)=sbarz(m)
         tmfd(i)=fdown(m)/pi
         tmfu(i)=fup(m)/pi
         do j=1,nolyryp
            tmf1(i,j)=acfg1(m,j)
         enddo
      enddo
c
      ff0=1.0d0
      write(30,502)wvlth*1.0e+4
      write(30,503)ff0
      write(30,504)(tma(i),i=1,lsza)
      write(30,506)(tmb(i),i=1,lsza)
      write(30,508)(tmfd(i),i=1,lsza)
      write(30,511)
      do k=1,nolyrp
      write(30,514)k,ht(k),pl(k),taupl(k),(tmf1(i,k),i=1,lsza)
      enddo
c
502   format('wavelength(um)',t20,1pe11.3)
503   format('solar flux(top)',t20,1pe11.3)
504   format('sza',t22,25(f4.1,7x))
506   format('f(dir)',t20,1p25e11.3)
508   format('f(diff)',t20,1p25e11.3)
511   format(t1,'lvl',t7,'height',t18,'pressure',t29,
     1       'tot. opt.',t40,'act_flx'/
     2       t1,'no.',t8,'(km)',t19,'(atm.)',t29,'thickness')
514   format(i3,1x,1p28e11.3)
c
      return
      end
c***********************************************************************