|
◆ 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 2055 del file grid_transform_class.F90.
2057 ynmax = this%inny - nr
2058 DO iy = 1, this%outny
2059 DO ix = 1, this%outnx
2060 IF (this%inter_index_x(ix,iy) < xnmin .OR. &
2061 this%inter_index_x(ix,iy) > xnmax .OR. &
2062 this%inter_index_y(ix,iy) < ynmin .OR. &
2063 this%inter_index_y(ix,iy) > ynmax) THEN
2064 this%inter_index_x(ix,iy) = imiss
2065 this%inter_index_y(ix,iy) = imiss
2071 CALL l4f_category_log(this%category, l4f_debug, &
2072 'stencilinter: stencil size '//t2c(n*n))
2073 CALL l4f_category_log(this%category, l4f_debug, &
2074 'stencilinter: stencil points '//t2c(count(this%stencil)))
2082 ELSE IF (this%trans%trans_type == 'maskinter') THEN
2084 IF (.NOT. PRESENT(maskgrid)) THEN
2085 CALL l4f_category_log(this%category,l4f_error, &
2086 'grid_transform_init maskgrid argument missing for maskinter transformation')
2087 CALL raise_fatal_error()
2090 CALL get_val(in, nx=this%innx, ny=this%inny)
2091 IF (this%innx /= SIZE(maskgrid,1) .OR. this%inny /= SIZE(maskgrid,2)) THEN
2092 CALL l4f_category_log(this%category,l4f_error, &
2093 'grid_transform_init mask non conformal with input field')
2094 CALL l4f_category_log(this%category,l4f_error, &
2095 'mask: '//t2c( SIZE(maskgrid,1))// 'x'//t2c( SIZE(maskgrid,2))// &
2096 ' input field:'//t2c(this%innx)// 'x'//t2c(this%inny))
2097 CALL raise_fatal_error()
2100 ALLOCATE(this%inter_index_x(this%innx,this%inny), &
2101 this%inter_index_y(this%innx,this%inny))
2102 this%inter_index_x(:,:) = imiss
2103 this%inter_index_y(:,:) = 1
2106 CALL gen_mask_class()
2114 DO iy = 1, this%inny
2115 DO ix = 1, this%innx
2116 IF (c_e(maskgrid(ix,iy))) THEN
2117 IF (maskgrid(ix,iy) <= lmaskbounds(nmaskarea+1)) THEN
2118 DO n = nmaskarea, 1, -1
2119 IF (maskgrid(ix,iy) > lmaskbounds(n)) THEN
2120 this%inter_index_x(ix,iy) = n
2130 this%outnx = nmaskarea
2132 CALL delete(v7d_out)
2133 CALL init(v7d_out, time_definition=time_definition)
2134 CALL vol7d_alloc(v7d_out, nana=nmaskarea)
2139 CALL init(v7d_out%ana(n), &
2140 lon=stat_average(pack(lin%dim%lon(:,:), &
2141 mask=(this%inter_index_x(:,:) == n))), &
2142 lat=stat_average(pack(lin%dim%lat(:,:), &
2143 mask=(this%inter_index_x(:,:) == n))))
2149 ELSE IF (this%trans%trans_type == 'metamorphosis') THEN
2156 CALL get_val(in, nx=this%innx, ny=this%inny)
2158 ALLOCATE(this%point_index(this%innx,this%inny))
2159 this%point_index(:,:) = imiss
2161 CALL delete(v7d_out)
2162 CALL init(v7d_out, time_definition=time_definition)
2164 IF (this%trans%sub_type == 'all' ) THEN
2166 this%outnx = this%innx*this%inny
2168 CALL vol7d_alloc(v7d_out, nana=this%outnx)
2173 CALL init(v7d_out%ana((iy-1)*this%innx+ix), &
2174 lon=lin%dim%lon(ix,iy),lat=lin%dim%lat(ix,iy))
2176 this%point_index(ix,iy) = n
2182 ELSE IF (this%trans%sub_type == 'coordbb' ) THEN
2187 DO iy = 1, this%inny
2188 DO ix = 1, this%innx
2190 IF (lin%dim%lon(ix,iy) > this%trans%rect_coo%ilon .AND. &
2191 lin%dim%lon(ix,iy) < this%trans%rect_coo%flon .AND. &
2192 lin%dim%lat(ix,iy) > this%trans%rect_coo%ilat .AND. &
2193 lin%dim%lat(ix,iy) < this%trans%rect_coo%flat) THEN
2194 this%outnx = this%outnx + 1
2195 this%point_index(ix,iy) = this%outnx
2200 IF (this%outnx <= 0) THEN
2201 CALL l4f_category_log(this%category,l4f_warn, &
2202 "metamorphosis:coordbb: no points inside bounding box "//&
2203 trim(to_char(this%trans%rect_coo%ilon))// ","// &
2204 trim(to_char(this%trans%rect_coo%flon))// ","// &
2205 trim(to_char(this%trans%rect_coo%ilat))// ","// &
2206 trim(to_char(this%trans%rect_coo%flat)))
2209 CALL vol7d_alloc(v7d_out, nana=this%outnx)
2213 DO iy = 1, this%inny
2214 DO ix = 1, this%innx
2215 IF (c_e(this%point_index(ix,iy))) THEN
2217 CALL init(v7d_out%ana(n), &
2218 lon=lin%dim%lon(ix,iy), lat=lin%dim%lat(ix,iy))
2225 ELSE IF (this%trans%sub_type == 'poly' ) THEN
2234 DO iy = 1, this%inny
2235 DO ix = 1, this%innx
2236 point = georef_coord_new(x=lin%dim%lon(ix,iy), y=lin%dim%lat(ix,iy))
2237 DO n = 1, this%trans%poly%arraysize
2238 IF (inside(point, this%trans%poly%array(n))) THEN
2239 this%outnx = this%outnx + 1
2240 this%point_index(ix,iy) = n
2249 IF (this%outnx <= 0) THEN
2250 CALL l4f_category_log(this%category,l4f_warn, &
2251 "metamorphosis:poly: no points inside polygons")
2254 CALL vol7d_alloc(v7d_out, nana=this%outnx)
2257 DO iy = 1, this%inny
2258 DO ix = 1, this%innx
2259 IF (c_e(this%point_index(ix,iy))) THEN
2261 CALL init(v7d_out%ana(n), &
2262 lon=lin%dim%lon(ix,iy), lat=lin%dim%lat(ix,iy))
2269 ELSE IF (this%trans%sub_type == 'mask' ) THEN
2271 IF (.NOT. PRESENT(maskgrid)) THEN
2272 CALL l4f_category_log(this%category,l4f_error, &
2273 'grid_transform_init maskgrid argument missing for metamorphosis:mask transformation')
2278 IF (this%innx /= SIZE(maskgrid,1) .OR. this%inny /= SIZE(maskgrid,2)) THEN
2279 CALL l4f_category_log(this%category,l4f_error, &
2280 'grid_transform_init mask non conformal with input field')
2281 CALL l4f_category_log(this%category,l4f_error, &
2282 'mask: '//t2c( SIZE(maskgrid,1))// 'x'//t2c( SIZE(maskgrid,2))// &
2283 ' input field:'//t2c(this%innx)// 'x'//t2c(this%inny))
2289 CALL gen_mask_class()
2297 DO iy = 1, this%inny
2298 DO ix = 1, this%innx
2299 IF (c_e(maskgrid(ix,iy))) THEN
2300 IF (maskgrid(ix,iy) <= lmaskbounds(nmaskarea+1)) THEN
2301 DO n = nmaskarea, 1, -1
2302 IF (maskgrid(ix,iy) > lmaskbounds(n)) THEN
2303 this%outnx = this%outnx + 1
2304 this%point_index(ix,iy) = n
2314 IF (this%outnx <= 0) THEN
2315 CALL l4f_category_log(this%category,l4f_warn, &
2316 "grid_transform_init no points inside mask for metamorphosis:mask transformation")
2320 CALL l4f_category_log(this%category,l4f_info, &
2321 "points in subarea "//t2c(n)// ": "// &
2322 t2c(count(this%point_index(:,:) == n)))
2325 CALL vol7d_alloc(v7d_out, nana=this%outnx)
2328 DO iy = 1, this%inny
2329 DO ix = 1, this%innx
2330 IF (c_e(this%point_index(ix,iy))) THEN
2332 CALL init(v7d_out%ana(n),lon=lin%dim%lon(ix,iy),lat=lin%dim%lat(ix,iy))
2345 SUBROUTINE gen_mask_class()
2346 REAL :: startmaskclass, mmin, mmax
2349 IF ( PRESENT(maskbounds)) THEN
2350 nmaskarea = SIZE(maskbounds) - 1
2351 IF (nmaskarea > 0) THEN
2352 lmaskbounds = maskbounds
2354 ELSE IF (nmaskarea == 0) THEN
2355 CALL l4f_category_log(this%category,l4f_warn, &
2356 'only one value provided for maskbounds, '//t2c(maskbounds(1)) &
2357 // ', it will be ignored')
2358 CALL l4f_category_log(this%category,l4f_warn, &
2359 'at least 2 values are required for maskbounds')
2363 mmin = minval(maskgrid, mask=c_e(maskgrid))
2364 mmax = maxval(maskgrid, mask=c_e(maskgrid))
2366 nmaskarea = int(mmax - mmin + 1.5)
2367 startmaskclass = mmin - 0.5
2369 ALLOCATE(lmaskbounds(nmaskarea+1))
2370 lmaskbounds(:) = (/(startmaskclass+real(i),i=0,nmaskarea)/)
2372 CALL l4f_category_log(this%category,l4f_debug, &
2373 'maskinter, '//t2c(nmaskarea)// ' subareas defined, with boundaries:')
2374 DO i = 1, SIZE(lmaskbounds)
2375 CALL l4f_category_log(this%category,l4f_debug, &
2376 'maskinter '//t2c(i)// ' '//t2c(lmaskbounds(i)))
2380 END SUBROUTINE gen_mask_class
2382 END SUBROUTINE grid_transform_grid_vol7d_init
2403 SUBROUTINE grid_transform_vol7d_grid_init(this, trans, v7d_in, out, categoryappend)
2404 TYPE(grid_transform), INTENT(out) :: this
2405 TYPE(transform_def), INTENT(in) :: trans
2406 TYPE(vol7d), INTENT(in) :: v7d_in
2407 TYPE(griddim_def), INTENT(in) :: out
2408 character(len=*), INTENT(in), OPTIONAL :: categoryappend
2411 DOUBLE PRECISION :: xmin, xmax, ymin, ymax, lonref
2412 DOUBLE PRECISION, ALLOCATABLE :: lon(:,:),lat(:,:)
2413 TYPE(griddim_def) :: lout
2416 CALL grid_transform_init_common(this, trans, categoryappend)
2418 CALL l4f_category_log(this%category, l4f_debug, "grid_transform v7d-vg6d")
2421 IF (this%trans%trans_type == 'inter') THEN
2423 IF ( this%trans%sub_type == 'linear' ) THEN
2425 this%innx= SIZE(v7d_in%ana)
2427 ALLOCATE(lon(this%innx,1),lat(this%innx,1))
2428 ALLOCATE(this%inter_xp(this%innx,this%inny),this%inter_yp(this%innx,this%inny))
2429 CALL getval(v7d_in%ana(:)%coord,lon=lon(:,1),lat=lat(:,1))
2431 CALL copy (out, lout)
2433 lonref = 0.5d0*(maxval(lon(:,1), mask=c_e(lon(:,1))) + minval(lon(:,1), mask=c_e(lon(:,1))))
2434 CALL griddim_set_central_lon(lout, lonref)
2436 CALL get_val(lout, nx=nx, ny=ny)
2439 ALLOCATE(this%inter_x(this%outnx,this%outny),this%inter_y(this%outnx,this%outny))
2441 CALL get_val(lout, xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax)
2442 CALL proj(lout, lon, lat, this%inter_xp, this%inter_yp)
2443 CALL griddim_gen_coord(lout, this%inter_x, this%inter_y)
2452 ELSE IF (this%trans%trans_type == 'boxinter') THEN
2454 this%innx= SIZE(v7d_in%ana)
2457 ALLOCATE(lon(this%innx,1),lat(this%innx,1))
2458 ALLOCATE(this%inter_index_x(this%innx,this%inny), &
2459 this%inter_index_y(this%innx,this%inny))
2461 CALL getval(v7d_in%ana(:)%coord,lon=lon(:,1),lat=lat(:,1))
2463 CALL copy (out, lout)
2465 lonref = 0.5d0*(maxval(lon(:,1), mask=c_e(lon(:,1))) + minval(lon(:,1), mask=c_e(lon(:,1))))
2466 CALL griddim_set_central_lon(lout, lonref)
2468 CALL get_val(lout, nx=this%outnx, ny=this%outny, &
2469 xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax)
2472 IF (.NOT.c_e(this%trans%area_info%boxdx)) &
2473 CALL get_val(out, dx=this%trans%area_info%boxdx)
2474 IF (.NOT.c_e(this%trans%area_info%boxdy)) &
2475 CALL get_val(out, dx=this%trans%area_info%boxdy)
2477 this%trans%area_info%boxdx = this%trans%area_info%boxdx*0.5d0
2478 this%trans%area_info%boxdy = this%trans%area_info%boxdy*0.5d0
2481 CALL this%find_index(lout, .true., &
2482 this%outnx, this%outny, xmin, xmax, ymin, ymax, &
2483 lon, lat, .false., &
2484 this%inter_index_x, this%inter_index_y)
2493 END SUBROUTINE grid_transform_vol7d_grid_init
2530 SUBROUTINE grid_transform_vol7d_vol7d_init(this, trans, v7d_in, v7d_out, &
2531 maskbounds, categoryappend)
2532 TYPE(grid_transform), INTENT(out) :: this
2533 TYPE(transform_def), INTENT(in) :: trans
2534 TYPE(vol7d), INTENT(in) :: v7d_in
2535 TYPE(vol7d), INTENT(inout) :: v7d_out
2536 REAL, INTENT(in), OPTIONAL :: maskbounds(:)
2537 CHARACTER(len=*), INTENT(in), OPTIONAL :: categoryappend
2540 DOUBLE PRECISION, ALLOCATABLE :: lon(:), lat(:)
2542 DOUBLE PRECISION :: lon1, lat1
2543 TYPE(georef_coord) :: point
2546 CALL grid_transform_init_common(this, trans, categoryappend)
2548 CALL l4f_category_log(this%category, l4f_debug, "grid_transform v7d-v7d")
2551 IF (this%trans%trans_type == 'inter') THEN
2553 IF ( this%trans%sub_type == 'linear' ) THEN
2555 CALL vol7d_alloc_vol(v7d_out)
2556 this%outnx= SIZE(v7d_out%ana)
2559 this%innx= SIZE(v7d_in%ana)
2562 ALLOCATE(this%inter_xp(this%innx,this%inny),this%inter_yp(this%innx,this%inny))
2563 ALLOCATE(this%inter_x(this%outnx,this%outny),this%inter_y(this%outnx,this%outny))
2565 CALL getval(v7d_in%ana(:)%coord,lon=this%inter_xp(:,1),lat=this%inter_yp(:,1))
2566 CALL getval(v7d_out%ana(:)%coord,lon=this%inter_x(:,1),lat=this%inter_y(:,1))
2572 ELSE IF (this%trans%trans_type == 'polyinter') THEN
|