subroutine uEMEP_region_mask() ! This routine defines use_subgrid_val=2 for regions outside the selected region. This can be used to control the interpolation routine ! It also sets use_subgrid=.false. outside the region so that no calculations are made there either character(256) :: temp_name, temp_str, temp_str1 integer, allocatable :: tile_municipality_subgrid(:,:,:) integer :: municipality_id real :: x_ssb, f_easting, ssb_dx, y_ssb, ssb_dy integer :: count integer(kind=8) :: ssb_id integer :: i, j, k, i_range, j_range, i_range_interp, j_range_interp, i_tile, j_tile logical :: exists integer :: unit_in integer :: index_val integer :: i_source character(256) :: region_number_str integer, parameter :: n_search = 5 character(16) :: search_str(n_search) real :: search_delta(n_search) integer :: temp_search integer :: io search_str = ['_1000m', '_500m ', '_250m ', '_100m ', '_50m '] search_delta = [1000.0, 500.0, 250.0, 100.0, 50.0] write(unit_logfile,'(A)') '' write(unit_logfile,'(A)') '================================================================' write(unit_logfile,'(A)') 'Masking region (uEMEP_region_mask)' write(unit_logfile,'(A)') '================================================================' if ( .not. allocated(tile_municipality_subgrid)) allocate (tile_municipality_subgrid(subgrid_dim(x_dim_index),subgrid_dim(y_dim_index),2)) tile_municipality_subgrid = 0 i_source = allsource_index ! Search file name to define the grid size ssb_dx = 0.0; ssb_dy = 0.0 do k = 1, n_search temp_search = index(filename_population(municipality_index), trim(adjustl(search_str(k)))) if (temp_search .ne. 0) then ssb_dx = search_delta(k) ssb_dy = search_delta(k) write(unit_logfile,'(i,A)') temp_search, ' Reading municipality data with resolution '//trim(adjustl(search_str(k))) end if end do if (ssb_dx .eq. 0) then write(unit_logfile,'(A)') 'Cannot find a valid SSB grid size. Stopping. '//trim(filename_population(municipality_index)) stop 1 end if region_number_str = '' write(region_number_str,*) region_index region_number_str = trim(region_number_str)//'_' ! Read in SSB file containing gridded municipality ids f_easting=2.0e6 pathfilename_population(municipality_index) = trim(pathname_population(municipality_index))//trim(adjustl(region_number_str))//trim(filename_population(municipality_index)) ! Test existence of the heating filename. If does not exist then use default inquire(file=trim(pathfilename_population(municipality_index)), exist=exists) if ( .not. exists) then write(unit_logfile,'(A,A)') ' ERROR: Masking region SSB file with municipality IDs does not exist: ', trim(pathfilename_population(municipality_index)) stop 1 end if temp_name = pathfilename_population(municipality_index) ! Open the file for reading unit_in = 20 open(unit_in, file=temp_name, access='sequential', status='old', readonly) write(unit_logfile,'(a)') ' Opening SSB municipality file '//trim(temp_name) rewind(unit_in) ! Read header SSBID0250M;kommunenum read(unit_in,'(A)') temp_str write(unit_logfile,'(A)') 'Header: '//trim(temp_str) count = 0 i_range = ceiling(ssb_dx/subgrid_delta(x_dim_index)/2.0) + 1 j_range = ceiling(ssb_dy/subgrid_delta(y_dim_index)/2.0) + 1 i_range_interp = ceiling(ssb_dx/subgrid_delta(x_dim_index)/2.0 + max_interpolation_subgrid_size/subgrid_delta(x_dim_index)) + 1 j_range_interp = ceiling(ssb_dy/subgrid_delta(y_dim_index)/2.0 + max_interpolation_subgrid_size/subgrid_delta(y_dim_index)) + 1 do ssb_id = 0; municipality_id = 0 ! Read in file string read(unit_in,'(A)',iostat=io) temp_str if (io /= 0) exit index_val = index(temp_str,';', back=.false.) temp_str1 = temp_str(1:index_val-1) temp_str = temp_str(index_val+1:) if (index_val .gt. 1) read(temp_str1,*) ssb_id read(temp_str,*) municipality_id ! If this ssb municipality grid has the correct ID then find the target grid that matches it if (municipality_id .eq. region_id) then count = count + 1 !Convert id to grid centre coordinates that are already in UTM33 for SSB data x_ssb = floor(ssb_id/10000000.0) - f_easting + ssb_dx/2.0 y_ssb = mod(ssb_id, 10000000) + ssb_dy/2.0 ! Find the tile this ssb grid is in i_tile = 1 + floor((x_ssb - subgrid_min(x_dim_index))/subgrid_delta(x_dim_index)) ! New definition j_tile = 1 + floor((y_ssb - subgrid_min(y_dim_index))/subgrid_delta(y_dim_index)) !New definition do j = j_tile-j_range, j_tile+j_range do i = i_tile-i_range, i_tile+i_range ! Make sure i and j are inside a valid range if (i .ge. 1 .and. i .le. subgrid_dim(x_dim_index) .and. j .ge. 1 .and. j .le. subgrid_dim(y_dim_index)) then ! Find the target subgrid within the ssb grid and the region if (x_subgrid(i,j) .ge. x_ssb-ssb_dx/2.0 .and. x_subgrid(i,j) .lt. x_ssb + ssb_dx/2.0 .and. & y_subgrid(i,j) .ge. y_ssb-ssb_dy/2.0 .and. y_subgrid(i,j) .lt. y_ssb+ssb_dy/2.0) then !If there is a target subgrid within this range then allocate the mask value if it is not the correct region_id tile_municipality_subgrid(i,j,1) = 1 end if end if end do end do do j = j_tile-j_range_interp, j_tile+j_range_interp do i = i_tile-i_range_interp, i_tile+i_range_interp ! Make sure i and j are inside a valid range if (i .ge. 1 .and. i .le. subgrid_dim(x_dim_index) .and. j .ge. 1 .and. j .le. subgrid_dim(y_dim_index)) then ! Find the target subgrid within the ssb grid and the region if (x_subgrid(i,j) .ge. x_ssb-ssb_dx/2.0 - max_interpolation_subgrid_size .and. x_subgrid(i,j) .le. x_ssb + ssb_dx/2.0 + max_interpolation_subgrid_size .and. & y_subgrid(i,j) .ge. y_ssb-ssb_dy/2.0 - max_interpolation_subgrid_size .and. y_subgrid(i,j) .le. y_ssb+ssb_dy/2.0 + max_interpolation_subgrid_size) then ! If there is a target subgrid within this range then allocate the mask value if it is not the correct region_id tile_municipality_subgrid(i,j,2) = 1 end if end if end do end do end if end do close(unit_in) do j = 1, subgrid_dim(y_dim_index) do i = 1, subgrid_dim(x_dim_index) if (tile_municipality_subgrid(i,j,2) .eq. 0) then use_subgrid_val(i,j,:) = outside_interpolation_region_index use_subgrid(i,j,:) = .false. end if if (tile_municipality_subgrid(i,j,1) .eq. 0) then use_subgrid_val(i,j,:) = outside_region_index end if end do end do if (allocated(tile_municipality_subgrid)) deallocate (tile_municipality_subgrid) end subroutine uEMEP_region_mask