| 1 | SUBROUTINE SUAER |
|---|
| 2 | implicit none |
|---|
| 3 | C |
|---|
| 4 | C Purpose. |
|---|
| 5 | C -------- |
|---|
| 6 | C initialize yomaer, the common that contains the |
|---|
| 7 | C radiative characteristics of the aerosols |
|---|
| 8 | c |
|---|
| 9 | C AUTHOR. |
|---|
| 10 | C ------- |
|---|
| 11 | c Richard Fournier (1996) Francois Forget (1996) |
|---|
| 12 | c Frederic Hourdin |
|---|
| 13 | C Jean-jacques morcrette *ECMWF* |
|---|
| 14 | c MODIF Francois Forget (2000) |
|---|
| 15 | c MODIF Franck Montmessin (add water ice) |
|---|
| 16 | C ------------------------------------------------------------------ |
|---|
| 17 | C |
|---|
| 18 | C----------------------------------------------------------------------- |
|---|
| 19 | C |
|---|
| 20 | #include "dimensions.h" |
|---|
| 21 | #include "dimphys.h" |
|---|
| 22 | #include "dimradmars.h" |
|---|
| 23 | #include "yomaer.h" |
|---|
| 24 | |
|---|
| 25 | c Aerosol Spectral properties : |
|---|
| 26 | #include "aerdust.h" |
|---|
| 27 | |
|---|
| 28 | #ifdef ICE |
|---|
| 29 | #include "aerice.h" |
|---|
| 30 | #endif |
|---|
| 31 | C----------------------------------------------------------------------- |
|---|
| 32 | c |
|---|
| 33 | INTEGER iaer,isun,iir,n |
|---|
| 34 | |
|---|
| 35 | c I/O of "aerave" (subroutine averaging spectrally sing.scat.parameters) |
|---|
| 36 | REAL tsun ! Sun brightness temperature (for SW) |
|---|
| 37 | REAL tsol ! Surface reference brightness temp (for LW) |
|---|
| 38 | REAL longref ! reference wavelengths |
|---|
| 39 | REAL longsun(nsun+1) ! solar band boundaries |
|---|
| 40 | REAL longir(nir+1) ! IR band boundaries |
|---|
| 41 | REAL epref ! reference extinction ep at wavelength "longref" |
|---|
| 42 | REAL epav(nir) ! average ep (= <Qext>/Qext(longref) if epref=1) |
|---|
| 43 | REAL omegav(nir) ! Average sing.scat.albedo |
|---|
| 44 | REAL gav(nir) ! Average assymetry parameter |
|---|
| 45 | REAL QIRTM9sQrefIR ![Qext averaged over IRTM 9um band]/Qext(longrefir) |
|---|
| 46 | ! with longrefir defined in dimradmars.h |
|---|
| 47 | |
|---|
| 48 | |
|---|
| 49 | C----------------------------------------------------------------------- |
|---|
| 50 | c quelques initialisations a 0 |
|---|
| 51 | call zerophys(naerkind*nsun,gvis) |
|---|
| 52 | call zerophys(naerkind*nsun,omegavis) |
|---|
| 53 | call zerophys(naerkind*nsun,QVISsQREF) |
|---|
| 54 | |
|---|
| 55 | call zerophys(naerkind*nir,gIR) |
|---|
| 56 | call zerophys(naerkind*nir,omegaIR) |
|---|
| 57 | call zerophys(naerkind*nir,QIRsQREF) |
|---|
| 58 | c |
|---|
| 59 | C----------------------------------------------------------------------- |
|---|
| 60 | C |
|---|
| 61 | C ---------------------------------------------------------------- |
|---|
| 62 | C * 1. SHORTWAVE COEFFICIENTS |
|---|
| 63 | C ---------------------------------------------------------------- |
|---|
| 64 | C |
|---|
| 65 | c Computing average optical properties on both solar bands |
|---|
| 66 | c For pure dust (naerkind=1) |
|---|
| 67 | c |
|---|
| 68 | do iaer=1,naerkind |
|---|
| 69 | |
|---|
| 70 | tsun=6000.E+0 |
|---|
| 71 | longsun(1)=long1vis |
|---|
| 72 | longsun(2)=long2vis |
|---|
| 73 | longsun(3)=long3vis |
|---|
| 74 | longref=longrefvis |
|---|
| 75 | epref=1.E+0 |
|---|
| 76 | |
|---|
| 77 | |
|---|
| 78 | c Here, epav is <Qext>/Qext(longrefvis) since epref=1 : |
|---|
| 79 | |
|---|
| 80 | if (iaer.eq.1) then |
|---|
| 81 | CALL aerave ( ndustvis, |
|---|
| 82 | & longdustvis,epdustvis,omegdustvis,gdustvis, |
|---|
| 83 | & longref,epref,tsun |
|---|
| 84 | & ,nsun,longsun, epav,omegav,gav ) |
|---|
| 85 | elseif (iaer.eq.2) then |
|---|
| 86 | #ifdef ICE |
|---|
| 87 | CALL aerave ( nicevis, |
|---|
| 88 | & longicevis,epicevis,omegicevis,gicevis, |
|---|
| 89 | & longref,epref,tsun |
|---|
| 90 | & ,nsun,longsun, epav,omegav,gav ) |
|---|
| 91 | #endif |
|---|
| 92 | endif |
|---|
| 93 | |
|---|
| 94 | do isun=1,nsun |
|---|
| 95 | QVISsQREF(isun,iaer)=epav(isun) |
|---|
| 96 | gvis(isun,iaer)=gav(isun) |
|---|
| 97 | omegavis(isun,iaer)=omegav(isun) |
|---|
| 98 | c TEST |
|---|
| 99 | c if (iaer.eq.2) omegavis(isun,iaer)=.86 |
|---|
| 100 | c if (iaer.eq.2) gvis(isun,iaer)=-1. |
|---|
| 101 | c if (iaer.eq.2) then !TEST |
|---|
| 102 | c QVISsQREF(isun,iaer)=QVISsQREF(isun,1) |
|---|
| 103 | c gvis(isun,iaer)=gvis(isun,1) |
|---|
| 104 | c omegavis(isun,iaer)=omegavis(isun,1) |
|---|
| 105 | c endif |
|---|
| 106 | c END TEST |
|---|
| 107 | |
|---|
| 108 | enddo |
|---|
| 109 | |
|---|
| 110 | c |
|---|
| 111 | |
|---|
| 112 | C ---------------------------------------------------------------- |
|---|
| 113 | C * 2. LONGWAVE COEFFICIENTS |
|---|
| 114 | C ---------------------------------------------------------------- |
|---|
| 115 | |
|---|
| 116 | if (iaer.eq.1) then |
|---|
| 117 | |
|---|
| 118 | c Computing average optical properties on both solar bands |
|---|
| 119 | c For dust (iaer=1) |
|---|
| 120 | c |
|---|
| 121 | c Calcul preliminaire |
|---|
| 122 | c ~~~~~~~~~~~~~~~~~~~ |
|---|
| 123 | c Ratio betwen Qext averaged over IRTM 9um band |
|---|
| 124 | c and Qext(longrefir) (longrefir is defined in dimradmars.h) |
|---|
| 125 | c -> useful because the ratio of extinction "solsir" |
|---|
| 126 | c is defined between 0.67um and the IRTM 9um band |
|---|
| 127 | c (for which it has been estimated) |
|---|
| 128 | |
|---|
| 129 | tsol=215.D+0 |
|---|
| 130 | c IRTM band (T9): |
|---|
| 131 | longir(1)=8.3E-6 |
|---|
| 132 | longir(2)=9.7E-6 |
|---|
| 133 | longref=longrefir |
|---|
| 134 | epref=1.E+0 |
|---|
| 135 | |
|---|
| 136 | c Here, epav is QavIRTM9/Qext(longrefir) since epref=1 : |
|---|
| 137 | |
|---|
| 138 | write(*,*) 'Call test 9 micron' |
|---|
| 139 | CALL aerave ( ndustir, |
|---|
| 140 | & longdustir,epdustir,omegdustir,gdustir, |
|---|
| 141 | & longref,epref,tsol |
|---|
| 142 | & ,1,longir,epav,omegav,gav ) |
|---|
| 143 | write(*,*) 'OK test 9 micron' |
|---|
| 144 | QIRTM9sQrefIR=epav(1) |
|---|
| 145 | |
|---|
| 146 | c Average scaterring properties of 3 IR bands defined as : |
|---|
| 147 | c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
|---|
| 148 | c [long1ir - long1co2] , [long1co2-long2co2], [long2co2 - long2ir] |
|---|
| 149 | c |
|---|
| 150 | |
|---|
| 151 | tsol=215.D+0 |
|---|
| 152 | longir(1)=long1ir |
|---|
| 153 | longir(2)=long1co2 |
|---|
| 154 | longir(3)=long2co2 |
|---|
| 155 | longir(4)=long2ir |
|---|
| 156 | longref=longrefir |
|---|
| 157 | epref=1.E+0 |
|---|
| 158 | |
|---|
| 159 | c Here, epav is <QIR>/Qext(longrefir) since epref=1 |
|---|
| 160 | CALL aerave ( ndustir, |
|---|
| 161 | & longdustir,epdustir,omegdustir,gdustir, |
|---|
| 162 | & longref,epref,tsol |
|---|
| 163 | & ,nir-1,longir,epav,omegav,gav ) |
|---|
| 164 | |
|---|
| 165 | c Computing <QIR>/Qext(longrefvis) |
|---|
| 166 | DO iir=1,4 |
|---|
| 167 | epav(iir)= epav(iir) / (QIRTM9sQrefIR * solsir) |
|---|
| 168 | ENDDO |
|---|
| 169 | |
|---|
| 170 | elseif (iaer.eq.2) then |
|---|
| 171 | |
|---|
| 172 | c Average scaterring properties of 3 IR bands defined as : |
|---|
| 173 | c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
|---|
| 174 | c [long1ir - long1co2] , [long1co2-long2co2], [long2co2 - long2ir] |
|---|
| 175 | c |
|---|
| 176 | |
|---|
| 177 | tsol=215.D+0 |
|---|
| 178 | longir(1)=long1ir |
|---|
| 179 | longir(2)=long1co2 |
|---|
| 180 | longir(3)=long2co2 |
|---|
| 181 | longir(4)=long2ir |
|---|
| 182 | longref=longrefir |
|---|
| 183 | epref=1.E+0 |
|---|
| 184 | |
|---|
| 185 | c Here, epav is <QIR>/Qext(longrefir) since epref=1 |
|---|
| 186 | #ifdef ICE |
|---|
| 187 | CALL aerave ( niceir, |
|---|
| 188 | & longiceir,epiceir,omegiceir,giceir, |
|---|
| 189 | & longref,epref,tsol |
|---|
| 190 | & ,nir-1,longir,epav,omegav,gav ) |
|---|
| 191 | |
|---|
| 192 | c Computing <QIR>/Qext(longrefvis) |
|---|
| 193 | DO iir=1,4 |
|---|
| 194 | epav(iir)= epav(iir) / solsirice |
|---|
| 195 | ENDDO |
|---|
| 196 | #endif |
|---|
| 197 | |
|---|
| 198 | endif |
|---|
| 199 | c Single scattering properties in each of the "nir" bands (cf. dimramars.h) |
|---|
| 200 | c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
|---|
| 201 | c iir=1 : central 15um CO2 bands |
|---|
| 202 | QIRsQREF(1,iaer)=epav(2) |
|---|
| 203 | omegaIR(1,iaer)=omegav(2) |
|---|
| 204 | gIR(1,iaer)=gav(2) |
|---|
| 205 | |
|---|
| 206 | c iir=2 : CO2 band wings (same properties than for central part) |
|---|
| 207 | QIRsQREF(2,iaer)=epav(2) |
|---|
| 208 | omegaIR(2,iaer)=omegav(2) |
|---|
| 209 | gIR(2,iaer)=gav(2) |
|---|
| 210 | |
|---|
| 211 | c iir=3 : 9 um band [long1ir - long1co2] |
|---|
| 212 | QIRsQREF(3,iaer)=epav(1) |
|---|
| 213 | omegaIR(3,iaer)=omegav(1) |
|---|
| 214 | gIR(3,iaer)=gav(1) |
|---|
| 215 | |
|---|
| 216 | c iir=4 : Far IR [long2co2 - long2ir] |
|---|
| 217 | QIRsQREF(4,iaer)=epav(3) |
|---|
| 218 | omegaIR(4,iaer)=omegav(3) |
|---|
| 219 | gIR(4,iaer)=gav(3) |
|---|
| 220 | |
|---|
| 221 | c if (iaer.eq.2) then !TEST |
|---|
| 222 | c do iir=1,4 |
|---|
| 223 | c QIRsQREF(iir,iaer)=QIRsQREF(iir,1) |
|---|
| 224 | c omegaIR(iir,iaer)= omegaIR(iir,1) |
|---|
| 225 | c gIR(iir,iaer)=gIR(iir,1) |
|---|
| 226 | c enddo |
|---|
| 227 | c endif |
|---|
| 228 | |
|---|
| 229 | C ---------------------------------------------------------------- |
|---|
| 230 | C Output on screen |
|---|
| 231 | C ---------------------------------------------------------------- |
|---|
| 232 | if (iaer.eq.1) then |
|---|
| 233 | PRINT*,'PURE DUST PROPERTIES :' |
|---|
| 234 | PRINT* |
|---|
| 235 | PRINT*,'Rapport Solaire/IR :',solsir |
|---|
| 236 | PRINT* |
|---|
| 237 | elseif (iaer.eq.2) then |
|---|
| 238 | #ifdef ICE |
|---|
| 239 | PRINT*,'ICE PROPERTIES :' |
|---|
| 240 | PRINT* |
|---|
| 241 | PRINT*,'Rapport Solaire/IR :',solsirice |
|---|
| 242 | PRINT* |
|---|
| 243 | #endif |
|---|
| 244 | endif |
|---|
| 245 | |
|---|
| 246 | PRINT *,'Les donnees spectrales :' |
|---|
| 247 | PRINT *,'Solaire (SW) ---->' |
|---|
| 248 | PRINT *,'<Qext>/Qext(0.67um) ; omega ; g' |
|---|
| 249 | DO isun=1,nsun |
|---|
| 250 | PRINT *,QVISsQREF(isun,iaer),omegavis(isun,iaer) |
|---|
| 251 | & ,gvis(isun,iaer) |
|---|
| 252 | ENDDO |
|---|
| 253 | PRINT *,'Thermal IR (LW) ---->' |
|---|
| 254 | PRINT *,'<Qext>/Qext(0.67um) ; omega ; g' |
|---|
| 255 | DO iir=1,nir |
|---|
| 256 | PRINT *,QIRsQREF(iir,iaer),omegaIR(iir,iaer),gIR(iir,iaer) |
|---|
| 257 | ENDDO |
|---|
| 258 | c |
|---|
| 259 | |
|---|
| 260 | print *,'Dans le co2 on prend <Qabs>/Qext(0.67um) =', |
|---|
| 261 | & QIRsQREF(1,iaer)*(1-omegaIR(1,iaer)) |
|---|
| 262 | write(*,*) |
|---|
| 263 | |
|---|
| 264 | enddo ! Loop on iaer |
|---|
| 265 | |
|---|
| 266 | |
|---|
| 267 | |
|---|
| 268 | RETURN |
|---|
| 269 | END |
|---|
