Changeset 2628
- Timestamp:
- Feb 28, 2022, 6:46:07 PM (3 years ago)
- Location:
- trunk/LMDZ.MARS
- Files:
-
- 13 edited
-
README (modified) (2 diffs)
-
libf/phymars/aeropacity_mod.F (modified) (5 diffs)
-
libf/phymars/callkeys.h (modified) (2 diffs)
-
libf/phymars/callradite_mod.F (modified) (4 diffs)
-
libf/phymars/callsedim_mod.F (modified) (5 diffs)
-
libf/phymars/conf_phys.F (modified) (5 diffs)
-
libf/phymars/initracer.F (modified) (4 diffs)
-
libf/phymars/phys_state_var_init_mod.F90 (modified) (2 diffs)
-
libf/phymars/physiq_mod.F (modified) (13 diffs)
-
libf/phymars/rocketduststorm_mod.F90 (modified) (3 diffs)
-
libf/phymars/surfdat_h.F90 (modified) (3 diffs)
-
libf/phymars/topmons_mod.F90 (modified) (17 diffs)
-
libf/phymars/updatereffrad_mod.F (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.MARS/README
r2627 r2628 3556 3556 Also cleaned up and commented comsaison_h in the process. 3557 3557 3558 == 04/01/202 1== CM3558 == 04/01/2022 == CM 3559 3559 - Clean co2condens_mod.F 3560 3560 - remove dqsurf duplication after call co2condens 3561 3561 3562 == 04/01/202 1== AB3562 == 04/01/2022 == AB 3563 3563 Some further cleaning of co2condens following r2599 and r2600 that fixed the bug appearing when the scavenging by CO2 ice was activated. 3564 3564 3565 == 04/01/202 1== CM3565 == 04/01/2022 == CM 3566 3566 following r2600, remove use co2condens_mod4micro in physiq_mod.F 3567 3567 … … 3608 3608 Open_MP :Small OpenMP fixes in conf_phys for reading radia.def with ifort 3609 3609 3610 == 28/02/2022 == AB 3611 Big changes on mountain top dust flows for GCM6: 3612 - the scheme now activates only in grid meshes that contain a mountain among 3613 a hard-written list, instead of every meshes. This is done to prevent strong 3614 artificial reinjections of dust in places that don't present huge converging 3615 slopes that concentrate dust (ex: Valles Marineris, Hellas). 3616 Topdust is now also detrained as soon as it leaves the column it originated from. 3617 - the list of the 19 allowed mountains is used by the subroutine topmons_setup 3618 in module topmons_mod, to compute a logical array contains_mons(ngrid). 3619 alpha_hmons and hsummit are also set up once and for all by this subroutine, 3620 which is called in physiq_mod's firstcall. 3621 - contains_mons, alpha_hmons and hsummit are now saved variables of the module 3622 surfdat_h, and are called as such and not as arguments in the subroutines 3623 using them. 3624 - the logical flag "slpwind" and the comments in the code have also been updated 3625 to the new terminology "mountain top dust flows", accordingly to ticket #71. 3626 The new flag read in callphys.def is "topflows". -
trunk/LMDZ.MARS/libf/phymars/aeropacity_mod.F
r2584 r2628 14 14 & QREFvis3d,QREFir3d,omegaREFir3d, 15 15 & totstormfract,clearatm,dsords,dsotop, 16 & alpha_hmons,nohmons,16 & nohmons, 17 17 & clearsky,totcloudfrac) 18 18 … … 38 38 use dust_scaling_mod, only: compute_dustscaling 39 39 use density_co2_ice_mod, only: density_co2_ice 40 use surfdat_h,only: alpha_hmons,contains_mons 41 40 42 IMPLICIT NONE 41 43 c======================================================================= … … 104 106 REAL, INTENT(IN) :: totstormfract(ngrid) ! mesh fraction with a rocket 105 107 ! dust storm 106 LOGICAL, INTENT(IN) :: nohmons ! true to compute RT without slope wind 107 ! topdust, false to compute RT in the topdust 108 REAL, INTENT(IN) :: alpha_hmons(ngrid) 108 LOGICAL, INTENT(IN) :: nohmons ! true to compute RT without topdust, 109 ! false to compute RT in the topdust 109 110 REAL,INTENT(OUT) :: tauscaling(ngrid) ! Scaling factor for qdust and Ndust 110 111 REAL,INTENT(OUT) :: dust_rad_adjust(ngrid) ! Radiative adjustment … … 596 597 c and once in the part of the mesh without the sub-grid mountain (nohmons=true) 597 598 aerosol(1:ngrid,1:nlayer,iaer) = 0. 598 IF (nohmons) THEN ! considering part of the mesh without storm599 IF (nohmons) THEN ! considering part of the mesh without top flows 599 600 aerosol(1:ngrid,1:nlayer,iaer)=1.e-25 600 ELSE ! part of the mesh with concentr ed dust storm601 ELSE ! part of the mesh with concentrated dust flows 601 602 DO l=1,nlayer 602 603 IF (l.LE.cstdustlevel) THEN … … 883 884 c aerosol/X for topdust to prepare calculation of radiative transfer 884 885 c ----------------------------------------------------------------- 885 IF ( slpwind) THEN886 IF (topflows) THEN 886 887 DO ig=1,ngrid 887 IF ( alpha_hmons(ig) .gt. 0.) THEN888 IF (contains_mons(ig)) THEN ! contains_mons=True ensures that alpha_hmons>0 888 889 DO l=1,nlayer 889 ! topdust: opacity relative to the stormfraction (topdust/x)890 ! topdust: opacity relative to the mons fraction (topdust/x) 890 891 aerosol(ig,l,iaer_topdust_doubleq) = 891 892 & aerosol(ig,l,iaer_topdust_doubleq)/alpha_hmons(ig) -
trunk/LMDZ.MARS/libf/phymars/callkeys.h
r2612 r2628 15 15 & ,calltherm,callrichsl,callslope,tituscap,callyamada4,co2clouds & 16 16 & ,co2useh2o,meteo_flux,activeco2ice,CLFvaryingCO2,spantCO2 & 17 & ,CLFvarying,satindexco2,rdstorm, slpwind,calllott_nonoro &17 & ,CLFvarying,satindexco2,rdstorm,topflows,calllott_nonoro & 18 18 & ,latentheat_surfwater,gwd_convective_source,startphy_file & 19 19 & ,hdo,hdofrac,cst_cap_albedo,temp_dependant_m,refill_watercap … … 72 72 logical scavenging 73 73 logical rdstorm ! rocket dust storm parametrization 74 logical slpwind ! entrainment by slope windparametrization74 logical topflows ! entrainment by mountain top dust flows parametrization 75 75 logical latentheat_surfwater ! latent heat release from ground water ice sublimation/condensation 76 76 logical cst_cap_albedo ! polar cap albedo remains unchanged by water frost deposition -
trunk/LMDZ.MARS/libf/phymars/callradite_mod.F
r2584 r2628 12 12 $ taucloudtes,rdust,rice,nuice,riceco2,nuiceco2,co2ice, 13 13 $ rstormdust,rtopdust,totstormfract,clearatm,dsords,dsotop, 14 $ alpha_hmons,nohmons,clearsky,totcloudfrac)14 $ nohmons,clearsky,totcloudfrac) 15 15 16 16 use aeropacity_mod, only: aeropacity … … 213 213 REAL,INTENT(OUT) :: dsords(ngrid,nlayer) ! density scaled opacity for rocket dust storm dust 214 214 215 c entrainment by slope wind 216 LOGICAL, INTENT(IN) :: nohmons ! true for background dust 217 REAL, INTENT(IN) :: alpha_hmons(ngrid) ! sub-grid scale topography mesh fraction 215 c entrainment by mountain top dust flows 216 LOGICAL, INTENT(IN) :: nohmons ! true for background dust 218 217 REAL,INTENT(OUT) :: rtopdust(ngrid,nlayer) ! Topdust geometric mean radius (m) 219 218 REAL,INTENT(OUT) :: dsotop(ngrid,nlayer) ! density scaled opacity for topmons dust … … 376 375 enddo 377 376 end if 378 if ( slpwind.AND.active) then377 if (topflows.AND.active) then 379 378 do iaer=1,naerkind 380 379 if (name_iaer(iaer).eq."topdust_doubleq") then … … 448 447 & QREFvis3d,QREFir3d,omegaREFir3d, 449 448 & totstormfract,clearatm,dsords,dsotop, 450 & alpha_hmons,nohmons,451 & clearsky,totcloudfrac)449 & nohmons,clearsky,totcloudfrac) 450 452 451 c Starting loop on sub-domain 453 452 c ---------------------------- -
trunk/LMDZ.MARS/libf/phymars/callsedim_mod.F
r2616 r2628 372 372 ENDIF !of if (rdstorm) 373 373 374 IF ( slpwind) THEN ! identifying topdust tracers for sedimentation374 IF (topflows) THEN ! identifying topdust tracers for sedimentation 375 375 itopdust_mass=0 ! dummy initialization 376 376 itopdust_number=0 ! dummy initialization … … 392 392 write(*,*) 'callsedim: error! could not identify' 393 393 write(*,*) ' tracers for topdust mass and number mixing' 394 write(*,*) ' ratio and slpwindis activated!'394 write(*,*) ' ratio and topflows is activated!' 395 395 call abort_physic(modname,"missing topdust tracers",1) 396 396 endif 397 ENDIF !of if ( slpwind)397 ENDIF !of if (topflows) 398 398 399 399 firstcall=.false. … … 452 452 end do 453 453 endif 454 c entrainment by slope wind455 if ( slpwind) then454 c entrainment by mountain top dust flows 455 if (topflows) then 456 456 do l=1,nlay 457 457 do ig=1, ngrid … … 710 710 endif ! of if (rdstorm) 711 711 712 if ( slpwind) then712 if (topflows) then 713 713 DO l = 1, nlay 714 714 DO ig=1,ngrid … … 718 718 ENDDO 719 719 ENDDO 720 endif ! of if ( slpwind)720 endif ! of if (topflows) 721 721 722 722 c Update the ice particle size "rice" -
trunk/LMDZ.MARS/libf/phymars/conf_phys.F
r2627 r2628 314 314 write(*,*)" coeff_detrainment = ",coeff_detrainment 315 315 316 ! entrainment by slope windscheme317 write(*,*)"call slope wind liftingparametrization"318 slpwind=.false. ! default value319 call getin_p(" slpwind",slpwind)320 write(*,*)" slpwind = ",slpwind316 ! entrainment by mountain top dust flows scheme 317 write(*,*)"call mountain top dust flows parametrization" 318 topflows=.false. ! default value 319 call getin_p("topflows",topflows) 320 write(*,*)" topflows = ",topflows 321 321 322 322 ! latent heat release from ground water ice sublimation/condensation … … 471 471 endif 472 472 endif 473 ! rocket dust storm and entrainment by slope wind473 ! rocket dust storm and entrainment by top flows 474 474 ! Test of incompatibility: 475 ! if rdstorm or slpwindis used, then doubleq should be true476 if ((rdstorm.or. slpwind).and..not.doubleq) then477 print*,'if rdstorm or slpwindis used, then doubleq475 ! if rdstorm or topflows is used, then doubleq should be true 476 if ((rdstorm.or.topflows).and..not.doubleq) then 477 print*,'if rdstorm or topflows is used, then doubleq 478 478 & should be used !' 479 479 call abort_physic(modname, 480 & "rdstorm or slpwindrequires doubleq",1)481 endif 482 if ((rdstorm.or. slpwind).and..not.active) then483 print*,'if rdstorm or slpwindis used, then active480 & "rdstorm or topflows requires doubleq",1) 481 endif 482 if ((rdstorm.or.topflows).and..not.active) then 483 print*,'if rdstorm or topflows is used, then active 484 484 & should be used !' 485 485 call abort_physic(modname, 486 & "rdstorm or slpwindrequires activ",1)486 & "rdstorm or topflows requires activ",1) 487 487 endif 488 488 if (rdstorm.and..not.lifting) then … … 492 492 & "rdstorm requires lifting",1) 493 493 endif 494 if ((rdstorm.or. slpwind).and..not.freedust) then495 print*,'if rdstorm or slpwindis used, then freedust494 if ((rdstorm.or.topflows).and..not.freedust) then 495 print*,'if rdstorm or topflows is used, then freedust 496 496 & should be used !' 497 497 call abort_physic(modname, 498 & "rdstorm or slpwindrequires freedust",1)498 & "rdstorm or topflows requires freedust",1) 499 499 endif 500 500 if (rdstorm.and.(dustinjection.eq.0)) then … … 900 900 ! and picky compilers who know name_iaer(2) is out of bounds 901 901 j=2 902 IF (rdstorm.AND..NOT.activice.AND..NOT. slpwind) then902 IF (rdstorm.AND..NOT.activice.AND..NOT.topflows) then 903 903 name_iaer(j) = "stormdust_doubleq" !! storm dust two-moment scheme 904 904 j = j+1 905 905 END IF 906 906 907 IF (rdstorm.AND.water.AND.activice.AND..NOT. slpwind) then907 IF (rdstorm.AND.water.AND.activice.AND..NOT.topflows) then 908 908 name_iaer(j) = "stormdust_doubleq" 909 909 j = j+1 910 910 END IF 911 911 912 IF ( slpwind.AND..NOT.activice.AND..NOT.rdstorm) then912 IF (topflows.AND..NOT.activice.AND..NOT.rdstorm) then 913 913 name_iaer(j) = "topdust_doubleq" !! storm dust two-moment scheme 914 914 j = j+1 915 915 END IF 916 916 917 IF ( slpwind.AND.water.AND.activice.AND..NOT.rdstorm) then917 IF (topflows.AND.water.AND.activice.AND..NOT.rdstorm) then 918 918 name_iaer(j) = "topdust_doubleq" 919 919 j = j+1 920 920 END IF 921 921 922 IF (rdstorm.AND. slpwind.AND..NOT.activice) THEN922 IF (rdstorm.AND.topflows.AND..NOT.activice) THEN 923 923 name_iaer(j) = "stormdust_doubleq" 924 924 name_iaer(j+1) = "topdust_doubleq" … … 926 926 ENDIF 927 927 928 IF (rdstorm.AND. slpwind.AND.water.AND.activice) THEN928 IF (rdstorm.AND.topflows.AND.water.AND.activice) THEN 929 929 name_iaer(j) = "stormdust_doubleq" 930 930 name_iaer(j+1) = "topdust_doubleq" -
trunk/LMDZ.MARS/libf/phymars/initracer.F
r2616 r2628 181 181 enddo 182 182 endif ! of if (rdstorm) 183 if ( slpwind) then183 if (topflows) then 184 184 do iq=1,nq 185 185 if (noms(iq).eq."topdust_mass") then … … 192 192 endif 193 193 enddo 194 endif ! of if ( slpwind)194 endif ! of if (topflows) 195 195 ! 2. find chemistry and water tracers 196 196 do iq=1,nq … … 613 613 end if !(rdstorm) 614 614 !c ---------------------------------------------------------------------- 615 !c slope windscheme615 !c mountain top dust flows scheme 616 616 !c you need a radius value for topdust to active its sedimentation 617 617 !c we take the same value as for the normal dust 618 if ( slpwind) then618 if (topflows) then 619 619 rho_q(igcm_topdust_mass)=rho_dust 620 620 rho_q(igcm_topdust_number)=rho_dust 621 621 radius(igcm_topdust_mass) = 3.e-6 622 622 radius(igcm_topdust_number) = 3.e-6 623 end if !( slpwind)623 end if !(topflows) 624 624 !c ---------------------------------------------------------------------- 625 625 … … 859 859 endif 860 860 861 if ( slpwind) then861 if (topflows) then 862 862 ! verify that we indeed have topdust_mass and topdust_number tracers 863 863 if (igcm_topdust_mass.eq.0) then 864 864 write(*,*) "initracer: error !!" 865 write(*,*) " cannot use slpwindoption without ",865 write(*,*) " cannot use topflows option without ", 866 866 & "a topdust_mass tracer !" 867 call abort_physic("initracer"," slpwindissue",1)867 call abort_physic("initracer","topflows issue",1) 868 868 endif 869 869 if (igcm_topdust_number.eq.0) then 870 870 write(*,*) "initracer: error !!" 871 write(*,*) " cannot use slpwindoption without ",871 write(*,*) " cannot use topflows option without ", 872 872 & "a topdust_number tracer !" 873 call abort_physic("initracer"," slpwindissue",1)873 call abort_physic("initracer","topflows issue",1) 874 874 endif 875 875 endif -
trunk/LMDZ.MARS/libf/phymars/phys_state_var_init_mod.F90
r2562 r2628 52 52 use rocketduststorm_mod, only: ini_rocketduststorm_mod, & 53 53 end_rocketduststorm_mod 54 use topmons_mod, only: ini_topmons_mod, &55 end_topmons_mod56 54 use calchim_mod, only: ini_calchim_mod,end_calchim_mod 57 55 use watercloud_mod, only: ini_watercloud_mod, & … … 137 135 call ini_rocketduststorm_mod(ngrid) 138 136 139 ! allocate arrays in "topmons_mod":140 call end_topmons_mod141 call ini_topmons_mod(ngrid,nlayer)142 143 137 ! allocate arrays in "calchim_mod" (aeronomars) 144 138 call end_calchim_mod -
trunk/LMDZ.MARS/libf/phymars/physiq_mod.F
r2616 r2628 23 23 use rocketduststorm_mod, only: rocketduststorm, dustliftday 24 24 use calcstormfract_mod, only: calcstormfract 25 use topmons_mod, only: topmons, alpha_hmons25 use topmons_mod, only: topmons,topmons_setup 26 26 use tracer_mod, only: noms, mmol, igcm_co2, igcm_n2, igcm_co2_ice, 27 27 & igcm_co, igcm_o, igcm_h2o_vap, igcm_h2o_ice, … … 308 308 ! - in a mesh with stormdust and background dust (false) 309 309 ! - in a mesh with background dust only (true) 310 c entrainment by slope winds310 c entrainment by mountain top dust flows 311 311 logical nohmons ! nohmons used to calculate twice the radiative 312 ! transfer when slpwindis active :312 ! transfer when topflows is active : 313 313 ! - in a mesh with topdust and background dust (false) 314 314 ! - in a mesh with background dust only (true) … … 507 507 REAL co2totB 508 508 509 c entrainment by slope winds above sb-grid scale topography509 c entrainment by mountain top dust flows above sub-grid scale topography 510 510 REAL pdqtop(ngrid,nlayer,nq) ! tendency for dust after topmons 511 REAL hmax,hmin512 REAL hsummit(ngrid)513 511 514 512 c when no startfi file is asked for init … … 718 716 endif 719 717 720 c Initialize mountain mesh fraction for the entrainment by slope windparam.718 c Initialize mountain mesh fraction for the entrainment by top flows param. 721 719 c ~~~~~~~~~~~~~~~ 722 if (slpwind) then 723 !! alpha_hmons calculation 724 if (ngrid.gt.1) then 725 call planetwide_maxval(hmons,hmax ) 726 call planetwide_minval(hmons,hmin ) 727 do ig=1,ngrid 728 alpha_hmons(ig)= 0.5*(hmons(ig)-hmin)/(hmax-hmin) 729 enddo 730 else 731 hmin=0. 732 hmax=23162.1 !set here the height of the sub-grid scaled topography 733 do ig=1,ngrid 734 alpha_hmons(ig)= (hmons(ig)-hmin)/(hmax-hmin) !0.1*(hmons(ig)-hmin)/(hmax-hmin) 735 print*,"1D, hmons=",hmons(ig),"alpha=",alpha_hmons(ig) 736 enddo 737 endif ! (ngrid.gt.1) 738 endif ! if (slpwind) 720 if (topflows) call topmons_setup(ngrid) 739 721 740 722 #endif … … 972 954 c Transfer through CO2 (except NIR CO2 absorption) 973 955 c and aerosols (dust and water ice) 974 ! callradite for background dust 956 ! callradite for background dust (out of the rdstorm fraction) 975 957 clearatm=.true. 976 !! callradite for background dust in the case of slope wind entrainment958 !! callradite for background dust (out of the topflows fraction) 977 959 nohmons=.true. 978 960 … … 988 970 & taucloudtes,rdust,rice,nuice,riceco2,nuiceco2,co2ice, 989 971 & rstormdust,rtopdust,totstormfract,clearatm,dsords,dsotop, 990 & alpha_hmons,nohmons,clearsky,totcloudfrac)972 & nohmons,clearsky,totcloudfrac) 991 973 992 974 ! case of sub-grid water ice clouds: callradite for the clear case … … 1006 988 & rice,nuice,riceco2, nuiceco2,co2ice,rstormdust, 1007 989 & rtopdust,totstormfract, 1008 & clearatm,dsords,dsotop, alpha_hmons,nohmons,1009 & clearsky,totcloudfrac)990 & clearatm,dsords,dsotop, 991 & nohmons,clearsky,totcloudfrac) 1010 992 clearsky = .false. ! just in case. 1011 993 ! Sum the fluxes and heating rates from cloudy/clear … … 1200 1182 & clearsky,totcloudfrac, 1201 1183 c input sub-grid scale topography 1202 & nohmons, alpha_hmons,1184 & nohmons, 1203 1185 c output 1204 1186 & pdqrds,wspeed,dsodust,dsords,dsotop, … … 1250 1232 c 3.2 Dust entrained from the PBL up to the top of sub-grid scale topography 1251 1233 c ------------------------------------------- 1252 IF (slpwind) THEN 1253 if (ngrid.gt.1) then 1254 hsummit(:)=summit(:)-phisfi(:)/g 1255 else 1256 hsummit(:)=14000. 1257 endif 1234 IF (topflows) THEN 1258 1235 clearatm=.true. ! stormdust is not accounted in the extra heating on top of the mountains 1259 1236 nohmons=.false. … … 1266 1243 & totstormfract,clearatm, 1267 1244 & clearsky,totcloudfrac, 1268 & nohmons, hsummit,1245 & nohmons, 1269 1246 & pdqtop,wtop,dsodust,dsords,dsotop, 1270 1247 & tau_pref_scenario,tau_pref_gcm) … … 1287 1264 ENDDO 1288 1265 1289 ENDIF ! end of if ( slpwind)1266 ENDIF ! end of if (topflows) 1290 1267 1291 1268 c 3.3 Dust injection from the surface … … 3387 3364 endif ! (rdstorm) 3388 3365 3389 if ( slpwind) then3366 if (topflows) then 3390 3367 call WRITEDIAGFI(ngrid,'refftopdust','refftopdust', 3391 3368 & 'm',3,rtopdust*ref_r0) … … 3404 3381 & 'm2.kg-1',3,dsotop) 3405 3382 end select 3406 endif ! ( slpwind)3383 endif ! (topflows) 3407 3384 3408 3385 if (dustscaling_mode==2) then -
trunk/LMDZ.MARS/libf/phymars/rocketduststorm_mod.F90
r2616 r2628 30 30 clearsky,totcloudfrac, & 31 31 ! input sub-grid scale topography 32 nohmons, alpha_hmons,&32 nohmons, & 33 33 ! output 34 34 pdqrds,wrad,dsodust,dsords,dsotop, & … … 81 81 REAL,INTENT(OUT) :: dust_rad_adjust(ngrid) 82 82 83 ! s bgrid scale water ice clouds83 ! subgrid scale water ice clouds 84 84 logical, intent(in) :: clearsky 85 85 real, intent(in) :: totcloudfrac(ngrid) 86 86 87 ! s bgrid scale topography87 ! subgrid scale topography 88 88 LOGICAL, INTENT(IN) :: nohmons 89 REAL, INTENT(IN) :: alpha_hmons(ngrid)90 89 91 90 !-------------------------------------------------------- … … 257 256 tau,aerosol,dsodust,tauscaling,dust_rad_adjust, & 258 257 taucloudtes,rdust,rice,nuice,riceco2,nuiceco2,co2ice,rstormdust,rtopdust, & 259 totstormfract,clearatm,dsords,dsotop, alpha_hmons,nohmons,&258 totstormfract,clearatm,dsords,dsotop,nohmons,& 260 259 clearsky,totcloudfrac) 261 260 -
trunk/LMDZ.MARS/libf/phymars/surfdat_h.F90
r2578 r2628 35 35 !$OMP TESice_Scoef,iceradius,dtemisice, & 36 36 !$OMP zmea,zstd,zsig,zgam,zthe,hmons,summit,base,z0,z0_default ) 37 38 !! mountain top dust flows 39 REAL,SAVE,ALLOCATABLE :: alpha_hmons(:) ! sub-grid scale mountain mesh fraction 40 REAL,SAVE,ALLOCATABLE :: hsummit(:) ! mountain height above the GCM surface 41 LOGICAL,SAVE,ALLOCATABLE :: contains_mons(:) ! is there a mountain in the grid mesh ? 42 43 !$OMP THREADPRIVATE(alpha_hmons,hsummit,contains_mons) 37 44 38 45 !! variables … … 75 82 allocate(summit(ngrid)) 76 83 allocate(base(ngrid)) 77 84 allocate(alpha_hmons(ngrid)) 85 allocate(hsummit(ngrid)) 86 allocate(contains_mons(ngrid)) 87 78 88 end subroutine ini_surfdat_h 79 89 … … 83 93 implicit none 84 94 85 if (allocated(albedodat)) deallocate(albedodat) 86 if (allocated(phisfi)) deallocate(phisfi) 87 if (allocated(watercaptag)) deallocate(watercaptag) 88 if (allocated(dryness)) deallocate(dryness) 89 if (allocated(zmea)) deallocate(zmea) 90 if (allocated(zstd)) deallocate(zstd) 91 if (allocated(zsig)) deallocate(zsig) 92 if (allocated(zgam)) deallocate(zgam) 93 if (allocated(zthe)) deallocate(zthe) 94 if (allocated(z0)) deallocate(z0) 95 if (allocated(qsurf)) deallocate(qsurf) 96 if (allocated(tsurf)) deallocate(tsurf) 97 if (allocated(co2ice)) deallocate(co2ice) 98 if (allocated(watercap)) deallocate(watercap) 99 if (allocated(emis)) deallocate(emis) 100 if (allocated(capcal)) deallocate(capcal) 101 if (allocated(fluxgrd)) deallocate(fluxgrd) 102 if (allocated(hmons)) deallocate(hmons) 103 if (allocated(summit)) deallocate(summit) 104 if (allocated(base)) deallocate(base) 95 if (allocated(albedodat)) deallocate(albedodat) 96 if (allocated(phisfi)) deallocate(phisfi) 97 if (allocated(watercaptag)) deallocate(watercaptag) 98 if (allocated(dryness)) deallocate(dryness) 99 if (allocated(zmea)) deallocate(zmea) 100 if (allocated(zstd)) deallocate(zstd) 101 if (allocated(zsig)) deallocate(zsig) 102 if (allocated(zgam)) deallocate(zgam) 103 if (allocated(zthe)) deallocate(zthe) 104 if (allocated(z0)) deallocate(z0) 105 if (allocated(qsurf)) deallocate(qsurf) 106 if (allocated(tsurf)) deallocate(tsurf) 107 if (allocated(co2ice)) deallocate(co2ice) 108 if (allocated(watercap)) deallocate(watercap) 109 if (allocated(emis)) deallocate(emis) 110 if (allocated(capcal)) deallocate(capcal) 111 if (allocated(fluxgrd)) deallocate(fluxgrd) 112 if (allocated(hmons)) deallocate(hmons) 113 if (allocated(summit)) deallocate(summit) 114 if (allocated(base)) deallocate(base) 115 if (allocated(alpha_hmons)) deallocate(alpha_hmons) 116 if (allocated(hsummit)) deallocate(hsummit) 117 if (allocated(contains_mons)) deallocate(contains_mons) 105 118 106 119 end subroutine end_surfdat_h -
trunk/LMDZ.MARS/libf/phymars/topmons_mod.F90
r2616 r2628 2 2 3 3 IMPLICIT NONE 4 5 ! sub-grid scale mountain mesh fraction6 REAL, SAVE, ALLOCATABLE :: alpha_hmons(:)7 8 !$OMP THREADPRIVATE(alpha_hmons)9 4 10 5 CONTAINS … … 32 27 clearsky,totcloudfrac, & 33 28 ! input sub-grid scale mountain 34 nohmons, hsummit,&29 nohmons, & 35 30 ! output 36 31 pdqtop,wfin,dsodust,dsords,dsotop, & … … 43 38 USE dimradmars_mod, only: albedo,naerkind 44 39 USE comsaison_h, only: dist_sol,mu0,fract 45 USE surfdat_h, only: emis,co2ice,hmons,summit 40 USE surfdat_h, only: emis,co2ice,hmons,summit,alpha_hmons, & 41 hsummit,contains_mons 46 42 USE callradite_mod, only: callradite 47 43 … … 87 83 ! input sub-grid scale mountain 88 84 LOGICAL, INTENT(IN) :: nohmons 89 REAL, INTENT(IN) :: hsummit(ngrid)90 85 91 86 !-------------------------------------------------------- … … 196 191 197 192 ! Detrainment 198 REAL coefdetrain(ngrid,nlayer) ! coefficient for detrainment : % of stormdust detrained193 REAL coefdetrain(ngrid,nlayer) ! coefficient for detrainment : % of topdust detrained 199 194 REAL dqdet_topdust_mass(ngrid,nlayer) ! tendancy pdq topdust mass after detrainment only 200 195 REAL dqdet_topdust_number(ngrid,nlayer) ! tendancy pdq topdust number after detrainment only … … 206 201 ! ********************************************************************** 207 202 ! ********************************************************************** 208 ! Parametrization of the entrainment by slope wind above the sub-grid209 ! scale topography203 ! Parametrization of the entrainment of dust by slope winds above the 204 ! converging sub-grid scale topography ("mountain top dust flows") 210 205 ! ********************************************************************** 211 206 ! ********************************************************************** … … 279 274 ! 1.1. Call the second radiative transfer for topdust, obtain the extra heating 280 275 ! ********************************************************************* 276 277 ! NB: since the only grid meshes that matter for the radiative transfer 278 ! are the ones that contain a mount (contains_mons(ig)=.true.), 279 ! it could be relevant to optimize the code by calling the RT 280 ! only for those grid meshes. 281 ! See Ticket #92 on trac.lmd.jussieu.fr/Planeto 281 282 CALL callradite(icount,ngrid,nlayer,nq,zday,zls,zq,albedo, & 282 283 emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout, & … … 285 286 tau,aerosol,dsodust,tauscaling,dust_rad_adjust, & 286 287 taucloudtes,rdust,rice,nuice,riceco2,nuiceco2,co2ice,rstormdust,rtopdust, & 287 totstormfract,clearatm,dsords,dsotop, alpha_hmons,nohmons,&288 totstormfract,clearatm,dsords,dsotop,nohmons,& 288 289 clearsky,totcloudfrac) 289 290 ! ********************************************************************** … … 291 292 ! ********************************************************************** 292 293 DO ig=1,ngrid 293 IF ( (mu0(ig) .gt. mu0lim) .and. (alpha_hmons(ig) .gt. 0.) ) THEN 294 IF ( (mu0(ig) .gt. mu0lim) .and. (contains_mons(ig)) ) THEN 295 !! mu0(ig)>mu0lim ensures that it is daytime 296 !! contains_mons=True ensures that there is a mount in the mesh and alpha_hmons>0 297 294 298 !! ********************************************************************** 295 299 !! Temperature profile above the mountain and in the close environment … … 353 357 endif 354 358 ENDDO 355 ENDIF ! IF ((mu0(ig) .gt. mu0lim) .and. alpha_hmons(ig) .gt. 0.)359 ENDIF ! IF ((mu0(ig) .gt. mu0lim) .and. contains_mons(ig)) 356 360 ENDDO ! DO ig=1,ngrid 357 361 … … 364 368 ! ********************************************************************** 365 369 DO ig=1,ngrid 366 IF ( (mu0(ig) .gt. mu0lim) .and. ( alpha_hmons(ig) .gt. 0.) ) THEN370 IF ( (mu0(ig) .gt. mu0lim) .and. (contains_mons(ig)) ) THEN 367 371 !! Positive buoyancy: negative vertical velocity entrains UP 368 372 IF (dt_top(ig) .gt. 0.) THEN … … 477 481 478 482 DO ig=1,ngrid 479 IF ( (mu0(ig) .gt. mu0lim) .and. ( alpha_hmons(ig) .gt. 0.) ) THEN483 IF ( (mu0(ig) .gt. mu0lim) .and. (contains_mons(ig)) ) THEN 480 484 !! Total air mass within the PBL before entrainment (=> by PBL we mean between the surface and the layer where the vertical wind is maximum) 481 485 masse_pbl(ig)=0. … … 489 493 ! ********************************************************************** 490 494 DO ig=1,ngrid 491 IF ( (mu0(ig) .gt. mu0lim) .and. ( alpha_hmons(ig) .gt. 0.) .and. (masse_pbl(ig) .gt. 0.) ) THEN495 IF ( (mu0(ig) .gt. mu0lim) .and. (contains_mons(ig)) .and. (masse_pbl(ig) .gt. 0.) ) THEN 492 496 !! Transport of background dust + concentrated topdust above lwmax 493 497 DO l=lwmax(ig),nlayer … … 583 587 DO l=1,nlayer!-1 584 588 !! Detrainment during the day 585 IF ( (mu0(ig) .gt. mu0lim) .and. (zq_topdust_mass(ig,l) .gt. zq_dust_mass(ig,l)*0.01) ) THEN589 IF ( (mu0(ig) .gt. mu0lim) .and. (zq_topdust_mass(ig,l) .gt. zq_dust_mass(ig,l)*0.01) .and. (contains_mons(ig)) ) THEN 586 590 coefdetrain(ig,l)=1.*( rhobarz(ig,l+1)*abs(wfin(ig,l+1)) - rhobarz(ig,l)*abs(wfin(ig,l)) ) / masse(ig,l) 587 591 !! Detrainment when abs(w(l)) > abs(w(l+1)), i.e. coefdetrain < 0 … … 601 605 ! dqdet_topdust_number(ig,l)=-(1.-exp(coefdetrain(ig,l)*ptimestep))*zq_dust_number(ig,l)/ptimestep 602 606 endif 603 !! Full detrainment during the night imposed607 !! Full detrainment imposed during the night or when topdust leaves its origin column (contains_mons=False) 604 608 ELSE 605 609 dqdet_topdust_mass(ig,l)=-zq_topdust_mass(ig,l)/ptimestep … … 681 685 CALL WRITEDIAGFI(ngrid,'wfin_top', & 682 686 'wfin_top','',3,wfin(:,:)) 687 CALL WRITEDIAGFI(ngrid,'hmons', & 688 'hmons','',2,hmons) 689 CALL WRITEDIAGFI(ngrid,'hsummit', & 690 'hsummit','',2,hsummit) 683 691 CALL WRITEDIAGFI(ngrid,'alpha_hmons', & 684 692 'alpha_hmons','',2,alpha_hmons) … … 961 969 962 970 963 end subroutine van_leer 964 971 end subroutine van_leer 972 965 973 !******************************************************************************** 966 ! initialization module variables 967 subroutine ini_topmons_mod(ngrid,nlayer) 968 969 implicit none 970 971 integer, intent(in) :: ngrid 972 integer, intent(in) :: nlayer 973 974 allocate(alpha_hmons(ngrid)) 975 976 end subroutine ini_topmons_mod 977 978 subroutine end_topmons_mod 979 980 implicit none 981 982 if (allocated(alpha_hmons)) deallocate(alpha_hmons) 983 984 end subroutine end_topmons_mod 974 subroutine topmons_setup(ngrid) 975 ! Purpose: 976 ! 1) Fill the logical array contains_mons(:), 977 ! with contains_mons(ig)=True if there is 978 ! a mountain in the mesh ig 979 ! 2) Compute alpha_hmons(:) and hsummit(:) 980 use surfdat_h,only: phisfi,hmons,summit,base,& 981 alpha_hmons,hsummit,contains_mons 982 use comcstfi_h,only: pi,g 983 use planetwide_mod,only: planetwide_maxval, planetwide_minval 984 use geometry_mod,only: longitude_deg,latitude_deg,& 985 boundslon,boundslat !boundslon/lat(ngrid,4) : 986 ! |------------------------------| 987 ! |north_west=2 north_east=1| 988 ! | | 989 ! | (ig) | 990 ! | | 991 ! |south_west=3 south_east=4| 992 ! |------------------------------| 993 994 implicit none 995 integer,intent(in) :: ngrid 996 997 ! Local variables 998 integer,parameter :: ntop_max = 19 ! total number of mounts written in the hmons list 999 real lon_top(ntop_max),lat_top(ntop_max) ! coordinates of the mounts (in deg) 1000 ! Mountains list : 1001 ! Olympus Mons,Ascraeus Mons,Elysium Mons,Arsia Mons,Pavonis Mons, 1002 ! Hecates Tholus,Tharsis Tholus,Ceraunius Tholus,Alba Mons,Apollinaris Mons, 1003 ! Albor Tholus,Biblis Tholus,Anseris Mons,Ulysses Tholus,Aeolis Mons, 1004 ! Euripus Mons,Hadriacus Mons,Tyrrhenus Mons,Uranius Mons 1005 ! 1006 ! NB: in 64x48 horiz. resolution, Biblis Tholus & Ulysses Tholus fall in the 1007 ! same mesh, hence only Biblis Tholus is kept by the alpha_hmons computation 1008 data lon_top/-134.,-104.5,146.9,-121.1,-113.4,& 1009 150.2,-90.8,-97.4,-109.6,174.4,& 1010 150.4,-124.6,86.6,-121.6,137.8,& 1011 105.,91.8,106.5,-92.2/ 1012 data lat_top/18.4,11.8,24.8,-8.4,-0.8,& 1013 31.8,13.4,24.,40.4,-9.3,& 1014 18.8,2.6,-29.8,2.9,-5.4,& 1015 -44.8,-32.1,-21.1,26.8/ 1016 integer,parameter :: ntop = 19 ! the topmons scheme is limited to the first ntop mounts 1017 real :: boundslon_deg(4),boundslat_deg(4) 1018 real :: hmax,hmin 1019 integer :: ig,itop 1020 1021 1022 1023 IF (ngrid.gt.1) THEN 1024 ! Sanity check 1025 if (ntop.gt.ntop_max) then 1026 call abort_physic("topmons_setup","Number of mountains ntop greater than ntop_max",1) 1027 endif 1028 1029 ! Determine contains_mons 1030 contains_mons(:)=.false. 1031 1032 do ig=1,ngrid 1033 boundslon_deg(:)=boundslon(ig,:)/pi*180. 1034 boundslat_deg(:)=boundslat(ig,:)/pi*180. 1035 1036 do itop=1,ntop 1037 if ( (lon_top(itop).gt.boundslon_deg(2)).and.(lon_top(itop).lt.boundslon_deg(1)) & 1038 .and.(lat_top(itop).gt.boundslat_deg(3)).and.(lat_top(itop).lt.boundslat_deg(2)) ) then 1039 contains_mons(ig)=.true. 1040 write(*,*) "topmons_setup: Found a mount at:" 1041 write(*,*) "(",boundslon_deg(2),",",boundslat_deg(2),") (",boundslon_deg(1),",",boundslat_deg(1),")" 1042 write(*,*) " ((",lon_top(itop),",",lat_top(itop),"))" 1043 write(*,*) "(",boundslon_deg(3),",",boundslat_deg(3),") (",boundslon_deg(4),",",boundslat_deg(4),")" 1044 endif 1045 enddo 1046 enddo 1047 1048 ! Compute alpha_hmons 1049 call planetwide_maxval(hmons,hmax) 1050 call planetwide_minval(hmons,hmin) 1051 do ig=1,ngrid 1052 if (contains_mons(ig)) then 1053 ! the mesh ig contains a mountain 1054 alpha_hmons(ig)= 0.5*(hmons(ig)-hmin)/(hmax-hmin) 1055 ! Sanity check 1056 if (alpha_hmons(ig).le.0) then 1057 call abort_physic("topmons_setup","ERROR: alpha_hmons cannot be <0 "//& 1058 "if the mesh contains a mountain. Please check your "//& 1059 "formula or your start files.",1) 1060 endif 1061 else 1062 ! the mesh ig doesn't contain a mountain 1063 alpha_hmons(ig)= 0 1064 endif 1065 enddo 1066 1067 ! Compute hsummit 1068 hsummit(:)=summit(:)-phisfi(:)/g 1069 1070 ELSE ! 1D case 1071 hmin=0. 1072 hmax=23162.1 !set here the height of the sub-grid scale topography 1073 do ig=1,ngrid 1074 alpha_hmons(ig)= (hmons(ig)-hmin)/(hmax-hmin) !0.1*(hmons(ig)-hmin)/(hmax-hmin) 1075 print*,"1D, hmons=",hmons(ig),"alpha=",alpha_hmons(ig) 1076 enddo 1077 1078 hsummit(:)=14000. 1079 ENDIF ! (ngrid.gt.1) 1080 1081 end subroutine topmons_setup 1082 !******************************************************************************** 985 1083 986 1084 END MODULE topmons_mod -
trunk/LMDZ.MARS/libf/phymars/updatereffrad_mod.F
r2584 r2628 142 142 143 143 ! updating radius of topdust particles 144 IF ( slpwind.AND.active) THEN144 IF (topflows.AND.active) THEN 145 145 DO l=1,nlayer 146 146 DO ig=1, ngrid
Note: See TracChangeset
for help on using the changeset viewer.
