Changeset 3557


Ignore:
Timestamp:
Dec 17, 2024, 2:11:17 PM (5 days ago)
Author:
debatzbr
Message:

Miscellaneous cleans + Set-up the physics for the implementation of the microphysical model.

Location:
trunk/LMDZ.PLUTO/libf/phypluto
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.PLUTO/libf/phypluto/callkeys_mod.F90

    r3539 r3557  
    209209      real,save    :: deltap    ! width of transition to alpha_top (Pa)
    210210!$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)
    212219
    213220      integer,save :: iddist

  • trunk/LMDZ.PLUTO/libf/phypluto/datafile_mod.F90

    r3353 r3557  
    1010!      character(len=300) :: datadir='/san/home/rdword/gcm/datagcm'
    1111      ! Default for LMD machines:
    12       character(len=300),save :: datadir='/u/lmdz/WWW/planets/LMDZ.GENERIC/datagcm'
     12      character(len=300),save :: datadir='datagcm'
    1313!$OMP THREADPRIVATE(datadir)
    1414
    1515      ! 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)
    1621
    1722      ! surfdir stores planetary topography, albedo, etc. (surface.nc files)
    … …  
    2732      character(len=300),save :: hazedens_file
    2833
    29 
    3034      end module datafile_mod
    3135!-----------------------------------------------------------------------

  • trunk/LMDZ.PLUTO/libf/phypluto/inifis_mod.F90

    r3539 r3557  
    1313  use radcommon_h, only: ini_radcommon_h
    1414  use radii_mod, only: radfixed, Nmix_n2
    15   use datafile_mod, only: datadir,hazeprop_file,hazerad_file,hazemmr_file,hazedens_file
     15  use datafile_mod, only: datadir,config_mufi,hazeprop_file,hazerad_file,hazemmr_file,hazedens_file
    1616  use comdiurn_h, only: sinlat, coslat, sinlon, coslon
    1717  use comgeomfi_h, only: totarea, totarea_planet
    … …  
    669669     !! Haze options
    670670
     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     ! ~~~~~~~~~~~~~~~~
    671732     if (is_master)write(*,*)trim(rname)//&
    672733     "Production of haze ?"

  • trunk/LMDZ.PLUTO/libf/phypluto/initracer.F90

    r3405 r3557  
    33      use surfdat_h, ONLY: dryness
    44      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
    66      USE recombin_corrk_mod, ONLY: ini_recombin
    77      USE mod_phys_lmdz_para, only: is_master, bcast
    … …  
    2323!   author: F.Forget
    2424!   ------
    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   
    2928!=======================================================================
    3029
    … …  
    3635      real r0_lift , reff_lift, rho_haze
    3736      integer nqhaze(nq)               ! to store haze tracers
    38       integer i, ia, block
     37      integer i, ia, block, j
    3938      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
    4141
    4242!-----------------------------------------------------------------------
    … …  
    350350        enddo
    351351      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
    352391
    353392      ! Get data of tracers. Need to rewind traceur.def first
    … …  
    406445      endif
    407446
     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
    408453!     Processing modern traceur options
    409454      if(moderntracdef) then
    … …  
    429474        else
    430475           nmono=1
    431         endif
     476        endif ! end fractal
    432477
    433478        ia=0
    … …  
    445490               block=1
    446491               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)"
    450495             endif
    451496           enddo
    452         endif
    453      endif
    454 
    455 !     Initialization for water vapor !AF24: removed
     497        endif ! end aerohaze
     498      endif ! end haze
    456499
    457500!     Output for records:

  • trunk/LMDZ.PLUTO/libf/phypluto/physiq_mod.F90

    r3544 r3557  
    6565                              startphy_file, testradtimes,                    &
    6666                              tracer, UseTurbDiff,                            &
    67                               global1d, szangle
     67                              global1d, szangle,                              &
     68                              callmufi
    6869      use generic_tracer_index_mod, only: generic_tracer_index
    6970      use check_fields_mod, only: check_physics_fields
    … …  
    8283      use mod_phys_lmdz_omp_data, ONLY: is_omp_master
    8384      USE mod_grid_phy_lmdz, ONLY: regular_lonlat, grid_type, unstructured
     85      ! Microphysical model (mp2m)
     86      use mp2m_calmufi
     87      use mp2m_diagnostics
    8488
    8589#ifdef CPP_XIOS
    … …  
    105109!     depending on the value of "tracer" in file "callphys.def".
    106110!
    107 !   It includes:
     111!     It includes:
    108112!
    109113!      I. Initialization :
    … …  
    113117!      II.1 Thermosphere
    114118!      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.
    117121!
    118122!      III. Vertical diffusion (turbulent mixing)
    … …  
    124128!
    125129!      VI. Tracers
    126 !         VI.1. Aerosols and particles.
     130!         VI.1. Microphysics / Aerosols and particles.
    127131!         VI.2. Updates (pressure variations, surface budget).
    128132!         VI.3. Surface Tracer Update.
    … …  
    196200!           Purge for Pluto model : A. Falco (2024)
    197201!           Adapting to Pluto : A. Falco, T. Bertrand (2024)
     202!           Microphysical moment model: B. de Batz de Trenquelléon (2024)
    198203!==================================================================
    199204
    … …  
    394399      real zdpsrfmr(ngrid)        ! Pressure tendency for mass_redistribution routine (Pa/s).
    395400
     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
    396408! Local variables for LOCAL CALCULATIONS:
    397409! ---------------------------------------
    … …  
    464476
    465477      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)
    468478
    469479      real nconsMAX, vdifcncons(ngrid), cadjncons(ngrid) ! Vdfic water conservation test. By RW
    … …  
    645655         call getin_p("metallicity",metallicity) ! --- is not used here but necessary to call function Psat_generic
    646656
    647 !        Set some parameters for the thermal plume model !AF24: removed
    648 !        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    649 
    650657         if (ngrid.ne.1) then ! Note : no need to create a restart file in 1d.
    651658            call physdem0("restartfi.nc",longitude,latitude,nsoilmx,ngrid,nlayer,nq, &
    … …  
    654661         endif
    655662
     663!        Initialize correlated-k.
     664!        ~~~~~~~~~~~~~~~~~~~~~~~~
    656665         if (corrk) then
    657666            ! We initialise the spectral grid here instead of
    … …  
    672681            endif
    673682         endif
     683
     684!        Initialize microphysics.
     685!        ~~~~~~~~~~~~~~~~~~~~~~~~
     686         IF (callmufi) THEN
     687            ! Initialize microphysics arrays.
     688            call inimufi(ptimestep)
     689         ENDIF ! end callmufi
    674690
    675691!!         call WriteField_phy("post_corrk_firstcall_qsurf",qsurf(1:ngrid,igcm_h2o_gas),1)
    … …  
    816832         call testconservmass(ngrid,nlayer,pplev(:,1),qsurf(:,1))
    817833      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
    818848
    819849! --------------------------------------------------------
    … …  
    14461476      if (tracer) then
    14471477
    1448 !   7a. Methane, CO, and ice
    14491478!      ---------------------------------------
    14501479!      Methane ice condensation in the atmosphere
    … …  
    15161545         END IF  ! of IF (carbox)
    15171546
    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
    15391622            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
    15411631            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
    15701635         if (generic_condensation) then
    15711636            call condensation_generic(ngrid,nlayer,nq,ptimestep,pplev,pplay,   &
    … …  
    16261691
    16271692  ! ---------------
    1628   !   VI.4. Updates
     1693  !   VI.2. Updates
    16291694  ! ---------------
    16301695
    … …  
    16641729
    16651730  ! -----------------------------
    1666   !   VI.6. Surface Tracer Update
     1731  !   VI.3. Surface Tracer Update
    16671732  ! -----------------------------
    16681733
    … …  
    17091774             ENDDO
    17101775      ENDIF
    1711 
    17121776
    17131777!------------------------------------------------

  • trunk/LMDZ.PLUTO/libf/phypluto/tracer_h.F90

    r3275 r3557  
    11
    22       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       !!------------------------------------------------------------------------------------------------------
    411       implicit none
    512
    6        integer, save :: nqtot ! total number of tracers
    7        integer, save :: nesp  ! number of species in the chemistry
    8        integer, save :: ngt   ! number of generic tracers
     13       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
    916       integer, save :: n_rgcs ! number of Radiative Generic Condensable Species
    1017!$OMP THREADPRIVATE(nqtot,nesp,ngt,n_rgcs)
    … …  
    1320!$OMP THREADPRIVATE(moderntracdef)
    1421
    15        character*30, save, allocatable :: noms(:)   ! name of the tracer
    16        real, save, allocatable :: mmol(:)     ! mole mass of tracer (g/mol)
    17        real, save, allocatable :: aki(:)      ! to compute coefficient of thermal concduction if photochem
    18        real, save, allocatable :: cpi(:)      ! to compute cpnew in concentration.F if photochem
    19        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 um
     22       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
    2229       real, save, allocatable :: alpha_lift(:)  ! saltation vertical flux/horiz flux ratio (m-1)
    2330       real, save, allocatable :: alpha_devil(:) ! lifting coeeficient by dust devil
    24        real, save, allocatable :: qextrhor(:) ! Intermediate for computing opt. depth from q
     31       real, save, allocatable :: qextrhor(:)    ! Intermediate for computing opt. depth from q
    2532
    2633       real,save :: varian      ! Characteristic variance of log-normal distribution
    27        real,save :: r3n_q     ! used to compute r0 from number and mass mixing ratio
    28        real,save :: rho_dust     ! Mars dust density (kg.m-3)
     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)
    2936       real,save :: rho_ice     ! Water ice density (kg.m-3)
    30        real,save :: rho_ch4_ice     ! ch4 ice density (kg.m-3)
    31        real,save :: rho_co_ice     ! co ice density (kg.m-3)
    32        real,save :: rho_n2     ! N2 ice density (kg.m-3)
    33        real,save :: lw_ch4     ! Latent heat CH4 gas -> solid
    34        real,save :: lw_co      ! Latent heat CO gas -> solid
    35        real,save :: lw_n2      ! Latent heat N2 gas -> solid
     37       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
    3643       integer,save :: nmono
    3744       real,save :: ref_r0        ! for computing reff=ref_r0*r0 (in log.n. distribution)
    … …  
    4956       integer, save, allocatable :: is_condensable(:)      ! 1 if tracer is generic, else 0 (added LT)
    5057       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
    5159       ! Lists of constants for condensable tracers
    52        real, save, allocatable :: constants_mass(:)                    ! molecular mass of the specie (g/mol)
     60       real, save, allocatable :: constants_mass(:)                 ! molecular mass of the specie (g/mol)
    5361       real, save, allocatable :: constants_delta_gasH(:)           ! Enthalpy of vaporization (J/mol)
    5462       real, save, allocatable :: constants_Tref(:)                 ! Ref temperature for Clausis-Clapeyron (K)
    5563       real, save, allocatable :: constants_Pref(:)                 ! Reference pressure for Clausius Clapeyron (Pa)
    56        real, save, allocatable :: constants_epsi_generic(:)                 ! fractionnal molecular mass (m/mugaz)
    57        real, save, allocatable :: constants_RLVTT_generic(:)                ! Latent heat of vaporization (J/kg)
     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)
    5866       real, save, allocatable :: constants_metallicity_coeff(:)    ! Coefficient to take into account the metallicity
    59        real, save, allocatable :: constants_RCPV_generic(:)                   ! specific heat capacity of the tracer vapor at Tref
     67       real, save, allocatable :: constants_RCPV_generic(:)         ! specific heat capacity of the tracer vapor at Tref
    6068!$OMP THREADPRIVATE(constants_mass,constants_delta_gasH,constants_Tref)
    6169!$OMP THREADPRIVATE(constants_Pref,constants_epsi_generic)
    6270!$OMP THREADPRIVATE(constants_RLVTT_generic,constants_metallicity_coeff,constants_RCPV_generic)
    6371
    64 !$OMP THREADPRIVATE(is_condensable,is_rgcs)   !also added by LT
    6572! tracer indexes: these are initialized in initracer and should be 0 if the
    6673!                 corresponding tracer does not exist
    6774
    68        !Pluto chemistry
     75       ! Pluto chemistry
    6976       integer,save :: igcm_co_gas
    7077       integer,save :: igcm_n2
    7178       integer,save :: igcm_ar
    7279       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
    7583       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)
    7786       integer,save :: igcm_prec_haze
    7887       integer,save :: igcm_haze
    … …  
    8190       integer,save :: igcm_haze50
    8291       integer,save :: igcm_haze100
     92!$OMP THREADPRIVATE(igcm_prec_haze,igcm_haze,igcm_haze10,igcm_haze30,igcm_haze50,igcm_haze100)
    8393       integer,save :: igcm_eddy1e6
    8494       integer,save :: igcm_eddy1e7
    … …  
    8696       integer,save :: igcm_eddy1e8
    8797       integer,save :: igcm_eddy5e8
     98!$OMP THREADPRIVATE(igcm_eddy1e6,igcm_eddy1e7,igcm_eddy5e7,igcm_eddy1e8,igcm_eddy5e8)
    8899
    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
    90192
    91193       end module tracer_h
    92 
Note: See TracChangeset for help on using the changeset viewer.