lambert2lb2_uEMEP Subroutine

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

Arguments

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

Called by

proc~~lambert2lb2_uemep~~CalledByGraph proc~lambert2lb2_uemep lambert2lb2_uEMEP proc~proj2ll PROJ2LL proc~proj2ll->proc~lambert2lb2_uemep proc~uemep_calculate_emissions_for_emep uEMEP_calculate_emissions_for_EMEP proc~uemep_calculate_emissions_for_emep->proc~lambert2lb2_uemep proc~uemep_grid_roads uEMEP_grid_roads proc~uemep_calculate_emissions_for_emep->proc~uemep_grid_roads proc~uemep_read_meteo_nc uEMEP_read_meteo_nc proc~uemep_calculate_emissions_for_emep->proc~uemep_read_meteo_nc proc~uemep_read_monthly_and_daily_shipping_asi_data uEMEP_read_monthly_and_daily_shipping_asi_data proc~uemep_calculate_emissions_for_emep->proc~uemep_read_monthly_and_daily_shipping_asi_data proc~uemep_read_roadlink_data_ascii uEMEP_read_roadlink_data_ascii proc~uemep_calculate_emissions_for_emep->proc~uemep_read_roadlink_data_ascii proc~uemep_read_weekly_shipping_asi_data uEMEP_read_weekly_shipping_asi_data proc~uemep_calculate_emissions_for_emep->proc~uemep_read_weekly_shipping_asi_data proc~read_country_bounding_box_data read_country_bounding_box_data proc~read_country_bounding_box_data->proc~proj2ll proc~uemep_define_subgrid uEMEP_define_subgrid proc~uemep_define_subgrid->proc~proj2ll proc~uemep_define_subgrid_extent uEMEP_define_subgrid_extent proc~uemep_define_subgrid_extent->proc~proj2ll proc~uemep_grid_roads->proc~proj2ll proc~uemep_preaggregate_shipping_asi_data uEMEP_preaggregate_shipping_asi_data proc~uemep_preaggregate_shipping_asi_data->proc~proj2ll proc~uemep_read_emep uEMEP_read_EMEP proc~uemep_read_emep->proc~proj2ll proc~uemep_read_landuse_rivm_data uEMEP_read_landuse_rivm_data proc~uemep_read_landuse_rivm_data->proc~proj2ll proc~uemep_read_meteo_nc->proc~proj2ll proc~uemep_read_monthly_and_daily_shipping_asi_data->proc~proj2ll proc~uemep_read_netcdf_landuse_latlon uEMEP_read_netcdf_landuse_latlon proc~uemep_read_netcdf_landuse_latlon->proc~proj2ll proc~uemep_read_netcdf_population_latlon uEMEP_read_netcdf_population_latlon proc~uemep_read_netcdf_population_latlon->proc~proj2ll proc~uemep_read_netcdf_shipping_latlon uEMEP_read_netcdf_shipping_latlon proc~uemep_read_netcdf_shipping_latlon->proc~proj2ll proc~uemep_read_roadlink_data_ascii->proc~proj2ll proc~uemep_read_weekly_shipping_asi_data->proc~proj2ll proc~uemep_region_mask_new uEMEP_region_mask_new proc~uemep_region_mask_new->proc~proj2ll proc~uemep_set_region_tile_grids uEMEP_set_region_tile_grids proc~uemep_set_region_tile_grids->proc~proj2ll proc~uemep_set_tile_grids uEMEP_set_tile_grids proc~uemep_set_tile_grids->proc~proj2ll program~uemep uEMEP program~uemep->proc~uemep_calculate_emissions_for_emep program~uemep->proc~read_country_bounding_box_data program~uemep->proc~uemep_define_subgrid program~uemep->proc~uemep_define_subgrid_extent program~uemep->proc~uemep_grid_roads program~uemep->proc~uemep_preaggregate_shipping_asi_data program~uemep->proc~uemep_read_emep 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_netcdf_landuse_latlon program~uemep->proc~uemep_read_netcdf_population_latlon program~uemep->proc~uemep_read_netcdf_shipping_latlon program~uemep->proc~uemep_read_roadlink_data_ascii program~uemep->proc~uemep_read_weekly_shipping_asi_data program~uemep->proc~uemep_region_mask_new program~uemep->proc~uemep_set_region_tile_grids program~uemep->proc~uemep_set_tile_grids

Source Code

    subroutine lambert2lb2_uEMEP(x, y, gl, gb, projection_attr)
        double precision, intent(in) :: projection_attr(10)
        real, intent(in) :: x, y
        real, intent(out):: gl, gb
        real :: r, t
        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 = sqrt(x*x + (y0 - y)*(y0 - y))
        t = atan(x/(y0 - y))
        gb = 2*180.0/PI*atan((F/r)**(1.0/k)) - 90.0
        gl = lon0 + 180.0/PI*t/k
    end subroutine lambert2lb2_uEMEP