|
◆ 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 2057 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
|