Changeset 3557 for trunk/LMDZ.PLUTO
- Timestamp:
- Dec 17, 2024, 2:11:17 PM (6 days ago)
- Location:
- trunk/LMDZ.PLUTO/libf/phypluto
- Files:
-
- 6 edited
-
callkeys_mod.F90 (modified) (1 diff)
-
datafile_mod.F90 (modified) (2 diffs)
-
inifis_mod.F90 (modified) (2 diffs)
-
initracer.F90 (modified) (7 diffs)
-
physiq_mod.F90 (modified) (17 diffs)
-
tracer_h.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.PLUTO/libf/phypluto/callkeys_mod.F90
r3539 r3557 209 209 real,save :: deltap ! width of transition to alpha_top (Pa) 210 210 !$OMP THREADPRIVATE(alpha_top,pref,deltap) 211 211 212 !! Microphysics-specific variables 213 logical,save :: callmufi, call_haze_prod_pCH4 214 !$OMP THREADPRIVATE(callmufi,call_haze_prod_pCH4) 215 real,save :: haze_p_prod, haze_tx_prod, haze_rc_prod 216 real,save :: haze_rm, haze_df, haze_rho 217 real,save :: air_rad 218 !$OMP THREADPRIVATE(haze_p_prod,haze_tx_prod,haze_rc_prod,haze_rm,haze_df,haze_rho,air_rad) 212 219 213 220 integer,save :: iddist -
trunk/LMDZ.PLUTO/libf/phypluto/datafile_mod.F90
r3353 r3557 10 10 ! character(len=300) :: datadir='/san/home/rdword/gcm/datagcm' 11 11 ! Default for LMD machines: 12 character(len=300),save :: datadir=' /u/lmdz/WWW/planets/LMDZ.GENERIC/datagcm'12 character(len=300),save :: datadir='datagcm' 13 13 !$OMP THREADPRIVATE(datadir) 14 14 15 15 ! Subdirectories of 'datadir': 16 17 ! Default directory for microphysics 18 ! Set in inifis_mod 19 character(LEN=100),save :: config_mufi ='datagcm/microphysics/config.cfg' 20 !$OMP THREADPRIVATE(config_mufi) 16 21 17 22 ! surfdir stores planetary topography, albedo, etc. (surface.nc files) … … 27 32 character(len=300),save :: hazedens_file 28 33 29 30 34 end module datafile_mod 31 35 !----------------------------------------------------------------------- -
trunk/LMDZ.PLUTO/libf/phypluto/inifis_mod.F90
r3539 r3557 13 13 use radcommon_h, only: ini_radcommon_h 14 14 use radii_mod, only: radfixed, Nmix_n2 15 use datafile_mod, only: datadir, hazeprop_file,hazerad_file,hazemmr_file,hazedens_file15 use datafile_mod, only: datadir,config_mufi,hazeprop_file,hazerad_file,hazemmr_file,hazedens_file 16 16 use comdiurn_h, only: sinlat, coslat, sinlon, coslon 17 17 use comgeomfi_h, only: totarea, totarea_planet … … 669 669 !! Haze options 670 670 671 ! Microphysical moment model 672 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~ 673 if (is_master) write(*,*) "Run with or without microphysics?" 674 callmufi=.false. ! default value 675 call getin_p("callmufi",callmufi) 676 if (is_master) write(*,*)" callmufi = ",callmufi 677 678 ! sanity check 679 if (callmufi.and.(.not.tracer)) then 680 print*,"You are running microphysics without tracer" 681 print*,"Please start again with tracer =.true." 682 stop 683 endif 684 685 if (is_master) write(*,*) "Path to microphysical config file?" 686 config_mufi='datagcm/microphysics/config.cfg' ! default value 687 call getin_p("config_mufi",config_mufi) 688 if (is_master) write(*,*)" config_mufi = ",config_mufi 689 690 if (is_master) write(*,*) "Use haze production from CH4 photolysis or production rate?" 691 call_haze_prod_pCH4=.false. ! default value 692 call getin_p("call_haze_prod_pCH4",call_haze_prod_pCH4) 693 if (is_master) write(*,*)" call_haze_prod_pCH4 = ",call_haze_prod_pCH4 694 695 if (is_master) write(*,*) "Pressure level of aerosols production (Pa)?" 696 haze_p_prod=1.0e-2 ! default value 697 call getin_p("haze_p_prod",haze_p_prod) 698 if (is_master) write(*,*)" haze_p_prod = ",haze_p_prod 699 700 if (is_master) write(*,*) "Aerosol production rate (kg.m-2.s-1)?" 701 haze_tx_prod=9.8e-14 ! default value 702 call getin_p("haze_tx_prod",haze_tx_prod) 703 if (is_master) write(*,*)" haze_tx_prod = ",haze_tx_prod 704 705 if (is_master) write(*,*) "Equivalent radius production (m)?" 706 haze_rc_prod=1.0e-9 ! default value 707 call getin_p("haze_rc_prod",haze_rc_prod) 708 if (is_master) write(*,*)" haze_rc_prod = ",haze_rc_prod 709 710 if (is_master) write(*,*) "Monomer radius (m)?" 711 haze_rm=1.0e-8 ! default value 712 call getin_p("haze_rm",haze_rm) 713 if (is_master) write(*,*)" haze_rm = ",haze_rm 714 715 if (is_master) write(*,*) "Aerosol's fractal dimension?" 716 haze_df=2.0 ! default value 717 call getin_p("haze_df",haze_df) 718 if (is_master) write(*,*)" haze_df = ",haze_df 719 720 if (is_master) write(*,*) "Aerosol density (kg.m-3)?" 721 haze_rho=800.0 ! default value 722 call getin_p("haze_rho",haze_rho) 723 if (is_master) write(*,*)" haze_rho = ",haze_rho 724 725 if (is_master) write(*,*) "Radius of air molecule (m)?" 726 air_rad=1.75e-10 ! default value 727 call getin_p("air_rad",air_rad) 728 if (is_master) write(*,*)" air_rad = ",air_rad 729 730 ! Pluto haze model 731 ! ~~~~~~~~~~~~~~~~ 671 732 if (is_master)write(*,*)trim(rname)//& 672 733 "Production of haze ?" -
trunk/LMDZ.PLUTO/libf/phypluto/initracer.F90
r3405 r3557 3 3 use surfdat_h, ONLY: dryness 4 4 USE tracer_h 5 USE callkeys_mod, only: aerohaze,nb_monomer,haze,fractal,fasthaze,rad_haze 5 USE callkeys_mod, only: aerohaze,nb_monomer,haze,fractal,fasthaze,rad_haze,callmufi 6 6 USE recombin_corrk_mod, ONLY: ini_recombin 7 7 USE mod_phys_lmdz_para, only: is_master, bcast … … 23 23 ! author: F.Forget 24 24 ! ------ 25 ! Ehouarn Millour (oct. 2008) identify tracers by their names 26 ! Y Jaziri & J. Vatant d'Ollone (2020) : Modern traceur.def 27 ! L Teinturier (2022): Tracer names are now read here instead of 28 ! inside interfaces 25 ! Ehouarn Millour (oct. 2008): identify tracers by their names 26 ! Y. Jaziri & J. Vatant d'Ollone (2020) : modern traceur.def 27 ! B. de Batz de Trenquelléon (2024): specific microphysical tracers 29 28 !======================================================================= 30 29 … … 36 35 real r0_lift , reff_lift, rho_haze 37 36 integer nqhaze(nq) ! to store haze tracers 38 integer i, ia, block 37 integer i, ia, block, j 39 38 character(len=20) :: txt ! to store some text 40 CHARACTER(LEN=20) :: tracername ! to temporarily store text 39 character(LEN=20) :: tracername ! to temporarily store text 40 character(LEN=20) :: str 41 41 42 42 !----------------------------------------------------------------------- … … 350 350 enddo 351 351 endif 352 353 ! Compute number of microphysics tracers: 354 ! By convention they all have the prefix "mu_" (case sensitive !) 355 nmicro = 0 356 IF (callmufi) THEN 357 DO iq=1,nq 358 str = noms(iq) 359 IF (str(1:3) == "mu_") THEN 360 nmicro = nmicro+1 361 count = count+1 362 ENDIF 363 ENDDO 364 365 ! Checking the expected number of tracers: 366 ! Microphysics moment model: nmicro = 4 367 IF (nmicro < 4) THEN 368 WRITE(*,*) "initracer:error:"," Inconsistent number of microphysical tracers" 369 WRITE(*,*) "expected at least 4 tracers,", nmicro, " given" 370 CALL abort 371 ELSE IF (nmicro > 4) THEN 372 WRITE(*,*) "!!! WARNING !!! initracer: I was expecting only four tracers, you gave me more." 373 CALL abort 374 ENDIF 375 376 ! microphysics indexes share the same values than original tracname. 377 IF (.NOT.ALLOCATED(micro_indx)) ALLOCATE(micro_indx(nmicro)) 378 j = 1 379 DO i=1,nq 380 str = noms(i) 381 IF (str(1:3) == "mu_") THEN 382 micro_indx(j) = i 383 j=j+1 384 ENDIF 385 ENDDO 386 387 ELSE 388 IF (.NOT.ALLOCATED(micro_indx)) ALLOCATE(micro_indx(nmicro)) 389 390 ENDIF ! end of callmufi 352 391 353 392 ! Get data of tracers. Need to rewind traceur.def first … … 406 445 endif 407 446 447 ! Calculate number of microphysical tracer 448 write(*,*) 'Number of microphysical tracer nmicro = ',nmicro 449 IF (callmufi) THEN 450 call dumptracers(micro_indx) 451 ENDIF 452 408 453 ! Processing modern traceur options 409 454 if(moderntracdef) then … … 429 474 else 430 475 nmono=1 431 endif 476 endif ! end fractal 432 477 433 478 ia=0 … … 445 490 block=1 446 491 write(*,*) "i_haze=",i_haze 447 write(*,*) "Careful: if you set many haze traceurs in &448 traceur.def,only ",tracername," will be radiatively active&449 (first one in traceur.def)"492 write(*,*) "Careful: if you set many haze traceurs in & 493 traceur.def,only ",tracername," will be radiatively active & 494 (first one in traceur.def)" 450 495 endif 451 496 enddo 452 endif 453 endif 454 455 ! Initialization for water vapor !AF24: removed 497 endif ! end aerohaze 498 endif ! end haze 456 499 457 500 ! Output for records: -
trunk/LMDZ.PLUTO/libf/phypluto/physiq_mod.F90
r3544 r3557 65 65 startphy_file, testradtimes, & 66 66 tracer, UseTurbDiff, & 67 global1d, szangle 67 global1d, szangle, & 68 callmufi 68 69 use generic_tracer_index_mod, only: generic_tracer_index 69 70 use check_fields_mod, only: check_physics_fields … … 82 83 use mod_phys_lmdz_omp_data, ONLY: is_omp_master 83 84 USE mod_grid_phy_lmdz, ONLY: regular_lonlat, grid_type, unstructured 85 ! Microphysical model (mp2m) 86 use mp2m_calmufi 87 use mp2m_diagnostics 84 88 85 89 #ifdef CPP_XIOS … … 105 109 ! depending on the value of "tracer" in file "callphys.def". 106 110 ! 107 ! It includes:111 ! It includes: 108 112 ! 109 113 ! I. Initialization : … … 113 117 ! II.1 Thermosphere 114 118 ! II.2 Compute radiative transfer tendencies (longwave and shortwave) : 115 ! II. a Option 1 : Call correlated-k radiative transfer scheme.116 ! II. b Option 2 : Atmosphere has no radiative effect.119 ! II.2.a Option 1 : Call correlated-k radiative transfer scheme. 120 ! II.2.b Option 2 : Atmosphere has no radiative effect. 117 121 ! 118 122 ! III. Vertical diffusion (turbulent mixing) … … 124 128 ! 125 129 ! VI. Tracers 126 ! VI.1. Aerosols and particles.130 ! VI.1. Microphysics / Aerosols and particles. 127 131 ! VI.2. Updates (pressure variations, surface budget). 128 132 ! VI.3. Surface Tracer Update. … … 196 200 ! Purge for Pluto model : A. Falco (2024) 197 201 ! Adapting to Pluto : A. Falco, T. Bertrand (2024) 202 ! Microphysical moment model: B. de Batz de Trenquelléon (2024) 198 203 !================================================================== 199 204 … … 394 399 real zdpsrfmr(ngrid) ! Pressure tendency for mass_redistribution routine (Pa/s). 395 400 401 ! Local variables for MICROPHYSICS: 402 ! --------------------------------- 403 real gzlat(ngrid,nlayer) ! Altitude-Latitude-dependent gravity (this should be stored elsewhere...). 404 real pdqmufi(ngrid,nlayer,nq) ! Microphysical tendency (X/kg_of_air/s). 405 real pdqmufi_prod(ngrid,nlayer,nq) ! Aerosols production tendency (kg/kg_of_air/s). 406 real int2ext(ngrid,nlayer) ! Intensive to extensive factor (kg_air/m3: X/kg_air --> X/m3). 407 396 408 ! Local variables for LOCAL CALCULATIONS: 397 409 ! --------------------------------------- … … 464 476 465 477 real reffrad_generic_zeros_for_wrf(ngrid,nlayer) ! !!! this is temporary, it is only a list of zeros, it will be replaced when a generic aerosol will be implemented 466 467 ! For Clear Sky Case. (AF24: deleted)468 478 469 479 real nconsMAX, vdifcncons(ngrid), cadjncons(ngrid) ! Vdfic water conservation test. By RW … … 645 655 call getin_p("metallicity",metallicity) ! --- is not used here but necessary to call function Psat_generic 646 656 647 ! Set some parameters for the thermal plume model !AF24: removed648 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~649 650 657 if (ngrid.ne.1) then ! Note : no need to create a restart file in 1d. 651 658 call physdem0("restartfi.nc",longitude,latitude,nsoilmx,ngrid,nlayer,nq, & … … 654 661 endif 655 662 663 ! Initialize correlated-k. 664 ! ~~~~~~~~~~~~~~~~~~~~~~~~ 656 665 if (corrk) then 657 666 ! We initialise the spectral grid here instead of … … 672 681 endif 673 682 endif 683 684 ! Initialize microphysics. 685 ! ~~~~~~~~~~~~~~~~~~~~~~~~ 686 IF (callmufi) THEN 687 ! Initialize microphysics arrays. 688 call inimufi(ptimestep) 689 ENDIF ! end callmufi 674 690 675 691 !! call WriteField_phy("post_corrk_firstcall_qsurf",qsurf(1:ngrid,igcm_h2o_gas),1) … … 816 832 call testconservmass(ngrid,nlayer,pplev(:,1),qsurf(:,1)) 817 833 endif 834 835 ! Compute variations of g with latitude (to do). 836 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 837 gzlat(:,:) = g 838 839 ! Initialize microphysical diagnostics. 840 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 841 IF (callmufi) THEN 842 ! Initialize intensive to extensive factor (kg_air/m3: X/kg_air --> X/m3). 843 int2ext(:,:) = (pplev(:,1:nlayer)-pplev(:,2:nlayer+1)) / gzlat(:,1:nlayer) / (zzlev(:,2:nlayer+1)-zzlev(:,1:nlayer)) 844 845 ! Initialize microphysics diagnostics arrays. 846 call inimufi_diag(ngrid,nlayer,nq,pq,int2ext) 847 ENDIF ! end callmufi 818 848 819 849 ! -------------------------------------------------------- … … 1446 1476 if (tracer) then 1447 1477 1448 ! 7a. Methane, CO, and ice1449 1478 ! --------------------------------------- 1450 1479 ! Methane ice condensation in the atmosphere … … 1516 1545 END IF ! of IF (carbox) 1517 1546 1518 ! 7b. Haze particle production 1519 ! ------------------- 1520 IF (haze) THEN 1521 1522 zdqphot_prec(:,:)=0. 1523 zdqphot_ch4(:,:)=0. 1524 zdqhaze(:,:,:)=0 1525 ! Forcing to a fixed haze profile if haze_proffix 1526 if (haze_proffix.and.i_haze.gt.0.) then 1527 call haze_prof(ngrid,nlayer,zzlay,pplay,pt, & 1528 reffrad,profmmr) 1529 zdqhaze(:,:,i_haze)=(profmmr(:,:)-pq(:,:,igcm_haze)) & 1530 /ptimestep 1531 else 1532 call hazecloud(ngrid,nlayer,nq,ptimestep, & 1533 pplay,pplev,pq,pdq,dist_star,mu0,zfluxuv,zdqhaze, & 1534 zdqphot_prec,zdqphot_ch4,zdqconv_prec,declin) 1535 endif 1536 1537 DO iq=1, nq ! should be updated 1538 DO l=1,nlayer 1547 ! ---------------------------------------- 1548 ! VI.1. Microphysics / Aerosol particles 1549 ! ---------------------------------------- 1550 ! Production for microphysics 1551 IF (callmufi .and. call_haze_prod_pCH4) THEN 1552 zdqphot_prec(:,:) = 0. 1553 zdqphot_ch4(:,:) = 0. 1554 pdqmufi_prod(:,:,:) = 0. 1555 1556 call hazecloud(ngrid,nlayer,nq,ptimestep, & 1557 pplay,pplev,pq,pdq,dist_star,mu0,zfluxuv,pdqmufi_prod, & 1558 zdqphot_prec,zdqphot_ch4,zdqconv_prec,declin) 1559 ENDIF ! end callmufi .and. .and.call_haze_prod_pCH4 1560 1561 ! Call of microphysics 1562 IF (callmufi) THEN 1563 1564 pdqmufi(:,:,:) = 0. 1565 1566 call calmufi(ptimestep,pplev,zzlev,pplay,zzlay,gzlat,pt,pq,pdq,pdqmufi_prod,pdqmufi) 1567 1568 pdq(:,:,:) = pdq(:,:,:) + pdqmufi(:,:,:) 1569 1570 ! [BBT: Temporal tests] 1571 ! >>>>>>>>>>>>>>>>>>>>> 1572 !write(*,*) 'pdqmufi_prod', MAXVAL(pdqmufi_prod(1,:,11)), 'i', MAXLOC(pdqmufi_prod(1,:,11)) 1573 open(187,file='Mufi_tracers.out') 1574 write(187,*) "Pressure (Pa) - Alt (m) - M0as (X/m3) - M3as (m3/m3) - M0af (X/m3) - M3af (m3/m3)" 1575 do l=1,nlayer 1576 write(187,*) pplay(1,l),zzlay(1,l), & 1577 (pq(1,l,micro_indx(1))+pdq(1,l,micro_indx(1))*ptimestep)*int2ext(1,l), & 1578 (pq(1,l,micro_indx(2))+pdq(1,l,micro_indx(2))*ptimestep)*int2ext(1,l), & 1579 (pq(1,l,micro_indx(3))+pdq(1,l,micro_indx(3))*ptimestep)*int2ext(1,l), & 1580 (pq(1,l,micro_indx(4))+pdq(1,l,micro_indx(4))*ptimestep)*int2ext(1,l) 1581 enddo 1582 close(187) 1583 open(188,file='Mufi_tendencies.out') 1584 write(188,*) "Pressure (Pa) - Alt (m) - dM0as (X/kg_air/s) - dM3as (m3/kg_air/s) - dM0af (X/kg_air/s) - dM3af (m3/kg_air/s)" 1585 do l=1,nlayer 1586 write(188,*) pplay(1,l),zzlay(1,l),pdqmufi(1,l,micro_indx(1)),pdqmufi(1,l,micro_indx(2)),pdqmufi(1,l,micro_indx(3)),pdqmufi(1,l,micro_indx(4)) 1587 enddo 1588 close(188) 1589 open(189,file='Mufi_diags.out') 1590 write(189,*) "Pressure (Pa) - Alt (m) - rc_sph (m) - rc_fra (m) - aer_w_sph (m/s) - aer_w_fra (m/s) - aer_prec_sph (kg/m2/s) - aer_prec_fra (kg/m2/s)" 1591 do l=1,nlayer 1592 write(189,*) pplay(1,l),zzlay(1,l),mp2m_rc_sph(1,l),mp2m_rc_fra(1,l),mp2m_aer_s_w(1,l),mp2m_aer_f_w(1,l),mp2m_aer_s_prec(1),mp2m_aer_f_prec(1) 1593 enddo 1594 close(189) 1595 ! <<<<<<<<<<<<<<<<<<<<< 1596 ENDIF ! end callmufi 1597 1598 IF (haze) THEN 1599 zdqphot_prec(:,:) = 0. 1600 zdqphot_ch4(:,:) = 0. 1601 zdqhaze(:,:,:) = 0. 1602 1603 ! Forcing to a fixed haze profile if haze_proffix 1604 if (haze_proffix.and.i_haze.gt.0.) then 1605 call haze_prof(ngrid,nlayer,zzlay,pplay,pt, & 1606 reffrad,profmmr) 1607 zdqhaze(:,:,i_haze)=(profmmr(:,:)-pq(:,:,igcm_haze))/ptimestep 1608 else 1609 call hazecloud(ngrid,nlayer,nq,ptimestep, & 1610 pplay,pplev,pq,pdq,dist_star,mu0,zfluxuv,zdqhaze, & 1611 zdqphot_prec,zdqphot_ch4,zdqconv_prec,declin) 1612 endif 1613 1614 pdq(:,:,:) = pdq(:,:,:) + zdqhaze(:,:,:) ! Should be updated 1615 ENDIF ! end haze 1616 1617 IF (fast.and.fasthaze) THEN 1618 call prodhaze(ngrid,nlayer,nq,ptimestep,pplev,pq,pdq,dist_star, & 1619 mu0,declin,zdqprodhaze,zdqsprodhaze,gradflux,fluxbot, & 1620 fluxlym_sol_bot,fluxlym_ipm_bot,flym_sol,flym_ipm) 1621 1539 1622 DO ig=1,ngrid 1540 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqhaze(ig,l,iq) 1623 pdq(ig,1,igcm_ch4_gas)=pdq(ig,1,igcm_ch4_gas)+ & 1624 zdqprodhaze(ig,igcm_ch4_gas) 1625 pdq(ig,1,igcm_prec_haze)=pdq(ig,1,igcm_prec_haze)+ & 1626 zdqprodhaze(ig,igcm_prec_haze) 1627 pdq(ig,1,igcm_haze)=abs(pdq(ig,1,igcm_haze)+ & 1628 zdqprodhaze(ig,igcm_haze)) 1629 qsurf(ig,igcm_haze)= qsurf(ig,igcm_haze)+ & 1630 zdqsprodhaze(ig)*ptimestep 1541 1631 ENDDO 1542 ENDDO 1543 ENDDO 1544 1545 ENDIF 1546 1547 IF (fast.and.fasthaze) THEN 1548 call prodhaze(ngrid,nlayer,nq,ptimestep,pplev,pq,pdq,dist_star, & 1549 mu0,declin,zdqprodhaze,zdqsprodhaze,gradflux,fluxbot, & 1550 fluxlym_sol_bot,fluxlym_ipm_bot,flym_sol,flym_ipm) 1551 1552 DO ig=1,ngrid 1553 pdq(ig,1,igcm_ch4_gas)=pdq(ig,1,igcm_ch4_gas)+ & 1554 zdqprodhaze(ig,igcm_ch4_gas) 1555 pdq(ig,1,igcm_prec_haze)=pdq(ig,1,igcm_prec_haze)+ & 1556 zdqprodhaze(ig,igcm_prec_haze) 1557 pdq(ig,1,igcm_haze)=abs(pdq(ig,1,igcm_haze)+ & 1558 zdqprodhaze(ig,igcm_haze)) 1559 qsurf(ig,igcm_haze)= qsurf(ig,igcm_haze)+ & 1560 zdqsprodhaze(ig)*ptimestep 1561 ENDDO 1562 1563 ENDIF 1564 1565 ! ------------------------- 1566 ! VI.3. Aerosol particles 1567 ! ------------------------- 1568 1569 !Generic Condensation 1632 ENDIF ! end fast.and.fasthaze 1633 1634 ! Generic Condensation 1570 1635 if (generic_condensation) then 1571 1636 call condensation_generic(ngrid,nlayer,nq,ptimestep,pplev,pplay, & … … 1626 1691 1627 1692 ! --------------- 1628 ! VI. 4. Updates1693 ! VI.2. Updates 1629 1694 ! --------------- 1630 1695 … … 1664 1729 1665 1730 ! ----------------------------- 1666 ! VI. 6. Surface Tracer Update1731 ! VI.3. Surface Tracer Update 1667 1732 ! ----------------------------- 1668 1733 … … 1709 1774 ENDDO 1710 1775 ENDIF 1711 1712 1776 1713 1777 !------------------------------------------------ -
trunk/LMDZ.PLUTO/libf/phypluto/tracer_h.F90
r3275 r3557 1 1 2 2 module tracer_h 3 3 !!------------------------------------------------------------------------------------------------------ 4 !! Stores data related to physics tracers. 5 !! 6 !! The module provides additional methods: 7 !! - indexoftracer : search for the index of a tracer in the global table (tracers_h:noms) by name. 8 !! - nameoftracer : get the name of tracer from a given index (of the global table). 9 !! - dumptracers : print the names of all tracers indexes given in argument. 10 !!------------------------------------------------------------------------------------------------------ 4 11 implicit none 5 12 6 integer, save :: nqtot ! total number of tracers7 integer, save :: nesp ! number of species in the chemistry8 integer, save :: ngt ! number of generic tracers13 integer, save :: nqtot ! total number of tracers 14 integer, save :: nesp ! number of species in the chemistry 15 integer, save :: ngt ! number of generic tracers 9 16 integer, save :: n_rgcs ! number of Radiative Generic Condensable Species 10 17 !$OMP THREADPRIVATE(nqtot,nesp,ngt,n_rgcs) … … 13 20 !$OMP THREADPRIVATE(moderntracdef) 14 21 15 character*30, save, allocatable :: noms(:) 16 real, save, allocatable :: mmol(:) ! mole mass of tracer (g/mol)17 real, save, allocatable :: aki(:) ! to compute coefficient of thermal concduction if photochem18 real, save, allocatable :: cpi(:) ! to compute cpnew in concentration.F if photochem19 real, save, allocatable :: radius(:) ! dust and ice particle radius (m)20 real, save, allocatable :: rho_q(:) ! tracer densities (kg.m-3)21 real, save, allocatable :: qext(:) ! Single Scat. Extinction coeff at 0.67 um22 character*30, save, allocatable :: noms(:)! name of the tracer 23 real, save, allocatable :: mmol(:) ! mole mass of tracer (g/mol) 24 real, save, allocatable :: aki(:) ! to compute coefficient of thermal concduction if photochem 25 real, save, allocatable :: cpi(:) ! to compute cpnew in concentration.F if photochem 26 real, save, allocatable :: radius(:) ! dust and ice particle radius (m) 27 real, save, allocatable :: rho_q(:) ! tracer densities (kg.m-3) 28 real, save, allocatable :: qext(:) ! Single Scat. Extinction coeff at 0.67 um 22 29 real, save, allocatable :: alpha_lift(:) ! saltation vertical flux/horiz flux ratio (m-1) 23 30 real, save, allocatable :: alpha_devil(:) ! lifting coeeficient by dust devil 24 real, save, allocatable :: qextrhor(:) ! Intermediate for computing opt. depth from q31 real, save, allocatable :: qextrhor(:) ! Intermediate for computing opt. depth from q 25 32 26 33 real,save :: varian ! Characteristic variance of log-normal distribution 27 real,save :: r3n_q ! used to compute r0 from number and mass mixing ratio28 real,save :: rho_dust 34 real,save :: r3n_q ! used to compute r0 from number and mass mixing ratio 35 real,save :: rho_dust ! Mars dust density (kg.m-3) 29 36 real,save :: rho_ice ! Water ice density (kg.m-3) 30 real,save :: rho_ch4_ice 31 real,save :: rho_co_ice 32 real,save :: rho_n2 ! N2 ice density (kg.m-3)33 real,save :: lw_ch4 ! Latent heat CH4 gas -> solid34 real,save :: lw_co ! Latent heat CO gas -> solid35 real,save :: lw_n2 ! Latent heat N2 gas -> solid37 real,save :: rho_ch4_ice ! ch4 ice density (kg.m-3) 38 real,save :: rho_co_ice ! co ice density (kg.m-3) 39 real,save :: rho_n2 ! N2 ice density (kg.m-3) 40 real,save :: lw_ch4 ! Latent heat CH4 gas -> solid 41 real,save :: lw_co ! Latent heat CO gas -> solid 42 real,save :: lw_n2 ! Latent heat N2 gas -> solid 36 43 integer,save :: nmono 37 44 real,save :: ref_r0 ! for computing reff=ref_r0*r0 (in log.n. distribution) … … 49 56 integer, save, allocatable :: is_condensable(:) ! 1 if tracer is generic, else 0 (added LT) 50 57 integer,save,allocatable :: is_rgcs(:) ! 1 if tracer is a radiative generic condensable specie, else 0 (added LT 2022) 58 !$OMP THREADPRIVATE(is_condensable,is_rgcs) !also added by LT 51 59 ! Lists of constants for condensable tracers 52 real, save, allocatable :: constants_mass(:) 60 real, save, allocatable :: constants_mass(:) ! molecular mass of the specie (g/mol) 53 61 real, save, allocatable :: constants_delta_gasH(:) ! Enthalpy of vaporization (J/mol) 54 62 real, save, allocatable :: constants_Tref(:) ! Ref temperature for Clausis-Clapeyron (K) 55 63 real, save, allocatable :: constants_Pref(:) ! Reference pressure for Clausius Clapeyron (Pa) 56 real, save, allocatable :: constants_epsi_generic(:) 57 real, save, allocatable :: constants_RLVTT_generic(:) 64 real, save, allocatable :: constants_epsi_generic(:) ! fractionnal molecular mass (m/mugaz) 65 real, save, allocatable :: constants_RLVTT_generic(:) ! Latent heat of vaporization (J/kg) 58 66 real, save, allocatable :: constants_metallicity_coeff(:) ! Coefficient to take into account the metallicity 59 real, save, allocatable :: constants_RCPV_generic(:) 67 real, save, allocatable :: constants_RCPV_generic(:) ! specific heat capacity of the tracer vapor at Tref 60 68 !$OMP THREADPRIVATE(constants_mass,constants_delta_gasH,constants_Tref) 61 69 !$OMP THREADPRIVATE(constants_Pref,constants_epsi_generic) 62 70 !$OMP THREADPRIVATE(constants_RLVTT_generic,constants_metallicity_coeff,constants_RCPV_generic) 63 71 64 !$OMP THREADPRIVATE(is_condensable,is_rgcs) !also added by LT65 72 ! tracer indexes: these are initialized in initracer and should be 0 if the 66 73 ! corresponding tracer does not exist 67 74 68 ! Pluto chemistry75 ! Pluto chemistry 69 76 integer,save :: igcm_co_gas 70 77 integer,save :: igcm_n2 71 78 integer,save :: igcm_ar 72 79 integer,save :: igcm_ch4_gas ! methane gas 73 ! other tracers 74 integer,save :: igcm_ar_n2 ! for simulations using co2 +neutral gaz 80 !$OMP THREADPRIVATE(igcm_co_gas,igcm_n2,igcm_ar,igcm_ch4_gas) 81 ! Other tracers 82 integer,save :: igcm_ar_n2 ! for simulations using co2 + neutral gaz 75 83 integer,save :: igcm_ch4_ice ! methane ice 76 integer,save :: igcm_co_ice ! methane ice 84 integer,save :: igcm_co_ice ! CO ice 85 !$OMP THREADPRIVATE(igcm_ar_n2,igcm_ch4_ice,igcm_co_ice) 77 86 integer,save :: igcm_prec_haze 78 87 integer,save :: igcm_haze … … 81 90 integer,save :: igcm_haze50 82 91 integer,save :: igcm_haze100 92 !$OMP THREADPRIVATE(igcm_prec_haze,igcm_haze,igcm_haze10,igcm_haze30,igcm_haze50,igcm_haze100) 83 93 integer,save :: igcm_eddy1e6 84 94 integer,save :: igcm_eddy1e7 … … 86 96 integer,save :: igcm_eddy1e8 87 97 integer,save :: igcm_eddy5e8 98 !$OMP THREADPRIVATE(igcm_eddy1e6,igcm_eddy1e7,igcm_eddy5e7,igcm_eddy1e8,igcm_eddy5e8) 88 99 89 !$OMP THREADPRIVATE(igcm_co_gas,igcm_n2,igcm_ar,igcm_ch4_gas,igcm_ar_n2,igcm_ch4_ice,igcm_co_ice,igcm_prec_haze,igcm_haze,igcm_haze10,igcm_haze30,igcm_haze50,igcm_haze100,igcm_eddy1e6,igcm_eddy1e7,igcm_eddy5e7,igcm_eddy1e8,igcm_eddy5e8) 100 ! Microphysical model 101 integer, save :: nmicro = 0 !! Number of microphysics tracers. 102 integer, save, allocatable :: micro_indx(:) !! Indexes of all microphysical tracers 103 !$OMP THREADPRIVATE(nmicro) 104 105 CONTAINS 106 107 FUNCTION indexoftracer(name, sensitivity) RESULT(idx) 108 !! Get the index of a tracer by name. 109 !! 110 !! The function searches in the global tracer table (tracer_h:noms) 111 !! for the given name and returns the first index matching "name". 112 !! 113 !! If no name in the table matches the given one, -1 is returned ! 114 IMPLICIT NONE 115 CHARACTER(len=*), INTENT(in) :: name !! Name of the tracer to search. 116 LOGICAL, OPTIONAL, INTENT(in) :: sensitivity !! Case sensitivity (true by default). 117 INTEGER :: idx !! Index of the first tracer matching name or -1 if not found. 118 LOGICAL :: zsens 119 INTEGER :: j 120 CHARACTER(len=LEN(name)) :: zname 121 zsens = .true. ; IF(PRESENT(sensitivity)) zsens = sensitivity 122 idx = -1 123 IF (.NOT.ALLOCATED(noms)) RETURN 124 IF (zsens) THEN 125 DO j=1,SIZE(noms) 126 IF (TRIM(noms(j)) == TRIM(name)) THEN 127 idx = j ; RETURN 128 ENDIF 129 ENDDO 130 ELSE 131 zname = to_lower(name) 132 DO j=1,SIZE(noms) 133 IF (TRIM(to_lower(noms(j))) == TRIM(zname)) THEN 134 idx = j ; RETURN 135 ENDIF 136 ENDDO 137 ENDIF 138 139 CONTAINS 140 141 FUNCTION to_lower(istr) RESULT(ostr) 142 !! Lower case conversion function. 143 IMPLICIT NONE 144 CHARACTER(len=*), INTENT(in) :: istr 145 CHARACTER(len=LEN(istr)) :: ostr 146 INTEGER :: i,ic 147 ostr = istr 148 DO i = 1, LEN_TRIM(istr) 149 ic = ICHAR(istr(i:i)) 150 IF (ic >= 65 .AND. ic < 90) ostr(i:i) = char(ic + 32) 151 ENDDO 152 END FUNCTION to_lower 153 END FUNCTION indexoftracer 154 155 FUNCTION nameoftracer(indx) RESULT(name) 156 !! Get the name of a tracer by index. 157 !! 158 !! The function searches in the global tracer table (tracer_h:noms) 159 !! and returns the name of the tracer at given index. 160 !! 161 !! If the index is out of range an empty string is returned. 162 IMPLICIT NONE 163 INTEGER, INTENT(in) :: indx !! Index of the tracer name to retrieve. 164 CHARACTER(len=30) :: name !! Name of the tracer at given index. 165 name = '' 166 IF (.NOT.ALLOCATED(noms)) RETURN 167 IF (indx <= 0 .OR. indx > SIZE(noms)) RETURN 168 name = noms(indx) 169 END FUNCTION nameoftracer 170 171 SUBROUTINE dumptracers(indexes) 172 !! Print the names of the given list of tracers indexes. 173 INTEGER, DIMENSION(:), INTENT(in) :: indexes 174 INTEGER :: i,idx 175 CHARACTER(len=:), ALLOCATABLE :: suffix 176 177 IF (.NOT.ALLOCATED(noms)) THEN 178 WRITE(*,'(a)') "[tracers_h:dump_tracers] warning: 'noms' is not allocated, initracer has not be called yet" 179 RETURN 180 ENDIF 181 182 DO i=1,size(indexes) 183 idx = indexes(i) 184 IF (ANY(micro_indx == idx)) THEN 185 suffix = ' (micro)' 186 ELSE 187 suffix=" ()" 188 ENDIF 189 WRITE(*,'(I5,(a),I6,(a))') i," -> ",idx ," : "//TRIM(noms(idx))//suffix 190 ENDDO 191 END SUBROUTINE dumptracers 90 192 91 193 end module tracer_h 92
Note: See TracChangeset
for help on using the changeset viewer.
