| 1 | subroutine hazecloud(ngrid,nlayer,nq,ptimestep, & |
|---|
| 2 | pplay,pplev,pq,pdq,pdist_sol,mu0,pfluxuv,zdqhaze, & |
|---|
| 3 | zdqphot_prec,zdqphot_ch4,zdqconv_prec,declin) |
|---|
| 4 | |
|---|
| 5 | ! zdqphot_ch4,zdqconv_prec,declin,zdqhaze_col) |
|---|
| 6 | |
|---|
| 7 | use radinc_h, only : naerkind |
|---|
| 8 | use comgeomfi_h |
|---|
| 9 | use comcstfi_mod, only: pi, g |
|---|
| 10 | use tracer_h, only: igcm_haze, igcm_ch4_gas, igcm_prec_haze, noms, mmol |
|---|
| 11 | use geometry_mod, only: longitude, latitude ! in radians |
|---|
| 12 | use callkeys_mod, only: hazeconservch4, diurnal |
|---|
| 13 | |
|---|
| 14 | implicit none |
|---|
| 15 | |
|---|
| 16 | !================================================================== |
|---|
| 17 | ! Purpose |
|---|
| 18 | ! ------- |
|---|
| 19 | ! Production of haze in the atmosphere |
|---|
| 20 | ! |
|---|
| 21 | ! Inputs |
|---|
| 22 | ! ------ |
|---|
| 23 | ! ngrid Number of vertical columns |
|---|
| 24 | ! nlayer Number of layers |
|---|
| 25 | ! pplay(ngrid,nlayer) Pressure layers |
|---|
| 26 | ! pplev(ngrid,nlayer+1) Pressure levels |
|---|
| 27 | ! |
|---|
| 28 | ! Outputs |
|---|
| 29 | ! ------- |
|---|
| 30 | ! |
|---|
| 31 | ! Both |
|---|
| 32 | ! ---- |
|---|
| 33 | ! |
|---|
| 34 | ! Authors |
|---|
| 35 | ! ------- |
|---|
| 36 | ! Tanguy Bertrand and Francois Forget (2014) |
|---|
| 37 | ! |
|---|
| 38 | !================================================================== |
|---|
| 39 | |
|---|
| 40 | |
|---|
| 41 | !----------------------------------------------------------------------- |
|---|
| 42 | ! Arguments |
|---|
| 43 | |
|---|
| 44 | INTEGER ngrid, nlayer, nq |
|---|
| 45 | ! REAL lati(ngrid) |
|---|
| 46 | ! REAL long(ngrid) |
|---|
| 47 | ! REAL declin |
|---|
| 48 | LOGICAL firstcall |
|---|
| 49 | SAVE firstcall |
|---|
| 50 | DATA firstcall/.true./ |
|---|
| 51 | REAL ptimestep |
|---|
| 52 | REAL pplay(ngrid,nlayer),pplev(ngrid,nlayer+1) |
|---|
| 53 | REAL,INTENT(IN) :: pq(ngrid,nlayer,nq) |
|---|
| 54 | REAL,INTENT(IN) :: pdq(ngrid,nlayer,nq) |
|---|
| 55 | ! REAL,INTENT(IN) :: mmol(nq) |
|---|
| 56 | REAL,INTENT(IN) :: pdist_sol ! distance SUN-pluto in AU |
|---|
| 57 | REAL,INTENT(IN) :: pfluxuv ! Lyman alpha flux at specific Ls (ph/cm/s) |
|---|
| 58 | REAL,INTENT(IN) :: mu0(ngrid) ! cosinus of solar incident flux |
|---|
| 59 | REAL,INTENT(IN) :: declin ! distance SUN-pluto in AU |
|---|
| 60 | REAL,INTENT(OUT) :: zdqhaze(ngrid,nlayer,nq) ! Final tendancy |
|---|
| 61 | ! REAL,INTENT(OUT) :: zdqhaze_col(ngrid) ! Final tendancy haze prod |
|---|
| 62 | !----------------------------------------------------------------------- |
|---|
| 63 | ! Local variables |
|---|
| 64 | |
|---|
| 65 | INTEGER l,ig,iq |
|---|
| 66 | REAL zq_ch4(ngrid,nlayer) |
|---|
| 67 | REAL zq_prec(ngrid,nlayer) |
|---|
| 68 | REAL tauch4(nlayer) |
|---|
| 69 | REAL sigch4 ! aborption cross section ch4 cm-2 mol-1 |
|---|
| 70 | REAL flym_sol_earth ! initial flux Earth ph.m-2.s-1 |
|---|
| 71 | REAL flym_sol_pluto ! initial Lyman alpha SOLAR flux Pluto ph.m-2.s-1 |
|---|
| 72 | REAL flym_ipm(ngrid) ! top of atm. Incident IPM (Interplanetary) flux Lyman alpha ph.m-2.s-1 |
|---|
| 73 | REAL fluxlym_sol(nlayer+1) ! Local Solar flux Lyman alpha ph.m-2.s-1 |
|---|
| 74 | REAL fluxlym_ipm(nlayer+1) ! Local IPM (Interplanetary) flux Lyman alpha ph.m-2.s-1 |
|---|
| 75 | REAL mu_ipm(ngrid) ! local Mean incident flux for IPM Lyman alpha photons |
|---|
| 76 | REAL mu_sol(ngrid) ! local Mean incident flux for solar lyman alpha photons |
|---|
| 77 | |
|---|
| 78 | REAL gradflux(nlayer) ! gradient flux Lyman alpha ph.m-2.s-1 |
|---|
| 79 | REAL zdqphot_ch4(ngrid,nlayer) ! tendancy due to photolysis of ch4 |
|---|
| 80 | REAL zdqphot_prec(ngrid,nlayer) ! tendancy due to photolysis of ch4 |
|---|
| 81 | REAL zdqconv_prec(ngrid,nlayer) ! tendancy due to conversion of |
|---|
| 82 | ! prec_haze into haze |
|---|
| 83 | REAL kch4 ! fraction of Carbon from ch4 directly dissociated |
|---|
| 84 | ! by prec_haze |
|---|
| 85 | CHARACTER(len=10) :: tname |
|---|
| 86 | REAL ncratio ! ration Nitrogen/Carbon observed in tholins |
|---|
| 87 | REAL tcon ! Time constant: conversion in aerosol |
|---|
| 88 | REAL avogadro ! avogadro constant |
|---|
| 89 | |
|---|
| 90 | REAL longit |
|---|
| 91 | REAL latit |
|---|
| 92 | REAL valmin |
|---|
| 93 | REAL valmax |
|---|
| 94 | REAL valmin_dl |
|---|
| 95 | REAL puis |
|---|
| 96 | REAL dist |
|---|
| 97 | REAL long2 |
|---|
| 98 | !----------------------------------------------------------------------- |
|---|
| 99 | |
|---|
| 100 | !---------------- INPUT ------------------------------------------------ |
|---|
| 101 | |
|---|
| 102 | avogadro = 6.022141e23 |
|---|
| 103 | sigch4 = 1.85e-17 ! aborption cross section ch4 cm-2 mol-1 |
|---|
| 104 | !! Initial Solar flux Lyman alpha on Earth (1AU) |
|---|
| 105 | flym_sol_earth=pfluxuv*1.e15 ! ph.m-2.s-1 -> 5e+11 ph.cm-2.s-1 |
|---|
| 106 | !! Initial Solar flux Lyman alpha on Pluto |
|---|
| 107 | flym_sol_pluto=flym_sol_earth/(pdist_sol*pdist_sol) ! ph.m-2.s-1 |
|---|
| 108 | ! option decrease by 12% the initial IPM flux to account for Interplanetary H absorption: |
|---|
| 109 | ! Fig 3 Gladstone et al 2014 : Lyalpha at Pluto |
|---|
| 110 | flym_sol_pluto=flym_sol_pluto*0.878 |
|---|
| 111 | |
|---|
| 112 | !!!! Top of atm. Incident IPM (Interplanetary) flux Lyman alpha ph.m-2.s-1 |
|---|
| 113 | ! fit Fig. 4 in Randall Gladstone et al. (2015) |
|---|
| 114 | ! -- New version : Integration over semi sphere of Gladstone data. |
|---|
| 115 | ! Fit of results |
|---|
| 116 | |
|---|
| 117 | IF (ngrid.eq.1) THEN |
|---|
| 118 | flym_ipm(1)=75.e10 |
|---|
| 119 | mu_ipm(1) = 0.5 !max(mu0(1), 0.5) |
|---|
| 120 | mu_sol(1)=0.25 |
|---|
| 121 | ELSE IF (.not.diurnal) THEN |
|---|
| 122 | flym_ipm(:)= mu0(:)*75.e10 |
|---|
| 123 | mu_sol(:) = mu0(:) |
|---|
| 124 | mu_ipm(:) = max(mu_sol(:), 0.5) |
|---|
| 125 | ELSE |
|---|
| 126 | ! 1) get longitude/latitude (rad) of anti-subsolar point (max de mu0 - 180) |
|---|
| 127 | longit=longitude((MAXLOC(mu0,DIM=1,MASK=mu0.GT.0.9))) ! rad |
|---|
| 128 | IF (longit.GE.0) THEN |
|---|
| 129 | longit=longit-pi |
|---|
| 130 | ELSE |
|---|
| 131 | longit=longit+pi |
|---|
| 132 | ENDIF |
|---|
| 133 | latit=-declin ! rad |
|---|
| 134 | |
|---|
| 135 | ! 2) Define input parameter for the fit |
|---|
| 136 | valmin=48.74e10 ! minimum value of ipm flux in ph/m2/s |
|---|
| 137 | valmax=115.014e10 ! maximal value of ipm flux in ph/m2/s |
|---|
| 138 | valmin_dl=74.5e10 ! daylight minimum value |
|---|
| 139 | puis=3.5 |
|---|
| 140 | |
|---|
| 141 | ! 3) Loop for each location and fit |
|---|
| 142 | DO ig=1,ngrid |
|---|
| 143 | ! calculation of cosinus of incident angle for IPM flux |
|---|
| 144 | mu_sol(ig) = mu0(ig) |
|---|
| 145 | mu_ipm(ig) = max(mu_sol(ig), 0.5) |
|---|
| 146 | IF (mu0(ig).LT.1.e-4) THEN |
|---|
| 147 | dist=acos(sin(latitude(ig))*sin(latit)+cos(latitude(ig))* & |
|---|
| 148 | cos(latit)*cos(longit-longitude(ig)))*180/pi |
|---|
| 149 | IF (dist.gt.90) dist=90 |
|---|
| 150 | flym_ipm(ig)=(valmin_dl-valmin)/(90.**puis)*(dist)**puis & |
|---|
| 151 | +valmin |
|---|
| 152 | ELSE |
|---|
| 153 | flym_ipm(ig)= mu0(ig)*(valmax-valmin_dl)+valmin_dl |
|---|
| 154 | ENDIF |
|---|
| 155 | ! proportional to lyman alpha solar flux (reference 2015 : 5e11 ph/cm2/s) |
|---|
| 156 | flym_ipm(ig)=flym_ipm(ig)*pfluxuv/5. |
|---|
| 157 | ENDDO ! nlayer |
|---|
| 158 | |
|---|
| 159 | |
|---|
| 160 | ENDIF ! ngrid |
|---|
| 161 | !--- |
|---|
| 162 | |
|---|
| 163 | !! Time constant of conversion in aerosol to be explore |
|---|
| 164 | tcon= 1.e7 ! 153 ! 1.E7 !second |
|---|
| 165 | ! tcon= 1. ! 153 ! 1.E7 !second |
|---|
| 166 | !! Parameter of conversion precurseur to haze |
|---|
| 167 | kch4=1. |
|---|
| 168 | ncratio=0.5 ! boost for haze considering nitrogen contribution |
|---|
| 169 | ! ratio n/c : =0.25 if there is 1N for 3C |
|---|
| 170 | IF (firstcall) then |
|---|
| 171 | write(*,*) 'hazecloud: haze parameters:' |
|---|
| 172 | write(*,*) 'tcon, kch4, ncratio = ' , tcon, kch4, ncratio |
|---|
| 173 | firstcall=.false. |
|---|
| 174 | ENDIF |
|---|
| 175 | ! note: mu0 = cos(solar zenith angle) |
|---|
| 176 | ! max(mu0) = declin |
|---|
| 177 | |
|---|
| 178 | !!---------------------------------------------------------- |
|---|
| 179 | !!---------------------------------------------------------- |
|---|
| 180 | |
|---|
| 181 | DO ig=1,ngrid |
|---|
| 182 | |
|---|
| 183 | zq_ch4(ig,:)=0. |
|---|
| 184 | zq_prec(ig,:)=0. |
|---|
| 185 | zdqconv_prec(ig,:)=0. |
|---|
| 186 | zdqhaze(ig,:,:)=0. |
|---|
| 187 | zdqphot_prec(ig,:)=0. |
|---|
| 188 | zdqphot_ch4(ig,:)=0. |
|---|
| 189 | tauch4(:)=0. |
|---|
| 190 | gradflux(:)=0. |
|---|
| 191 | fluxlym_sol(1:nlayer)=0. |
|---|
| 192 | fluxlym_sol(nlayer+1)=flym_sol_pluto*mu_sol(ig) ! |
|---|
| 193 | fluxlym_ipm(nlayer+1)= flym_ipm(ig) |
|---|
| 194 | |
|---|
| 195 | DO l=nlayer,1,-1 |
|---|
| 196 | !! Actualisation tracer ch4 and prec_haze |
|---|
| 197 | |
|---|
| 198 | !IF (ngrid.eq.1) THEN |
|---|
| 199 | !! option zq_ch4 = cte |
|---|
| 200 | ! zq_ch4(ig,l)=0.01*0.5*16./28. ! Temporaire |
|---|
| 201 | !ELSE |
|---|
| 202 | zq_ch4(ig,l)=pq(ig,l,igcm_ch4_gas)+ & |
|---|
| 203 | pdq(ig,l,igcm_ch4_gas)*ptimestep |
|---|
| 204 | !ENDIF |
|---|
| 205 | if (zq_ch4(ig,l).lt.0.) then |
|---|
| 206 | zq_ch4(ig,l)=0. |
|---|
| 207 | endif |
|---|
| 208 | |
|---|
| 209 | !! option zq_ch4 = cte |
|---|
| 210 | ! zq_ch4(ig,l)=0.1*16./28. ! Temporaire |
|---|
| 211 | |
|---|
| 212 | zq_prec(ig,l)=pq(ig,l,igcm_prec_haze)+ & |
|---|
| 213 | pdq(ig,l,igcm_prec_haze)*ptimestep |
|---|
| 214 | |
|---|
| 215 | !! Calculation optical depth ch4 in Lyman alpha for each layer l |
|---|
| 216 | tauch4(l)=sigch4*1.e-4*avogadro* & |
|---|
| 217 | (zq_ch4(ig,l)/(mmol(igcm_ch4_gas)*1.e-3))* & |
|---|
| 218 | (pplev(ig,l)-pplev(ig,l+1))/g |
|---|
| 219 | !! Calculation of Flux in each layer l |
|---|
| 220 | if (mu_sol(ig).gt.1.e-6) then |
|---|
| 221 | fluxlym_sol(l)=fluxlym_sol(l+1)*exp(-tauch4(l)/mu_sol(ig)) |
|---|
| 222 | endif |
|---|
| 223 | |
|---|
| 224 | fluxlym_ipm(l)=fluxlym_ipm(l+1)*exp(-tauch4(l)/mu_ipm(ig)) |
|---|
| 225 | |
|---|
| 226 | gradflux(l)=fluxlym_sol(l+1)-fluxlym_sol(l) & |
|---|
| 227 | + fluxlym_ipm(l+1)-fluxlym_ipm(l) |
|---|
| 228 | !! tendancy on ch4 |
|---|
| 229 | !! considering 1 photon destroys 1 ch4 by photolysis |
|---|
| 230 | zdqphot_ch4(ig,l)=-mmol(igcm_ch4_gas)*1.e-3/avogadro* & |
|---|
| 231 | gradflux(l)*g/(pplev(ig,l)-pplev(ig,l+1)) |
|---|
| 232 | |
|---|
| 233 | !! tendency of prec created by photolysis of ch4 |
|---|
| 234 | zdqphot_prec(ig,l)=-zdqphot_ch4(ig,l) |
|---|
| 235 | |
|---|
| 236 | !! update precurseur zq_prec |
|---|
| 237 | zq_prec(ig,l)=zq_prec(ig,l)+ & |
|---|
| 238 | zdqphot_prec(ig,l)*ptimestep |
|---|
| 239 | |
|---|
| 240 | !! Conversion of prec_haze into haze |
|---|
| 241 | !! controlled by the time constant tcon |
|---|
| 242 | !! New tendancy for prec_haze |
|---|
| 243 | zdqconv_prec(ig,l) = -zq_prec(ig,l)* & |
|---|
| 244 | (1-exp(-ptimestep/tcon))/ptimestep |
|---|
| 245 | |
|---|
| 246 | ENDDO ! nlayer |
|---|
| 247 | |
|---|
| 248 | !! Final tendancy for prec_haze and haze |
|---|
| 249 | |
|---|
| 250 | DO iq=1,nq |
|---|
| 251 | tname=noms(iq) |
|---|
| 252 | !print*, 'TB17 tname=',tname,tname(1:4) |
|---|
| 253 | if (tname(1:4).eq."haze") then |
|---|
| 254 | zdqhaze(ig,:,iq) = -zdqconv_prec(ig,:)* & |
|---|
| 255 | kch4*(1.+ncratio*14./12.) |
|---|
| 256 | else if (noms(iq).eq."prec_haze") then |
|---|
| 257 | zdqhaze(ig,:,igcm_prec_haze)= zdqphot_prec(ig,:) + & |
|---|
| 258 | zdqconv_prec(ig,:) |
|---|
| 259 | |
|---|
| 260 | else if (noms(iq).eq."ch4_gas".and.(.not.hazeconservch4)) then |
|---|
| 261 | zdqhaze(ig,:,igcm_ch4_gas)= zdqphot_ch4(ig,:) |
|---|
| 262 | endif |
|---|
| 263 | ENDDO |
|---|
| 264 | |
|---|
| 265 | ENDDO ! ngrid |
|---|
| 266 | |
|---|
| 267 | |
|---|
| 268 | !! tendency kg/m2/s for haze column: |
|---|
| 269 | ! zdqhaze_col(:)=0. |
|---|
| 270 | ! DO ig=1,ngrid |
|---|
| 271 | ! DO l=1,nlayer |
|---|
| 272 | ! zdqhaze_col(ig)=zdqhaze_col(ig)+zdqhaze(ig,l,igcm_haze)* & |
|---|
| 273 | ! (pplev(ig,l)-pplev(ig,l+1))/g |
|---|
| 274 | ! ENDDO |
|---|
| 275 | ! ENDDO |
|---|
| 276 | |
|---|
| 277 | end subroutine hazecloud |
|---|
| 278 | |
|---|
