source: trunk/LMDZ.PLUTO.old/libf/phypluto/setspv.F90

      subroutine setspv

!==================================================================
!     
!     Purpose
!     -------
!     Set up spectral intervals, stellar spectrum and Rayleigh 
!     opacity in the shortwave. 
!     
!     Authors
!     ------- 
!     Adapted from setspv in the NASA Ames radiative code by
!     Robin Wordsworth (2009).
!
!     Called by
!     ---------
!     callcorrk.F
!     
!     Calls
!     -----
!     ave_stelspec.F
!     
!==================================================================

      use radinc_h,    only: L_NSPECTV, corrkdir, banddir
      use radcommon_h, only: BWNV,BLAMV,WNOV,DWNV,WAVEV, &
                             STELLARF,TAURAY,gastype
      use datafile_mod, only: datadir
      implicit none

#include "comcstfi.h"
#include "callkeys.h"

      logical file_ok

      integer N, M, file_entries

      character(len=30)  :: temp1
      character(len=100) :: file_id
      character(len=100) :: file_path

      real*8 :: lastband(2)

      real*8 STELLAR(L_NSPECTV)
      real*8 sum

!=======================================================================
!     Set up spectral bands - wavenumber [cm^(-1)]. Go from smaller to
!     larger wavenumbers, the same as in the IR.

      write(temp1,'(i2.2)') L_NSPECTV
      file_id='/corrk_data/'//trim(adjustl(banddir))//'/narrowbands_VI.in' 
      file_path=TRIM(datadir)//TRIM(file_id)

      ! check that the file exists
      inquire(FILE=file_path,EXIST=file_ok)
      if(.not.file_ok) then
         write(*,*)'The file ',file_path(1:LEN_TRIM(file_path))
         write(*,*)'was not found by setspv.F90, exiting.'
         call abort
      endif
      
      ! check that the file contains the right number of bands
      call system('wc -l '//file_path//' > bandlen.txt')
      open(131,file='bandlen.txt', form='formatted')
      read(131,*) file_entries
      close(131)
      call system('rm -f bandlen.txt')

      if(file_entries-1.ne.L_NSPECTV) then
         write(*,*) 'L_NSPECTV = ',L_NSPECTV, 'in the model, but there are '
         write(*,*) file_entries-1,'entries in ', &
              file_path(1:LEN_TRIM(file_path)),', exiting.'
         call abort
      endif

      ! load and display the data
      open(111,file=file_path,form='formatted')
      read(111,*) 
       do M=1,L_NSPECTV-1
         read(111,*) BWNV(M)
      end do
      read(111,*) lastband
      close(111)
      BWNV(L_NSPECTV)  =lastband(1)
      BWNV(L_NSPECTV+1)=lastband(2)


      print*,'VI band limits:'
      do M=1,L_NSPECTV+1
         print*,m,'-->',BWNV(M),' cm^-1'
      end do
      print*,' '

!     Set up mean wavenumbers and wavenumber deltas.  Units of 
!     wavenumbers is cm^(-1); units of wavelengths is microns.

      do M=1,L_NSPECTV
         WNOV(M)  = 0.5*(BWNV(M+1)+BWNV(M))
         DWNV(M)  = BWNV(M+1)-BWNV(M)
         WAVEV(M) = 1.0E+4/WNOV(M)
         BLAMV(M) = 0.01/BWNV(M)
      end do
      BLAMV(M) = 0.01/BWNV(M) ! wavelength in METERS for aerosol stuff
!     note M=L_NSPECTV+1 after loop due to Fortran bizarreness

!=======================================================================
!     Set up stellar spectrum

      write(*,*)'Interpolating stellar spectrum from the hires data...'
      call ave_stelspec(startype,STELLAR)

!     Sum the stellar flux, and write out the result.  
      sum = 0.0  
      do N=1,L_NSPECTV
         STELLARF(N) = STELLAR(N) * Fat1AU
         sum         = sum+STELLARF(N)
      end do
!      write(19,*)'stellarf',STELLARF
!      write(6,'(" Stellar flux at 1 AU = ",f7.2," W m-2")') sum
!      print*,' '

!=======================================================================
!     Set up the wavelength independent part of the Rayleigh scattering.
!     The pressure dependent part will be computed elsewhere (OPTCV).
!     WAVEV is in microns.  There is no Rayleigh scattering in the IR.

!      if(rayleigh) then
!         call calc_rayleigh
!      else
       print*,'No Rayleigh scattering, check for NaN in output!'
       do N=1,L_NSPECTV
          TAURAY(N) = 1E-16
       end do
!      endif

      RETURN
    END subroutine setspv