|
◆ grid_transform_grid_vol7d_init()
subroutine 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 |
|
) |
| |
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
2238 DO iy = 1, this%inny
2239 DO ix = 1, this%innx
2240 point = georef_coord_new(x=lin%dim%lon(ix,iy), y=lin%dim%lat(ix,iy))
2241 DO n = 1, this%trans%poly%arraysize
2242 IF (inside(point, this%trans%poly%array(n))) THEN
2246 this%outnx = this%outnx + 1
2248 this%point_index(ix,iy) = n
2257 IF (this%outnx <= 0) THEN
2258 CALL l4f_category_log(this%category,l4f_warn, &
2259 "metamorphosis:poly: no points inside polygons")
2262 CALL vol7d_alloc(v7d_out, nana=this%outnx)
2265 DO iy = 1, this%inny
2266 DO ix = 1, this%innx
2267 IF (c_e(this%point_index(ix,iy))) THEN
2269 CALL init(v7d_out%ana(n), &
2270 lon=lin%dim%lon(ix,iy), lat=lin%dim%lat(ix,iy))
2277 ELSE IF (this%trans%sub_type == 'mask' ) THEN
2279 IF (.NOT. PRESENT(maskgrid)) THEN
2280 CALL l4f_category_log(this%category,l4f_error, &
2281 'grid_transform_init maskgrid argument missing for metamorphosis:mask transformation')
2286 IF (this%innx /= SIZE(maskgrid,1) .OR. this%inny /= SIZE(maskgrid,2)) THEN
2287 CALL l4f_category_log(this%category,l4f_error, &
2288 'grid_transform_init mask non conformal with input field')
2289 CALL l4f_category_log(this%category,l4f_error, &
2290 'mask: '//t2c( SIZE(maskgrid,1))// 'x'//t2c( SIZE(maskgrid,2))// &
2291 ' input field:'//t2c(this%innx)// 'x'//t2c(this%inny))
2297 CALL gen_mask_class()
2309 DO iy = 1, this%inny
2310 DO ix = 1, this%innx
2311 IF (c_e(maskgrid(ix,iy))) THEN
2312 IF (maskgrid(ix,iy) <= lmaskbounds(nmaskarea+1)) THEN
2313 DO n = nmaskarea, 1, -1
2314 IF (maskgrid(ix,iy) > lmaskbounds(n)) THEN
2318 this%outnx = this%outnx + 1
2320 this%point_index(ix,iy) = n
2331 IF (this%outnx <= 0) THEN
2332 CALL l4f_category_log(this%category,l4f_warn, &
2333 "grid_transform_init no points inside mask for metamorphosis:mask transformation")
2337 CALL l4f_category_log(this%category,l4f_info, &
2338 "points in subarea "//t2c(n)// ": "// &
2339 t2c(count(this%point_index(:,:) == n)))
2342 CALL vol7d_alloc(v7d_out, nana=this%outnx)
2345 DO iy = 1, this%inny
2346 DO ix = 1, this%innx
2347 IF (c_e(this%point_index(ix,iy))) THEN
2349 CALL init(v7d_out%ana(n),lon=lin%dim%lon(ix,iy),lat=lin%dim%lat(ix,iy))
2362 SUBROUTINE gen_mask_class()
2363 REAL :: startmaskclass, mmin, mmax
2366 IF ( PRESENT(maskbounds)) THEN
2367 nmaskarea = SIZE(maskbounds) - 1
2368 IF (nmaskarea > 0) THEN
2369 lmaskbounds = maskbounds
2371 ELSE IF (nmaskarea == 0) THEN
2372 CALL l4f_category_log(this%category,l4f_warn, &
2373 'only one value provided for maskbounds, '//t2c(maskbounds(1)) &
2374 // ', it will be ignored')
2375 CALL l4f_category_log(this%category,l4f_warn, &
2376 'at least 2 values are required for maskbounds')
2380 mmin = minval(maskgrid, mask=c_e(maskgrid))
2381 mmax = maxval(maskgrid, mask=c_e(maskgrid))
2383 nmaskarea = int(mmax - mmin + 1.5)
2384 startmaskclass = mmin - 0.5
2386 ALLOCATE(lmaskbounds(nmaskarea+1))
2387 lmaskbounds(:) = (/(startmaskclass+real(i),i=0,nmaskarea)/)
2389 CALL l4f_category_log(this%category,l4f_debug, &
2390 'maskinter, '//t2c(nmaskarea)// ' subareas defined, with boundaries:')
2391 DO i = 1, SIZE(lmaskbounds)
2392 CALL l4f_category_log(this%category,l4f_debug, &
2393 'maskinter '//t2c(i)// ' '//t2c(lmaskbounds(i)))
2397 END SUBROUTINE gen_mask_class
2399 END SUBROUTINE grid_transform_grid_vol7d_init
2420 SUBROUTINE grid_transform_vol7d_grid_init(this, trans, v7d_in, out, categoryappend)
2421 TYPE(grid_transform), INTENT(out) :: this
2422 TYPE(transform_def), INTENT(in) :: trans
2423 TYPE(vol7d), INTENT(in) :: v7d_in
2424 TYPE(griddim_def), INTENT(in) :: out
2425 character(len=*), INTENT(in), OPTIONAL :: categoryappend
2428 DOUBLE PRECISION :: xmin, xmax, ymin, ymax, lonref
2429 DOUBLE PRECISION, ALLOCATABLE :: lon(:,:),lat(:,:)
2430 TYPE(griddim_def) :: lout
2433 CALL grid_transform_init_common(this, trans, categoryappend)
2435 CALL l4f_category_log(this%category, l4f_debug, "grid_transform v7d-vg6d")
2438 IF (this%trans%trans_type == 'inter') THEN
2440 IF ( this%trans%sub_type == 'linear' ) THEN
2442 this%innx= SIZE(v7d_in%ana)
2444 ALLOCATE(lon(this%innx,1),lat(this%innx,1))
2445 ALLOCATE(this%inter_xp(this%innx,this%inny),this%inter_yp(this%innx,this%inny))
2446 CALL getval(v7d_in%ana(:)%coord,lon=lon(:,1),lat=lat(:,1))
2448 CALL copy (out, lout)
2450 lonref = 0.5d0*(maxval(lon(:,1), mask=c_e(lon(:,1))) + minval(lon(:,1), mask=c_e(lon(:,1))))
2451 CALL griddim_set_central_lon(lout, lonref)
2453 CALL get_val(lout, nx=nx, ny=ny)
2456 ALLOCATE(this%inter_x(this%outnx,this%outny),this%inter_y(this%outnx,this%outny))
2458 CALL get_val(lout, xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax)
2459 CALL proj(lout, lon, lat, this%inter_xp, this%inter_yp)
2460 CALL griddim_gen_coord(lout, this%inter_x, this%inter_y)
2469 ELSE IF (this%trans%trans_type == 'boxinter') THEN
2471 this%innx= SIZE(v7d_in%ana)
2474 ALLOCATE(lon(this%innx,1),lat(this%innx,1))
2475 ALLOCATE(this%inter_index_x(this%innx,this%inny), &
2476 this%inter_index_y(this%innx,this%inny))
2478 CALL getval(v7d_in%ana(:)%coord,lon=lon(:,1),lat=lat(:,1))
2480 CALL copy (out, lout)
2482 lonref = 0.5d0*(maxval(lon(:,1), mask=c_e(lon(:,1))) + minval(lon(:,1), mask=c_e(lon(:,1))))
2483 CALL griddim_set_central_lon(lout, lonref)
2485 CALL get_val(lout, nx=this%outnx, ny=this%outny, &
2486 xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax)
2489 IF (.NOT.c_e(this%trans%area_info%boxdx)) &
2490 CALL get_val(out, dx=this%trans%area_info%boxdx)
2491 IF (.NOT.c_e(this%trans%area_info%boxdy)) &
2492 CALL get_val(out, dx=this%trans%area_info%boxdy)
2494 this%trans%area_info%boxdx = this%trans%area_info%boxdx*0.5d0
2495 this%trans%area_info%boxdy = this%trans%area_info%boxdy*0.5d0
2498 CALL this%find_index(lout, .true., &
2499 this%outnx, this%outny, xmin, xmax, ymin, ymax, &
2500 lon, lat, .false., &
2501 this%inter_index_x, this%inter_index_y)
2510 END SUBROUTINE grid_transform_vol7d_grid_init
2547 SUBROUTINE grid_transform_vol7d_vol7d_init(this, trans, v7d_in, v7d_out, &
2548 maskbounds, categoryappend)
2549 TYPE(grid_transform), INTENT(out) :: this
2550 TYPE(transform_def), INTENT(in) :: trans
2551 TYPE(vol7d), INTENT(in) :: v7d_in
2552 TYPE(vol7d), INTENT(inout) :: v7d_out
2553 REAL, INTENT(in), OPTIONAL :: maskbounds(:)
2554 CHARACTER(len=*), INTENT(in), OPTIONAL :: categoryappend
2557 DOUBLE PRECISION, ALLOCATABLE :: lon(:), lat(:)
2559 DOUBLE PRECISION :: lon1, lat1
2560 TYPE(georef_coord) :: point
2563 CALL grid_transform_init_common(this, trans, categoryappend)
2565 CALL l4f_category_log(this%category, l4f_debug, "grid_transform v7d-v7d")
2568 IF (this%trans%trans_type == 'inter') THEN
2570 IF ( this%trans%sub_type == 'linear' ) THEN
2572 CALL vol7d_alloc_vol(v7d_out)
2573 this%outnx= SIZE(v7d_out%ana)
2576 this%innx= SIZE(v7d_in%ana)
2579 ALLOCATE(this%inter_xp(this%innx,this%inny),this%inter_yp(this%innx,this%inny))
2580 ALLOCATE(this%inter_x(this%outnx,this%outny),this%inter_y(this%outnx,this%outny))
2582 CALL getval(v7d_in%ana(:)%coord,lon=this%inter_xp(:,1),lat=this%inter_yp(:,1))
2583 CALL getval(v7d_out%ana(:)%coord,lon=this%inter_x(:,1),lat=this%inter_y(:,1))
2589 ELSE IF (this%trans%trans_type == 'polyinter') THEN
|