lb2lambert2_uEMEP Subroutine

public subroutine lb2lambert2_uEMEP(x, y, gl, gb, projection_attr)

Arguments

Type IntentOptional Attributes Name
real, intent(out) :: x
real, intent(out) :: y
real, intent(in) :: gl
real, intent(in) :: gb
double precision, intent(in) :: projection_attr(10)

Called by

proc~~lb2lambert2_uemep~~CalledByGraph proc~lb2lambert2_uemep lb2lambert2_uEMEP proc~ll2proj LL2PROJ proc~ll2proj->proc~lb2lambert2_uemep proc~uemep_crossreference_grids uEMEP_crossreference_grids proc~uemep_crossreference_grids->proc~lb2lambert2_uemep proc~uemep_define_subgrid uEMEP_define_subgrid proc~uemep_define_subgrid->proc~lb2lambert2_uemep proc~uemep_grid_roads uEMEP_grid_roads proc~uemep_grid_roads->proc~lb2lambert2_uemep proc~uemep_read_agriculture_rivm_data uEMEP_read_agriculture_rivm_data proc~uemep_read_agriculture_rivm_data->proc~lb2lambert2_uemep proc~uemep_read_emep uEMEP_read_EMEP proc~uemep_read_emep->proc~lb2lambert2_uemep proc~uemep_read_industry_data uEMEP_read_industry_data proc~uemep_read_industry_data->proc~lb2lambert2_uemep proc~uemep_read_landuse_rivm_data uEMEP_read_landuse_rivm_data proc~uemep_read_landuse_rivm_data->proc~lb2lambert2_uemep proc~uemep_read_landuse_rivm_data->proc~uemep_crossreference_grids proc~uemep_read_meteo_nc uEMEP_read_meteo_nc proc~uemep_read_meteo_nc->proc~lb2lambert2_uemep proc~uemep_read_monthly_and_daily_shipping_asi_data uEMEP_read_monthly_and_daily_shipping_asi_data proc~uemep_read_monthly_and_daily_shipping_asi_data->proc~lb2lambert2_uemep proc~uemep_read_roadlink_data_ascii uEMEP_read_roadlink_data_ascii proc~uemep_read_roadlink_data_ascii->proc~lb2lambert2_uemep proc~uemep_read_rwc_heating_data uEMEP_read_RWC_heating_data proc~uemep_read_rwc_heating_data->proc~lb2lambert2_uemep proc~uemep_read_shipping_asi_data uEMEP_read_shipping_asi_data proc~uemep_read_shipping_asi_data->proc~lb2lambert2_uemep proc~uemep_read_weekly_shipping_asi_data uEMEP_read_weekly_shipping_asi_data proc~uemep_read_weekly_shipping_asi_data->proc~lb2lambert2_uemep proc~uemep_subgrid_emission_emep uEMEP_subgrid_emission_EMEP proc~uemep_subgrid_emission_emep->proc~lb2lambert2_uemep proc~uemep_calculate_emissions_for_emep uEMEP_calculate_emissions_for_EMEP proc~uemep_calculate_emissions_for_emep->proc~uemep_grid_roads proc~uemep_calculate_emissions_for_emep->proc~uemep_read_agriculture_rivm_data proc~uemep_calculate_emissions_for_emep->proc~uemep_read_industry_data proc~uemep_calculate_emissions_for_emep->proc~uemep_read_meteo_nc proc~uemep_calculate_emissions_for_emep->proc~uemep_read_monthly_and_daily_shipping_asi_data proc~uemep_calculate_emissions_for_emep->proc~uemep_read_roadlink_data_ascii proc~uemep_calculate_emissions_for_emep->proc~uemep_read_rwc_heating_data proc~uemep_calculate_emissions_for_emep->proc~uemep_read_shipping_asi_data proc~uemep_calculate_emissions_for_emep->proc~uemep_read_weekly_shipping_asi_data proc~uemep_region_mask_new uEMEP_region_mask_new proc~uemep_region_mask_new->proc~ll2proj proc~uemep_subgrid_emep_from_in_region uEMEP_subgrid_EMEP_from_in_region proc~uemep_subgrid_emep_from_in_region->proc~ll2proj program~uemep uEMEP program~uemep->proc~uemep_crossreference_grids program~uemep->proc~uemep_define_subgrid program~uemep->proc~uemep_grid_roads program~uemep->proc~uemep_read_agriculture_rivm_data program~uemep->proc~uemep_read_emep program~uemep->proc~uemep_read_industry_data program~uemep->proc~uemep_read_landuse_rivm_data program~uemep->proc~uemep_read_meteo_nc program~uemep->proc~uemep_read_monthly_and_daily_shipping_asi_data program~uemep->proc~uemep_read_roadlink_data_ascii program~uemep->proc~uemep_read_rwc_heating_data program~uemep->proc~uemep_read_shipping_asi_data program~uemep->proc~uemep_read_weekly_shipping_asi_data program~uemep->proc~uemep_subgrid_emission_emep program~uemep->proc~uemep_calculate_emissions_for_emep program~uemep->proc~uemep_region_mask_new program~uemep->proc~uemep_subgrid_emep_from_in_region

Source Code

    subroutine lb2lambert2_uEMEP(x, y, gl, gb, projection_attr)
        double precision, intent(in) :: projection_attr(10)
        real, intent(in) :: gl, gb
        real, intent(out):: x, y
        real :: r
        real :: earth_radius, k, F, y0
        real :: deg2rad, rad2deg, k_lambert, lat0_lambert
        real :: lat0
        real :: lat_stand1_lambert, lat_stand2_lambert, lon0, lat0_in

        lat_stand1_lambert = projection_attr(1)
        lat_stand2_lambert = projection_attr(2)
        lon0 = projection_attr(3)
        lat0_in = projection_attr(4)
        earth_radius = projection_attr(5)
        deg2rad = PI/180.0
        rad2deg = 180.0/PI

        if (lat_stand1_lambert .eq. lat_stand2_lambert) then
            k_lambert = sin(PI/180.0*lat0_in)
        else
            k_lambert = log(cos(deg2rad*lat_stand1_lambert)/cos(deg2rad*lat_stand2_lambert))/ &
                (log(tan(0.25*PI + 0.5*deg2rad*lat_stand2_lambert)/tan(0.25*PI + 0.5*deg2rad*lat_stand1_lambert)))
        end if

        lat0_lambert = rad2deg*asin(k_lambert)
        lat0 = lat0_in
        k = k_lambert
        F = earth_radius*cos(PI/180.0*lat_stand1_lambert)*(tan(PI/4.0 + PI/360.0*lat_stand1_lambert)**k)/k
        y0 = F*tan(PI/4.0 - PI/360.0*lat0)**k
        r = F*tan(PI/4.0 - PI/360.0*gb)**k
        x = r*sin(PI/180.0*k*(gl - lon0))
        y = y0 - r*cos(PI/180.0*k*(gl - lon0))
    end subroutine lb2lambert2_uEMEP