| 1 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
|---|
| 2 | ! SUBROUTINE getoptcld(WLN,RADIUS,Q_EXT,Q_SCT,Q_ABS,Q_BAR) |
|---|
| 3 | ! |
|---|
| 4 | ! Obtention des QEXT,Q_SCT,Q_ABS,Q_BAR pour une particule de rayon RADIUS a la longueur |
|---|
| 5 | ! d'onde WLN . |
|---|
| 6 | ! |
|---|
| 7 | ! ARGUMENTS D'ENTREE : |
|---|
| 8 | ! WLN : Longueur d'onde traitee (en metres !) |
|---|
| 9 | ! RADIUS : Rayon de la particule (en metres !) |
|---|
| 10 | ! |
|---|
| 11 | ! ARGUMENT DE SORTIE : |
|---|
| 12 | ! Q_EXT : section efficace d'extinction |
|---|
| 13 | ! Q_SCT : section efficace de diffusion |
|---|
| 14 | ! Q_ABS : section efficace d'absorption |
|---|
| 15 | ! Q_BAR : Parametre d'asymetrie |
|---|
| 16 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
|---|
| 17 | SUBROUTINE getoptcld(WLN,RADIUS,Q_EXT,Q_SCT,Q_ABS,Q_BAR) |
|---|
| 18 | USE optcld |
|---|
| 19 | IMPLICIT NONE |
|---|
| 20 | ! ------ INPUT |
|---|
| 21 | REAL ,INTENT(in) :: WLN,RADIUS |
|---|
| 22 | ! ------ OUTPUT |
|---|
| 23 | REAL ,INTENT(out) :: Q_EXT,Q_SCT,Q_ABS,Q_BAR |
|---|
| 24 | ! ------ LOCAL/COMMON |
|---|
| 25 | REAL :: tmp |
|---|
| 26 | REAL,EXTERNAL :: get_qopt |
|---|
| 27 | |
|---|
| 28 | ! INTERPOLATION/EXTRAPOLATION de QEXT,QABS,QBAR et CALCUL de QSCT |
|---|
| 29 | ! notes : |
|---|
| 30 | ! Comme les indices optiques des gaz sont peu variables en ldo et qu'on |
|---|
| 31 | ! approxime la goutte comme etant composee d'hydrocarbone seulement, on |
|---|
| 32 | ! a les relations suivantes : |
|---|
| 33 | ! sigma(r,ldo) = sigma(r0,ldo*r0/r) * (r/r0)**2. |
|---|
| 34 | ! gg(r,ldo) = gg(r0,ldo*r0/r) |
|---|
| 35 | ! |
|---|
| 36 | ! La routine get_qopt calcule sigma(r0,ldo*r0/r) ou gg(r0,ldo*r0/r) (selon les inputs) |
|---|
| 37 | ! ====> il ne reste plus qu'a multiplier par (r/r0)**2. les sections efficaces :) |
|---|
| 38 | ! |
|---|
| 39 | ! ------------ |
|---|
| 40 | ! QEXT (attention : ltq_ex car on travaille en log dans get_qopt) |
|---|
| 41 | ! ------------ |
|---|
| 42 | tmp=get_qopt(radius,wln,A_ex,B_ex,fmin_ex,ltq_ex) |
|---|
| 43 | Q_EXT=tmp*(radius/r0cld)**2. |
|---|
| 44 | ! ------------ |
|---|
| 45 | ! QABS (attention : ltq_ab car on travaille en log dans get_qopt) |
|---|
| 46 | ! ------------ |
|---|
| 47 | tmp=get_qopt(radius,wln,A_ab,B_ab,fmin_ab,ltq_ab) |
|---|
| 48 | Q_ABS=tmp*(radius/r0cld)**2. |
|---|
| 49 | ! ------------ |
|---|
| 50 | ! QSCT |
|---|
| 51 | ! ------------ |
|---|
| 52 | Q_SCT=Q_EXT-Q_ABS |
|---|
| 53 | ! ------------ |
|---|
| 54 | ! QBAR (attention : ltq_gg car on travaille en log dans get_qopt) |
|---|
| 55 | ! ------------ |
|---|
| 56 | tmp=get_qopt(radius,wln,A_gg,B_gg,fmin_gg,ltq_gg) |
|---|
| 57 | Q_BAR=tmp |
|---|
| 58 | |
|---|
| 59 | END SUBROUTINE getoptcld |
|---|
| 60 | |
|---|
| 61 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
|---|
| 62 | ! REAL FUNCTION get_qopt(r,wln,A,B,fmin,) |
|---|
| 63 | ! |
|---|
| 64 | ! obtention d'une propriete optique pour une particule de taille r a la longueur d'onde wln |
|---|
| 65 | ! a partir de la table tq. |
|---|
| 66 | ! Les parametres tq,fmin,A et B definissent la propriete calculee (qext,qabs ou gg) |
|---|
| 67 | ! |
|---|
| 68 | ! ARGUMENTS D'ENTREE : |
|---|
| 69 | ! r : Rayon de la particule (en metres !) |
|---|
| 70 | ! wln : Longueur d'onde traitee (en metres !) |
|---|
| 71 | ! tq : table de la propriete. |
|---|
| 72 | ! fmin : parametre pour extrapolation (debut de table) |
|---|
| 73 | ! A : parametre (coefficient directeur) pour extrapolation (fin de table) |
|---|
| 74 | ! B : parametre (ordonnee a l'origine) pour extrapolation (fin de table) |
|---|
| 75 | ! |
|---|
| 76 | ! VALEUR DE RETOUR : |
|---|
| 77 | ! Propriete optique recherchee a wln pour une taille r. |
|---|
| 78 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
|---|
| 79 | REAL FUNCTION get_qopt(r,wln,A,B,fmin,tq) |
|---|
| 80 | USE optcld |
|---|
| 81 | IMPLICIT NONE |
|---|
| 82 | ! ------ INPUT |
|---|
| 83 | REAL ,INTENT(in) :: r,wln,A,B,fmin,tq(npts) |
|---|
| 84 | ! ------ LOCAL |
|---|
| 85 | REAL :: wln_t,val |
|---|
| 86 | INTEGER :: ind,iver |
|---|
| 87 | |
|---|
| 88 | ! initialisation generale |
|---|
| 89 | iver = 0 |
|---|
| 90 | val = 0. |
|---|
| 91 | wln_t = wln * (r0cld/r) |
|---|
| 92 | |
|---|
| 93 | ! Recherche du point le plus proche dans la table |
|---|
| 94 | CALL locate(tq_wln,npts,wln_t,ind) |
|---|
| 95 | |
|---|
| 96 | ! Interpolation/extrapolation selon l'indice. |
|---|
| 97 | IF (ind.le.0) THEN |
|---|
| 98 | val = fmin |
|---|
| 99 | ELSEIF(ind.ge.npts) THEN |
|---|
| 100 | CALL extrapolemoi(wln_t,A,B,val,.true.) |
|---|
| 101 | ELSE |
|---|
| 102 | CALL interpolemoi(ind,wln_t,ltq_wln,tq,npts,val,iver,.true.) |
|---|
| 103 | ENDIF |
|---|
| 104 | get_qopt=val |
|---|
| 105 | |
|---|
| 106 | END FUNCTION get_qopt |
|---|
| 107 | |
|---|
| 108 | |
|---|
