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_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 2753 del file grid_transform_class.F90. #ifdef DEBUG CALL l4f_category_log(this%category, l4f_debug, & "grid_transform_init setting invalid data to "//t2c(this%val1)) #endif ENDIF CALL metamorphosis_all_setup() ELSE IF (this%trans%sub_type == 'settoinvalid' ) THEN 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 !> Destructor of \a grid_tranform object. !! It releases any memory and data associated to !! \a grid_transform object \a this, the logger category will be deleted too. SUBROUTINE grid_transform_delete(this) TYPE(grid_transform),INTENT(inout) :: this !< grid_transform object 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 !> Method for returning the contents of the object. !! Only a few selected memebrs of \a grid_transform object can be !! queried, this is mainly for use by \a volgrid6d_class, rather than !! for public use. SUBROUTINE grid_transform_get_val(this, output_level_auto, point_mask, & point_index, output_point_index, levshift, levused) TYPE(grid_transform),INTENT(in) :: this !< object to examine TYPE(vol7d_level),POINTER,OPTIONAL :: output_level_auto(:) !< array of auto-generated output levels LOGICAL,INTENT(out),ALLOCATABLE,OPTIONAL :: point_mask(:) !< mask array indicating the input points that are kept in the output, for metamorphosis transformations INTEGER,INTENT(out),ALLOCATABLE,OPTIONAL :: point_index(:) !< array of indices indicating the polygon to which every input point has been assigned, if applicable INTEGER,INTENT(out),ALLOCATABLE,OPTIONAL :: output_point_index(:) !< array of indices indicating the polygon to which every output point has been assigned, if applicable INTEGER,INTENT(out),OPTIONAL :: levshift !< shift between input and output levels for vertint INTEGER,INTENT(out),OPTIONAL :: levused !< number of input levels used for vertint 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 !> Returns \a .TRUE. if, after \a init , the corresponding \a grid_transform !! object has been correctly initilised. FUNCTION grid_transform_c_e(this) TYPE(grid_transform),INTENT(in) :: this !< grid_transform object LOGICAL :: grid_transform_c_e grid_transform_c_e = this%valid END FUNCTION grid_transform_c_e !> Compute the output data array from input data array according to !! the defined transformation. The \a grid_transform object \a this !! must have been properly initialised, so that it contains all the !! information needed for computing the transformation. This is the !! grid-to-grid and grid-to-sparse points version. In the case of !! grid-to-sparse points transformation, the output argument is still !! a 2-d array with shape \a (np,1), which may have to be reshaped and !! assigned to the target 1-d array after the subroutine call by means !! of the \a RESHAPE() intrinsic function. RECURSIVE SUBROUTINE grid_transform_compute(this, field_in, field_out, var, & coord_3d_in, zlist) TYPE(grid_transform),INTENT(in),TARGET :: this !< grid_transformation object REAL,INTENT(in) :: field_in(:,:,:) !< input array REAL,INTENT(out) :: field_out(:,:,:) !< output array TYPE(vol7d_var),INTENT(in),OPTIONAL :: var !< physical variable to be interpolated, if provided, some ad-hoc algorithms may be used where possible REAL,INTENT(in),OPTIONAL,TARGET :: coord_3d_in(:,:,:) !< input vertical coordinate for vertical interpolation, if not provided by other means LOGICAL,INTENT(in),OPTIONAL :: zlist(:) !< list of levels actually present in input volume, if provided, levels marked as \a .FALSE. will not be interpolated regardless of their content (optimisation to avoid interpolating missing data) 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