c  $Header: /usr/people/flittner/radtran/tomrad/pv2.2/src/RCS/prthead.f,v 2.22 2000/08/30 16:38:09 flittner Exp $
      subroutine prthead
c
c print the header telling of the status of the switchs and input file
c names
c
c     last mod. Sep. 6, 1998...def
c     purpose: combine several commons into switches.cmn.
c
c     mod. Sept 29, 1998...eac
c     purpose: format file output.
c
c last mod. Oct. 14, 1998...def
c purpose: add userfn and stdprf to output.
c
c     last mod. May 3, 1999...def
c     purpose: add option to compute addition absorbing gas profile using the
c     internal, implicit neutral density profile and a constant mixing ratio.
c     Currently it is set to do only o2 or o4 absorption and is controled by
c     the lo2abs and lo4abs logicals read in the ENV file.
c
c last mod. Feb. 10, 2000...def
c purpose: add switch to turn-off call to geopro and also prevent call to geopro
c if itmax less than 3.
c
c
c*****************************************************************************
      implicit none
c commons
      include 'in.cmn'
      include 'cgas2.cmn'
      include 'switches.cmn'
      include 'cfilenames.cmn'
c local
      integer iunt,i,j
c
c do once the screen (iunt=6) once for the default out file (iunt=23)
c
      do iunt=6,23,17
c
c spherical correction to the out-going beam
c
      if(lsphout)then
        write(iunt,*)'The solution is corrected for the',
     &            ' sphericity of the out-going beam.'
      else
        write(iunt,*)'The solution is NOT corrected for the',
     &            ' sphericity of the out-going beam.'
      endif
c
c pseudo-spherical switch
c
      if(ipsudo.eq.0)then
        write(iunt,*)'The direct solar beam is attenuated to ',
     &            'the zenith in a FLAT atmosphere.'
      else
        write(iunt,*)'The direct solar beam is attenuated to ',
     &            'the zenith in a SPHERICAL atmosphere.'
      endif
c
c number of gaseous absorbers
c
      if(ngas.eq.1)then
        write(iunt,*)'Only 1 absorbing gas is used in the model.'
      else
        write(iunt,*)ngas,' absorbing gases are used in the model.'
c load the default profile & absorption file names of the other absorbing gases
        do i=2,ngas
           write(fgasprf(i-1),'(a3,i1,a4)')"gas",i,".prf"
           write(fgasalfa(i-1),'(a3,i1,a4)')"gas",i,".coe"
        enddo
      endif
c
c switch for radiance at the surface
c
      if(ldown)then
        write(iunt,*)'Will compute the tranmitted radiance to the ',
     &'surface.'
      else
        write(iunt,*)'Will compute the reflected radiance at the top',
     &' of the atmosphere.'
      endif
c
c switch for the profile to use
c
      if(prf_type.eq.0)then
        write(iunt,*)'Will use the standard 11 layer profile.'
      else if(prf_type.eq.1)then
        write(iunt,*)'Will use the umkher profile.'
      else if(prf_type.eq.2)then
        write(iunt,*)'Will use the user input profile ',userfn
      endif
c
c now write out all the logical switches also
c
      write(iunt,2)'The logical switches are:'
      write(iunt,3)'lsphout ',lsphout

      write(iunt,3)'lprtflx ',lprtflx
      write(iunt,3)'ldown ',ldown
      write(iunt,3)'lphiindep ',lphiindep
      write(iunt,3)'write_iter_file ',write_iter_file
      write(iunt,3)'lo2abs ',lo2abs
      write(iunt,3)'lo4abs ',lo4abs
      write(iunt,3)'lnoextrap ',lnoextrap
      write(iunt,3)'lwgttmp ',lwgttmp
      write(iunt,3)'lwgt11',lwgt11
      write(iunt,3)'lv7tab',lv7tab
      write(iunt,3)'lv7tabout',lv7tabout
c #s
      write(iunt,2)'The numerical settings are:'
      write(iunt,4)'ngas ',ngas
      write(iunt,4)'ipsudo ',ipsudo
      write(iunt,4)'gc_type ',gc_type
      write(iunt,4)'prf_type ',prf_type
      write(iunt,4)'irefrac ',irefrac
c file names
      write(iunt,2)'The file names are:'
      j=min(len(inprffn),index(inprffn,' '))
      write(iunt,5)'inprffn =',inprffn(1:j)
      j=min(len(nvalfn),index(nvalfn,' '))
      write(iunt,5)'nvalfn  =',nvalfn(1:j)
      j=min(len(outerrfn),index(outerrfn,' '))
      write(iunt,5)'outerrfn  =',outerrfn(1:j)
      j=min(len(outprffn),index(outprffn,' '))
      write(iunt,5)'outprffn  =',outprffn(1:j)
      j=min(len(sumryfn),index(sumryfn,' '))
      write(iunt,5)'sumryfn  =',sumryfn(1:j)
      j=min(len(iterfn),index(iterfn,' '))
      write(iunt,5)'iterfn  =',iterfn(1:j)
      j=min(len(coeffn),index(coeffn,' '))
      write(iunt,5)'coeffn  =',coeffn(1:j)
      j=min(len(outflxfnasc),index(outflxfnasc,' '))
      write(iunt,5)'outflxfnasc  =',outflxfnasc(1:j)
      j=min(len(outflxfnbin),index(outflxfnbin,' '))
      write(iunt,5)'outflxfnbin  =',outflxfnbin(1:j)
      j=min(len(userfn),index(userfn,' '))
      write(iunt,5)'userfn  =',userfn(1:j)
      write(iunt,*)'    (Not all these may be written in this run.)'
      write(iunt,*)''
      enddo
c
      return

    2 FORMAT(//a/)
    3 FORMAT(5x,a,t25,l5)
    4 FORMAT(5x,a,t25,i5)
    5 FORMAT(5x,a,t25,a)
      end