grid_transform_c_e grid_transform_compute grid_transform_delete grid_transform_get_val grid_transform_grid_vol7d_init grid_transform_init grid_transform_levtype_levtype_init grid_transform_v7d_grid_compute grid_transform_vol7d_grid_init grid_transform_vol7d_vol7d_init interval_info_new transform_delete transform_get_val transform_init

grid_transform_vol7d_vol7d_init() subroutine grid_transform_class::grid_transform_vol7d_vol7d_init ( type(grid_transform), intent(out)  this, type(transform_def), intent(in)  trans, type(vol7d), intent(in)  v7d_in, type(vol7d), intent(inout)  v7d_out, real, dimension(:), intent(in), optional  maskbounds, character(len=*), intent(in), optional  categoryappend  ) private Constructor for a grid_transform object, defining a particular sparse points-to-sparse points transformation. It defines an object describing a transformation from a set of sparse points 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 list of the input sparse points in the form of a vol7d object (parameter v7d_in), which can be the same volume that will be successively used for interpolation, or a volume with just the same coordinate data, 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 'metamorphosis' transformation, no target point information has to be provided in input (it is calculated on the basis of input grid and trans object), and, as for 'polyinter', this information is returned in output in v7d_out argument. The generated grid_transform object is specific to the input and output sparse point lists 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] v7d_in vol7d object with the coordinates of the sparse point to be used as input (only information about coordinates is used) [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, when output, it must have been initialised anyway) [in] maskbounds array of boundary values for defining a subset of valid points where the values of maskgrid are within the first and last value of maskbounds (for transformation type 'metamorphosis:maskvalid/settoinvalid' and others) [in] categoryappend append this suffix to log4fortran namespace category Definizione alla linea 2765 del file grid_transform_class.F90. IF (.NOT.PRESENT(maskbounds)) THEN CALL l4f_category_log(this%category,l4f_error, & 'grid_transform_init maskbounds missing for metamorphosis:'// & trim(this%trans%sub_type)//' transformation') CALL raise_error() RETURN ELSE IF (SIZE(maskbounds) < 2) THEN CALL l4f_category_log(this%category,l4f_error, & 'grid_transform_init maskbounds must have at least 2 elements for metamorphosis:'// & trim(this%trans%sub_type)//' transformation') CALL raise_error() RETURN ELSE this%val1 = maskbounds(1) this%val2 = maskbounds(SIZE(maskbounds)) #ifdef DEBUG CALL l4f_category_log(this%category, l4f_debug, & "grid_transform_init setting to invalid interval ]"//t2c(this%val1)//','// & t2c(this%val2)//']') #endif ENDIF CALL metamorphosis_all_setup() ENDIF ENDIF CONTAINS ! common code to metamorphosis transformations conserving the number ! of points SUBROUTINE metamorphosis_all_setup() this%outnx = SIZE(v7d_in%ana) this%outny = 1 this%point_index(:,1) = (/(i,i=1,this%innx)/) CALL vol7d_alloc(v7d_out, nana=SIZE(v7d_in%ana)) v7d_out%ana = v7d_in%ana this%valid = .true. END SUBROUTINE metamorphosis_all_setup END SUBROUTINE grid_transform_vol7d_vol7d_init ! Private subroutine for performing operations common to all constructors SUBROUTINE grid_transform_init_common(this, trans, categoryappend) TYPE(grid_transform),INTENT(inout) :: this TYPE(transform_def),INTENT(in) :: trans CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend CHARACTER(len=512) :: a_name IF (PRESENT(categoryappend)) THEN CALL l4f_launcher(a_name,a_name_append=trim(subcategory)//"."// & trim(categoryappend)) ELSE CALL l4f_launcher(a_name,a_name_append=trim(subcategory)) ENDIF this%category=l4f_category_get_handle(a_name) #ifdef DEBUG CALL l4f_category_log(this%category,l4f_debug,"start init_grid_transform") #endif this%trans=trans END SUBROUTINE grid_transform_init_common ! internal subroutine to correctly initialise the output coordinates ! with polygon centroid coordinates SUBROUTINE poly_to_coordinates(poly, v7d_out) TYPE(arrayof_georef_coord_array),intent(in) :: poly TYPE(vol7d),INTENT(inout) :: v7d_out INTEGER :: n, sz DOUBLE PRECISION,ALLOCATABLE :: lon(:), lat(:) DO n = 1, poly%arraysize CALL getval(poly%array(n), x=lon, y=lat) sz = min(SIZE(lon), SIZE(lat)) IF (lon(1) == lon(sz) .AND. lat(1) == lat(sz)) THEN ! closed polygon sz = sz - 1 ENDIF CALL init(v7d_out%ana(n), lon=stat_average(lon(1:sz)), lat=stat_average(lat(1:sz))) ENDDO END SUBROUTINE poly_to_coordinates SUBROUTINE grid_transform_delete(this) TYPE(grid_transform),INTENT(inout) :: this CALL delete(this%trans) this%innx=imiss this%inny=imiss this%outnx=imiss this%outny=imiss this%iniox=imiss this%inioy=imiss this%infox=imiss this%infoy=imiss this%outinx=imiss this%outiny=imiss this%outfnx=imiss this%outfny=imiss if (associated(this%inter_index_x)) deallocate (this%inter_index_x) if (associated(this%inter_index_y)) deallocate (this%inter_index_y) if (associated(this%inter_index_z)) deallocate (this%inter_index_z) if (associated(this%point_index)) deallocate (this%point_index) if (associated(this%inter_x)) deallocate (this%inter_x) if (associated(this%inter_y)) deallocate (this%inter_y) if (associated(this%inter_xp)) deallocate (this%inter_xp) if (associated(this%inter_yp)) deallocate (this%inter_yp) if (associated(this%inter_zp)) deallocate (this%inter_zp) if (associated(this%vcoord_in)) deallocate (this%vcoord_in) if (associated(this%vcoord_out)) deallocate (this%vcoord_out) if (associated(this%point_mask)) deallocate (this%point_mask) if (associated(this%stencil)) deallocate (this%stencil) if (associated(this%output_level_auto)) deallocate (this%output_level_auto) IF (ALLOCATED(this%coord_3d_in)) DEALLOCATE(this%coord_3d_in) this%valid = .false. ! close the logger call l4f_category_delete(this%category) END SUBROUTINE grid_transform_delete SUBROUTINE grid_transform_get_val(this, output_level_auto, point_mask, & point_index, output_point_index, levshift, levused) TYPE(grid_transform),INTENT(in) :: this TYPE(vol7d_level),POINTER,OPTIONAL :: output_level_auto(:) LOGICAL,INTENT(out),ALLOCATABLE,OPTIONAL :: point_mask(:) INTEGER,INTENT(out),ALLOCATABLE,OPTIONAL :: point_index(:) INTEGER,INTENT(out),ALLOCATABLE,OPTIONAL :: output_point_index(:) INTEGER,INTENT(out),OPTIONAL :: levshift INTEGER,INTENT(out),OPTIONAL :: levused INTEGER :: i IF (PRESENT(output_level_auto)) output_level_auto => this%output_level_auto IF (PRESENT(point_mask)) THEN IF (ASSOCIATED(this%point_index)) THEN point_mask = c_e(reshape(this%point_index, (/SIZE(this%point_index)/))) ENDIF ENDIF IF (PRESENT(point_index)) THEN IF (ASSOCIATED(this%point_index)) THEN point_index = reshape(this%point_index, (/SIZE(this%point_index)/)) ENDIF ENDIF IF (PRESENT(output_point_index)) THEN IF (ASSOCIATED(this%point_index)) THEN ! metamorphosis, index is computed from input origin of output point output_point_index = pack(this%point_index(:,:), c_e(this%point_index)) ELSE IF (this%trans%trans_type == 'polyinter' .OR. & this%trans%trans_type == 'maskinter') THEN ! other cases, index is order of output point output_point_index = (/(i,i=1,this%outnx)/) ENDIF ENDIF IF (PRESENT(levshift)) levshift = this%levshift IF (PRESENT(levused)) levused = this%levused END SUBROUTINE grid_transform_get_val FUNCTION grid_transform_c_e(this) TYPE(grid_transform),INTENT(in) :: this LOGICAL :: grid_transform_c_e grid_transform_c_e = this%valid END FUNCTION grid_transform_c_e RECURSIVE SUBROUTINE grid_transform_compute(this, field_in, field_out, var, & coord_3d_in, zlist) TYPE(grid_transform),INTENT(in),TARGET :: this REAL,INTENT(in) :: field_in(:,:,:) REAL,INTENT(out) :: field_out(:,:,:) TYPE(vol7d_var),INTENT(in),OPTIONAL :: var REAL,INTENT(in),OPTIONAL,TARGET :: coord_3d_in(:,:,:) LOGICAL,INTENT(in),OPTIONAL :: zlist(:) INTEGER :: i, j, k, l, m, s, ii, jj, ie, je, n, navg, kk, kkcache, kkup, kkdown, & kfound, kfoundin, inused, i1, i2, j1, j2, np, ns, ix, iy INTEGER,ALLOCATABLE :: nval(:,:) REAL :: z1,z2,z3,z4,z(4) DOUBLE PRECISION :: x1,x3,y1,y3,xp,yp, disttmp, dist INTEGER :: innx, inny, innz, outnx, outny, outnz, vartype, nearcount REAL,ALLOCATABLE :: coord_in(:) LOGICAL,ALLOCATABLE :: mask_in(:) REAL,ALLOCATABLE :: val_in(:), field_tmp(:,:,:) REAL,POINTER :: coord_3d_in_act(:,:,:) TYPE(grid_transform) :: likethis LOGICAL :: alloc_coord_3d_in_act, nm1, optsearch, farenough CHARACTER(len=4) :: env_var LOGICAL,ALLOCATABLE :: lzlist(:) #ifdef DEBUG CALL l4f_category_log(this%category,l4f_debug,"start grid_transform_compute") #endif field_out(:,:,:) = rmiss IF (.NOT.this%valid) THEN CALL l4f_category_log(this%category,l4f_error, & "refusing to perform a non valid transformation") RETURN ENDIF