|
◆ grid_transform_grid_vol7d_init()
subroutine grid_transform_class::grid_transform_grid_vol7d_init |
( |
type(grid_transform), intent(out) |
this, |
|
|
type(transform_def), intent(in) |
trans, |
|
|
type(griddim_def), intent(in) |
in, |
|
|
type(vol7d), intent(inout) |
v7d_out, |
|
|
real, dimension(:,:), intent(in), optional |
maskgrid, |
|
|
real, dimension(:), intent(in), optional |
maskbounds, |
|
|
procedure(basic_find_index), optional, pointer |
find_index, |
|
|
character(len=*), intent(in), optional |
categoryappend |
|
) |
| |
|
private |
Constructor for a grid_transform object, defining a particular grid-to-sparse points transformation.
It defines an object describing a transformation from a rectangular grid to a set of sparse points; the abstract type of transformation is described in the transformation object trans (type transform_def) which must have been properly initialised. The additional information required here is the description of the input grid in (type griddim_def), and, if required by the transformation type, the information about the target sparse points over which the transformation should take place:
- for 'inter' transformation, this is provided in the form of a vol7d object (v7d_out argument, input), which must have been initialized with the coordinates of desired sparse points
- for 'polyinter' transformation, no target point information has to be provided in input (it is calculated on the basis of input grid and trans object), and the coordinates of the target points (polygons' centroids) are returned in output in v7d_out argument
- for 'maskinter' transformation, this is a two dimensional real field (maskgrid argument), which, together with the maskbounds argument (optional with default), divides the input grid in a number of subareas according to the values of maskinter, and, in this case, v7d_out is an output argument which returns the coordinates of the target points (subareas' centroids)
- for 'metamorphosis' transformation, no target point information has to be provided in input (it is calculated on the basis of input grid and trans object), except for 'mask' subtype, for which the same information as for 'maskinter' transformation has to be provided; in all the cases, as for 'polyinter', the information about target points is returned in output in v7d_out argument.
The generated grid_transform object is specific to the grid and sparse point list provided or computed. The function c_e can be used in order to check whether the object has been successfully initialised, if the result is .FALSE., it should not be used further on.
- Parametri
-
[out] | this | grid_transformation object |
[in] | trans | transformation object |
[in] | in | griddim object to transform |
[in,out] | v7d_out | vol7d object with the coordinates of the sparse points to be used as transformation target (input or output depending on type of transformation) |
[in] | maskgrid | 2D field to be used for defining subareas according to its values, it must have the same shape as the field to be interpolated (for transformation type 'maskinter' and 'metamorphosis:mask') |
[in] | maskbounds | array of boundary values for defining subareas from the values of maskgrid, the number of subareas is SIZE(maskbounds) - 1, if not provided a default based on extreme values of maskgrid is used |
[in] | categoryappend | append this suffix to log4fortran namespace category |
Definizione alla linea 2049 del file grid_transform_class.F90.
2049 ynmax = this%inny - nr 2050 DO iy = 1, this%outny 2051 DO ix = 1, this%outnx 2052 IF (this%inter_index_x(ix,iy) < xnmin .OR. & 2053 this%inter_index_x(ix,iy) > xnmax .OR. & 2054 this%inter_index_y(ix,iy) < ynmin .OR. & 2055 this%inter_index_y(ix,iy) > ynmax) THEN 2056 this%inter_index_x(ix,iy) = imiss 2057 this%inter_index_y(ix,iy) = imiss 2063 CALL l4f_category_log(this%category, l4f_debug, & 2064 'stencilinter: stencil size '//t2c(n*n)) 2065 CALL l4f_category_log(this%category, l4f_debug, & 2066 'stencilinter: stencil points '//t2c(count(this%stencil))) 2074 ELSE IF (this%trans%trans_type == 'maskinter') THEN 2076 IF (.NOT. PRESENT(maskgrid)) THEN 2077 CALL l4f_category_log(this%category,l4f_error, & 2078 'grid_transform_init maskgrid argument missing for maskinter transformation') 2079 CALL raise_fatal_error() 2082 CALL get_val(in, nx=this%innx, ny=this%inny) 2083 IF (this%innx /= SIZE(maskgrid,1) .OR. this%inny /= SIZE(maskgrid,2)) THEN 2084 CALL l4f_category_log(this%category,l4f_error, & 2085 'grid_transform_init mask non conformal with input field') 2086 CALL l4f_category_log(this%category,l4f_error, & 2087 'mask: '//t2c( SIZE(maskgrid,1))// 'x'//t2c( SIZE(maskgrid,2))// & 2088 ' input field:'//t2c(this%innx)// 'x'//t2c(this%inny)) 2089 CALL raise_fatal_error() 2092 ALLOCATE(this%inter_index_x(this%innx,this%inny), & 2093 this%inter_index_y(this%innx,this%inny)) 2094 this%inter_index_x(:,:) = imiss 2095 this%inter_index_y(:,:) = 1 2098 CALL gen_mask_class() 2106 DO iy = 1, this%inny 2107 DO ix = 1, this%innx 2108 IF (c_e(maskgrid(ix,iy))) THEN 2109 IF (maskgrid(ix,iy) <= lmaskbounds(nmaskarea+1)) THEN 2110 DO n = nmaskarea, 1, -1 2111 IF (maskgrid(ix,iy) > lmaskbounds(n)) THEN 2112 this%inter_index_x(ix,iy) = n 2122 this%outnx = nmaskarea 2124 CALL delete(v7d_out) 2125 CALL init(v7d_out, time_definition=time_definition) 2126 CALL vol7d_alloc(v7d_out, nana=nmaskarea) 2131 CALL init(v7d_out%ana(n), & 2132 lon=stat_average(pack(lin%dim%lon(:,:), & 2133 mask=(this%inter_index_x(:,:) == n))), & 2134 lat=stat_average(pack(lin%dim%lat(:,:), & 2135 mask=(this%inter_index_x(:,:) == n)))) 2141 ELSE IF (this%trans%trans_type == 'metamorphosis') THEN 2148 CALL get_val(in, nx=this%innx, ny=this%inny) 2150 ALLOCATE(this%point_index(this%innx,this%inny)) 2151 this%point_index(:,:) = imiss 2153 CALL delete(v7d_out) 2154 CALL init(v7d_out, time_definition=time_definition) 2156 IF (this%trans%sub_type == 'all' ) THEN 2158 this%outnx = this%innx*this%inny 2160 CALL vol7d_alloc(v7d_out, nana=this%outnx) 2165 CALL init(v7d_out%ana((iy-1)*this%innx+ix), & 2166 lon=lin%dim%lon(ix,iy),lat=lin%dim%lat(ix,iy)) 2168 this%point_index(ix,iy) = n 2174 ELSE IF (this%trans%sub_type == 'coordbb' ) THEN 2179 DO iy = 1, this%inny 2180 DO ix = 1, this%innx 2182 IF (lin%dim%lon(ix,iy) > this%trans%rect_coo%ilon .AND. & 2183 lin%dim%lon(ix,iy) < this%trans%rect_coo%flon .AND. & 2184 lin%dim%lat(ix,iy) > this%trans%rect_coo%ilat .AND. & 2185 lin%dim%lat(ix,iy) < this%trans%rect_coo%flat) THEN 2186 this%outnx = this%outnx + 1 2187 this%point_index(ix,iy) = this%outnx 2192 IF (this%outnx <= 0) THEN 2193 CALL l4f_category_log(this%category,l4f_warn, & 2194 "metamorphosis:coordbb: no points inside bounding box "//& 2195 trim(to_char(this%trans%rect_coo%ilon))// ","// & 2196 trim(to_char(this%trans%rect_coo%flon))// ","// & 2197 trim(to_char(this%trans%rect_coo%ilat))// ","// & 2198 trim(to_char(this%trans%rect_coo%flat))) 2201 CALL vol7d_alloc(v7d_out, nana=this%outnx) 2205 DO iy = 1, this%inny 2206 DO ix = 1, this%innx 2207 IF (c_e(this%point_index(ix,iy))) THEN 2209 CALL init(v7d_out%ana(n), & 2210 lon=lin%dim%lon(ix,iy), lat=lin%dim%lat(ix,iy)) 2217 ELSE IF (this%trans%sub_type == 'poly' ) THEN 2226 DO iy = 1, this%inny 2227 DO ix = 1, this%innx 2228 point = georef_coord_new(x=lin%dim%lon(ix,iy), y=lin%dim%lat(ix,iy)) 2229 DO n = 1, this%trans%poly%arraysize 2230 IF (inside(point, this%trans%poly%array(n))) THEN 2231 this%outnx = this%outnx + 1 2232 this%point_index(ix,iy) = n 2241 IF (this%outnx <= 0) THEN 2242 CALL l4f_category_log(this%category,l4f_warn, & 2243 "metamorphosis:poly: no points inside polygons") 2246 CALL vol7d_alloc(v7d_out, nana=this%outnx) 2249 DO iy = 1, this%inny 2250 DO ix = 1, this%innx 2251 IF (c_e(this%point_index(ix,iy))) THEN 2253 CALL init(v7d_out%ana(n), & 2254 lon=lin%dim%lon(ix,iy), lat=lin%dim%lat(ix,iy)) 2261 ELSE IF (this%trans%sub_type == 'mask' ) THEN 2263 IF (.NOT. PRESENT(maskgrid)) THEN 2264 CALL l4f_category_log(this%category,l4f_error, & 2265 'grid_transform_init maskgrid argument missing for metamorphosis:mask transformation') 2270 IF (this%innx /= SIZE(maskgrid,1) .OR. this%inny /= SIZE(maskgrid,2)) THEN 2271 CALL l4f_category_log(this%category,l4f_error, & 2272 'grid_transform_init mask non conformal with input field') 2273 CALL l4f_category_log(this%category,l4f_error, & 2274 'mask: '//t2c( SIZE(maskgrid,1))// 'x'//t2c( SIZE(maskgrid,2))// & 2275 ' input field:'//t2c(this%innx)// 'x'//t2c(this%inny)) 2281 CALL gen_mask_class() 2289 DO iy = 1, this%inny 2290 DO ix = 1, this%innx 2291 IF (c_e(maskgrid(ix,iy))) THEN 2292 IF (maskgrid(ix,iy) <= lmaskbounds(nmaskarea+1)) THEN 2293 DO n = nmaskarea, 1, -1 2294 IF (maskgrid(ix,iy) > lmaskbounds(n)) THEN 2295 this%outnx = this%outnx + 1 2296 this%point_index(ix,iy) = n 2306 IF (this%outnx <= 0) THEN 2307 CALL l4f_category_log(this%category,l4f_warn, & 2308 "grid_transform_init no points inside mask for metamorphosis:mask transformation") 2312 CALL l4f_category_log(this%category,l4f_info, & 2313 "points in subarea "//t2c(n)// ": "// & 2314 t2c(count(this%point_index(:,:) == n))) 2317 CALL vol7d_alloc(v7d_out, nana=this%outnx) 2320 DO iy = 1, this%inny 2321 DO ix = 1, this%innx 2322 IF (c_e(this%point_index(ix,iy))) THEN 2324 CALL init(v7d_out%ana(n),lon=lin%dim%lon(ix,iy),lat=lin%dim%lat(ix,iy)) 2337 SUBROUTINE gen_mask_class() 2338 REAL :: startmaskclass, mmin, mmax 2341 IF ( PRESENT(maskbounds)) THEN 2342 nmaskarea = SIZE(maskbounds) - 1 2343 IF (nmaskarea > 0) THEN 2344 lmaskbounds = maskbounds 2346 ELSE IF (nmaskarea == 0) THEN 2347 CALL l4f_category_log(this%category,l4f_warn, & 2348 'only one value provided for maskbounds, '//t2c(maskbounds(1)) & 2349 // ', it will be ignored') 2350 CALL l4f_category_log(this%category,l4f_warn, & 2351 'at least 2 values are required for maskbounds') 2355 mmin = minval(maskgrid, mask=c_e(maskgrid)) 2356 mmax = maxval(maskgrid, mask=c_e(maskgrid)) 2358 nmaskarea = int(mmax - mmin + 1.5) 2359 startmaskclass = mmin - 0.5 2361 ALLOCATE(lmaskbounds(nmaskarea+1)) 2362 lmaskbounds(:) = (/(startmaskclass+ REAL(i),i=0,nmaskarea)/) 2364 CALL l4f_category_log(this%category,l4f_debug, & 2365 'maskinter, '//t2c(nmaskarea)// ' subareas defined, with boundaries:') 2366 DO i = 1, SIZE(lmaskbounds) 2367 CALL l4f_category_log(this%category,l4f_debug, & 2368 'maskinter '//t2c(i)// ' '//t2c(lmaskbounds(i))) 2372 END SUBROUTINE gen_mask_class 2374 END SUBROUTINE grid_transform_grid_vol7d_init 2395 SUBROUTINE grid_transform_vol7d_grid_init(this, trans, v7d_in, out, categoryappend) 2396 TYPE(grid_transform), INTENT(out) :: this 2397 TYPE(transform_def), INTENT(in) :: trans 2398 TYPE(vol7d), INTENT(in) :: v7d_in 2399 TYPE(griddim_def), INTENT(in) :: out 2400 character(len=*), INTENT(in), OPTIONAL :: categoryappend 2403 DOUBLE PRECISION :: xmin, xmax, ymin, ymax, lonref 2404 DOUBLE PRECISION, ALLOCATABLE :: lon(:,:),lat(:,:) 2405 TYPE(griddim_def) :: lout 2408 CALL grid_transform_init_common(this, trans, categoryappend) 2410 CALL l4f_category_log(this%category, l4f_debug, "grid_transform v7d-vg6d") 2413 IF (this%trans%trans_type == 'inter') THEN 2415 IF ( this%trans%sub_type == 'linear' ) THEN 2417 this%innx= SIZE(v7d_in%ana) 2419 ALLOCATE(lon(this%innx,1),lat(this%innx,1)) 2420 ALLOCATE(this%inter_xp(this%innx,this%inny),this%inter_yp(this%innx,this%inny)) 2421 CALL getval(v7d_in%ana(:)%coord,lon=lon(:,1),lat=lat(:,1)) 2423 CALL copy (out, lout) 2425 lonref = 0.5d0*(maxval(lon(:,1), mask=c_e(lon(:,1))) + minval(lon(:,1), mask=c_e(lon(:,1)))) 2426 CALL griddim_set_central_lon(lout, lonref) 2428 CALL get_val(lout, nx=nx, ny=ny) 2431 ALLOCATE(this%inter_x(this%outnx,this%outny),this%inter_y(this%outnx,this%outny)) 2433 CALL get_val(lout, xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax) 2434 CALL proj(lout, lon, lat, this%inter_xp, this%inter_yp) 2435 CALL griddim_gen_coord(lout, this%inter_x, this%inter_y) 2444 ELSE IF (this%trans%trans_type == 'boxinter') THEN 2446 this%innx= SIZE(v7d_in%ana) 2449 ALLOCATE(lon(this%innx,1),lat(this%innx,1)) 2450 ALLOCATE(this%inter_index_x(this%innx,this%inny), & 2451 this%inter_index_y(this%innx,this%inny)) 2453 CALL getval(v7d_in%ana(:)%coord,lon=lon(:,1),lat=lat(:,1)) 2455 CALL copy (out, lout) 2457 lonref = 0.5d0*(maxval(lon(:,1), mask=c_e(lon(:,1))) + minval(lon(:,1), mask=c_e(lon(:,1)))) 2458 CALL griddim_set_central_lon(lout, lonref) 2460 CALL get_val(lout, nx=this%outnx, ny=this%outny, & 2461 xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax) 2464 IF (.NOT.c_e(this%trans%area_info%boxdx)) & 2465 CALL get_val(out, dx=this%trans%area_info%boxdx) 2466 IF (.NOT.c_e(this%trans%area_info%boxdy)) & 2467 CALL get_val(out, dx=this%trans%area_info%boxdy) 2469 this%trans%area_info%boxdx = this%trans%area_info%boxdx*0.5d0 2470 this%trans%area_info%boxdy = this%trans%area_info%boxdy*0.5d0 2473 CALL this%find_index(lout, .true., & 2474 this%outnx, this%outny, xmin, xmax, ymin, ymax, & 2475 lon, lat, .false., & 2476 this%inter_index_x, this%inter_index_y) 2485 END SUBROUTINE grid_transform_vol7d_grid_init 2522 SUBROUTINE grid_transform_vol7d_vol7d_init(this, trans, v7d_in, v7d_out, & 2523 maskbounds, categoryappend) 2524 TYPE(grid_transform), INTENT(out) :: this 2525 TYPE(transform_def), INTENT(in) :: trans 2526 TYPE(vol7d), INTENT(in) :: v7d_in 2527 TYPE(vol7d), INTENT(inout) :: v7d_out 2528 REAL, INTENT(in), OPTIONAL :: maskbounds(:) 2529 CHARACTER(len=*), INTENT(in), OPTIONAL :: categoryappend 2532 DOUBLE PRECISION, ALLOCATABLE :: lon(:), lat(:) 2534 DOUBLE PRECISION :: lon1, lat1 2535 TYPE(georef_coord) :: point 2538 CALL grid_transform_init_common(this, trans, categoryappend) 2540 CALL l4f_category_log(this%category, l4f_debug, "grid_transform v7d-v7d") 2543 IF (this%trans%trans_type == 'inter') THEN 2545 IF ( this%trans%sub_type == 'linear' ) THEN 2547 CALL vol7d_alloc_vol(v7d_out) 2548 this%outnx= SIZE(v7d_out%ana) 2551 this%innx= SIZE(v7d_in%ana) 2554 ALLOCATE(this%inter_xp(this%innx,this%inny),this%inter_yp(this%innx,this%inny)) 2555 ALLOCATE(this%inter_x(this%outnx,this%outny),this%inter_y(this%outnx,this%outny)) 2557 CALL getval(v7d_in%ana(:)%coord,lon=this%inter_xp(:,1),lat=this%inter_yp(:,1)) 2558 CALL getval(v7d_out%ana(:)%coord,lon=this%inter_x(:,1),lat=this%inter_y(:,1)) 2564 ELSE IF (this%trans%trans_type == 'polyinter') THEN
|