*=*=*=*= radref.html =*=*=*=*
SUBROUTINE radref

SUBROUTINE radref


      SUBROUTINE radref
     & (spectre,longref,epref,tsol,tbas,thaut,nlay,fab,fdb)
      IMPLICIT NONE
c.......................................................................
#include "dimensions.h"
#include "dimphys.h"
#include "dimradmars.h"
#include "yomaer.h"
c.......................................................................
c
c calcul monochromatique pour une atmosphere homogene et un profil
c de temperature lineaire entre "tsol" et "thaut". le sol est noir.
c le spectre est dans le fichier "spectre" et l'epaisseur optique de
c la couche est "epref" a la longueur d'onde "longref".
c
c entree
c
c  * spectre : nom du fichier de donnees spectrales
c  * longref : longueur d'onde a laquelle l'epaisseur optique
c              est connue
c  * epref : epaisseur optique a longref
c  * tsol : temperature au sol
c  * tbas : temperature en bas de l'atmosphere
c  * thaut : temperature en haut de l'atmosphere
c  * nlay : nombre de couches
c
c sortie
c
c  * fab : flux ascendant integre "hors de la bande du co2" en bas
c          de chaque couche (nlay+1 pour le dernier niveau)
c  * fdb : flux descendant integre "hors de la bande du co2" en bas
c          de chaque couche (nlay+1 pour le dernier niveau)
c
c.......................................................................
c
      CHARACTER*100 spectre
      REAL longref
      REAL epref
      REAL tsol,tbas,thaut
      INTEGER nlay
      REAL fab(nlay+1),fdb(nlay+1)
c
c.......................................................................
c
      REAL pi
      PARAMETER (pi=3.141592653589793E+0)
c
      INTEGER idata,ndata,ndatamx
      PARAMETER (ndatamx=1000)
      REAL longdata(ndatamx),epdata(ndatamx)
     &    ,omegdata(ndatamx),gdata(ndatamx)
c
      INTEGER ibande,nbande
      PARAMETER (nbande=1000)
      REAL long,deltalong
      INTEGER ilong
      INTEGER i1,i2
      REAL c1,c2
      REAL factep,ep,omeg,g
c
      INTEGER ilay,ilaydd
      REAL omeglay(nlayermx),glay(nlayermx),eplay(nlayermx)
     &,bhlay(nlayermx+1),bhsol
     &,fahlay(nlayermx+1),fdhlay(nlayermx+1)
c
c.......................................................................
c
      DOUBLE PRECISION tmp1,tmp2
c
c.......................................................................
c
      OPEN (100,file=spectre,status='old')
      READ (100,*)
      READ (100,*)
      READ (100,*) ndata
      READ (100,*)
      DO idata=1,ndata
        READ (100,*) longdata(idata),epdata(idata)
     &              ,omegdata(idata),gdata(idata)
        longdata(idata)=longdata(idata)*1.E-6
      ENDDO
      CLOSE (100)
c
c.......................................................................
c
      long=longref
c
c********************************************************
c interpolation
      ilong=1
      DO idata=2,ndata
        IF (long.gt.longdata(idata)) ilong=idata
      ENDDO
      i1=ilong
      i2=ilong+1
      IF (i2.gt.ndata) i2=ndata
      IF (long.lt.longdata(1)) i2=1
      IF (i1.eq.i2) THEN
        c1=1.E+0
        c2=0.E+0
      ELSE
        c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
        c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
      ENDIF
c********************************************************
c
      ep=c1*epdata(i1)+c2*epdata(i2)
      factep=ep/epref
      DO idata=1,ndata
        epdata(idata)=epdata(idata)/factep
      ENDDO
c
c.......................................................................
c
      DO ilay=1,nlay+1
        fab(ilay)=0.E+0
        fdb(ilay)=0.E+0
      ENDDO
      deltalong=(long2ir - long1ir)/nbande
c
c.......................................................................
c
      DO ibande=1,nbande
c
c.......................................................................
c
        long=long1ir + (ibande-0.5E+0) * deltalong
        DO ilaydd=1,nlay+1
          tmp1=DBLE(ilaydd-1)/DBLE(nlay)*DBLE(tbas-thaut)+DBLE(thaut)
          CALL blackl(DBLE(long),tmp1,tmp2)
          bhlay(ilaydd)=REAL(tmp2)/pi
        ENDDO
        tmp1=DBLE(tsol)
        CALL blackl(DBLE(long),tmp1,tmp2)
        bhsol=REAL(tmp2)/pi
c
c.......................................................................
c
c********************************************************
c interpolation
      ilong=1
      DO idata=2,ndata
        IF (long.gt.longdata(idata)) ilong=idata
      ENDDO
      i1=ilong
      i2=ilong+1
      IF (i2.gt.ndata) i2=ndata
      IF (long.lt.longdata(1)) i2=1
      IF (i1.eq.i2) THEN
        c1=1.E+0
        c2=0.E+0
      ELSE
        c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
        c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
      ENDIF
c********************************************************
c
        ep=c1*epdata(i1)+c2*epdata(i2)
        omeg=c1*omegdata(i1)+c2*omegdata(i2)
        g=c1*gdata(i1)+c2*gdata(i2)
c
c.......................................................................
c
        DO ilaydd=1,nlay
          eplay(ilaydd)=ep/nlay
          omeglay(ilaydd)=omeg
          glay(ilaydd)=g
        ENDDO
c
c.......................................................................
c
        CALL flusv(1,0,nlay,omeglay,glay,eplay,1.E+0
     &            ,bhlay,bhsol,fahlay,fdhlay)
c
c.......................................................................
c
        DO ilay=1,nlay+1
          ilaydd=nlay+2-ilay
          IF ((long.lt.long1co2).or.(long.gt.long2co2)) THEN
            fab(ilay)=fab(ilay)+deltalong*fahlay(ilaydd)
            fdb(ilay)=fdb(ilay)+deltalong*fdhlay(ilaydd)
          ENDIF
        ENDDO
c
c.......................................................................
c
      ENDDO
c
c.......................................................................
c
      RETURN
      END