uEMEP_crossreference_grids Subroutine

public subroutine uEMEP_crossreference_grids()

Arguments

None

Calls

proc~~uemep_crossreference_grids~~CallsGraph proc~uemep_crossreference_grids uEMEP_crossreference_grids proc~lb2lambert2_uemep lb2lambert2_uEMEP proc~uemep_crossreference_grids->proc~lb2lambert2_uemep proc~ll2ps_spherical LL2PS_spherical proc~uemep_crossreference_grids->proc~ll2ps_spherical

Called by

proc~~uemep_crossreference_grids~~CalledByGraph proc~uemep_crossreference_grids uEMEP_crossreference_grids proc~uemep_read_landuse_rivm_data uEMEP_read_landuse_rivm_data proc~uemep_read_landuse_rivm_data->proc~uemep_crossreference_grids program~uemep uEMEP program~uemep->proc~uemep_crossreference_grids program~uemep->proc~uemep_read_landuse_rivm_data

Source Code

    subroutine uEMEP_crossreference_grids()
        integer :: i, j, k
        integer :: ii, jj
        integer :: i_source
        real :: x_temp, y_temp

        ! Cross referencing must be done for each new grid when using multiple grids
        if (allocated(crossreference_target_to_emep_subgrid)) then
            deallocate (crossreference_target_to_emep_subgrid)
        end if
        if (allocated(crossreference_target_to_localfraction_subgrid)) then
            deallocate (crossreference_target_to_localfraction_subgrid)
        end if
        if (allocated(crossreference_integral_to_emep_subgrid)) then
            deallocate (crossreference_integral_to_emep_subgrid)
        end if
        if (allocated(crossreference_target_to_integral_subgrid)) then
            deallocate (crossreference_target_to_integral_subgrid)
        end if
        if (allocated(crossreference_target_to_emission_subgrid)) then
            deallocate (crossreference_target_to_emission_subgrid)
        end if
        if (allocated(crossreference_emission_to_EMEP_subgrid)) then
            deallocate (crossreference_emission_to_EMEP_subgrid)
        end if
        if (allocated(crossreference_integral_to_emission_subgrid)) then
            deallocate (crossreference_integral_to_emission_subgrid)
        end if
        if (allocated(crossreference_emission_to_integral_subgrid)) then
            deallocate (crossreference_emission_to_integral_subgrid)
        end if
        if (allocated(crossreference_target_to_population_subgrid)) then
            deallocate (crossreference_target_to_population_subgrid)
        end if
        if (use_alternative_meteorology_flag) then
            if (allocated(crossreference_integral_to_meteo_nc_subgrid)) then
                deallocate (crossreference_integral_to_meteo_nc_subgrid)
            end if
        end if
        if (calculate_deposition_flag) then
            if (allocated(crossreference_emission_to_deposition_subgrid)) then
                deallocate (crossreference_emission_to_deposition_subgrid)
            end if
            if (allocated(crossreference_target_to_deposition_subgrid)) then
                deallocate (crossreference_target_to_deposition_subgrid)
            end if
            if (allocated(crossreference_deposition_to_emep_subgrid)) then
                deallocate (crossreference_deposition_to_emep_subgrid)
            end if
        end if
        if (read_landuse_flag) then
            if (allocated(crossreference_emission_to_landuse_subgrid)) then
                deallocate (crossreference_emission_to_landuse_subgrid)
            end if
        end if

        ! Allocate arrays
        allocate (crossreference_target_to_emep_subgrid(subgrid_dim(x_dim_index),subgrid_dim(y_dim_index),2))
        allocate (crossreference_target_to_localfraction_subgrid(subgrid_dim(x_dim_index),subgrid_dim(y_dim_index),2,n_local_fraction_grids))
        allocate (crossreference_integral_to_emep_subgrid(integral_subgrid_dim(x_dim_index),integral_subgrid_dim(y_dim_index),2))
        allocate (crossreference_target_to_integral_subgrid(subgrid_dim(x_dim_index),subgrid_dim(y_dim_index),2))
        allocate (crossreference_target_to_emission_subgrid(subgrid_dim(x_dim_index),subgrid_dim(y_dim_index),2,n_source_index))
        allocate (crossreference_emission_to_EMEP_subgrid(emission_max_subgrid_dim(x_dim_index),emission_max_subgrid_dim(y_dim_index),2,n_source_index))
        allocate (crossreference_integral_to_emission_subgrid(integral_subgrid_dim(x_dim_index),integral_subgrid_dim(y_dim_index),2,n_source_index))
        allocate (crossreference_emission_to_integral_subgrid(emission_max_subgrid_dim(x_dim_index),emission_max_subgrid_dim(y_dim_index),2,n_source_index))
        allocate (crossreference_target_to_population_subgrid(subgrid_dim(x_dim_index),subgrid_dim(y_dim_index),2))

        if (use_alternative_meteorology_flag) then
            allocate (crossreference_integral_to_meteo_nc_subgrid(integral_subgrid_dim(x_dim_index),integral_subgrid_dim(y_dim_index),2))
        end if
        if (calculate_deposition_flag) then
            allocate (crossreference_emission_to_deposition_subgrid(emission_max_subgrid_dim(x_dim_index),emission_max_subgrid_dim(y_dim_index),2,n_source_index))
            allocate (crossreference_target_to_deposition_subgrid(subgrid_dim(x_dim_index),subgrid_dim(y_dim_index),2))
            allocate (crossreference_deposition_to_emep_subgrid(deposition_subgrid_dim(x_dim_index),deposition_subgrid_dim(y_dim_index),2))
        end if
        if (read_landuse_flag) then
            allocate (crossreference_emission_to_landuse_subgrid(emission_max_subgrid_dim(x_dim_index),emission_max_subgrid_dim(y_dim_index),2,n_source_index))
        end if

        write(unit_logfile,'(A)') 'Allocating EMEP grid index to subgrid index'
        
        ! Loop through subgrid and find those subgrids within EMEP grids and allocate concentrations directly from EMEP grids.
        do j = 1, subgrid_dim(y_dim_index)
            do i = 1, subgrid_dim(x_dim_index)
                if (EMEP_projection_type .eq. LL_projection_index) then
                    ii = 1 + floor((lon_subgrid(i,j) - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index) + 0.5)
                    jj = 1 + floor((lat_subgrid(i,j) - var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index) + 0.5)
                else if (EMEP_projection_type .eq. LCC_projection_index) then
                    ! When EMEP is read as x,y projection then var1d_nc(:,lon/lat_nc_index) are the x, y projection indexes, actually
                    call lb2lambert2_uEMEP(x_temp, y_temp, lon_subgrid(i,j), lat_subgrid(i,j), EMEP_projection_attributes)
                    ii = 1 + floor((x_temp - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index) + 0.5)
                    jj = 1 + floor((y_temp - var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index) + 0.5)
                else if (EMEP_projection_type .eq. PS_projection_index) then
                    call LL2PS_spherical(x_temp,y_temp,lon_subgrid(i,j),lat_subgrid(i,j),EMEP_projection_attributes)
                    ii = 1 + floor((x_temp - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index) + 0.5)
                    jj = 1 + floor((y_temp - var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index) + 0.5)
                else
                    write(unit_logfile,'(A)') 'No valid projection in use. Stopping'
                    stop 1
                end if
                crossreference_target_to_emep_subgrid(i,j,x_dim_index) = ii
                crossreference_target_to_emep_subgrid(i,j,y_dim_index) = jj
            end do
        end do

        write(unit_logfile,'(A)') 'Allocating EMEP local fraction grid index to subgrid index'
        ! Loop through subgrid and find those subgrids within EMEP grids and allocate concentrations directly from EMEP grids.
        do k = 1, n_local_fraction_grids
            do j = 1, subgrid_dim(y_dim_index)
                do i = 1, subgrid_dim(x_dim_index)
                    if (EMEP_projection_type .eq. LL_projection_index) then
                        ii = 1 + floor((lon_subgrid(i,j) - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index)/local_fraction_grid_size(k) + 0.5)
                        jj = 1 + floor((lat_subgrid(i,j) - var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index)/local_fraction_grid_size(k) + 0.5)
                    else if (EMEP_projection_type .eq. LCC_projection_index) then
                        !When EMEP is read as x,y projection then var1d_nc(:,lon/lat_nc_index) are the x, y projection indexes, actually
                        call lb2lambert2_uEMEP(x_temp, y_temp, lon_subgrid(i,j), lat_subgrid(i,j), EMEP_projection_attributes)
                        ii = 1 + floor((x_temp - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index)/local_fraction_grid_size(k) + 0.5)
                        jj = 1 + floor((y_temp - var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index)/local_fraction_grid_size(k) + 0.5)
                    else if (EMEP_projection_type .eq. PS_projection_index) then
                        call LL2PS_spherical(x_temp, y_temp, lon_subgrid(i,j), lat_subgrid(i,j),EMEP_projection_attributes)
                        ii = 1 + floor((x_temp - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index)/local_fraction_grid_size(k) + 0.5)
                        jj = 1 + floor((y_temp - var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index)/local_fraction_grid_size(k) + 0.5)
                    else
                        write(unit_logfile,'(A)') 'No valid projection in use. Stopping'
                        stop 1
                    end if
                    crossreference_target_to_localfraction_subgrid(i,j,x_dim_index,k) = ii
                    crossreference_target_to_localfraction_subgrid(i,j,y_dim_index,k) = jj
                end do
            end do
        end do

        write(unit_logfile,'(A)') 'Allocating integral grid index to subgrid index'
        do j = 1, subgrid_dim(y_dim_index)
            do i = 1, subgrid_dim(x_dim_index)
                crossreference_target_to_integral_subgrid(i,j,x_dim_index) = 1 + floor((x_subgrid(i,j) - integral_subgrid_min(x_dim_index))/integral_subgrid_delta(x_dim_index))
                crossreference_target_to_integral_subgrid(i,j,y_dim_index) = 1 + floor((y_subgrid(i,j) - integral_subgrid_min(y_dim_index))/integral_subgrid_delta(y_dim_index))
            end do
        end do
        write(unit_logfile,'(A)') 'Allocating population grid index to subgrid index'
        do j = 1, subgrid_dim(y_dim_index)
            do i = 1, subgrid_dim(x_dim_index)
                crossreference_target_to_population_subgrid(i,j,x_dim_index) = 1 + floor((x_subgrid(i,j) - population_subgrid_min(x_dim_index))/population_subgrid_delta(x_dim_index))
                crossreference_target_to_population_subgrid(i,j,y_dim_index) = 1 + floor((y_subgrid(i,j) - population_subgrid_min(y_dim_index))/population_subgrid_delta(y_dim_index))
            end do
        end do

        write(unit_logfile,'(A)') 'Allocating EMEP grid index to integral subgrid index'
        do j = 1, integral_subgrid_dim(y_dim_index)
            do i = 1, integral_subgrid_dim(x_dim_index)
                if (EMEP_projection_type .eq. LL_projection_index) then
                    ii = 1 + floor((lon_integral_subgrid(i,j) - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index) + 0.5)
                    jj = 1 + floor((lat_integral_subgrid(i,j) - var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index) + 0.5)
                else if (EMEP_projection_type .eq. LCC_projection_index) then
                    call lb2lambert2_uEMEP(x_temp, y_temp, lon_integral_subgrid(i,j), lat_integral_subgrid(i,j), EMEP_projection_attributes)
                    ii = 1 + floor((x_temp - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index) + 0.5)
                    jj = 1 + floor((y_temp - var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index) + 0.5)
                else if (EMEP_projection_type .eq. PS_projection_index) then
                    call LL2PS_spherical(x_temp, y_temp, lon_integral_subgrid(i,j), lat_integral_subgrid(i,j), EMEP_projection_attributes)
                    ii = 1 + floor((x_temp - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index) + 0.5)
                    jj = 1 + floor((y_temp - var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index) + 0.5)
                else
                    write(unit_logfile,'(A)') 'No valid projection in use. Stopping'
                    stop 1
                end if
                crossreference_integral_to_emep_subgrid(i,j,x_dim_index) = ii
                crossreference_integral_to_emep_subgrid(i,j,y_dim_index) = jj
            end do
        end do

        if (use_alternative_meteorology_flag) then
            write(unit_logfile,'(A)') 'Allocating alternative meteo nc grid index to integral subgrid index'
            do j = 1, integral_subgrid_dim(y_dim_index)
                do i = 1, integral_subgrid_dim(x_dim_index)
                    if (meteo_nc_projection_type .eq. LL_projection_index) then
                        ii = 1 + floor((lon_integral_subgrid(i,j) - meteo_var1d_nc(1,lon_nc_index))/meteo_dgrid_nc(lon_nc_index) + 0.5)
                        jj = 1 + floor((lat_integral_subgrid(i,j) - meteo_var1d_nc(1,lat_nc_index))/meteo_dgrid_nc(lat_nc_index) + 0.5)
                    else if (meteo_nc_projection_type .eq. LCC_projection_index) then
                        call lb2lambert2_uEMEP(x_temp, y_temp, lon_integral_subgrid(i,j), lat_integral_subgrid(i,j), meteo_nc_projection_attributes)
                        ii = 1 + floor((x_temp - meteo_var1d_nc(1,lon_nc_index))/meteo_dgrid_nc(lon_nc_index) + 0.5)
                        jj = 1 + floor((y_temp - meteo_var1d_nc(1,lat_nc_index))/meteo_dgrid_nc(lat_nc_index) + 0.5)
                    else if (meteo_nc_projection_type .eq. PS_projection_index) then
                        call LL2PS_spherical(x_temp, y_temp, lon_integral_subgrid(i,j), lat_integral_subgrid(i,j), meteo_nc_projection_attributes)
                        ii = 1 + floor((x_temp - meteo_var1d_nc(1,lon_nc_index))/meteo_dgrid_nc(lon_nc_index) + 0.5)
                        jj = 1 + floor((y_temp - meteo_var1d_nc(1,lat_nc_index))/meteo_dgrid_nc(lat_nc_index) + 0.5)
                    else
                        write(unit_logfile,'(A)')'No valid projection in use. Stopping'
                        stop 1
                    end if
                    crossreference_integral_to_meteo_nc_subgrid(i,j,x_dim_index) = ii
                    crossreference_integral_to_meteo_nc_subgrid(i,j,y_dim_index) = jj
                end do
            end do
        end if

        do i_source = 1, n_source_index
            if (calculate_source(i_source)) then
                do j = 1, emission_subgrid_dim(y_dim_index,i_source)
                    do i = 1, emission_subgrid_dim(x_dim_index,i_source)
                        if (EMEP_projection_type .eq. LL_projection_index) then
                            ii = 1 + floor((lon_emission_subgrid(i,j,i_source) - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index) + 0.5)
                            jj = 1 + floor((lat_emission_subgrid(i,j,i_source) - var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index) + 0.5)
                        else if (EMEP_projection_type .eq. LCC_projection_index) then
                            call lb2lambert2_uEMEP(x_temp, y_temp, lon_emission_subgrid(i,j,i_source), lat_emission_subgrid(i,j,i_source), EMEP_projection_attributes)
                            ii = 1 + floor((x_temp - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index) + 0.5)
                            jj = 1 + floor((y_temp-var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index) + 0.5)
                        else if (EMEP_projection_type .eq. PS_projection_index) then
                            call LL2PS_spherical(x_temp, y_temp, lon_emission_subgrid(i,j,i_source), lat_emission_subgrid(i,j,i_source), EMEP_projection_attributes)
                            ii = 1 + floor((x_temp - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index) + 0.5)
                            jj = 1 + floor((y_temp - var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index) + 0.5)
                        else
                            write(unit_logfile,'(A)') 'No valid projection in use. Stopping'
                            stop 1
                        end if
                        crossreference_emission_to_emep_subgrid(i,j,x_dim_index,i_source) = ii
                        crossreference_emission_to_emep_subgrid(i,j,y_dim_index,i_source) = jj
                    end do
                end do
                do j = 1, subgrid_dim(y_dim_index)
                    do i = 1, subgrid_dim(x_dim_index)
                        crossreference_target_to_emission_subgrid(i,j,x_dim_index,i_source) = 1 + floor((x_subgrid(i,j) - emission_subgrid_min(x_dim_index,i_source))/emission_subgrid_delta(x_dim_index,i_source))
                        crossreference_target_to_emission_subgrid(i,j,y_dim_index,i_source) = 1 + floor((y_subgrid(i,j) - emission_subgrid_min(y_dim_index,i_source))/emission_subgrid_delta(y_dim_index,i_source))
                    end do
                end do
                do j = 1, emission_subgrid_dim(y_dim_index,i_source)
                    do i = 1, emission_subgrid_dim(x_dim_index,i_source)
                        crossreference_emission_to_integral_subgrid(i,j,x_dim_index,i_source) = 1 + floor((x_emission_subgrid(i,j,i_source) - integral_subgrid_min(x_dim_index))/integral_subgrid_delta(x_dim_index))
                        crossreference_emission_to_integral_subgrid(i,j,y_dim_index,i_source) = 1 + floor((y_emission_subgrid(i,j,i_source) - integral_subgrid_min(y_dim_index))/integral_subgrid_delta(y_dim_index))

                        ! At edge this can return negative distances due to the different sizes of emission and integral grids and buffer zones. Set the limits here. Should not be a problem
                        crossreference_emission_to_integral_subgrid(i,j,x_dim_index,i_source) = max(min(crossreference_emission_to_integral_subgrid(i,j,x_dim_index,i_source), integral_subgrid_dim(x_dim_index)), 1)
                        crossreference_emission_to_integral_subgrid(i,j,y_dim_index,i_source) = max(min(crossreference_emission_to_integral_subgrid(i,j,y_dim_index,i_source), integral_subgrid_dim(y_dim_index)), 1)

                        if (crossreference_emission_to_integral_subgrid(i,j,x_dim_index,i_source) .lt. 1 .or. crossreference_emission_to_integral_subgrid(i,j,x_dim_index,i_source) .gt. integral_subgrid_dim(x_dim_index) &
                            .or. crossreference_emission_to_integral_subgrid(i,j,y_dim_index,i_source) .lt. 1 .or. crossreference_emission_to_integral_subgrid(i,j,y_dim_index,i_source) .gt. integral_subgrid_dim(y_dim_index)) then

                            write(unit_logfile,'(A,4i,4f)') 'WARNING: crossreference_emission_to_integral_subgrid is out of bounds (i_emis,j_emis,i_integral,j_integral,x_emis,y_emis)', i, j, &
                                crossreference_emission_to_integral_subgrid(i,j,x_dim_index,i_source), crossreference_emission_to_integral_subgrid(i,j,y_dim_index,i_source), &
                                x_emission_subgrid(i,j,i_source)/1000, y_emission_subgrid(i,j,i_source)/1000, (x_emission_subgrid(i,j,i_source) - integral_subgrid_min(x_dim_index))/integral_subgrid_delta(x_dim_index) + 0.5, &
                                (y_emission_subgrid(i,j,i_source) - integral_subgrid_min(y_dim_index))/integral_subgrid_delta(y_dim_index) + 0.5
                        end if
                    end do
                end do
                do j = 1, integral_subgrid_dim(y_dim_index)
                    do i = 1, integral_subgrid_dim(x_dim_index)
                        crossreference_integral_to_emission_subgrid(i,j,x_dim_index,i_source) = 1 + floor((x_integral_subgrid(i,j) - emission_subgrid_min(x_dim_index,i_source))/emission_subgrid_delta(x_dim_index,i_source))
                        crossreference_integral_to_emission_subgrid(i,j,y_dim_index,i_source) = 1 + floor((y_integral_subgrid(i,j) - emission_subgrid_min(y_dim_index,i_source))/emission_subgrid_delta(y_dim_index,i_source))
                    end do
                end do

                if (calculate_deposition_flag) then
                    do j = 1, emission_subgrid_dim(y_dim_index,i_source)
                        do i = 1, emission_subgrid_dim(x_dim_index,i_source)
                            crossreference_emission_to_deposition_subgrid(i,j,x_dim_index,i_source) = 1 + floor((x_emission_subgrid(i,j,i_source)-deposition_subgrid_min(x_dim_index))/deposition_subgrid_delta(x_dim_index))
                            crossreference_emission_to_deposition_subgrid(i,j,y_dim_index,i_source) = 1 + floor((y_emission_subgrid(i,j,i_source)-deposition_subgrid_min(y_dim_index))/deposition_subgrid_delta(y_dim_index))
                            
                            ! At edge this can return negative distances due to the different sizes of emission and integral grids and buffer zones. Set the limits here. Should not be a problem
                            crossreference_emission_to_deposition_subgrid(i,j,x_dim_index,i_source) = max(min(crossreference_emission_to_deposition_subgrid(i,j,x_dim_index,i_source), deposition_subgrid_dim(x_dim_index)), 1)
                            crossreference_emission_to_deposition_subgrid(i,j,y_dim_index,i_source) = max(min(crossreference_emission_to_deposition_subgrid(i,j,y_dim_index,i_source), deposition_subgrid_dim(y_dim_index)), 1)
                        end do
                    end do
                end if

                if (read_landuse_flag) then
                    do j = 1, emission_subgrid_dim(y_dim_index,i_source)
                        do i = 1, emission_subgrid_dim(x_dim_index,i_source)
                            crossreference_emission_to_landuse_subgrid(i,j,x_dim_index,i_source) = 1 + floor((x_emission_subgrid(i,j,i_source)-landuse_subgrid_min(x_dim_index))/landuse_subgrid_delta(x_dim_index))
                            crossreference_emission_to_landuse_subgrid(i,j,y_dim_index,i_source) = 1 + floor((y_emission_subgrid(i,j,i_source)-landuse_subgrid_min(y_dim_index))/landuse_subgrid_delta(y_dim_index))
                            
                            ! At edge this can return negative distances due to the different sizes of emission and integral grids and buffer zones. Set the limits here. Should not be a problem
                            crossreference_emission_to_landuse_subgrid(i,j,x_dim_index,i_source) = max(min(crossreference_emission_to_landuse_subgrid(i,j,x_dim_index,i_source), landuse_subgrid_dim(x_dim_index)), 1)
                            crossreference_emission_to_landuse_subgrid(i,j,y_dim_index,i_source) = max(min(crossreference_emission_to_landuse_subgrid(i,j,y_dim_index,i_source), landuse_subgrid_dim(y_dim_index)), 1)
                        end do
                    end do
                end if
            end if
        end do

        if (calculate_deposition_flag) then
            do j = 1, subgrid_dim(y_dim_index)
                do i = 1, subgrid_dim(x_dim_index)
                    crossreference_target_to_deposition_subgrid(i,j,x_dim_index) = 1 + floor((x_subgrid(i,j)-deposition_subgrid_min(x_dim_index))/deposition_subgrid_delta(x_dim_index))
                    crossreference_target_to_deposition_subgrid(i,j,y_dim_index) = 1 + floor((y_subgrid(i,j)-deposition_subgrid_min(y_dim_index))/deposition_subgrid_delta(y_dim_index))
                    
                    ! At edge this can return negative distances due to the different sizes of emission and integral grids and buffer zones. Set the limits here. Should not be a problem
                    crossreference_target_to_deposition_subgrid(i,j,x_dim_index) = max(min(crossreference_target_to_deposition_subgrid(i,j,x_dim_index), deposition_subgrid_dim(x_dim_index)), 1)
                    crossreference_target_to_deposition_subgrid(i,j,y_dim_index) = max(min(crossreference_target_to_deposition_subgrid(i,j,y_dim_index), deposition_subgrid_dim(y_dim_index)), 1)
                end do
            end do

            write(unit_logfile,'(A)') 'Allocating EMEP grid index to deposition subgrid index'
            do j = 1, deposition_subgrid_dim(y_dim_index)
                do i = 1, deposition_subgrid_dim(x_dim_index)
                    if (EMEP_projection_type .eq. LL_projection_index) then
                        ii = 1 + floor((lon_deposition_subgrid(i,j) - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index) + 0.5)
                        jj = 1 + floor((lat_deposition_subgrid(i,j) - var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index) + 0.5)
                    else if (EMEP_projection_type .eq. LCC_projection_index) then
                        call lb2lambert2_uEMEP(x_temp, y_temp, lon_deposition_subgrid(i,j), lat_deposition_subgrid(i,j), EMEP_projection_attributes)
                        ii = 1 + floor((x_temp - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index) + 0.5)
                        jj = 1 + floor((y_temp - var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index) + 0.5)
                    else if (EMEP_projection_type .eq. PS_projection_index) then
                        call LL2PS_spherical(x_temp, y_temp, lon_deposition_subgrid(i,j), lat_deposition_subgrid(i,j), EMEP_projection_attributes)
                        ii = 1 + floor((x_temp - var1d_nc(1,lon_nc_index))/dgrid_nc(lon_nc_index) + 0.5)
                        jj = 1 + floor((y_temp - var1d_nc(1,lat_nc_index))/dgrid_nc(lat_nc_index) + 0.5)
                    else
                        write(unit_logfile,'(A)') 'No valid projection in use. Stopping'
                        stop 1
                    end if
                    crossreference_deposition_to_emep_subgrid(i,j,x_dim_index) = ii
                    crossreference_deposition_to_emep_subgrid(i,j,y_dim_index) = jj
                end do
            end do
        end if

    end subroutine uEMEP_crossreference_grids