Changeset 2199
- Timestamp:
- Dec 13, 2019, 2:06:35 PM (5 years ago)
- Location:
- trunk/LMDZ.MARS
- Files:
-
- 1 added
- 15 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.MARS/README
r2189 r2199 2798 2798 surface tracers) in co2condens. 2799 2799 2800 2800 == 13/12/2019 == MV 2801 Implementation of a new parametrization of the dust entrainment by slope winds above the sub-grid scale topography. The parametrization is activated with the flag slpwind=.true. (set to "false" by default) in callphys.def. The new parametrization involves the new tracers topdust_mass and topdust_number. -
trunk/LMDZ.MARS/libf/phymars/aeropacity_mod.F
r2161 r2199 9 9 & QREFvis3d,QREFir3d,omegaREFir3d, 10 10 & totstormfract,clearatm,dsords, 11 & alpha_hmons,nohmons, 11 12 & clearsky,totcloudfrac) 12 13 … … 15 16 use tracer_mod, only: noms, igcm_h2o_ice, igcm_dust_mass, 16 17 & igcm_dust_submicron, rho_dust, rho_ice, 17 & nqdust, igcm_stormdust_mass 18 & nqdust, igcm_stormdust_mass, 19 & igcm_topdust_mass 18 20 use geometry_mod, only: latitude ! grid point latitudes (rad) 19 21 use comgeomfi_h, only: sinlat ! sines of grid point latitudes … … 28 30 & iaer_dust_conrath,iaer_dust_doubleq, 29 31 & iaer_dust_submicron,iaer_h2o_ice, 30 & iaer_stormdust_doubleq 32 & iaer_stormdust_doubleq, 33 & iaer_topdust_doubleq 31 34 USE calcstormfract_mod 32 35 IMPLICIT NONE … … 94 97 LOGICAL, INTENT(IN) :: clearatm 95 98 REAL, INTENT(IN) :: totstormfract(ngrid) 99 LOGICAL, INTENT(IN) :: nohmons 100 REAL, INTENT(IN) :: alpha_hmons(ngrid) 96 101 REAL, INTENT(OUT) :: tauscaling(ngrid) ! Scaling factor for qdust and Ndust 97 102 REAL,INTENT(IN) :: totcloudfrac(ngrid) ! total cloud fraction … … 176 181 txt=name_iaer(iaer) 177 182 ! CW17: choice tauscaling for stormdust or not 178 IF ((txt(1:4).eq."dust").OR.(txt(1:5).eq."storm")) THEN 183 IF ((txt(1:4).eq."dust").OR.(txt(1:5).eq."storm") 184 & .OR.(txt(1:3).eq."top")) THEN !MV19: topdust tracer 179 185 naerdust=naerdust+1 180 186 iaerdust(naerdust)=iaer … … 517 523 ENDIF 518 524 c================================================================== 525 CASE("topdust_doubleq") aerkind ! MV18 : Two-moment scheme for 526 c topdust (transport of mass and number mixing ratio) 527 c================================================================== 528 c aerosol is calculated twice : once "above" the sub-grid mountain (nohmons=false) 529 c and once in the part of the mesh without the sub-grid mountain (nohmons=true) 530 aerosol(1:ngrid,1:nlayer,iaer) = 0. 531 IF (nohmons) THEN ! considering part of the mesh without storm 532 aerosol(1:ngrid,1:nlayer,iaer)=1.e-25 533 ELSE ! part of the mesh with concentred dust storm 534 DO l=1,nlayer 535 ! IF (l.LE.cstdustlevel) THEN 536 !c Opacity in the first levels is held constant to 537 !c avoid unrealistic values due to constant lifting: 538 ! DO ig=1,ngrid 539 ! aerosol(ig,l,iaer) = 540 ! & ( 0.75 * QREFvis3d(ig,cstdustlevel,iaer) / 541 ! & ( rho_dust * reffrad(ig,cstdustlevel,iaer) ) ) * 542 ! & pq(ig,cstdustlevel,igcm_topdust_mass) * 543 ! & ( pplev(ig,l) - pplev(ig,l+1) ) / g 544 ! ENDDO 545 ! ELSE 546 DO ig=1,ngrid 547 aerosol(ig,l,iaer) = 548 & ( 0.75 * QREFvis3d(ig,l,iaer) / 549 & ( rho_dust * reffrad(ig,l,iaer) ) ) * 550 & pq(ig,l,igcm_topdust_mass) * 551 & ( pplev(ig,l) - pplev(ig,l+1) ) / g 552 ENDDO 553 ! ENDIF 554 555 ENDDO 556 ENDIF 557 c================================================================== 519 558 END SELECT aerkind 520 559 c ----------------------------------- … … 733 772 ENDIF 734 773 #endif 735 tauref(ig) = tauref(ig) + 736 & aerosol(ig,l,iaerdust(iaer)) 774 ! tauref(ig) = tauref(ig) + 775 ! & aerosol(ig,l,iaerdust(iaer)) 776 c MV19: tauref must ALWAYS contain the opacity of all dust tracers 777 IF (name_iaer(iaerdust(iaer)).eq."dust_doubleq") THEN 778 tauref(ig) = tauref(ig) + 779 & ( 0.75 * QREFvis3d(ig,l,iaerdust(iaer)) / 780 & ( rho_dust * reffrad(ig,l,iaerdust(iaer)) ) ) * 781 & pq(ig,l,igcm_dust_mass) * 782 & ( pplev(ig,l) - pplev(ig,l+1) ) / g 783 ELSE IF (name_iaer(iaerdust(iaer)).eq."stormdust_doubleq") THEN 784 tauref(ig) = tauref(ig) + 785 & ( 0.75 * QREFvis3d(ig,l,iaerdust(iaer)) / 786 & ( rho_dust * reffrad(ig,l,iaerdust(iaer)) ) ) * 787 & pq(ig,l,igcm_stormdust_mass) * 788 & ( pplev(ig,l) - pplev(ig,l+1) ) / g 789 ELSE IF (name_iaer(iaerdust(iaer)).eq."topdust_doubleq") THEN 790 tauref(ig) = tauref(ig) + 791 & ( 0.75 * QREFvis3d(ig,l,iaerdust(iaer)) / 792 & ( rho_dust * reffrad(ig,l,iaerdust(iaer)) ) ) * 793 & pq(ig,l,igcm_topdust_mass) * 794 & ( pplev(ig,l) - pplev(ig,l+1) ) / g 795 ENDIF 796 737 797 ENDDO 738 798 ENDDO … … 821 881 822 882 c ----------------------------------------------------------------- 823 c -----------------------------------------------------------------824 883 c aerosol/X for stormdust to prepare calculation of radiative transfer 825 884 c ----------------------------------------------------------------- 826 if (rdstorm) then885 IF (rdstorm) THEN 827 886 DO l=1,nlayer 828 887 DO ig=1,ngrid 888 ! stormdust: opacity relative to the storm fraction (stormdust/x) 829 889 aerosol(ig,l,iaer_stormdust_doubleq) = 830 890 & aerosol(ig,l,iaer_stormdust_doubleq)/totstormfract(ig) 831 891 ENDDO 832 892 ENDDO 833 endif 834 893 ENDIF 894 895 c ----------------------------------------------------------------- 896 c aerosol/X for topdust to prepare calculation of radiative transfer 897 c ----------------------------------------------------------------- 898 IF (slpwind) THEN 899 DO ig=1,ngrid 900 IF (alpha_hmons(ig) .gt. 0.) THEN 901 DO l=1,nlayer 902 ! topdust: opacity relative to the storm fraction (topdust/x) 903 aerosol(ig,l,iaer_topdust_doubleq) = 904 & aerosol(ig,l,iaer_topdust_doubleq)/alpha_hmons(ig) 905 ENDDO 906 ENDIF 907 ENDDO 908 ENDIF 835 909 836 910 END SUBROUTINE aeropacity -
trunk/LMDZ.MARS/libf/phymars/callkeys.h
r2179 r2199 15 15 & ,calltherm,callrichsl,callslope,tituscap,callyamada4,co2clouds & 16 16 & ,co2useh2o,meteo_flux,CLFvaryingCO2,spantCO2,CLFvarying & 17 & ,satindexco2,rdstorm, calllott_nonoro,latentheat17 & ,satindexco2,rdstorm,slpwind,calllott_nonoro,latentheat 18 18 19 19 COMMON/callkeys_i/iradia,iaervar,iddist,ilwd,ilwb,ilwn,ncouche & … … 66 66 logical active,doubleq,submicron,lifting,callddevil,scavenging 67 67 logical rdstorm ! rocket dust storm parametrization 68 logical slpwind ! entrainment by slope wind parametrization 68 69 logical latentheat ! latent heat release from ground water ice sublimation/condensation 69 70 logical sedimentation -
trunk/LMDZ.MARS/libf/phymars/callradite_mod.F
r1983 r2199 9 9 $ dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw, 10 10 $ fluxtop_sw,tauref,tau,aerosol,dsodust,tauscaling, 11 $ taucloudtes,rdust,rice,nuice,co2ice,rstormdust, 12 $ totstormfract,clearatm,dsords, 11 $ taucloudtes,rdust,rice,nuice,co2ice,rstormdust,rtopdust, 12 $ totstormfract,clearatm,dsords,alpha_hmons,nohmons, 13 13 $ clearsky,totcloudfrac) 14 14 … … 19 19 & iaer_dust_conrath,iaer_dust_doubleq, 20 20 & iaer_dust_submicron,iaer_h2o_ice, 21 & iaer_stormdust_doubleq 21 & iaer_stormdust_doubleq,iaer_topdust_doubleq 22 22 use yomlw_h, only: gcp, nlaylte 23 23 use comcstfi_h, only: g,cpp … … 205 205 REAL dsords(ngrid,nlayer) ! density scaled opacity for rocket dust storm dust 206 206 207 c entrainment by slope wind 208 LOGICAL, INTENT(IN) :: nohmons ! true for background dust 209 REAL, INTENT(IN) :: alpha_hmons(ngrid) ! sub-grid scale topography mesh fraction 210 REAL,INTENT(OUT) :: rtopdust(ngrid,nlayer) ! Topdust geometric mean radius (m) 211 207 212 c sub-grid scale water ice clouds 208 213 LOGICAL,INTENT(IN) :: clearsky … … 304 309 iaer_h2o_ice=0 305 310 iaer_stormdust_doubleq=0 311 iaer_topdust_doubleq=0 306 312 307 313 aer_count=0 … … 342 348 if (name_iaer(iaer).eq."stormdust_doubleq") then 343 349 iaer_stormdust_doubleq = iaer 350 aer_count = aer_count + 1 351 endif 352 enddo 353 end if 354 if (slpwind.AND.active) then 355 do iaer=1,naerkind 356 if (name_iaer(iaer).eq."topdust_doubleq") then 357 iaer_topdust_doubleq = iaer 344 358 aer_count = aer_count + 1 345 359 endif … … 392 406 c Updating aerosol size distributions: 393 407 CALL updatereffrad(ngrid,nlayer, 394 & rdust,rstormdust,r ice,nuice,408 & rdust,rstormdust,rtopdust,rice,nuice, 395 409 & reffrad,nueffrad, 396 410 & pq,tauscaling,tau,pplay) … … 408 422 & QREFvis3d,QREFir3d,omegaREFir3d, 409 423 & totstormfract,clearatm,dsords, 424 & alpha_hmons,nohmons, 410 425 & clearsky,totcloudfrac) 411 426 -
trunk/LMDZ.MARS/libf/phymars/callsedim_mod.F
r1983 r2199 6 6 7 7 SUBROUTINE callsedim(ngrid,nlay,ptimestep, 8 & pplev,zlev,zlay,pt,pdt,rdust,rstormdust,rice, 9 & rsedcloud,rhocloud, 8 & pplev,zlev,zlay,pt,pdt, 9 & rdust,rstormdust,rtopdust, 10 & rice,rsedcloud,rhocloud, 10 11 & pq,pdqfi,pdqsed,pdqs_sed,nq, 11 12 & tau,tauscaling) … … 19 20 & igcm_ccnco2_mass,igcm_ccnco2_number, 20 21 & igcm_co2_ice, igcm_stormdust_mass, 21 & igcm_stormdust_number 22 & igcm_stormdust_number,igcm_topdust_mass, 23 & igcm_topdust_number 22 24 USE newsedim_mod, ONLY: newsedim 23 25 USE comcstfi_h, ONLY: g … … 64 66 real,intent(out) :: rdust(ngrid,nlay) ! Dust geometric mean radius (m) 65 67 real,intent(out) :: rstormdust(ngrid,nlay) ! Stormdust geometric mean radius (m) 68 real,intent(out) :: rtopdust(ngrid,nlay) ! topdust geometric mean radius (m) 66 69 real,intent(out) :: rice(ngrid,nlay) ! H2O Ice geometric mean radius (m) 67 70 c Sedimentation radius of water ice … … 94 97 real r0stormdust(ngrid,nlay) ! Geometric mean radius used for stormdust (m) 95 98 ! ! CCNs (m) 99 real r0topdust(ngrid,nlay) ! Geometric mean radius used for topdust (m) 100 ! ! CCNs (m) 96 101 real,save :: beta ! correction for the shape of the ice particles (cf. newsedim) 97 102 c for ice radius computation … … 138 143 !stormdust mass mix. ratio 139 144 INTEGER,SAVE :: istormdust_number ! index of tracer containing 140 !stormdust number mix. ratio 145 !stormdust number mix. ratio 146 INTEGER,SAVE :: itopdust_mass ! index of tracer containing 147 !topdust mass mix. ratio 148 INTEGER,SAVE :: itopdust_number ! index of tracer containing 149 !topdust number mix. ratio 141 150 INTEGER,SAVE :: iccnco2_number ! index of tracer containing CCN number 142 151 INTEGER,SAVE :: iccnco2_mass ! index of tracer containing CCN number … … 283 292 endif 284 293 ENDIF !of if (rdstorm) 285 294 295 IF (slpwind) THEN ! identifying topdust tracers for sedimentation 296 itopdust_mass=0 ! dummy initialization 297 itopdust_number=0 ! dummy initialization 298 299 do iq=1,nq 300 if (noms(iq).eq."topdust_mass") then 301 itopdust_mass=iq 302 write(*,*)"callsedim: itopdust_mass=",itopdust_mass 303 endif 304 if (noms(iq).eq."topdust_number") then 305 itopdust_number=iq 306 write(*,*)"callsedim: itopdust_number=", 307 & itopdust_number 308 endif 309 enddo 310 311 ! check that we did find the tracers 312 if ((itopdust_mass.eq.0).or.(itopdust_number.eq.0)) then 313 write(*,*) 'callsedim: error! could not identify' 314 write(*,*) ' tracers for topdust mass and number mixing' 315 write(*,*) ' ratio and slpwind is activated!' 316 stop 317 endif 318 ENDIF !of if (slpwind) 319 286 320 firstcall=.false. 287 321 ENDIF ! of IF (firstcall) … … 325 359 end do 326 360 endif 327 !rocket dust storm361 c rocket dust storm 328 362 if (rdstorm) then 329 363 do l=1,nlay … … 337 371 end do 338 372 endif 373 c entrainment by slope wind 374 if (slpwind) then 375 do l=1,nlay 376 do ig=1, ngrid 377 378 call updaterdust(zqi(ig,l,igcm_topdust_mass), 379 & zqi(ig,l,igcm_topdust_number),r0topdust(ig,l), 380 & tauscaling(ig)) 381 382 end do 383 end do 384 endif 339 385 c ================================================================= 340 386 do iq=1,nq … … 346 392 c DOUBLEQ CASE 347 393 c ----------------------------------------------------------------- 348 if ( (doubleq.and.394 if ( doubleq.and. 349 395 & ((iq.eq.idust_mass).or.(iq.eq.idust_number).or. 350 & (iq.eq.istormdust_mass).or.(iq.eq.istormdust_number)))) then 396 & (iq.eq.istormdust_mass).or.(iq.eq.istormdust_number).or. 397 & (iq.eq.itopdust_mass).or.(iq.eq.itopdust_number)) ) then 351 398 352 399 c Computing size distribution: … … 366 413 end do 367 414 end do 415 else if ((iq.eq.itopdust_mass).or. 416 & (iq.eq.itopdust_number)) then 417 do l=1,nlay 418 do ig=1, ngrid 419 r0(ig,l)=r0topdust(ig,l) 420 end do 421 end do 368 422 endif 369 423 sigma0 = varian … … 371 425 c Computing mass mixing ratio for each particle size 372 426 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 373 IF ((iq.EQ.idust_mass).or.(iq.EQ.istormdust_mass)) then 427 IF ((iq.EQ.idust_mass).or.(iq.EQ.istormdust_mass) 428 & .or.(iq.EQ.itopdust_mass)) then 374 429 radpower = 2 375 430 ELSE ! number … … 514 569 ENDDO 515 570 endif ! of if (rdstorm) 571 572 if (slpwind) then 573 DO l = 1, nlay 574 DO ig=1,ngrid 575 call updaterdust(zqi(ig,l,igcm_topdust_mass), 576 & zqi(ig,l,igcm_topdust_number),rtopdust(ig,l), 577 & tauscaling(ig)) 578 ENDDO 579 ENDDO 580 endif ! of if (slpwind) 516 581 517 582 c Update the ice particle size "rice" -
trunk/LMDZ.MARS/libf/phymars/conf_phys.F
r2184 r2199 298 298 write(*,*)" coeff_detrainment = ",coeff_detrainment 299 299 300 ! entrainment by slope wind scheme 301 write(*,*)"call slope wind lifting parametrization" 302 slpwind=.false. ! default value 303 call getin("slpwind",slpwind) 304 write(*,*)" slpwind = ",slpwind 305 300 306 ! latent heat release from ground water ice sublimation/condensation 301 307 write(*,*)"latent heat release during sublimation", … … 430 436 endif 431 437 endif 432 ! rocket dust storm 438 ! rocket dust storm and entrainment by slope wind 433 439 ! Test of incompatibility: 434 ! if rdstorm is used, then doubleq should be true 435 if (rdstorm.and..not.doubleq) then 436 print*,'if rdstorm is used, then doubleq should be used !' 437 stop 438 endif 439 if (rdstorm.and..not.active) then 440 print*,'if rdstorm is used, then active should be used !' 440 ! if rdstorm or slpwind is used, then doubleq should be true 441 if ((rdstorm.or.slpwind).and..not.doubleq) then 442 print*,'if rdstorm or slpwind is used, then doubleq 443 & should be used !' 444 stop 445 endif 446 if ((rdstorm.or.slpwind).and..not.active) then 447 print*,'if rdstorm or slpwind is used, then active 448 & should be used !' 441 449 stop 442 450 endif 443 451 if (rdstorm.and..not.lifting) then 444 print*,'if rdstorm is used, then lifting should be used !' 445 stop 446 endif 447 if (rdstorm.and..not.freedust) then 448 print*,'if rdstorm is used, then freedust should be used !' 452 print*,'if rdstorm is used, then lifting 453 & should be used !' 454 stop 455 endif 456 if ((rdstorm.or.slpwind).and..not.freedust) then 457 print*,'if rdstorm or slpwind is used, then freedust 458 & should be used !' 449 459 stop 450 460 endif 451 461 if (rdstorm.and.(dustinjection.eq.0)) then 452 print*,'if rdstorm is used, then dustinjection should453 & be used !'462 print*,'if rdstorm is used, then dustinjection 463 & should be used !' 454 464 stop 455 465 endif … … 765 775 ! and picky compilers who know name_iaer(2) is out of bounds 766 776 j=2 767 IF (rdstorm.AND..NOT.activice ) name_iaer(2) =777 IF (rdstorm.AND..NOT.activice.AND..NOT.slpwind) name_iaer(2) = 768 778 & "stormdust_doubleq" !! storm dust two-moment scheme 769 IF (rdstorm.AND.water.AND.activice) name_iaer(3) = 770 & "stormdust_doubleq" 779 IF (rdstorm.AND.water.AND.activice.AND..NOT.slpwind) 780 & name_iaer(3) = "stormdust_doubleq" 781 IF (slpwind.AND..NOT.activice.AND..NOT.rdstorm) name_iaer(2) = 782 & "topdust_doubleq" !! storm dust two-moment scheme 783 IF (slpwind.AND.water.AND.activice.AND..NOT.rdstorm) 784 & name_iaer(3) = "topdust_doubleq" 785 IF (rdstorm.AND.slpwind.AND..NOT.activice) THEN 786 name_iaer(2) = "stormdust_doubleq" 787 name_iaer(3) = "topdust_doubleq" 788 ENDIF 789 IF (rdstorm.AND.slpwind.AND.water.AND.activice) THEN 790 name_iaer(3) = "stormdust_doubleq" 791 name_iaer(4) = "topdust_doubleq" 792 ENDIF 771 793 IF (water.AND.activice) name_iaer(j) = "h2o_ice" !! radiatively-active clouds 772 794 IF (submicron.AND.active) name_iaer(j) = "dust_submicron" !! JBM experimental stuff -
trunk/LMDZ.MARS/libf/phymars/dimradmars_mod.F90
r1974 r2199 33 33 ! particles 34 34 integer iaer_stormdust_doubleq ! Storm dust profile is given by the 35 ! mass mixing ratio of the two moment scheme 36 ! method (doubleq) 37 integer iaer_topdust_doubleq ! top dust profile is given by the 35 38 ! mass mixing ratio of the two moment scheme 36 39 ! method (doubleq) -
trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F
r2167 r2199 556 556 zsig(1)=0.E+0 557 557 zgam(1)=0.E+0 558 zthe(1)=0.E+0 558 zthe(1)=0.E+0 559 c 560 c for the slope wind scheme 561 c --------------------------------- 562 c 559 563 hmons(1)=0.E+0 564 PRINT *,'hmons is initialized to ',hmons(1) 560 565 summit(1)=0.E+0 566 PRINT *,'summit is initialized to ',summit(1) 561 567 base(1)=0.E+0 562 568 c 569 c Default values initializing the coefficients calculated later 570 c --------------------------------- 571 c 572 tauscaling(1)=1. ! calculated in aeropacity_mod.F 573 totcloudfrac(1)=1. ! calculated in watercloud_mod.F 574 563 575 c Specific initializations for "physiq" 564 576 c ------------------------------------- -
trunk/LMDZ.MARS/libf/phymars/initracer.F
r1974 r2199 72 72 igcm_stormdust_mass=0 73 73 igcm_stormdust_number=0 74 igcm_topdust_mass=0 75 igcm_topdust_number=0 74 76 igcm_co2=0 75 77 igcm_co=0 … … 161 163 endif 162 164 enddo 163 endif ! of if (rdstorm) 165 endif ! of if (rdstorm) 166 if (slpwind) then 167 do iq=1,nq 168 if (noms(iq).eq."topdust_mass") then 169 igcm_topdust_mass=iq 170 count=count+1 171 endif 172 if (noms(iq).eq."topdust_number") then 173 igcm_topdust_number=iq 174 count=count+1 175 endif 176 enddo 177 endif ! of if (slpwind) 164 178 ! 2. find chemistry and water tracers 165 179 do iq=1,nq … … 480 494 radius(igcm_stormdust_number) = reff_storm 481 495 end if !(rdstorm) 496 !c ---------------------------------------------------------------------- 497 !c slope wind scheme 498 !c you need a radius value for topdust to active its sedimentation 499 !c we take the same value as for the normal dust 500 if (slpwind) then 501 rho_q(igcm_topdust_mass)=rho_dust 502 rho_q(igcm_topdust_number)=rho_dust 503 radius(igcm_topdust_mass) = 3.e-6 504 radius(igcm_topdust_number) = 3.e-6 505 end if !(slpwind) 482 506 !c ---------------------------------------------------------------------- 483 507 … … 676 700 write(*,*) " cannot use rdstorm option without ", 677 701 & "a stormdust_number tracer !" 702 stop 703 endif 704 endif 705 706 if (slpwind) then 707 ! verify that we indeed have topdust_mass and topdust_number tracers 708 if (igcm_topdust_mass.eq.0) then 709 write(*,*) "initracer: error !!" 710 write(*,*) " cannot use slpwind option without ", 711 & "a topdust_mass tracer !" 712 stop 713 endif 714 if (igcm_topdust_number.eq.0) then 715 write(*,*) "initracer: error !!" 716 write(*,*) " cannot use slpwind option without ", 717 & "a topdust_number tracer !" 678 718 stop 679 719 endif -
trunk/LMDZ.MARS/libf/phymars/phys_state_var_init_mod.F90
r2162 r2199 49 49 use rocketduststorm_mod, only: ini_rocketduststorm_mod, & 50 50 end_rocketduststorm_mod 51 use topmons_mod, only: ini_topmons_mod, & 52 end_topmons_mod 51 53 use calchim_mod, only: ini_calchim_mod,end_calchim_mod 52 54 use watercloud_mod, only: ini_watercloud_mod, & … … 120 122 call end_rocketduststorm_mod 121 123 call ini_rocketduststorm_mod(ngrid) 122 124 125 ! allocate arrays in "topmons_mod": 126 call end_topmons_mod 127 call ini_topmons_mod(ngrid,nlayer) 128 123 129 ! allocate arrays in "calchim_mod" (aeronomars) 124 130 call end_calchim_mod -
trunk/LMDZ.MARS/libf/phymars/physiq_mod.F
r2184 r2199 24 24 use rocketduststorm_mod, only: rocketduststorm, dustliftday 25 25 use calcstormfract_mod, only: calcstormfract 26 use topmons_mod, only: topmons,alpha_hmons 26 27 use tracer_mod, only: noms, mmol, igcm_co2, igcm_n2, igcm_co2_ice, 27 28 & igcm_co, igcm_o, igcm_h2o_vap, igcm_h2o_ice, … … 32 33 & nuice_ref, rho_ice, rho_dust, ref_r0, 33 34 & igcm_he, igcm_stormdust_mass, 34 & igcm_stormdust_number 35 & igcm_stormdust_number, igcm_topdust_mass, 36 & igcm_topdust_number 35 37 use comsoil_h, only: inertiedat, ! soil thermal inertia 36 38 & tsoil, nsoilmx ! number of subsurface layers … … 275 277 ! - in a mesh with stormdust and background dust (false) 276 278 ! - in a mesh with background dust only (true) 279 c entrainment by slope winds 280 logical nohmons ! nohmons used to calculate twice the radiative 281 ! transfer when slpwind is active : 282 ! - in a mesh with topdust and background dust (false) 283 ! - in a mesh with background dust only (true) 277 284 278 285 real,parameter :: odpref=610. ! DOD reference pressure (Pa) … … 348 355 real rdust(ngrid,nlayer) ! dust geometric mean radius (m) 349 356 real rstormdust(ngrid,nlayer) ! stormdust geometric mean radius (m) 357 real rtopdust(ngrid,nlayer) ! topdust geometric mean radius (m) 350 358 integer igmin, lmin 351 359 logical tdiag … … 390 398 REAL rdsndust(ngrid,nlayer) ! true n stormdust (kg/kg) 391 399 REAL rdsqdust(ngrid,nlayer) ! true q stormdust (kg/kg) 392 REAL wspeed(ngrid,nlayer+1) ! vertical speed tracer stormdust400 REAL wspeed(ngrid,nlayer+1) ! vertical velocity stormdust tracer 393 401 REAL dsodust(ngrid,nlayer) 394 402 REAL dsords(ngrid,nlayer) 403 REAL wtop(ngrid,nlayer+1) ! vertical velocity topdust tracer 395 404 396 405 REAL nccnco2(ngrid,nlayer) ! true n ccnco2 (kg/kg) … … 456 465 real tf_clf, ntf_clf ! tf: fraction of clouds, ntf: fraction without clouds 457 466 real rave2(ngrid), totrave2(ngrid) ! Mean water ice mean radius (m) 467 468 c entrainment by slope winds above sb-grid scale topography 469 REAL pdqtop(ngrid,nlayer,nq) ! tendency for dust after topmons 470 REAL hmax,hmin 471 REAL hsummit(ngrid) 458 472 459 473 c======================================================================= … … 593 607 endif 594 608 #endif 595 609 610 c Initialize mountain mesh fraction for the entrainment by slope wind param. 611 c ~~~~~~~~~~~~~~~ 612 if (slpwind) then 613 !! alpha_hmons calculation 614 if (ngrid.gt.1) then 615 call planetwide_maxval(hmons,hmax ) 616 call planetwide_minval(hmons,hmin ) 617 do ig=1,ngrid 618 alpha_hmons(ig)= 0.5*(hmons(ig)-hmin)/(hmax-hmin) 619 enddo 620 else 621 hmin=0. 622 hmax=23162.1 !set here the height of the sub-grid scaled topography 623 do ig=1,ngrid 624 alpha_hmons(ig)= (hmons(ig)-hmin)/(hmax-hmin) !0.1*(hmons(ig)-hmin)/(hmax-hmin) 625 print*,"1D, hmons=",hmons(ig),"alpha=",alpha_hmons(ig) 626 enddo 627 endif ! (ngrid.gt.1) 628 endif ! if (slpwind) 629 596 630 ENDIF ! (end of "if firstcall") 597 631 … … 785 819 ! callradite for background dust 786 820 clearatm=.true. 821 !! callradite for background dust in the case of slope wind entrainment 822 nohmons=.true. 787 823 c Radiative transfer 788 824 c ------------------ … … 793 829 & zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw, 794 830 & fluxtop_sw,tauref,tau,aerosol,dsodust,tauscaling, 795 & taucloudtes,rdust,rice,nuice,co2ice,rstormdust, 796 & totstormfract,clearatm,dsords, 831 & taucloudtes,rdust,rice,nuice,co2ice,rstormdust,rtopdust, 832 & totstormfract,clearatm,dsords,alpha_hmons,nohmons, 797 833 & clearsky,totcloudfrac) 798 834 … … 809 845 & fluxsurf_swclf,fluxtop_lwclf,fluxtop_swclf,tauref, 810 846 & tau,aerosol,dsodust,tauscaling,taucloudtesclf,rdust, 811 & rice,nuice,co2ice,rstormdust,totstormfract, 812 & clearatm,dsords,clearsky,totcloudfrac) 847 & rice,nuice,co2ice,rstormdust,rtopdust,totstormfract, 848 & clearatm,dsords,alpha_hmons,nohmons, 849 & clearsky,totcloudfrac) 813 850 clearsky = .false. ! just in case. 814 851 ! Sum the fluxes and heating rates from cloudy/clear … … 839 876 ENDIF ! (CLFvarying) 840 877 841 ! Dustinjection842 if (dustinjection.gt.0) then843 CALL compute_dtau(ngrid,nlayer,844 & zday,pplev,tauref,845 & ptimestep,dustliftday,local_time)846 endif878 ! ! Dustinjection 879 ! if (dustinjection.gt.0) then 880 ! CALL compute_dtau(ngrid,nlayer, 881 ! & zday,pplev,tauref, 882 ! & ptimestep,dustliftday,local_time) 883 ! endif 847 884 c============================================================================ 848 885 … … 969 1006 ENDIF ! of IF (callrad) 970 1007 971 c 3. Rocket dust storm1008 c 3.1 Rocket dust storm 972 1009 c ------------------------------------------- 973 1010 IF (rdstorm) THEN … … 1003 1040 c input sub-grid scale cloud 1004 1041 & clearsky,totcloudfrac, 1042 c input sub-grid scale topography 1043 & nohmons,alpha_hmons, 1005 1044 c output 1006 & pdqrds,wspeed,dsodust,dsords) 1045 & pdqrds,wspeed,dsodust,dsords, 1046 & tauref) 1007 1047 1008 1048 c update the tendencies of both dust after vertical transport … … 1048 1088 1049 1089 ENDIF ! end of if(rdstorm) 1090 1091 c 3.2 Dust entrained from the PBL up to the top of sub-grid scale topography 1092 c ------------------------------------------- 1093 IF (slpwind) THEN 1094 if (ngrid.gt.1) then 1095 hsummit(:)=summit(:)-phisfi(:)/g 1096 else 1097 hsummit(:)=14000. 1098 endif 1099 nohmons=.false. 1100 pdqtop(:,:,:)=0. 1101 CALL topmons(ngrid,nlayer,nq,ptime,ptimestep, 1102 & pq,pdq,pt,pdt,zplev,zplay,zzlev, 1103 & zzlay,zdtsw,zdtlw, 1104 & icount,zday,zls,tsurf,igout,aerosol, 1105 & totstormfract,clearatm,dsords, 1106 & clearsky,totcloudfrac, 1107 & nohmons,hsummit, 1108 & pdqtop,wtop,dsodust, 1109 & tauref) 1110 1111 1112 c update the tendencies of both dust after vertical transport 1113 DO l=1,nlayer 1114 DO ig=1,ngrid 1115 pdq(ig,l,igcm_topdust_mass)= 1116 & pdq(ig,l,igcm_topdust_mass)+ 1117 & pdqtop(ig,l,igcm_topdust_mass) 1118 pdq(ig,l,igcm_topdust_number)= 1119 & pdq(ig,l,igcm_topdust_number)+ 1120 & pdqtop(ig,l,igcm_topdust_number) 1121 pdq(ig,l,igcm_dust_mass)= 1122 & pdq(ig,l,igcm_dust_mass)+ pdqtop(ig,l,igcm_dust_mass) 1123 pdq(ig,l,igcm_dust_number)= 1124 & pdq(ig,l,igcm_dust_number)+pdqtop(ig,l,igcm_dust_number) 1125 1126 ENDDO 1127 ENDDO 1128 1129 ENDIF ! end of if (slpwind) 1130 1131 c 3.3 Dust injection from the surface 1132 c ------------------------------------------- 1133 if (dustinjection.gt.0) then 1134 CALL compute_dtau(ngrid,nlayer, 1135 & zday,pplev,tauref, 1136 & ptimestep,dustliftday,local_time) 1137 endif ! end of if (dustinjection.gt.0) 1050 1138 1051 1139 c----------------------------------------------------------------------- … … 1551 1639 c Zdqssed isn't 1552 1640 call callsedim(ngrid,nlayer,ptimestep, 1553 & zplev,zzlev,zzlay,pt,pdt,rdust,rstormdust, 1641 & zplev,zzlev,zzlay,pt,pdt, 1642 & rdust,rstormdust,rtopdust, 1554 1643 & rice,rsedcloud,rhocloud, 1555 1644 & pq,pdq,zdqsed,zdqssed,nq, -
trunk/LMDZ.MARS/libf/phymars/rocketduststorm_mod.F90
r2160 r2199 26 26 ! input sub-grid scale cloud 27 27 clearsky,totcloudfrac, & 28 ! input sub-grid scale topography 29 nohmons,alpha_hmons, & 28 30 ! output 29 pdqrds,wrad,dsodust,dsords) 31 pdqrds,wrad,dsodust,dsords, & 32 tauref) 30 33 31 34 USE tracer_mod, only: igcm_stormdust_mass,igcm_stormdust_number & … … 75 78 ! sbgrid scale water ice clouds 76 79 logical, intent(in) :: clearsky 77 real, intent(in) :: totcloudfrac(ngrid) 80 real, intent(in) :: totcloudfrac(ngrid) 81 82 ! sbgrid scale topography 83 LOGICAL, INTENT(IN) :: nohmons 84 REAL, INTENT(IN) :: alpha_hmons(ngrid) 78 85 79 86 !-------------------------------------------------------- … … 85 92 REAL, INTENT(OUT) :: dsodust(ngrid,nlayer) ! density scaled opacity of env. dust 86 93 REAL, INTENT(OUT) :: dsords(ngrid,nlayer) ! density scaled opacity of storm dust 94 REAL, INTENT(OUT) :: tauref(ngrid) 87 95 88 96 !-------------------------------------------------------- … … 146 154 REAL fluxtop_lw1(ngrid) 147 155 REAL fluxtop_sw1(ngrid,2) 148 REAL tauref(ngrid)149 156 REAL tau(ngrid,naerkind) 150 157 REAL aerosol(ngrid,nlayer,naerkind) … … 153 160 REAL rdust(ngrid,nlayer) 154 161 REAL rstormdust(ngrid,nlayer) 162 REAL rtopdust(ngrid,nlayer) 155 163 REAL rice(ngrid,nlayer) 156 164 REAL nuice(ngrid,nlayer) … … 229 237 ! 1. Call the second radiative transfer for stormdust, obtain the extra heating 230 238 ! ********************************************************************* 231 CALL callradite(icount,ngrid,nlayer,nq,zday,zls,pq,albedo, &232 emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout, &233 zdtlw1,zdtsw1,fluxsurf_lw1,fluxsurf_sw1,fluxtop_lw1, &234 fluxtop_sw1,tauref,tau,aerosol,dsodust,tauscaling, &235 taucloudtes,rdust,rice,nuice,co2ice,rstormdust, 236 totstormfract,clearatm,dsords, 239 CALL callradite(icount,ngrid,nlayer,nq,zday,zls,pq,albedo, & 240 emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout, & 241 zdtlw1,zdtsw1,fluxsurf_lw1,fluxsurf_sw1,fluxtop_lw1, & 242 fluxtop_sw1,tauref,tau,aerosol,dsodust,tauscaling, & 243 taucloudtes,rdust,rice,nuice,co2ice,rstormdust,rtopdust, & 244 totstormfract,clearatm,dsords,alpha_hmons,nohmons, & 237 245 clearsky,totcloudfrac) 238 246 -
trunk/LMDZ.MARS/libf/phymars/suaer.F90
r1974 r2199 6 6 iaer_dust_conrath,iaer_dust_doubleq,& 7 7 iaer_dust_submicron,iaer_h2o_ice,& 8 iaer_stormdust_doubleq, &8 iaer_stormdust_doubleq,iaer_topdust_doubleq,& 9 9 file_id,radiustab, gvis, omegavis, & 10 10 QVISsQREF, gIR, omegaIR, & … … 156 156 !================================================================== 157 157 CASE("stormdust_doubleq") aerkind ! Two-moment scheme for stormdust - radiative properties 158 !================================================================== 159 ! Visible domain: 160 file_id(iaer,1) = 'optprop_dustvis_TM_n50.dat' !T-Matrix 161 ! Infrared domain: 162 file_id(iaer,2) = 'optprop_dustir_n50.dat' !Mie 163 ! Reference wavelength in the visible: 164 longrefvis(iaer)=0.67E-6 165 ! If not equal to 0.67e-6 -> change readtesassim accordingly; 166 ! Reference wavelength in the infrared: 167 longrefir(iaer)=dustrefir 168 !================================================================== 169 CASE("topdust_doubleq") aerkind ! Two-moment scheme for topdust - radiative properties 158 170 !================================================================== 159 171 ! Visible domain: -
trunk/LMDZ.MARS/libf/phymars/tracer_mod.F90
r1974 r2199 44 44 integer,save :: igcm_stormdust_mass ! storm dust mass mixing ratio 45 45 integer,save :: igcm_stormdust_number ! storm dust number mixing ratio 46 46 integer,save :: igcm_topdust_mass ! topdust mass mixing ratio 47 integer,save :: igcm_topdust_number ! topdust number mixing ratio 48 47 49 integer,save :: igcm_ccnco2_mass ! CCN (dust and/or water ice) for CO2 mass mixing ratio 48 50 integer,save :: igcm_ccnco2_number ! CCN (dust and/or water ice) for CO2 number mixing ratio -
trunk/LMDZ.MARS/libf/phymars/updatereffrad_mod.F
r1974 r2199 6 6 7 7 SUBROUTINE updatereffrad(ngrid,nlayer, 8 & rdust,rstormdust,r ice,nuice,8 & rdust,rstormdust,rtopdust,rice,nuice, 9 9 & reffrad,nueffrad, 10 10 & pq,tauscaling,tau,pplay) … … 15 15 & igcm_ccn_number, nuice_ref, varian, 16 16 & ref_r0, igcm_dust_submicron, 17 & igcm_stormdust_mass,igcm_stormdust_number 17 & igcm_stormdust_mass,igcm_stormdust_number, 18 & igcm_topdust_mass,igcm_topdust_number 18 19 USE dimradmars_mod, only: nueffdust,naerkind, 19 20 & name_iaer, 20 21 & iaer_dust_conrath,iaer_dust_doubleq, 21 22 & iaer_dust_submicron,iaer_h2o_ice, 22 & iaer_stormdust_doubleq 23 & iaer_stormdust_doubleq,iaer_topdust_doubleq 23 24 24 25 IMPLICIT NONE … … 58 59 REAL, INTENT(in) :: pq(ngrid,nlayer,nqmx) 59 60 REAL, INTENT(out) :: rdust(ngrid,nlayer) ! Dust geometric mean radius (m) 60 REAL, INTENT(out) :: rstormdust(ngrid,nlayer) ! Dust geometric mean radius (m) 61 REAL, INTENT(out) :: rstormdust(ngrid,nlayer) ! Dust geometric mean radius (m) 62 REAL, INTENT(out) :: rtopdust(ngrid,nlayer) ! Dust geometric mean radius (m) 61 63 REAL, INTENT(in) :: pplay(ngrid,nlayer) ! altitude at the middle of the layers 62 64 REAL, INTENT(in) :: tau(ngrid,naerkind) … … 118 120 call updaterdust(pq(ig,l,igcm_stormdust_mass), 119 121 & pq(ig,l,igcm_stormdust_number),rstormdust(ig,l)) 122 nueffdust(ig,l) = exp(varian**2.)-1. 123 ENDDO 124 ENDDO 125 ENDIF 126 127 ! updating radius of topdust particles 128 IF (slpwind.AND.active) THEN 129 DO l=1,nlayer 130 DO ig=1, ngrid 131 call updaterdust(pq(ig,l,igcm_topdust_mass), 132 & pq(ig,l,igcm_topdust_number),rtopdust(ig,l)) 120 133 nueffdust(ig,l) = exp(varian**2.)-1. 121 134 ENDDO … … 224 237 ENDDO 225 238 c================================================================== 239 CASE("topdust_doubleq") aerkind! MV18: Two-moment scheme for 240 c topdust; same distribution than normal dust 241 c================================================================== 242 DO l=1,nlayer 243 DO ig=1,ngrid 244 reffrad(ig,l,iaer) = rtopdust(ig,l) * ref_r0 245 nueffrad(ig,l,iaer) = nueffdust(ig,l) 246 ENDDO 247 ENDDO 248 c================================================================== 226 249 END SELECT aerkind 227 250 ENDDO ! iaer (loop on aerosol kind)
Note: See TracChangeset
for help on using the changeset viewer.