module set_crtm_aerosolmod !$$$ module documentation block ! . . . . ! module: set_crtm_aerosolmod ! prgmmr: todling org: gmao date: 2011-06-01 ! ! abstract: module providing interface to set-crtm-aerosol procedures ! ! program history log: ! 2011-06-01 todling ! 2011-09-20 hclin - separate na and na_crtm for p25 handling ! 2019-03-21 martin - replaced blank subroutine here with that previously ! in stub_set_crtm_aerosol.f90; ! also moved eff rad for dust to size function ! ! subroutines included: ! sub Set_CRTM_Aerosol_ ! ! attributes: ! language: f90 ! machine: ! !$$$ end documentation block implicit none private public Set_CRTM_Aerosol contains subroutine Set_CRTM_Aerosol ( km, na, na_crtm, aero_name, aero_conc, rh, aerosol) !$$$ subprogram documentation block ! . . . . ! subprogram: Set_CRTM_Aerosol ! prgmmr: hclin org: ncar/mmm date: 2011-09-20 ! ! abstract: Set the CRTM Aerosol object given GOCART aerosol properties. ! ! ! program history log: ! 2011-02-23 da Silva - Initial version, FORTRAN-77 interface for GSI. ! 2011-08-01 Lueken - Replaced F90 with f90 (no machine logic) ! 2011-09-20 HCLin - Coded based on the WRFCHEM implementation of GOCART. ! 2013-11-17 Todling - Brought HCLin implementation into stub - it live ! outside GSI, but to not break DTC usage it's placed ! here temporarily. ! 2019-03-21 Martin - Moved aerosol eff radius for dust to function GOCART_Aerosol_size ! ! input argument list: ! km : number of CRTM levels ! na : number of aerosols ! na_crtm : number of aerosols seen by CRTM ! aero_name : GOCART aerosol names ! aero_conc : aerosol concentration (Kg/m2) ! rh : relative humdity [0,1] ! aerosol : CRTM Aerosol object ! ! output argument list: ! aero_conc : aerosol concentration (Kg/m2) ! aerosol : CRTM Aerosol object ! ! attributes: ! language: f90 ! machine: ibm RS/6000 SP ! !$$$ ! USES: use kinds, only: i_kind,r_kind use constants, only: tiny_r_kind use CRTM_Aerosol_Define, only: CRTM_Aerosol_type use mpeu_util, only: getindex use crtm_module, only: SULFATE_AEROSOL,BLACK_CARBON_AEROSOL,ORGANIC_CARBON_AEROSOL,& DUST_AEROSOL,SEASALT_SSAM_AEROSOL,SEASALT_SSCM1_AEROSOL,SEASALT_SSCM2_AEROSOL,SEASALT_SSCM3_AEROSOL implicit none ! !ARGUMENTS: integer(i_kind) , intent(in) :: km ! number of levels integer(i_kind) , intent(in) :: na ! number of aerosols integer(i_kind) , intent(in) :: na_crtm ! number of aerosols seen by CRTM character(len=*), intent(in) :: aero_name(na) ! [na] GOCART aerosol names real(r_kind), intent(inout) :: aero_conc(km,na) ! [km,na] aerosol concentration (Kg/m2) real(r_kind), intent(in) :: rh(km) ! [km] relative humdity [0,1] type(CRTM_Aerosol_type), intent(inout) :: aerosol(na_crtm)! [na] CRTM Aerosol object integer(i_kind) :: i, k integer(i_kind) :: indx_p25, indx_dust1, indx_dust2, indx_dust3, indx_dust4, indx_dust5 integer(i_kind) :: indx_bc1, indx_oc1 indx_bc1=-1; indx_oc1=-1; indx_dust1=-1; indx_dust2=-1 indx_dust3=-1; indx_dust4=-1; indx_dust5=-1; indx_p25=-1 indx_p25 = getindex(aero_name,'p25') indx_dust1 = getindex(aero_name,'dust1') indx_dust2 = getindex(aero_name,'dust2') indx_dust3 = getindex(aero_name,'dust3') indx_dust4 = getindex(aero_name,'dust4') indx_dust5 = getindex(aero_name,'dust5') indx_bc1 = getindex(aero_name,'bc1') indx_oc1 = getindex(aero_name,'oc1') do i = 1, na if ( trim(aero_name(i)) == 'p25' ) cycle ! assign aerosol type select case ( trim(aero_name(i)) ) case ('sulf') aerosol(i)%type = SULFATE_AEROSOL case ('bc1','bc2') aerosol(i)%type = BLACK_CARBON_AEROSOL case ('oc1','oc2') aerosol(i)%type = ORGANIC_CARBON_AEROSOL case ('dust1','dust2','dust3','dust4','dust5') aerosol(i)%type = DUST_AEROSOL case ('seas1') aerosol(i)%type = SEASALT_SSAM_AEROSOL case ('seas2') aerosol(i)%type = SEASALT_SSCM1_AEROSOL case ('seas3') aerosol(i)%type = SEASALT_SSCM2_AEROSOL case ('seas4') aerosol(i)%type = SEASALT_SSCM3_AEROSOL end select if ( indx_p25 > 0 ) then ! partition p25 to dust1 and dust2 if ( i == indx_dust1 ) then aero_conc(:,i) = aero_conc(:,i)+ 0.78_r_kind*aero_conc(:,indx_p25) endif if ( i == indx_dust2 ) then aero_conc(:,i) = aero_conc(:,i)+ 0.22_r_kind*aero_conc(:,indx_p25) endif endif ! crtm aerosol structure do k = 1, km aerosol(i)%concentration(k) = max(tiny_r_kind, aero_conc(k,i)) ! calculate effective radius aerosol(i)%effective_radius(k) & = GOCART_Aerosol_size(i, aerosol(i)%type, rh(k)) enddo enddo ! na contains function GOCART_Aerosol_size( kk, itype, & ! Input eh ) & ! Input in 0-1 result( R_eff ) ! in micrometer use crtm_aerosolcoeff, only: AeroC implicit none ! ! modified from a function provided by Quanhua Liu ! integer(i_kind) ,intent(in) :: kk, itype real(r_kind) ,intent(in) :: eh integer(i_kind) :: j1,j2,k real(r_kind) :: h1 real(r_kind) :: R_eff if ( itype==DUST_AEROSOL ) then if (kk==indx_dust1) then R_eff = 0.55_r_kind else if (kk==indx_dust2) then R_eff = 1.4_r_kind else if (kk==indx_dust3) then R_eff = 2.4_r_kind else if (kk==indx_dust4) then R_eff = 4.5_r_kind else if (kk==indx_dust5) then R_eff = 8.0_r_kind end if return else if ( itype==BLACK_CARBON_AEROSOL .and. kk==indx_bc1 ) then R_eff = AeroC%Reff(1,itype ) return else if ( itype==ORGANIC_CARBON_AEROSOL .and. kk==indx_oc1 ) then R_eff = AeroC%Reff(1,itype ) return endif j2 = 0 if ( eh < AeroC%RH(1) ) then j1 = 1 else if ( eh > AeroC%RH(AeroC%n_RH) ) then j1 = AeroC%n_RH else do k = 1, AeroC%n_RH-1 if ( eh <= AeroC%RH(k+1) .and. eh > AeroC%RH(k) ) then j1 = k j2 = k+1 h1 = (eh-AeroC%RH(k))/(AeroC%RH(k+1)-AeroC%RH(k)) exit endif enddo endif if ( j2 == 0 ) then R_eff = AeroC%Reff(j1,itype ) else R_eff = (1.0_r_kind-h1)*AeroC%Reff(j1,itype ) + h1*AeroC%Reff(j2,itype ) endif return end function GOCART_Aerosol_size end subroutine Set_CRTM_Aerosol end module set_crtm_aerosolmod