PartMC  2.2.0
mosaic.F90
Go to the documentation of this file.
00001 ! Copyright (C) 2007-2011 Matthew West
00002 ! Licensed under the GNU General Public License version 2 or (at your
00003 ! option) any later version. See the file COPYING for details.
00004 
00005 !> \file
00006 !> The pmc_mosaic module.
00007 
00008 !> Interface to the MOSAIC aerosol and gas phase chemistry code.
00009 module pmc_mosaic
00010   
00011   use pmc_aero_data
00012   use pmc_aero_state
00013   use pmc_constants
00014   use pmc_env_state
00015   use pmc_gas_data
00016   use pmc_gas_state
00017   use pmc_util
00018   
00019 contains
00020   
00021 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00022 
00023   !> Whether MOSAIC support is compiled in.
00024   logical function mosaic_support()
00025 
00026 #ifdef PMC_USE_MOSAIC
00027     mosaic_support = .true.
00028 #else
00029     mosaic_support = .false.
00030 #endif
00031 
00032   end function mosaic_support
00033 
00034 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00035 
00036   !> Initialize all MOSAIC data-structures.
00037   subroutine mosaic_init(env_state, aero_data, del_t, do_optical)
00038     
00039 #ifdef PMC_USE_MOSAIC
00040     use module_data_mosaic_aero, only: alpha_ASTEM, rtol_eqb_ASTEM, &
00041          ptol_mol_ASTEM, mGAS_AER_XFER, mDYNAMIC_SOLVER
00042     
00043     use module_data_mosaic_main, only: tbeg_sec, dt_sec, rlon, rlat, &
00044          zalt_m, RH, te, pr_atm, cair_mlc, cair_molm3, ppb, avogad, &
00045          mmode, mgas, maer, mcld, maeroptic, mshellcore, &
00046          msolar, mphoto, lun_aeroptic, naerbin
00047 #endif
00048     
00049     !> Environment state.
00050     type(env_state_t), intent(inout) :: env_state
00051     !> Aerosol data.
00052     type(aero_data_t), intent(in) :: aero_data
00053     !> Timestep for coagulation.
00054     real(kind=dp), intent(in) :: del_t
00055     !> Whether to compute optical properties.
00056     logical, intent(in) :: do_optical
00057 
00058 #ifdef PMC_USE_MOSAIC
00059     ! MOSAIC function interfaces
00060     interface
00061        subroutine LoadPeroxyParameters()
00062        end subroutine LoadPeroxyParameters
00063        subroutine init_data_modules()
00064        end subroutine init_data_modules
00065        subroutine AllocateMemory()
00066        end subroutine AllocateMemory
00067     end interface
00068 
00069     call init_data_modules  ! initialize indices and vars
00070 
00071     ! allocate one aerosol bin
00072     naerbin = 1
00073     call AllocateMemory()
00074     
00075     ! parameters
00076     mmode = 1               ! 1 = time integration, 2 = parametric analysis
00077     mgas = 1                ! 1 = gas chem on, 0 = gas chem off
00078     maer = 1                ! 1 = aer chem on, 0 = aer chem off
00079     mcld = 0                ! 1 = cld chem on, 0 = cld chem off
00080     if (do_optical) then
00081        maeroptic = 1        ! 1 = aer_optical on, 0 = aer_optical off
00082     else
00083        maeroptic = 0
00084     end if
00085     mshellcore = 1          ! 0 = no shellcore, 1 = core is BC only
00086                             ! 2 = core is BC and DUST
00087     msolar = 1              ! 1 = diurnally varying phot, 2 = fixed phot
00088     mphoto = 2              ! 1 = Rick's param, 2 = Yang's param
00089     mGAS_AER_XFER = 1       ! 1 = gas-aerosol partitioning, 0 = no partition
00090     mDYNAMIC_SOLVER = 1     ! 1 = astem, 2 = lsodes
00091     alpha_ASTEM = 0.5d0     ! solver parameter. range: 0.01 - 1.0
00092     rtol_eqb_ASTEM = 0.01d0 ! relative eqb tolerance. range: 0.01 - 0.03
00093     ptol_mol_ASTEM = 0.01d0 ! percent mol tolerance.  range: 0.01 - 1.0
00094     
00095     ! time variables
00096     dt_sec = del_t                                 ! time-step (s)
00097     tbeg_sec = env_state%start_day*24*3600 + &     ! time since the beg of
00098          nint(env_state%start_time)                ! year 00:00, UTC (s)
00099     
00100     ! geographic location
00101     rlon = deg2rad(env_state%longitude)            ! longitude
00102     rlat = deg2rad(env_state%latitude)             ! latitude
00103     zalt_m = env_state%altitude                    ! altitude (m)
00104  
00105     ! environmental parameters: map PartMC -> MOSAIC
00106     RH = env_state%rel_humid * 100.d0              ! relative humidity (%)
00107     te = env_state%temp                            ! temperature (K)
00108     pr_atm = env_state%pressure / const%air_std_press ! pressure (atm)
00109     cair_mlc = avogad*pr_atm/(82.056d0*te)         ! air conc [molec/cc]
00110     cair_molm3 = 1d6*pr_atm/(82.056d0*te)          ! air conc [mol/m^3]
00111     ppb = 1d9
00112 
00113     call LoadPeroxyParameters ! Aperox and Bperox only once
00114     
00115     ! get unit for aerosol optical output
00116     if (lun_aeroptic <= 0 ) lun_aeroptic = get_unit()
00117 
00118     ! ensure H2O is a valid species
00119     call assert_msg(111041803, aero_data%i_water > 0, &
00120          "MOSAIC requires H2O as an aerosol species")
00121 
00122 #endif
00123     
00124   end subroutine mosaic_init
00125 
00126 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00127 
00128   !> Clean-up after running MOSAIC, deallocating memory.
00129   subroutine mosaic_cleanup()
00130     
00131 #ifdef PMC_USE_MOSAIC
00132     ! MOSAIC function interfaces
00133     interface
00134        subroutine DeallocateMemory()
00135        end subroutine DeallocateMemory
00136     end interface
00137 
00138     call DeallocateMemory()
00139 #endif
00140     
00141   end subroutine mosaic_cleanup
00142 
00143 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00144 
00145   !> Map all data PartMC -> MOSAIC.
00146   subroutine mosaic_from_partmc(env_state, aero_data, &
00147        aero_state, gas_data, gas_state)
00148     
00149 #ifdef PMC_USE_MOSAIC
00150     use module_data_mosaic_aero, only: nbin_a, aer, num_a, jhyst_leg, &
00151          jtotal, water_a
00152     
00153     use module_data_mosaic_main, only: tbeg_sec, tcur_sec, tmid_sec, &
00154          dt_sec, dt_min, dt_aeroptic_min, RH, te, pr_atm, cnn, cair_mlc, &
00155          cair_molm3, ppb, avogad, msolar, naerbin
00156 #endif
00157     
00158     !> Environment state.
00159     type(env_state_t), intent(in) :: env_state
00160     !> Aerosol data.
00161     type(aero_data_t), intent(in) :: aero_data
00162     !> Aerosol state.
00163     type(aero_state_t), intent(in) :: aero_state
00164     !> Gas data.
00165     type(gas_data_t), intent(in) :: gas_data
00166     !> Gas state.
00167     type(gas_state_t), intent(in) :: gas_state
00168 
00169 #ifdef PMC_USE_MOSAIC
00170     ! local variables
00171     real(kind=dp) :: time_UTC    ! 24-hr UTC clock time (hr).
00172     real(kind=dp) :: tmar21_sec  ! Time at noon, march 21, UTC (s).
00173     real(kind=dp) :: conv_fac(aero_data%n_spec), dum_var
00174     integer :: i_part, i_spec, i_spec_mosaic
00175     type(aero_particle_t), pointer :: particle
00176     real(kind=dp) :: num_conc
00177 
00178     ! MOSAIC function interfaces
00179     interface
00180        subroutine AllocateMemory()
00181        end subroutine AllocateMemory
00182        subroutine DeallocateMemory()
00183        end subroutine DeallocateMemory
00184     end interface
00185 
00186     ! update time variables
00187     tmar21_sec = real((79*24 + 12)*3600, kind=dp)    ! noon, mar 21, UTC
00188     tcur_sec = real(tbeg_sec, kind=dp) + env_state%elapsed_time
00189     ! current (old) time since the beg of year 00:00, UTC (s)
00190 
00191     time_UTC = env_state%start_time/3600d0  ! 24-hr UTC clock time (hr)
00192     time_UTC = time_UTC + dt_sec/3600d0
00193 
00194     do while (time_UTC >= 24d0)
00195        time_UTC = time_UTC - 24d0
00196     end do
00197 
00198     tmid_sec = tcur_sec + 0.5d0*dt_sec
00199     if(tmid_sec .ge. tmar21_sec)then
00200        tmid_sec = tmid_sec - tmar21_sec     ! seconds since noon, march 21
00201     else
00202        tmid_sec = tmid_sec &
00203             + dble(((365-79)*24 - 12)*3600) ! seconds since noon, march 21
00204     endif
00205 
00206     ! transport timestep (min)
00207     dt_min = dt_sec/60d0
00208     ! aerosol optics timestep (min)
00209     dt_aeroptic_min = 0d0
00210 
00211     ! compute aerosol conversion factors
00212     do i_spec = 1,aero_data%n_spec
00213        ! converts m^3(species) to nmol(species)/m^3(air)
00214        conv_fac(i_spec) = 1.D9 * aero_data%density(i_spec) &
00215             / aero_data%molec_weight(i_spec)
00216     enddo
00217 
00218     ! environmental parameters: map PartMC -> MOSAIC
00219     RH = env_state%rel_humid * 100.d0              ! relative humidity (%)
00220     te = env_state%temp                            ! temperature (K)
00221     pr_atm = env_state%pressure / const%air_std_press ! pressure (atm)
00222     cair_mlc = avogad*pr_atm/(82.056d0*te)   ! air conc [molec/cc]
00223     cair_molm3 = 1d6*pr_atm/(82.056d0*te)    ! air conc [mol/m^3]
00224     ppb = 1d9
00225     
00226     ! aerosol data: map PartMC -> MOSAIC
00227     nbin_a = aero_state_total_particles(aero_state)
00228     if (nbin_a > naerbin) then
00229        call DeallocateMemory()
00230        naerbin = nbin_a
00231        call AllocateMemory()
00232     end if
00233     aer = 0d0    ! initialize to zero
00234     ! work backwards for consistency with mosaic_to_partmc(), which
00235     ! has specific ordering requirements
00236     do i_part = aero_state%apa%n_part,1,-1
00237        particle => aero_state%apa%particle(i_part)
00238        num_conc = aero_weight_array_num_conc(aero_state%aero_weight, particle)
00239        do i_spec = 1,aero_data%n_spec
00240           i_spec_mosaic = aero_data%mosaic_index(i_spec)
00241           if (i_spec_mosaic > 0) then
00242              ! convert m^3(species) to nmol(species)/m^3(air)
00243              aer(i_spec_mosaic, 3, i_part) &   ! nmol/m^3(air)
00244                   = particle%vol(i_spec) * conv_fac(i_spec) * num_conc
00245           end if
00246        end do
00247        ! handle water specially
00248        ! convert m^3(water) to kg(water)/m^3(air)
00249        water_a(i_part) = particle%vol(aero_data%i_water) &
00250             * aero_data%density(aero_data%i_water) * num_conc
00251        num_a(i_part) = 1d-6 * num_conc ! num conc (#/cc(air))
00252        jhyst_leg(i_part) = particle%water_hyst_leg
00253     end do
00254 
00255     ! gas chemistry: map PartMC -> MOSAIC
00256     cnn = 0d0
00257     do i_spec = 1,gas_data%n_spec
00258        i_spec_mosaic = gas_data%mosaic_index(i_spec)
00259        if (i_spec_mosaic > 0) then
00260           ! convert ppbv to molec/cc
00261           cnn(i_spec_mosaic) = gas_state%mix_rat(i_spec) * cair_mlc / ppb
00262        end if
00263     end do
00264 #endif
00265 
00266   end subroutine mosaic_from_partmc
00267 
00268 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00269   
00270   !> Map all data MOSAIC -> PartMC.
00271   subroutine mosaic_to_partmc(env_state, aero_data, aero_state, gas_data, &
00272        gas_state)
00273     
00274 #ifdef PMC_USE_MOSAIC
00275     use module_data_mosaic_aero, only: nbin_a, aer, num_a, jhyst_leg, &
00276          jtotal, water_a
00277     
00278     use module_data_mosaic_main, only: tbeg_sec, tcur_sec, tmid_sec, &
00279          dt_sec, dt_min, dt_aeroptic_min, RH, te, pr_atm, cnn, cair_mlc, &
00280          cair_molm3, ppb, avogad, msolar, cos_sza
00281 #endif
00282     
00283     !> Environment state.
00284     type(env_state_t), intent(inout) :: env_state
00285     !> Aerosol data.
00286     type(aero_data_t), intent(in) :: aero_data
00287     !> Aerosol state.
00288     type(aero_state_t), intent(inout) :: aero_state
00289     !> Gas data.
00290     type(gas_data_t), intent(in) :: gas_data
00291     !> Gas state.
00292     type(gas_state_t), intent(inout) :: gas_state
00293 
00294 #ifdef PMC_USE_MOSAIC
00295     ! local variables
00296     real(kind=dp) :: conv_fac(aero_data%n_spec), dum_var, num_conc
00297     integer :: i_part, i_spec, i_spec_mosaic
00298     type(aero_particle_t), pointer :: particle
00299     real(kind=dp) :: reweight_num_conc(aero_state%apa%n_part)
00300 
00301     ! compute aerosol conversion factors
00302     do i_spec = 1,aero_data%n_spec
00303        ! converts m^3(species) to nmol(species)/m^3(air)
00304        conv_fac(i_spec) = 1d9 * aero_data%density(i_spec) &
00305             / aero_data%molec_weight(i_spec)
00306     enddo
00307 
00308     ! environmental parameters: map MOSAIC -> PartMC
00309     env_state%rel_humid = RH / 100d0
00310     env_state%temp = te
00311     env_state%pressure = pr_atm * const%air_std_press
00312     if (msolar == 1) then
00313        env_state%solar_zenith_angle = acos(cos_sza)
00314     end if
00315     cair_mlc = avogad*pr_atm/(82.056d0*te)   ! air conc [molec/cc]
00316     cair_molm3 = 1d6*pr_atm/(82.056d0*te)    ! air conc [mol/m^3]
00317     ppb = 1d9
00318 
00319     ! We're modifying particle diameters, so the bin sort is now invalid
00320     aero_state%valid_sort = .false.
00321 
00322     ! aerosol data: map MOSAIC -> PartMC
00323     call aero_state_num_conc_for_reweight(aero_state, reweight_num_conc)
00324     do i_part = 1,aero_state%apa%n_part,1
00325        particle => aero_state%apa%particle(i_part)
00326        num_conc = aero_weight_array_num_conc( &
00327             aero_state%aero_weight, particle)
00328        do i_spec = 1,aero_data%n_spec
00329           i_spec_mosaic = aero_data%mosaic_index(i_spec)
00330           if (i_spec_mosaic > 0) then
00331              particle%vol(i_spec) = &
00332                   ! convert nmol(species)/m^3(air) to m^3(species)
00333                   aer(i_spec_mosaic, 3, i_part) &
00334                   / (conv_fac(i_spec) * num_conc)
00335           end if
00336        end do
00337        particle%water_hyst_leg = jhyst_leg(i_part)
00338        ! handle water specially
00339        ! convert kg(water)/m^3(air) to m^3(water)
00340        particle%vol(aero_data%i_water) = water_a(i_part) &
00341             / aero_data%density(aero_data%i_water) / num_conc
00342     end do
00343     ! adjust particles to account for weight changes
00344     call aero_state_reweight(aero_state, reweight_num_conc)
00345 
00346     ! gas chemistry: map MOSAIC -> PartMC
00347     do i_spec = 1,gas_data%n_spec
00348        i_spec_mosaic = gas_data%mosaic_index(i_spec)
00349        if (i_spec_mosaic > 0) then
00350           ! convert molec/cc to ppbv
00351           gas_state%mix_rat(i_spec) = cnn(i_spec_mosaic) / cair_mlc * ppb
00352        end if
00353     end do
00354 #endif
00355 
00356   end subroutine mosaic_to_partmc
00357 
00358 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00359 
00360   !> Do one timestep with MOSAIC.
00361   !!
00362   !! We currently also compute aerosol optical properties within this
00363   !! subroutine. In principle this could be done at data analysis
00364   !! time, rather than inside the timestepper. It's not clear if this
00365   !! really matters, however. Because of this mosaic_aero_optical() is
00366   !! currently disabled.
00367   subroutine mosaic_timestep(env_state, aero_data, aero_state, gas_data, &
00368        gas_state, do_optical)
00369     
00370 #ifdef PMC_USE_MOSAIC
00371     use module_data_mosaic_main, only: msolar
00372 #endif
00373     
00374     !> Environment state.
00375     type(env_state_t), intent(inout) :: env_state
00376     !> Aerosol data.
00377     type(aero_data_t), intent(in) :: aero_data
00378     !> Aerosol state.
00379     type(aero_state_t), intent(inout) :: aero_state
00380     !> Gas data.
00381     type(gas_data_t), intent(in) :: gas_data
00382     !> Gas state.
00383     type(gas_state_t), intent(inout) :: gas_state
00384     !> Whether to compute optical properties.
00385     logical, intent(in) :: do_optical
00386 
00387 #ifdef PMC_USE_MOSAIC
00388     ! MOSAIC function interfaces
00389     interface
00390        subroutine SolarZenithAngle()
00391        end subroutine SolarZenithAngle
00392        subroutine IntegrateChemistry()
00393        end subroutine IntegrateChemistry
00394        subroutine aerosol_optical()
00395        end subroutine aerosol_optical
00396     end interface
00397     
00398     ! map PartMC -> MOSAIC
00399     call mosaic_from_partmc(env_state, aero_data, aero_state, gas_data, &
00400          gas_state)
00401 
00402     if (msolar == 1) then
00403       call SolarZenithAngle
00404     end if
00405 
00406     call IntegrateChemistry
00407 
00408     ! map MOSAIC -> PartMC
00409     if (do_optical) then
00410        ! must do optical properties first, as mosaic_to_partmc() may
00411        ! change the number of particles
00412        call aerosol_optical
00413        call mosaic_aero_optical(env_state, aero_data, &
00414             aero_state, gas_data, gas_state)
00415     end if
00416 
00417     call mosaic_to_partmc(env_state, aero_data, aero_state, gas_data, &
00418          gas_state)
00419 #endif
00420 
00421   end subroutine mosaic_timestep
00422 
00423 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00424 
00425   !> Compute the optical properties of each aerosol particle.
00426   !> FIXME: currently disabled.
00427   !!
00428   !! At the moment we are computing the aerosol optical properties
00429   !! every timestep from withing mosaic_timestep. This decision should
00430   !! be re-evaluated at some point in the future.
00431   subroutine mosaic_aero_optical(env_state, aero_data, &
00432        aero_state, gas_data, gas_state)
00433     
00434 #ifdef PMC_USE_MOSAIC
00435     use module_data_mosaic_aero, only: ri_shell_a, ri_core_a, &
00436          ext_cross, scat_cross, asym_particle
00437 #endif
00438     
00439     !> Environment state.
00440     type(env_state_t), intent(in) :: env_state
00441     !> Aerosol data.
00442     type(aero_data_t), intent(in) :: aero_data
00443     !> Aerosol state.
00444     type(aero_state_t), intent(inout) :: aero_state
00445     !> Gas data.
00446     type(gas_data_t), intent(in) :: gas_data
00447     !> Gas state.
00448     type(gas_state_t), intent(in) :: gas_state
00449 
00450 #ifdef PMC_USE_MOSAIC
00451     ! MOSAIC function interfaces
00452     interface
00453        subroutine aerosol_optical()
00454        end subroutine aerosol_optical
00455     end interface
00456 
00457     integer :: i_part
00458     type(aero_particle_t), pointer :: particle
00459     
00460     ! map PartMC -> MOSAIC
00461 !    call mosaic_from_partmc(env_state, aero_data, aero_state, &
00462 !         gas_data, gas_state)
00463 
00464 !    call aerosol_optical
00465 
00466     ! map MOSAIC -> PartMC
00467     ! work backwards for consistency with mosaic_to_partmc(), which
00468     ! has specific ordering requirements
00469     do i_part = aero_state%apa%n_part,1,-1
00470        particle => aero_state%apa%particle(i_part)
00471        particle%absorb_cross_sect = (ext_cross(i_part) &
00472             - scat_cross(i_part)) / 1d4                       ! (m^2)
00473        particle%scatter_cross_sect = scat_cross(i_part) / 1d4 ! (m^2)
00474        particle%asymmetry = asym_particle(i_part)             ! (1)
00475        particle%refract_shell = cmplx(ri_shell_a(i_part), kind=dc) ! (1)
00476        particle%refract_core = cmplx(ri_core_a(i_part), kind=dc)   ! (1)
00477        ! FIXME: how do we get core_vol?
00478        !particle%core_vol = diam2vol(dp_core_a(i_part))        ! (m^3)
00479        particle%core_vol = 0d0
00480     end do
00481 #endif
00482 
00483   end subroutine mosaic_aero_optical
00484 
00485 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00486 
00487 end module pmc_mosaic