LCOV - code coverage report
Current view: | top level - chemistry/aerosol - modal_aerosol_state_mod.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 214 | 0.0 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 0 | 25 | 0.0 %

              Line data    Source code
           1             : module modal_aerosol_state_mod
           2             :   use shr_kind_mod, only: r8 => shr_kind_r8
           3             :   use shr_spfn_mod, only: erf => shr_spfn_erf
           4             :   use aerosol_state_mod, only: aerosol_state, ptr2d_t
           5             :   use rad_constituents, only: rad_cnst_get_aer_mmr, rad_cnst_get_mode_num, rad_cnst_get_info
           6             :   use rad_constituents, only: rad_cnst_get_mode_props
           7             :   use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index
           8             :   use physics_types, only: physics_state
           9             :   use aerosol_properties_mod, only: aerosol_properties, aero_name_len
          10             :   use physconst,  only: rhoh2o
          11             :
          12             :   implicit none
          13             :
          14             :   private
          15             :
          16             :   public :: modal_aerosol_state
          17             :
          18             :   type, extends(aerosol_state) :: modal_aerosol_state
          19             :      private
          20             :      type(physics_state), pointer :: state => null()
          21             :      type(physics_buffer_desc), pointer :: pbuf(:) => null()
          22             :    contains
          23             :
          24             :      procedure :: get_transported
          25             :      procedure :: set_transported
          26             :      procedure :: ambient_total_bin_mmr
          27             :      procedure :: get_ambient_mmr_0list
          28             :      procedure :: get_ambient_mmr_rlist
          29             :      procedure :: get_cldbrne_mmr
          30             :      procedure :: get_ambient_num
          31             :      procedure :: get_cldbrne_num
          32             :      procedure :: get_states
          33             :      procedure :: icenuc_size_wght_arr
          34             :      procedure :: icenuc_size_wght_val
          35             :      procedure :: icenuc_type_wght
          36             :      procedure :: update_bin
          37             :      procedure :: hetfrz_size_wght
          38             :      procedure :: hygroscopicity
          39             :      procedure :: water_uptake
          40             :      procedure :: dry_volume
          41             :      procedure :: wet_volume
          42             :      procedure :: water_volume
          43             :      procedure :: wet_diameter
          44             :      procedure :: convcld_actfrac
          45             :
          46             :      final :: destructor
          47             :
          48             :   end type modal_aerosol_state
          49             :
          50             :   interface modal_aerosol_state
          51             :      procedure :: constructor
          52             :   end interface modal_aerosol_state
          53             :
          54             :   real(r8), parameter :: rh2odens = 1._r8/rhoh2o
          55             :
          56             : contains
          57             :
          58             :   !------------------------------------------------------------------------------
          59             :   !------------------------------------------------------------------------------
          60           0 :   function constructor(state,pbuf) result(newobj)
          61             :     type(physics_state), target :: state
          62             :     type(physics_buffer_desc), pointer :: pbuf(:)
          63             :
          64             :     type(modal_aerosol_state), pointer :: newobj
          65             :
          66             :     integer :: ierr
          67             :
          68           0 :     allocate(newobj,stat=ierr)
          69           0 :     if( ierr /= 0 ) then
          70           0 :        nullify(newobj)
          71             :        return
          72             :     end if
          73             :
          74           0 :     newobj%state => state
          75           0 :     newobj%pbuf => pbuf
          76             :
          77           0 :   end function constructor
          78             :
          79             :   !------------------------------------------------------------------------------
          80             :   !------------------------------------------------------------------------------
          81           0 :   subroutine destructor(self)
          82             :     type(modal_aerosol_state), intent(inout) :: self
          83             :
          84           0 :     nullify(self%state)
          85           0 :     nullify(self%pbuf)
          86             :
          87           0 :   end subroutine destructor
          88             :
          89             :   !------------------------------------------------------------------------------
          90             :   ! sets transported components
          91             :   ! This aerosol model with the state of the transported aerosol constituents
          92             :   ! (mass mixing ratios or number mixing ratios)
          93             :   !------------------------------------------------------------------------------
          94           0 :   subroutine set_transported( self, transported_array )
          95             :     class(modal_aerosol_state), intent(inout) :: self
          96             :     real(r8), intent(in) :: transported_array(:,:,:)
          97             :     ! to be implemented later
          98           0 :   end subroutine set_transported
          99             :
         100             :   !------------------------------------------------------------------------------
         101             :   ! returns transported components
         102             :   ! This returns to current state of the transported aerosol constituents
         103             :   ! (mass mixing ratios or number mixing ratios)
         104             :   !------------------------------------------------------------------------------
         105           0 :   subroutine get_transported( self, transported_array )
         106             :     class(modal_aerosol_state), intent(in) :: self
         107             :     real(r8), intent(out) :: transported_array(:,:,:)
         108             :     ! to be implemented later
         109           0 :   end subroutine get_transported
         110             :
         111             :   !------------------------------------------------------------------------
         112             :   ! Total aerosol mass mixing ratio for a bin in a given grid box location (column and layer)
         113             :   !------------------------------------------------------------------------
         114           0 :   function ambient_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) result(mmr_tot)
         115             :     class(modal_aerosol_state), intent(in) :: self
         116             :     class(aerosol_properties), intent(in) :: aero_props
         117             :     integer, intent(in) :: bin_ndx      ! bin index
         118             :     integer, intent(in) :: col_ndx      ! column index
         119             :     integer, intent(in) :: lyr_ndx      ! vertical layer index
         120             :
         121             :     real(r8) :: mmr_tot                 ! mass mixing ratios totaled for all species
         122           0 :     real(r8),pointer :: mmrptr(:,:)
         123             :     integer :: spec_ndx
         124             :
         125           0 :     mmr_tot = 0._r8
         126             :
         127           0 :     do spec_ndx=1,aero_props%nspecies(bin_ndx)
         128           0 :        call rad_cnst_get_aer_mmr(0, bin_ndx, spec_ndx, 'a', self%state, self%pbuf, mmrptr)
         129           0 :        mmr_tot = mmr_tot + mmrptr(col_ndx,lyr_ndx)
         130             :     end do
         131             :
         132           0 :   end function ambient_total_bin_mmr
         133             :
         134             :   !------------------------------------------------------------------------------
         135             :   ! returns ambient aerosol mass mixing ratio for a given species index and bin index
         136             :   !------------------------------------------------------------------------------
         137           0 :   subroutine get_ambient_mmr_0list(self, species_ndx, bin_ndx, mmr)
         138             :     class(modal_aerosol_state), intent(in) :: self
         139             :     integer, intent(in) :: species_ndx  ! species index
         140             :     integer, intent(in) :: bin_ndx      ! bin index
         141             :     real(r8), pointer :: mmr(:,:)       ! mass mixing ratios (ncol,nlev)
         142             :
         143           0 :     call rad_cnst_get_aer_mmr(0, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr)
         144           0 :   end subroutine get_ambient_mmr_0list
         145             :
         146             :   !------------------------------------------------------------------------------
         147             :   ! returns ambient aerosol mass mixing ratio for a given radiation diagnostics
         148             :   ! list index, species index and bin index
         149             :   !------------------------------------------------------------------------------
         150           0 :   subroutine get_ambient_mmr_rlist(self, list_ndx, species_ndx, bin_ndx, mmr)
         151             :     class(modal_aerosol_state), intent(in) :: self
         152             :     integer, intent(in) :: list_ndx     ! rad climate list index
         153             :     integer, intent(in) :: species_ndx  ! species index
         154             :     integer, intent(in) :: bin_ndx      ! bin index
         155             :     real(r8), pointer :: mmr(:,:)       ! mass mixing ratios (ncol,nlev)
         156             :
         157           0 :     call rad_cnst_get_aer_mmr(list_ndx, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr)
         158           0 :   end subroutine get_ambient_mmr_rlist
         159             :
         160             :   !------------------------------------------------------------------------------
         161             :   ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index
         162             :   !------------------------------------------------------------------------------
         163           0 :   subroutine get_cldbrne_mmr(self, species_ndx, bin_ndx, mmr)
         164             :     class(modal_aerosol_state), intent(in) :: self
         165             :     integer, intent(in) :: species_ndx  ! species index
         166             :     integer, intent(in) :: bin_ndx      ! bin index
         167             :     real(r8), pointer :: mmr(:,:)       ! mass mixing ratios (ncol,nlev)
         168             :
         169           0 :     call rad_cnst_get_aer_mmr(0, bin_ndx, species_ndx, 'c', self%state, self%pbuf, mmr)
         170           0 :   end subroutine get_cldbrne_mmr
         171             :
         172             :   !------------------------------------------------------------------------------
         173             :   ! returns ambient aerosol number mixing ratio for a given species index and bin index
         174             :   !------------------------------------------------------------------------------
         175           0 :   subroutine get_ambient_num(self, bin_ndx, num)
         176             :     class(modal_aerosol_state), intent(in) :: self
         177             :     integer, intent(in) :: bin_ndx     ! bin index
         178             :     real(r8), pointer   :: num(:,:)    ! number densities
         179             :
         180           0 :     call rad_cnst_get_mode_num(0, bin_ndx, 'a', self%state, self%pbuf, num)
         181           0 :   end subroutine get_ambient_num
         182             :
         183             :   !------------------------------------------------------------------------------
         184             :   ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index
         185             :   !------------------------------------------------------------------------------
         186           0 :   subroutine get_cldbrne_num(self, bin_ndx, num)
         187             :     class(modal_aerosol_state), intent(in) :: self
         188             :     integer, intent(in) :: bin_ndx             ! bin index
         189             :     real(r8), pointer :: num(:,:)
         190             :
         191           0 :     call rad_cnst_get_mode_num(0, bin_ndx, 'c', self%state, self%pbuf, num)
         192           0 :   end subroutine get_cldbrne_num
         193             :
         194             :   !------------------------------------------------------------------------------
         195             :   ! returns interstitial and cloud-borne aerosol states
         196             :   !------------------------------------------------------------------------------
         197           0 :   subroutine get_states( self, aero_props, raer, qqcw )
         198             :     class(modal_aerosol_state), intent(in) :: self
         199             :     class(aerosol_properties), intent(in) :: aero_props
         200             :     type(ptr2d_t), intent(out) :: raer(:)
         201             :     type(ptr2d_t), intent(out) :: qqcw(:)
         202             :
         203             :     integer :: ibin,ispc, indx
         204             :
         205           0 :     do ibin = 1, aero_props%nbins()
         206           0 :        indx = aero_props%indexer(ibin, 0)
         207           0 :        call self%get_ambient_num(ibin, raer(indx)%fld)
         208           0 :        call self%get_cldbrne_num(ibin, qqcw(indx)%fld)
         209           0 :        do ispc = 1, aero_props%nspecies(ibin)
         210           0 :           indx = aero_props%indexer(ibin, ispc)
         211           0 :           call self%get_ambient_mmr(ispc,ibin, raer(indx)%fld)
         212           0 :           call self%get_cldbrne_mmr(ispc,ibin, qqcw(indx)%fld)
         213             :        end do
         214             :     end do
         215             :
         216           0 :   end subroutine get_states
         217             :
         218             :   !------------------------------------------------------------------------------
         219             :   ! return aerosol bin size weights for a given bin
         220             :   !------------------------------------------------------------------------------
         221           0 :   subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_preexisting_ice, wght)
         222             :     class(modal_aerosol_state), intent(in) :: self
         223             :     integer, intent(in) :: bin_ndx                ! bin number
         224             :     integer, intent(in) :: ncol                ! number of columns
         225             :     integer, intent(in) :: nlev                ! number of vertical levels
         226             :     character(len=*), intent(in) :: species_type  ! species type
         227             :     logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag
         228             :     real(r8), intent(out) :: wght(:,:)
         229             :
         230             :     character(len=aero_name_len) :: modetype
         231           0 :     real(r8), pointer :: dgnum(:,:,:)    ! mode dry radius
         232             :     real(r8) :: sigmag_aitken
         233             :     integer :: i,k
         234             :
         235           0 :     call rad_cnst_get_info(0, bin_ndx, mode_type=modetype)
         236             :
         237           0 :     wght = 0._r8
         238             :
         239           0 :     select case ( trim(species_type) )
         240             :     case('dust')
         241           0 :        if (modetype=='coarse' .or. modetype=='coarse_dust') then
         242           0 :           wght(:ncol,:) = 1._r8
         243             :        end if
         244             :     case('sulfate')
         245           0 :        if (modetype=='aitken') then
         246           0 :           if ( use_preexisting_ice ) then
         247           0 :              wght(:ncol,:) = 1._r8
         248             :           else
         249           0 :              call rad_cnst_get_mode_props(0, bin_ndx, sigmag=sigmag_aitken)
         250           0 :              call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUM' ), dgnum)
         251           0 :              do k = 1,nlev
         252           0 :                 do i = 1,ncol
         253           0 :                    if (dgnum(i,k,bin_ndx) > 0._r8) then
         254             :                       ! only allow so4 with D>0.1 um in ice nucleation
         255           0 :                       wght(i,k) = max(0._r8,(0.5_r8 - 0.5_r8* &
         256             :                            erf(log(0.1e-6_r8/dgnum(i,k,bin_ndx))/ &
         257           0 :                            (2._r8**0.5_r8*log(sigmag_aitken)))  ))
         258             :                    end if
         259             :                 end do
         260             :              end do
         261             :           endif
         262             :        endif
         263             :     case('black-c')
         264           0 :        if (modetype=='accum') then
         265           0 :           wght(:ncol,:) = 1._r8
         266             :        endif
         267             :     case('sulfate_strat')
         268           0 :        if (modetype=='accum' .or. modetype=='coarse' .or. modetype=='coarse_strat') then
         269           0 :           wght(:ncol,:) = 1._r8
         270             :        endif
         271             :     end select
         272             :
         273           0 :   end subroutine icenuc_size_wght_arr
         274             :
         275             :   !------------------------------------------------------------------------------
         276             :   ! return aerosol bin size weights for a given bin, column and vertical layer
         277             :   !------------------------------------------------------------------------------
         278           0 :   subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, use_preexisting_ice, wght)
         279             :     class(modal_aerosol_state), intent(in) :: self
         280             :     integer, intent(in) :: bin_ndx                ! bin number
         281             :     integer, intent(in) :: col_ndx                ! column index
         282             :     integer, intent(in) :: lyr_ndx                ! vertical layer index
         283             :     character(len=*), intent(in) :: species_type  ! species type
         284             :     logical, intent(in) :: use_preexisting_ice    ! pre-existing ice flag
         285             :     real(r8), intent(out) :: wght
         286             :
         287             :     character(len=aero_name_len) :: modetype
         288           0 :     real(r8), pointer :: dgnum(:,:,:)    ! mode dry radius
         289             :     real(r8) :: sigmag_aitken
         290             :
         291           0 :     wght = 0._r8
         292             :
         293           0 :     call rad_cnst_get_info(0, bin_ndx, mode_type=modetype)
         294             :
         295           0 :     select case ( trim(species_type) )
         296             :     case('dust')
         297           0 :        if (modetype=='coarse' .or. modetype=='coarse_dust') then
         298           0 :           wght = 1._r8
         299             :        end if
         300             :     case('sulfate')
         301           0 :        if (modetype=='aitken') then
         302           0 :           if ( use_preexisting_ice ) then
         303           0 :              wght = 1._r8
         304             :           else
         305           0 :              call rad_cnst_get_mode_props(0, bin_ndx, sigmag=sigmag_aitken)
         306           0 :              call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUM' ), dgnum)
         307             :
         308           0 :              if (dgnum(col_ndx,lyr_ndx,bin_ndx) > 0._r8) then
         309             :                 ! only allow so4 with D>0.1 um in ice nucleation
         310             :                 wght = max(0._r8,(0.5_r8 - 0.5_r8* &
         311             :                      erf(log(0.1e-6_r8/dgnum(col_ndx,lyr_ndx,bin_ndx))/ &
         312           0 :                      (2._r8**0.5_r8*log(sigmag_aitken)))  ))
         313             :
         314             :              end if
         315             :           endif
         316             :        endif
         317             :     case('black-c')
         318           0 :        if (modetype=='accum') then
         319           0 :           wght = 1._r8
         320             :        endif
         321             :     case('sulfate_strat')
         322           0 :        if (modetype=='accum' .or. modetype=='coarse' .or. modetype=='coarse_strat') then
         323           0 :           wght = 1._r8
         324             :        endif
         325             :     end select
         326             :
         327           0 :   end subroutine icenuc_size_wght_val
         328             :
         329             :   !------------------------------------------------------------------------------
         330             :   ! returns aerosol type weights for a given aerosol type and bin
         331             :   !------------------------------------------------------------------------------
         332           0 :   subroutine icenuc_type_wght(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne)
         333             :
         334             :     use aerosol_properties_mod, only: aerosol_properties
         335             :
         336             :     class(modal_aerosol_state), intent(in) :: self
         337             :     integer, intent(in) :: bin_ndx                ! bin number
         338             :     integer, intent(in) :: ncol                   ! number of columns
         339             :     integer, intent(in) :: nlev                   ! number of vertical levels
         340             :     character(len=*), intent(in) :: species_type  ! species type
         341             :     class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object
         342             :     real(r8), intent(in) :: rho(:,:)              ! air density (kg m-3)
         343             :     real(r8), intent(out) :: wght(:,:)            ! type weights
         344             :     logical, optional, intent(in) :: cloud_borne  ! if TRUE cloud-borne aerosols are used
         345             :                                                   ! otherwise ambient aerosols are used
         346             :
         347             :     character(len=aero_name_len) :: modetype
         348             :
         349           0 :     call rad_cnst_get_info(0, bin_ndx, mode_type=modetype)
         350             :
         351           0 :     wght = 0._r8
         352             :
         353           0 :     if (species_type == 'dust') then
         354           0 :        if (modetype=='coarse_dust') then
         355           0 :           wght(:ncol,:) = 1._r8
         356             :        else
         357           0 :           call self%icenuc_type_wght_base(bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne)
         358             :        end if
         359           0 :     else if (species_type == 'sulfate_strat') then
         360           0 :        if (modetype=='accum') then
         361           0 :           wght(:ncol,:) = 1._r8
         362           0 :        elseif ( modetype=='coarse' .or. modetype=='coarse_strat') then
         363           0 :           call self%icenuc_type_wght_base(bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne)
         364             :        endif
         365             :     else
         366           0 :        wght(:ncol,:) = 1._r8
         367             :     end if
         368             :
         369           0 :   end subroutine icenuc_type_wght
         370             :
         371             :   !------------------------------------------------------------------------------
         372             :   !------------------------------------------------------------------------------
         373           0 :   subroutine update_bin( self, bin_ndx, col_ndx, lyr_ndx, delmmr_sum, delnum_sum, tnd_ndx, dtime, tend )
         374             :     class(modal_aerosol_state), intent(in) :: self
         375             :     integer, intent(in) :: bin_ndx                ! bin number
         376             :     integer, intent(in) :: col_ndx                ! column index
         377             :     integer, intent(in) :: lyr_ndx                ! vertical layer index
         378             :     real(r8),intent(in) :: delmmr_sum             ! mass mixing ratio change summed over all species in bin
         379             :     real(r8),intent(in) :: delnum_sum             ! number mixing ratio change summed over all species in bin
         380             :     integer, intent(in) :: tnd_ndx                ! tendency index
         381             :     real(r8),intent(in) :: dtime                  ! time step size (sec)
         382             :     real(r8),intent(inout) :: tend(:,:,:)         ! tendency
         383             :
         384           0 :     real(r8), pointer :: amb_num(:,:)
         385           0 :     real(r8), pointer :: cld_num(:,:)
         386             :
         387           0 :     call self%get_ambient_num(bin_ndx, amb_num)
         388           0 :     call self%get_cldbrne_num(bin_ndx, cld_num)
         389             :
         390             :     ! if there is no bin mass compute updates/tendencies for bin number
         391             :     ! -- apply the total number change to bin number
         392           0 :     if (tnd_ndx>0) then
         393           0 :        tend(col_ndx,lyr_ndx,tnd_ndx) = -delnum_sum/dtime
         394             :     else
         395           0 :        amb_num(col_ndx,lyr_ndx) = amb_num(col_ndx,lyr_ndx) - delnum_sum
         396             :     end if
         397             :
         398             :     ! apply the total number change to bin number
         399           0 :     cld_num(col_ndx,lyr_ndx) = cld_num(col_ndx,lyr_ndx) + delnum_sum
         400             :
         401           0 :   end subroutine update_bin
         402             :
         403             :   !------------------------------------------------------------------------------
         404             :   ! returns the volume-weighted fractions of aerosol subset `bin_ndx` that can act
         405             :   ! as heterogeneous freezing nuclei
         406             :   !------------------------------------------------------------------------------
         407           0 :   function hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght)
         408             :     class(modal_aerosol_state), intent(in) :: self
         409             :     integer, intent(in) :: bin_ndx             ! bin number
         410             :     integer, intent(in) :: ncol                ! number of columns
         411             :     integer, intent(in) :: nlev                ! number of vertical levels
         412             :
         413             :     real(r8) :: wght(ncol,nlev)
         414             :
         415             :     character(len=aero_name_len) :: modetype
         416             :
         417           0 :     wght(:,:) = 1._r8
         418             :
         419           0 :     call rad_cnst_get_info(0, bin_ndx, mode_type=modetype)
         420             :
         421           0 :     if (trim(modetype) == 'aitken') then
         422           0 :        wght(:,:) = 0._r8
         423             :     end if
         424             :
         425           0 :   end function hetfrz_size_wght
         426             :
         427             :   !------------------------------------------------------------------------------
         428             :   ! returns hygroscopicity for a given radiation diagnostic list number and
         429             :   ! bin number
         430             :   !------------------------------------------------------------------------------
         431           0 :   function hygroscopicity(self, list_ndx, bin_ndx) result(kappa)
         432             :     class(modal_aerosol_state), intent(in) :: self
         433             :     integer, intent(in) :: list_ndx        ! rad climate list number
         434             :     integer, intent(in) :: bin_ndx         ! bin number
         435             :
         436             :     real(r8), pointer :: kappa(:,:)        ! hygroscopicity (ncol,nlev)
         437             :
         438           0 :     nullify(kappa)
         439             :
         440           0 :   end function hygroscopicity
         441             :
         442             :   !------------------------------------------------------------------------------
         443             :   ! returns aerosol wet diameter and aerosol water concentration for a given
         444             :   ! radiation diagnostic list number and bin number
         445             :   !------------------------------------------------------------------------------
         446           0 :   subroutine water_uptake(self, aero_props, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat)
         447             :     use modal_aero_wateruptake, only: modal_aero_wateruptake_dr
         448             :     use modal_aero_calcsize,    only: modal_aero_calcsize_diag
         449             :
         450             :     class(modal_aerosol_state), intent(in) :: self
         451             :     class(aerosol_properties), intent(in) :: aero_props
         452             :     integer, intent(in) :: list_idx             ! rad climate/diags list number
         453             :     integer, intent(in) :: bin_idx              ! bin number
         454             :     integer, intent(in) :: ncol                 ! number of columns
         455             :     integer, intent(in) :: nlev                 ! number of levels
         456             :     real(r8),intent(out) :: dgnumwet(ncol,nlev) ! aerosol wet diameter (m)
         457             :     real(r8),intent(out) :: qaerwat(ncol,nlev)  ! aerosol water concentration (g/g)
         458             :
         459             :     integer :: istat, nmodes
         460           0 :     real(r8), pointer :: dgnumdry_m(:,:,:) ! number mode dry diameter for all modes
         461           0 :     real(r8), pointer :: dgnumwet_m(:,:,:) ! number mode wet diameter for all modes
         462           0 :     real(r8), pointer :: qaerwat_m(:,:,:)  ! aerosol water (g/g) for all modes
         463           0 :     real(r8), pointer :: wetdens_m(:,:,:)  !
         464           0 :     real(r8), pointer :: hygro_m(:,:,:)  !
         465           0 :     real(r8), pointer :: dryvol_m(:,:,:)  !
         466           0 :     real(r8), pointer :: dryrad_m(:,:,:)  !
         467           0 :     real(r8), pointer :: drymass_m(:,:,:)  !
         468           0 :     real(r8), pointer :: so4dryvol_m(:,:,:)  !
         469           0 :     real(r8), pointer :: naer_m(:,:,:)  !
         470             :
         471           0 :     nmodes = aero_props%nbins()
         472             :
         473           0 :     if (list_idx == 0) then
         474             :        ! water uptake and wet radius for the climate list has already been calculated
         475           0 :        call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUMWET'), dgnumwet_m)
         476           0 :        call pbuf_get_field(self%pbuf, pbuf_get_index('QAERWAT'),  qaerwat_m)
         477             :
         478           0 :        dgnumwet(:ncol,:nlev) = dgnumwet_m(:ncol,:nlev,bin_idx)
         479           0 :        qaerwat (:ncol,:nlev) =  qaerwat_m(:ncol,:nlev,bin_idx)
         480             :
         481             :     else
         482             :        ! If doing a diagnostic calculation then need to calculate the wet radius
         483             :        ! and water uptake for the diagnostic modes
         484             :        allocate(dgnumdry_m(ncol,nlev,nmodes),  dgnumwet_m(ncol,nlev,nmodes), &
         485             :                 qaerwat_m(ncol,nlev,nmodes),   wetdens_m(ncol,nlev,nmodes), &
         486             :                 hygro_m(ncol,nlev,nmodes),     dryvol_m(ncol,nlev,nmodes), &
         487             :                 dryrad_m(ncol,nlev,nmodes),    drymass_m(ncol,nlev,nmodes),  &
         488           0 :                 so4dryvol_m(ncol,nlev,nmodes), naer_m(ncol,nlev,nmodes), stat=istat)
         489           0 :        if (istat > 0) then
         490           0 :           dgnumwet = -huge(1._r8)
         491           0 :           qaerwat = -huge(1._r8)
         492             :           return
         493             :        end if
         494             :        call modal_aero_calcsize_diag(self%state, self%pbuf, list_idx, dgnumdry_m, hygro_m, &
         495           0 :                                      dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m)
         496             :        call modal_aero_wateruptake_dr(self%state, self%pbuf, list_idx, dgnumdry_m, dgnumwet_m, &
         497             :                                       qaerwat_m, wetdens_m,  hygro_m, dryvol_m, dryrad_m, &
         498           0 :                                       drymass_m, so4dryvol_m, naer_m)
         499             :
         500           0 :        dgnumwet(:ncol,:nlev) = dgnumwet_m(:ncol,:nlev,bin_idx)
         501           0 :        qaerwat (:ncol,:nlev) =  qaerwat_m(:ncol,:nlev,bin_idx)
         502             :
         503           0 :        deallocate(dgnumdry_m)
         504           0 :        deallocate(dgnumwet_m)
         505           0 :        deallocate(qaerwat_m)
         506           0 :        deallocate(wetdens_m)
         507           0 :        deallocate(hygro_m)
         508           0 :        deallocate(dryvol_m)
         509           0 :        deallocate(dryrad_m)
         510           0 :        deallocate(drymass_m)
         511           0 :        deallocate(so4dryvol_m)
         512           0 :        deallocate(naer_m)
         513             :     endif
         514             :
         515             :
         516           0 :   end subroutine water_uptake
         517             :
         518             :   !------------------------------------------------------------------------------
         519             :   ! aerosol dry volume (m3/kg) for given radiation diagnostic list number and bin number
         520             :   !------------------------------------------------------------------------------
         521           0 :   function dry_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol)
         522             :
         523             :     class(modal_aerosol_state), intent(in) :: self
         524             :     class(aerosol_properties), intent(in) :: aero_props
         525             :
         526             :     integer, intent(in) :: list_idx  ! rad climate/diags list number
         527             :     integer, intent(in) :: bin_idx   ! bin number
         528             :     integer, intent(in) :: ncol      ! number of columns
         529             :     integer, intent(in) :: nlev      ! number of levels
         530             :
         531             :     real(r8) :: vol(ncol,nlev)       ! m3/kg
         532             :
         533           0 :     real(r8), pointer :: mmr(:,:)
         534             :     real(r8) :: specdens              ! species density (kg/m3)
         535             :
         536             :     integer :: ispec
         537             :
         538           0 :     vol(:,:) = 0._r8
         539             :
         540           0 :     do ispec = 1, aero_props%nspecies(list_idx,bin_idx)
         541           0 :        call self%get_ambient_mmr(list_idx, ispec, bin_idx, mmr)
         542           0 :        call aero_props%get(bin_idx, ispec, list_ndx=list_idx, density=specdens)
         543           0 :        vol(:ncol,:) = vol(:ncol,:) + mmr(:ncol,:)/specdens
         544             :     end do
         545             :
         546           0 :   end function dry_volume
         547             :
         548             :   !------------------------------------------------------------------------------
         549             :   ! aerosol wet volume (m3/kg) for given radiation diagnostic list number and bin number
         550             :   !------------------------------------------------------------------------------
         551           0 :   function wet_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol)
         552             :
         553             :     class(modal_aerosol_state), intent(in) :: self
         554             :     class(aerosol_properties), intent(in) :: aero_props
         555             :
         556             :     integer, intent(in) :: list_idx  ! rad climate/diags list number
         557             :     integer, intent(in) :: bin_idx   ! bin number
         558             :     integer, intent(in) :: ncol      ! number of columns
         559             :     integer, intent(in) :: nlev      ! number of levels
         560             :
         561             :     real(r8) :: vol(ncol,nlev)       ! m3/kg
         562             :
         563           0 :     real(r8) :: dryvol(ncol,nlev)
         564           0 :     real(r8) :: watervol(ncol,nlev)
         565             :
         566           0 :     dryvol = self%dry_volume(aero_props, list_idx, bin_idx, ncol, nlev)
         567           0 :     watervol = self%water_volume(aero_props, list_idx, bin_idx, ncol, nlev)
         568             :
         569           0 :     vol = watervol + dryvol
         570             :
         571           0 :   end function wet_volume
         572             :
         573             :   !------------------------------------------------------------------------------
         574             :   ! aerosol water volume (m3/kg) for given radiation diagnostic list number and bin number
         575             :   !------------------------------------------------------------------------------
         576           0 :   function water_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol)
         577             :
         578             :     class(modal_aerosol_state), intent(in) :: self
         579             :     class(aerosol_properties), intent(in) :: aero_props
         580             :
         581             :     integer, intent(in) :: list_idx  ! rad climate/diags list number
         582             :     integer, intent(in) :: bin_idx   ! bin number
         583             :     integer, intent(in) :: ncol      ! number of columns
         584             :     integer, intent(in) :: nlev      ! number of levels
         585             :
         586             :     real(r8) :: vol(ncol,nlev)       ! m3/kg
         587             :
         588           0 :     real(r8) :: dgnumwet(ncol,nlev)
         589           0 :     real(r8) :: qaerwat(ncol,nlev)
         590             :
         591           0 :     call self%water_uptake(aero_props, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat)
         592             :
         593           0 :     vol(:ncol,:nlev) = qaerwat(:ncol,:nlev)*rh2odens
         594           0 :     where (vol<0._r8)
         595             :        vol = 0._r8
         596             :     end where
         597             :
         598           0 :   end function water_volume
         599             :
         600             :   !------------------------------------------------------------------------------
         601             :   ! aerosol wet diameter
         602             :   !------------------------------------------------------------------------------
         603           0 :   function wet_diameter(self, bin_idx, ncol, nlev) result(diam)
         604             :     class(modal_aerosol_state), intent(in) :: self
         605             :     integer, intent(in) :: bin_idx   ! bin number
         606             :     integer, intent(in) :: ncol      ! number of columns
         607             :     integer, intent(in) :: nlev      ! number of levels
         608             :
         609             :     real(r8) :: diam(ncol,nlev)
         610             :
         611           0 :     real(r8), pointer :: dgnumwet(:,:,:)
         612             :
         613           0 :     call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUMWET'), dgnumwet)
         614             :
         615           0 :     diam(:ncol,:nlev) = dgnumwet(:ncol,:nlev,bin_idx)
         616             :
         617           0 :   end function wet_diameter
         618             :
         619             :   !------------------------------------------------------------------------------
         620             :   ! prescribed aerosol activation fraction for convective cloud
         621             :   !------------------------------------------------------------------------------
         622           0 :   function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac)
         623             :
         624             :     use modal_aero_data
         625             :
         626             :     class(modal_aerosol_state), intent(in) :: self
         627             :     integer, intent(in) :: ibin   ! bin index
         628             :     integer, intent(in) :: ispc   ! species index
         629             :     integer, intent(in) :: ncol   ! number of columns
         630             :     integer, intent(in) :: nlev   ! number of vertical levels
         631             :
         632             :     real(r8) :: frac(ncol,nlev)
         633             :
         634           0 :     real(r8) :: f_act_conv_coarse(ncol,nlev)
         635             :     real(r8) :: f_act_conv_coarse_dust, f_act_conv_coarse_nacl
         636             :     real(r8) :: tmpdust, tmpnacl
         637             :     integer :: lcoardust, lcoarnacl
         638             :     integer :: i,k
         639             :
         640           0 :     f_act_conv_coarse(:,:) = 0.60_r8
         641           0 :     f_act_conv_coarse_dust = 0.40_r8
         642           0 :     f_act_conv_coarse_nacl = 0.80_r8
         643           0 :     if (modeptr_coarse > 0) then
         644           0 :        lcoardust = lptr_dust_a_amode(modeptr_coarse)
         645           0 :        lcoarnacl = lptr_nacl_a_amode(modeptr_coarse)
         646           0 :        if ((lcoardust > 0) .and. (lcoarnacl > 0)) then
         647           0 :           do k = 1, nlev
         648           0 :              do i = 1, ncol
         649           0 :                 tmpdust = max( 0.0_r8, self%state%q(i,k,lcoardust) )
         650           0 :                 tmpnacl = max( 0.0_r8, self%state%q(i,k,lcoarnacl) )
         651           0 :                 if ((tmpdust+tmpnacl) > 1.0e-30_r8) then
         652           0 :                    f_act_conv_coarse(i,k) = (f_act_conv_coarse_dust*tmpdust &
         653           0 :                         + f_act_conv_coarse_nacl*tmpnacl)/(tmpdust+tmpnacl)
         654             :                 end if
         655             :              end do
         656             :           end do
         657             :        end if
         658             :     end if
         659             :
         660           0 :     if (ibin == modeptr_pcarbon) then
         661           0 :        frac = 0.0_r8
         662           0 :     else if ((ibin == modeptr_finedust) .or. (ibin == modeptr_coardust)) then
         663           0 :        frac = 0.4_r8
         664             :     else
         665           0 :        frac = 0.8_r8
         666             :     end if
         667             :
         668             :     ! set f_act_conv for interstitial (lphase=1) coarse mode species
         669             :     ! for the convective in-cloud, we conceptually treat the coarse dust and seasalt
         670             :     ! as being externally mixed, and apply f_act_conv = f_act_conv_coarse_dust/nacl to dust/seasalt
         671             :     ! number and sulfate are conceptually partitioned to the dust and seasalt
         672             :     ! on a mass basis, so the f_act_conv for number and sulfate are
         673             :     ! mass-weighted averages of the values used for dust/seasalt
         674           0 :     if (ibin == modeptr_coarse) then
         675           0 :        frac = f_act_conv_coarse
         676           0 :        if (ispc>0) then
         677           0 :           if (lmassptr_amode(ispc,ibin) == lptr_dust_a_amode(ibin)) then
         678           0 :              frac = f_act_conv_coarse_dust
         679           0 :           else if (lmassptr_amode(ispc,ibin) == lptr_nacl_a_amode(ibin)) then
         680           0 :              frac = f_act_conv_coarse_nacl
         681             :           end if
         682             :        end if
         683             :     end if
         684             :
         685           0 :   end function convcld_actfrac
         686             :
         687           0 : end module modal_aerosol_state_mod

Generated by: LCOV version 1.14