headr.f

Go to the documentation of this file.

      subroutine headr(iprn)
c
c     output the header record
c**********************************************************************
c
       include 'afrt_rt2.cmn'
c
c***********************************************************************
c
      character*28 sd1(5)
      character*10 sd2(5)
      character*3 tranc
c
      sd1(1)='junge'
      sd1(2)='deirmendjian modified gamma'
      sd1(3)='log-normal (uni-modal)'
      sd1(4)='log-normal (bi-modal)'
      sd1(5)='log-normal (tri-modal)'
c
      sd2(1)='(haze l)'
      sd2(2)='(haze m)'
      sd2(3)='(haze h)'
      sd2(4)='(cloud c1)'
      sd2(5)='(unknown)'
c
      kfc=bfr1(47)+0.01
      kpsudo=bfr1(34)+0.01
      kref=bfr1(45)+0.01
      kfoam=bfr1(41)+0.01
      kwatr=bfr1(42)+0.01
      chlo=bfr1(43)
      wwrr=bfr1(44)
      foamf=bfr1(75)
c
      if(kfoam.eq.0)foamf=0.0
      if(kwatr.eq.0)wwrr=0.0
      if(kwatr.eq.0)chlo=0.0
c
      if(iprn.eq.4)write(iprn,100)
      if(iprn.eq.3)write(iprn,101)
      if(iprn.eq.2)write(iprn,104)
      if(iprn.eq.14)write(iprn,102)
      if(iprn.eq.13)write(iprn,103)
c
      write(iprn,105)bfr1(5)
      if(kfc.eq.1)then
        write(iprn,110)
        kfunc=bfr1(48)+0.01
        nfunc=bfr1(49)+0.01
        if(kfunc.eq.2)then
          write(iprn,111)sd1(kfunc),sd2(nfunc)
        else
          write(iprn,112)sd1(kfunc)
        endif
        goto(10,20,30,40,50),kfunc
10      continue
        write(iprn,115)bfr1(6),bfr1(7)
        write(iprn,200)bfr1(51),bfr1(52)
        write(iprn,205)bfr1(53),bfr1(12)
        write(iprn,120)bfr1(10),bfr1(11)
        write(iprn,130)bfr1(13),bfr1(12)
        goto 60
20      continue
        write(iprn,115)bfr1(6),bfr1(7)
        write(iprn,210)bfr1(54),bfr1(55)
        write(iprn,215)bfr1(56),bfr1(57)
        write(iprn,120)bfr1(10),bfr1(11)
        write(iprn,130)bfr1(13),bfr1(12)
        goto 60
30      continue
        write(iprn,115)bfr1(6),bfr1(7)
        write(iprn,125)bfr1(8),bfr1(9)
        write(iprn,120)bfr1(10),bfr1(11)
        write(iprn,130)bfr1(13),bfr1(12)
        goto 60
40      continue
        write(iprn,217)bfr1(6),bfr1(7)
        write(iprn,220)bfr1(63),bfr1(64)
        write(iprn,222)bfr1(8),bfr1(9)
        write(iprn,225)bfr1(59),bfr1(60)
        write(iprn,230)bfr1(58),bfr1(61)
        write(iprn,235)bfr1(12),bfr1(62)
        write(iprn,237)bfr1(10),bfr1(11)
        write(iprn,238)bfr1(65),bfr1(66)
        write(iprn,260)bfr1(13)
        goto 60
50      continue
        write(iprn,115)bfr1(6),bfr1(7)
        write(iprn,220)bfr1(63),bfr1(64)
        write(iprn,221)bfr1(71),bfr1(72)
        write(iprn,125)bfr1(8),bfr1(9)
        write(iprn,225)bfr1(59),bfr1(60)
        write(iprn,245)bfr1(67),bfr1(68)
        write(iprn,230)bfr1(58),bfr1(61)
        write(iprn,250)bfr1(69),bfr1(12)
        write(iprn,253)bfr1(62),bfr1(70)
        write(iprn,237)bfr1(10),bfr1(11)
        write(iprn,238)bfr1(65),bfr1(66)
        write(iprn,239)bfr1(73),bfr1(74)
        write(iprn,260)bfr1(13)
60      continue        
        write(iprn,135)bfr1(14),bfr1(15)
        write(iprn,140)bfr1(16),bfr1(17)
        write(iprn,145)bfr1(18),bfr1(19)
        write(iprn,146)bfr1(31),bfr1(32)
        write(iprn,150)bfr1(20),bfr1(21)
      endif
c
      if(kref.eq.2)then
         write(iprn,155)
         write(iprn,160)bfr1(23),bfr1(24),bfr1(22),wwrr
         write(iprn,163)foamf,chlo
      endif
      write(iprn,165)
      write(iprn,170)bfr1(25),bfr1(26)
      write(iprn,175)bfr1(27),bfr1(28)
      write(iprn,180)bfr1(29),bfr1(30)
      if(icrft.eq.1)then
        write(iprn,182)bfr1(100+nx-1+jpart+1),bfr1(100+nx-1+jpart+2)
      endif
      if(kpsudo.eq.1)then
        write(iprn,186)
      else
        write(iprn,185)
      endif
