*=*=*=*= radref.html =*=*=*=*
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