Changeset 334 for trunk/LMDZ.MARS/libf/aeronomars
- Timestamp:
- Oct 28, 2011, 5:00:48 PM (13 years ago)
- Location:
- trunk/LMDZ.MARS/libf/aeronomars
- Files:
-
- 2 added
- 2 deleted
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.MARS/libf/aeronomars/calchim.F
r38 r334 1 1 subroutine calchim(ptimestep,pplay,pplev,pt,pdt,dist_sol,mu0, 2 $ zzlay,zday,pq,pdq,rice, 3 & dqchim,dqschim,dqcloud,dqscloud) 2 $ zzlev,zzlay,zday,pq,pdq,dqchim,dqschim,dqcloud, 3 $ dqscloud,tauref,co2ice, 4 $ pu,pdu,pv,pdv,surfdust,surfice) 4 5 c 5 6 implicit none … … 19 20 c update 03/05/2005 cosmetic changes (Franck Lefevre) 20 21 c update sept. 2008 identify tracers by their names (Ehouarn Millour) 22 c update 17/03/2011 synchronize with latest version of chemistry (Franck Lefevre) 21 23 c 22 24 c Arguments: … … 30 32 c pt(ngridmx,nlayermx) Temperature (K) 31 33 c pdt(ngridmx,nlayermx) Temperature tendency (K) 34 c pu(ngridmx,nlayermx) u component of the wind (ms-1) 35 c pdu(ngridmx,nlayermx) u component tendency (K) 36 c pv(ngridmx,nlayermx) v component of the wind (ms-1) 37 c pdv(ngridmx,nlayermx) v component tendency (K) 32 38 c dist_sol distance of the sun (AU) 33 39 c mu0(ngridmx) cos of solar zenith angle (=1 when sun at zenith) 34 40 c pq(ngridmx,nlayermx,nqmx) Advected fields, ie chemical species here 35 41 c pdq(ngridmx,nlayermx,nqmx) Previous tendencies on pq 36 c rice(ngridmx,nlayermx) Estimated ice crystal radius (m) 42 c tauref(ngridmx) Optical depth at 7 hPa 43 c co2ice(ngridmx) co2 ice surface layer (kg.m-2) 44 c surfdust(ngridmx,nlayermx) dust surface area (micron2/cm3) 45 c surfice(ngridmx,nlayermx) ice surface area (micron2/cm3) 37 46 c 38 47 c Output: … … 64 73 real zzlay(ngridmx,nlayermx) ! pressure at the middle of the layers 65 74 real pplev(ngridmx,nlayermx+1) ! intermediate pressure levels 75 real zzlev(ngridmx,nlayermx+1) ! altitude at layer boundaries 66 76 real pt(ngridmx,nlayermx) ! temperature 67 77 real pdt(ngridmx,nlayermx) ! temperature tendency 78 real pu(ngridmx,nlayermx) ! u component of the wind (m.s-1) 79 real pdu(ngridmx,nlayermx) ! u component tendency 80 real pv(ngridmx,nlayermx) ! v component of the wind (m.s-1) 81 real pdv(ngridmx,nlayermx) ! v component tendency 68 82 real dist_sol ! distance of the sun (AU) 69 real mu0(ngridmx) ! cos of solar zenith angle (=1 when sun at zenith)83 real mu0(ngridmx) ! cos of solar zenith angle (=1 when sun at zenith) 70 84 real pq(ngridmx,nlayermx,nqmx) ! tracers mass mixing ratio 71 85 real pdq(ngridmx,nlayermx,nqmx) ! previous tendencies 72 86 real zday ! date (time since Ls=0, in martian days) 73 real rice(ngridmx,nlayermx) ! Estimated ice crystal radius (m) 87 real tauref(ngridmx) ! optical depth at 7 hPa 88 real co2ice(ngridmx) ! co2 ice surface layer (kg.m-2) 89 real surfdust(ngridmx,nlayermx) ! dust surface area (micron2/cm3) 90 real surfice(ngridmx,nlayermx) ! ice surface area (micron2/cm3) 74 91 75 92 c outputs: … … 87 104 integer ig,l,i,iq 88 105 integer foundswitch, lswitch 106 integer ig_vl1 107 real latvl1, lonvl1 89 108 real zq(ngridmx,nlayermx,nqmx) ! pq+pdq*ptimestep before chemistry 90 109 ! new mole fraction after 91 real colden(ngridmx,nqmx) ! Column densities (cm-2)92 110 real zt(ngridmx,nlayermx) ! temperature 111 real zu(ngridmx,nlayermx) ! u component of the wind 112 real zv(ngridmx,nlayermx) ! v component of the wind 113 real taucol ! optical depth at 7 hPa 114 115 logical depos ! switch for dry deposition 116 parameter (depos=.false.) 93 117 c 94 118 c for each column of atmosphere: … … 100 124 real zycol(nlayermx,nqmx) ! Composition (mole fractions) 101 125 real szacol ! Solar zenith angle 126 real surfice1d(nlayermx) ! Ice surface area (cm2/cm3) 127 real surfdust1d(nlayermx) ! Dust surface area (cm2/cm3) 102 128 real jo3(nlayermx) ! Photodissociation rate O3->O1D (s-1) 103 129 c 104 130 c for output: 105 131 c 106 real zdens3d(ngridmx,nlayermx) ! Density (cm-3)107 132 real jo3_3d(ngridmx,nlayermx) ! Photodissociation rate O3->O1D (s-1) 108 real surfice(ngridmx,nlayermx) ! Surface of ice particules (um2/cm3)109 133 110 134 logical output ! to issue calls to writediagfi and stats … … 112 136 113 137 logical,save :: firstcall=.true. 114 integer,save :: nbq ! number of tracers used in the chemistry138 integer,save :: nbq ! number of tracers used in the chemistry 115 139 integer,save :: niq(nqmx) ! array storing the indexes of the tracers 116 140 117 141 ! index of tracers: 142 118 143 integer,save :: i_co2=0 119 144 integer,save :: i_co=0 … … 127 152 integer,save :: i_ho2=0 128 153 integer,save :: i_h2o2=0 154 integer,save :: i_ch4=0 129 155 integer,save :: i_n2=0 130 156 integer,save :: i_ar=0 131 157 integer,save :: i_ice=0 ! water ice 132 158 integer,save :: i_h2o=0 ! water vapour 133 134 c135 c scheme A: 1 ; scheme B: 2136 c137 integer,parameter :: scheme=2138 159 c 139 160 c======================================================================= … … 144 165 c 145 166 if (photochem) then 146 print*,'calchim: INIT CHEMISTRY' 147 if (scheme .eq. 1) then 148 print*,'calchim: Scheme A : A METTRE A JOUR !!' 149 stop 150 c call init_chimie_A 151 else 152 print*,'calchim: Scheme B' 153 call init_chimie_B 154 end if 167 print*,'calchim: Read photolysis lookup table' 168 call read_phototable 155 169 end if 156 170 … … 245 259 niq(nbq)=i_h2o2 246 260 endif 261 i_ch4=igcm_ch4 262 if (i_ch4.eq.0) then 263 write(*,*) "calchim: Error; no CH4 tracer !!!" 264 stop 265 else 266 nbq=nbq+1 267 niq(nbq)=i_ch4 268 endif 247 269 i_n2=igcm_n2 248 270 if (i_n2.eq.0) then … … 278 300 endif 279 301 280 write(*,*) 'calchim: found nbq=',nbq,' tracers' 281 write(*,*) ' i_co2=',i_co2 282 write(*,*) ' i_co=',i_co 283 write(*,*) ' i_o=',i_o 284 write(*,*) ' i_o1d=',i_o1d 285 write(*,*) ' i_o2=',i_o2 286 write(*,*) ' i_o3=',i_o3 287 write(*,*) ' i_h=',i_h 288 write(*,*) ' i_h2=',i_h2 289 write(*,*) ' i_oh=',i_oh 290 write(*,*) ' i_ho2=',i_ho2 291 write(*,*) ' i_h2o2=',i_h2o2 292 write(*,*) ' i_n2=',i_n2 293 write(*,*) ' i_ar=',i_ar 294 write(*,*) ' i_ice=',i_ice 295 write(*,*) ' i_h2o=',i_h2o 296 ! write(*,*) ' niq(:)=',niq 297 ! write(*,*) ' nqchem_min,nqmx=',nqchem_min,nqmx 302 write(*,*) 'calchim: found nbq = ',nbq,' tracers' 303 write(*,*) ' i_co2 = ',i_co2 304 write(*,*) ' i_co = ',i_co 305 write(*,*) ' i_o = ',i_o 306 write(*,*) ' i_o1d = ',i_o1d 307 write(*,*) ' i_o2 = ',i_o2 308 write(*,*) ' i_o3 = ',i_o3 309 write(*,*) ' i_h = ',i_h 310 write(*,*) ' i_h2 = ',i_h2 311 write(*,*) ' i_oh = ',i_oh 312 write(*,*) ' i_ho2 = ',i_ho2 313 write(*,*) ' i_h2o2 = ',i_h2o2 314 write(*,*) ' i_ch4 = ',i_ch4 315 write(*,*) ' i_n2 = ',i_n2 316 write(*,*) ' i_ar = ',i_ar 317 write(*,*) ' i_ice = ',i_ice 318 write(*,*) ' i_h2o = ',i_h2o 298 319 299 320 firstcall = .false. … … 302 323 ! Initialize output tendencies to zero (to handle case of tracers which 303 324 ! are not used in the chemistry (e.g. dust)) 304 dqchim(:,:,:)=0 305 dqschim(:,:)=0 306 307 325 326 dqchim(:,:,:) = 0 327 dqschim(:,:) = 0 328 c 329 ! latvl1= 22.27 330 ! lonvl1= -47.94 331 ! ig_vl1= 1+ int( (1.5-(latvl1-90.)*jjm/180.) -2 )*iim + 332 ! $ int(1.5+(lonvl1+180)*iim/360.) 308 333 c 309 334 c======================================================================= … … 317 342 foundswitch = 0 318 343 do l = 1,nlayermx 319 zt(ig,l)=pt(ig,l)+pdt(ig,l)*ptimestep 320 do i=1,nbq 321 iq=niq(i) ! get tracer index 344 do i = 1,nbq 345 iq = niq(i) ! get tracer index 322 346 zq(ig,l,iq) = pq(ig,l,iq) + pdq(ig,l,iq)*ptimestep 323 zycol(l,iq) = zq(ig,l,iq) * mmean(ig,l)/mmol(iq) 324 enddo 347 zycol(l,iq) = zq(ig,l,iq)*mmean(ig,l)/mmol(iq) 348 end do 349 zt(ig,l) = pt(ig,l) + pdt(ig,l)*ptimestep 350 zu(ig,l) = pu(ig,l) + pdu(ig,l)*ptimestep 351 zv(ig,l) = pv(ig,l) + pdv(ig,l)*ptimestep 352 c 325 353 zpress(l) = pplay(ig,l)/100. 326 354 ztemp(l) = zt(ig,l) … … 328 356 zlocal(l) = zzlay(ig,l)/1000. 329 357 c 330 c search for switch index between regions 358 c surfdust1d and surfice1d in cm2/cm3 359 c 360 surfdust1d(l) = surfdust(ig,l)*1.e-8 361 surfice1d(l) = surfice(ig,l)*1.e-8 362 c 363 c search for switch index between regions 331 364 c 332 365 if (photochem .and. thermochem) then … … 340 373 end if 341 374 if (.not. thermochem) then 342 lswitch = min( 33,nlayermx+1)375 lswitch = min(50,nlayermx+1) ! FL (original value: 33) 343 376 end if 344 377 c 345 c ice surface area in microns^2/cm^3346 c347 c = 4 pi r^2 * [ zq * mugaz/NA / (rhoice*4/3 pi r^3) ] *zdens348 c = 3/r * [ zq * mugaz/NA / rhoice ] *zdens349 c with r in microns, rhoice = 0.92e-12 g microns^-3 and zdens in cm^-3350 c351 if (water) then352 zycol(l,i_ice) = (3.e-6/rice(ig,l))*zq(ig,l,i_ice)353 $ *(mugaz/6.022e23)*zdens(l)/0.92e-12354 c write(*,*) "rice=",rice(ig,l)," m / zdens=",zdens(l),355 c $ " cm-3 / icesurf=",zycol(l,nqmx-1)," microns^2/cm^3"356 surfice(ig,l) = zycol(l,i_ice)357 end if358 c359 378 end do ! of do l=1,nlayermx 360 379 c 361 380 szacol = acos(mu0(ig))*180./pi 381 taucol = tauref(ig) 362 382 c 363 383 c======================================================================= … … 365 385 c======================================================================= 366 386 c 367 if (photochem) then 368 if (scheme .eq. 1) then 369 print*,'Scheme A : A METTRE A JOUR !!' 370 c call photochemist_A(zycol,szacol,ptimestep, 371 c $ zpress,ztemp,zdens,dist_sol) 372 else 373 call photochemist_B(lswitch,zycol,szacol,ptimestep, 374 $ zpress,ztemp,zdens,dist_sol,jo3) 375 end if 376 end if 377 378 if (thermochem) then 379 call chemthermos(ig,lswitch,zycol,ztemp,zdens,zpress, 380 $ zlocal,szacol,ptimestep,zday) 381 end if 387 c chemistry in lower atmosphere 388 c 389 if (photochem) then 390 call photochemistry(lswitch,zycol,szacol,ptimestep, 391 $ zpress,ztemp,zdens,dist_sol, 392 $ surfdust1d,surfice1d,jo3,taucol) 393 end if 394 c 395 c chemistry in upper atmosphere 396 c 397 if (thermochem) then 398 call chemthermos(ig,lswitch,zycol,ztemp,zdens,zpress, 399 $ zlocal,szacol,ptimestep,zday) 400 end if 401 c 402 c dry deposition 403 c 404 if (depos) then 405 call deposition(ig, ig_vl1, pplay, pplev, zzlay, zzlev, 406 $ zu, zv, zt, zycol, ptimestep, co2ice) 407 end if 382 408 c 383 409 c======================================================================= … … 389 415 if (water) then 390 416 do l = 1,nlayermx 391 ! dqchim(ig,l,nqmx-1) = 0.392 417 dqchim(ig,l,i_ice) = 0. 393 418 end do … … 425 450 $ - zq(ig,l,iq))/ptimestep 426 451 else if (iq.eq.i_o) then 427 ! i_o = iq428 452 dqchim(ig,l,iq) = 0. 429 453 end if … … 440 464 end do ! of do l = 1,nlayermx 441 465 c 442 c dust: This is now taken care of as a first step at beginning of routine443 c444 ! if (nqchem_min .gt. 1) then445 ! do iq = 1,nqchem_min-1446 ! do l = 1,nlayermx447 ! dqchim(ig,l,iq) = 0.448 ! end do449 ! dqschim(ig,iq) = 0.450 ! end do451 ! end if452 c453 466 c condensation of h2o2 454 467 c … … 456 469 $ ztemp,zycol,dqcloud,dqscloud) 457 470 c 458 c for outputs459 c460 do i=1,nbq461 iq=niq(i) ! get tracer index462 colden(ig,iq) = 0.463 do l = 1,nlayermx464 c465 c column density converted in cm-2466 c pplev en pa, mugaz en g.mol-1 et g en m.s-2467 c not for ice468 c469 if (iq.ne.i_h2o2) then470 colden(ig,iq) = colden(ig,iq) + zycol(l,iq)471 $ *6.022e22*(pplev(ig,l)-pplev(ig,l+1))472 $ /(mmean(ig,l)*g)473 else ! for H2O2, remove condensation from zycol474 colden(ig,iq) = colden(ig,iq) + (zycol(l,iq) +475 $ dqcloud(ig,l,iq)*ptimestep*mmean(ig,l)/mmol(iq))476 $ *6.022e22*(pplev(ig,l)-pplev(ig,l+1))477 $ /(mmean(ig,l)*g)478 end if479 c480 c local densities, for outputs (put in zq)481 c not for ice482 c483 zq(ig,l,iq) = zycol(l,iq)*zdens(l)484 c for H2O2, remove condensation from zycol485 if (iq.eq.i_h2o2) then486 zq(ig,l,iq) = zdens(l)*(zycol(l,iq) +487 $ dqcloud(ig,l,iq)*ptimestep*mmean(ig,l)/mmol(iq))488 end if489 end do490 end do491 c492 471 c density and j(o3->o1d), for outputs 493 472 c 494 zdens3d(ig,1) = zdens(1) 495 jo3_3d(ig,1) = jo3(1) 496 do l = 2,nlayermx 497 zdens3d(ig,l) = zdens(l) 473 do l = 1,nlayermx 498 474 jo3_3d(ig,l) = jo3(l) 499 475 end do … … 513 489 514 490 if (output) then 515 516 491 if (ngridmx .gt. 1) then 517 c call writediagfi(ngridmx,'dens','atm dens.','cm-3',3,zdens3d(1,1)) 518 c call writediagfi(ngridmx,'jo3','j o3->o1d','s-1',3,jo3_3d(1,1)) 519 c call writediagfi(ngridmx,'sice','ice surf.','um2/cm3',3,surfice(1,1)) 520 do i=1,nbq 521 iq=niq(i) ! get tracer index 522 if (iq.ne.i_ice) then 523 write(str20(1:20),'(a20)') noms(iq) 524 call writediagfi(ngridmx,'n_'//trim(str20),'density', 525 $ 'cm-3',3,zq(1,1,iq)) 526 c call writediagfi(ngridmx,'dqch_'//str5,'density','cm-3',3,dqchim(1,1,iq)) 527 c if (noms(iq) .eq. "h2o2" .or. noms(iq) .eq. "h2o") then 528 c call writediagfi(ngridmx,'cl_'//str5,'density','cm-3',3,dqcloud(1,1,iq)) 529 c end if 530 call writediagfi(ngridmx,'c_'//trim(str20), 531 $ 'col. dens.','cm-2',2,colden(1,iq)) 532 end if 533 end do 534 c 535 if (callstats) then 536 c 537 c convert to mole.cm-2 for the column densities 538 c 539 do i=1,nbq 540 iq=niq(i) ! get tracer index 541 do ig = 1,ngridmx 542 colden(ig,iq) = colden(ig,iq)/6.022e23 543 end do 544 end do 545 c 546 c call wstats(ngridmx,"jo3","jo3->o1d","s-1",3,jo3_3d) 547 c 548 do i=1,nbq 549 iq=niq(i) ! get tracer index 550 if (iq.ne.i_ice) then 551 write(str20(1:20),'(a20)') noms(iq) 552 call wstats(ngridmx,"n_"//trim(str20),"density", 553 & "cm-3",3,zq(1,1,iq)) 554 call wstats(ngridmx,"c_"//trim(str20),"col. dens.", 555 & "mol cm-2",2,colden(1,iq)) 556 end if 557 end do ! of i=1,nbq 558 end if ! of if (callstats) 492 call writediagfi(ngridmx,'jo3','j o3->o1d', 493 $ 's-1',3,jo3_3d(1,1)) 494 call wstats(ngridmx,'jo3','j o3->o1d', 495 $ 's-1',3,jo3_3d(1,1)) 559 496 end if ! of if (ngridmx.gt.1) 560 c561 497 endif ! of if (output) 562 498 c -
trunk/LMDZ.MARS/libf/aeronomars/chimiedata.h
r38 r334 2 2 c --- Data for chemical routines --- 3 3 c ------------------------------------ 4 c Author: Sebastien Lebonnois5 c Franck Lefevre6 c7 c Update after water clouds included8 c ------------------------------------9 4 c 10 integer nd, nozo, nr, nsza, ntemp5 integer nd, nozo, nr, nsza, ntemp, ntau 11 6 c 12 parameter (nd = 11)7 parameter (nd = 29) 13 8 parameter (nozo = 7) 14 9 parameter (nr = nd + 28) 15 10 parameter (nsza = 27) 16 11 parameter (ntemp = 4) 12 parameter (ntau = 8) 17 13 c 18 real 19 parameter (kb = 1.38 e-23)14 real kb 15 parameter (kb = 1.3806e-23) 20 16 c 21 c factor: molecular gas constant/(boltzmann*gravity) 17 common/chimiedata/jphot,colairtab,table_ozo 22 18 c 23 real factor 24 parameter (factor = 192./(kb*1.e4*3.72)) 19 real jphot(ntemp,nsza,0:200,nozo,ntau,nd) 20 real colairtab(0:200) 21 real szatab(nsza) 22 real table_ozo(nozo) 23 real tautab(ntau) 25 24 c 26 common/chimiedata/reactifs,nprod,nperte,prod,perte,jphot, 27 $ colairtab,table_ozo 25 data szatab/0., 5., 10., 15., 20., 25., 26 $ 30., 35., 40., 45., 50., 55., 27 $ 60., 65., 70., 75., 80., 82., 28 $ 84., 86., 88., 90., 91., 92., 29 $ 93., 94., 95./ 28 30 c 29 c used in obsolete scheme A : 30 integer reactifs(nr,5),nprod(nqmx),nperte(nqmx) 31 integer prod(nqmx,100),perte(nqmx,100,2) 32 c 33 c VERSION: 28/05/2004 (update: Ar) 34 c 35 c photodissociation rates matrix: version dependent 36 c for this version, file jmars.20030707 37 c 38 real jphot(ntemp,nsza,0:200,nozo,nd) 39 real colairtab(0:200) 40 real szatab(nsza) 41 real table_ozo(nozo) 42 c 43 data szatab/0., 5., 10., 15., 20., 25., 44 $ 30., 35., 40., 45., 50., 55., 45 $ 60., 65., 70., 75., 80., 82., 46 $ 84., 86., 88., 90., 91., 92., 47 $ 93., 94., 95./ 48 c 49 c compounds taken into account: version dependent 50 c DOES NOT INCLUDE h2o NOR water ice 31 data tautab/0., 0.2, 0.4, 0.6, 0.8, 1., 2., 4./ 51 32 c 52 33 integer ncomp 53 parameter (ncomp =13)34 parameter (ncomp = 15) 54 35 character*10 nomchem(ncomp) 55 36 data nomchem/"co2","co","o","o1d","o2","o3","h","h2", 56 $ "oh","ho2","h2o2", "n2", "ar"/37 $ "oh","ho2","h2o2", "ch4", "n2", "ar", "h2o"/ 57 38 c 58 real 59 data mmolchem/44.,28.,16.,16.,32.,48.,1.,2.,17.,33.,34.,28.,40./60 39 real mmolchem(ncomp) 40 data mmolchem/44.,28.,16.,16.,32.,48., 1., 41 $ 2.,17.,33.,34.,16.,28.,40.,18./
Note: See TracChangeset
for help on using the changeset viewer.