c
      if(kref.eq.0)then
        write(iprn,255)
      endif
      if(kref.eq.2)then
        write(iprn,256)
      endif
      tranc=' no'
      if(itrans.eq.1)tranc='yes'
      write(iprn,257)bfr1(46),tranc
      return
c
c.....format statements................................................
c
100   format(t18,'upwelling radiance at the top of the atmosphere')
101    format(t18,'downwelling radiance at the bottom of the',
     1        ' atmosphere')
102   format(t18,'upwelling radiance at the aircraft altidue')
103   format(t18,'downwelling radiance at the aircraft altidue')
104   format(t18,'upwelling radiance just above the flat ocean surface')
105   format(t1,'wavelength',t32,f6.4,' um')
110   format(t1,'aerosols')
111   format(t8,'particle size dist.',t40,a,1x,a)
112   format(t8,'particle size dist.',t40,a)
115   format(t8,'n1 (refr. index real)',t32,f6.4,
     1       t40,'n2 (refr. index imag.)',t66,1pe10.4)
120   format(t8,'rmin (um)',t32,f6.4,t40,'rmax (um)',t67,f9.4)
125   format(t8,'rg (um)',t32,f6.4,t40,'sigma',t70,f6.4)
130   format(t8,'r(eff)',t29,f9.4,t40,'delta x',t70,f6.4)
135   format(t8,'r1 (first moment)',t26,1pe12.4,
     1       t40,'r2 (second moment)',t64,1pe12.4)
140   format(t8,'r3 (third moment)',t26,1pe12.4,
     1       t40,'r4 (fourth moment)',t64,1pe12.4)
145   format(t8,'single scat. albedo',t32,f6.4,
     1       t40,'asym. fac. (g)',t70,f6.4)
146   format(t8,'ccn',t29,f9.4,t40,'back scat. ratio',t67,f9.4)
150   format(t8,'scat. coeff',t26,1pe12.4,
     1       t40,'ext. coeff.',t64,1pe12.4)
155   format(t1,'ocean')
160   format(t8,'n1 (refr. index real)',t32,f6.4,
     1       t40,'n2 (refr. index imag.)',t66,1pe10.4/
     2       t8,'wind speed (m/sec)',t32,0pf6.2,
     3       t40,'albedo(water_leaving rad)',t65,1pe11.4) 
163   format(t8,'foam (fraction)',t32,f6.4,
     1       t40,'chlorophyl conc.(mg/m3)',t65,1pe11.4)
165   format(t1,'atmosphere')
170   format(t8,'tau(rayleigh)',t29,f9.4,
     1       t40,'tau(aerosol)',t67,f9.4)
175   format(t8,'tau(ozone)',t29,f9.4,
     1       t40,'tau(h2o)',t67,f9.4)
180   format(t8,'tau(total)',t29,f9.4,
     1       t40,'mol. depol. fac',t70,f6.4)
182   format(t8,'tau(total_aircraft)',t29,f9.4,
     1       t40,'aircraft_alt(km)',t70,f5.2)
185   format(t1,'model (atmosphere)',t32,'plane parallel')
186   format(t1,'model (atmosphere)',t32,'pseudo spherical')
200   format(t8,'rc',t29,f9.4,t40,'c',t64,1pe12.4)
205   format(t8,'nu',t29,f9.4,t40,'delx',t67,f9.4)
210   format(t8,'alfa',t29,f9.4,t40,'gamma',t67,f9.4)
215   format(t8,'a',t29,f9.4,t40,'b',t67,f9.4)
217   format(t8,'n1 (real mode 1)',t32,f6.4,
     1       t40,'n2 (imag. mode 1)',t66,1pe10.4)
220   format(t8,'n1 (real mode 2)',t32,f6.4,
     1       t40,'n2 (imag. mode 2)',t66,1pe10.4)
221   format(t8,'n1 (real mode 3)',t32,f6.4,
     1       t40,'n2 (imag. mode 3)',t66,1pe10.4)
222   format(t8,'rg1(um)',t32,f6.4,t40,'sigma1',t70,f6.4)
225   format(t8,'rg2(um)',t32,f6.4,t40,'sigma2',t70,f6.4)
230   format(t8,'xnum1',t26,1pe12.4,t40,'xnum2',t64,1pe12.4)
235   format(t8,'delx1',t29,f9.4,t40,'delx2',t67,f9.4)
237   format(t8,'rmin1(um)',t32,f6.4,t40,'rmax1(um)',t67,f9.4)
238   format(t8,'rmin2(um)',t32,f6.4,t40,'rmax2(um)',t67,f9.4)
239   format(t8,'rmin3(um)',t32,f6.4,t40,'rmax3(um)',t67,f9.4)
245   format(t8,'rg3(um)',t32,f6.4,t40,'sigma3',t70,f6.4)
250   format(t8,'xnum3',t26,1pe12.4,t40,'delx1',t67,f9.4)
253   format(t8,'delx2',t29,f9.4,t40,'delx3',t67,f9.4)
255   format(t1,'model (lower surface)',t32,'lambertian (ground)')
256   format(t1,'model (lower surface)',t32,'non lambertian',
     1       ' (rough ocean)')
257   format(t1,'surface pressure (atm.)',t32,f5.3,t40,'diffuse trans',
     1       t73,a)
260   format(t8,'r(eff)',t29,f9.4)
c
      end
c**********************************************************************