libsim Versione 7.2.4

◆ 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]thisgrid_transformation object
[in]transtransformation object
[in]v7d_invol7d object with the coordinates of the sparse point to be used as input (only information about coordinates is used)
[in,out]v7d_outvol7d 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]maskboundsarray 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]categoryappendappend this suffix to log4fortran namespace category

Definizione alla linea 2711 del file grid_transform_class.F90.

2713#ifdef DEBUG
2714 CALL l4f_category_log(this%category, l4f_debug, &
2715 "grid_transform_init setting invalid data to "//t2c(this%val1))
2716#endif
2717 ENDIF
2718
2719 CALL metamorphosis_all_setup()
2720
2721 ELSE IF (this%trans%sub_type == 'settoinvalid' ) THEN
2722
2723 IF (.NOT.PRESENT(maskbounds)) THEN
2724 CALL l4f_category_log(this%category,l4f_error, &
2725 'grid_transform_init maskbounds missing for metamorphosis:'// &
2726 trim(this%trans%sub_type)//' transformation')
2727 CALL raise_error()
2728 RETURN
2729 ELSE IF (SIZE(maskbounds) < 2) THEN
2730 CALL l4f_category_log(this%category,l4f_error, &
2731 'grid_transform_init maskbounds must have at least 2 elements for metamorphosis:'// &
2732 trim(this%trans%sub_type)//' transformation')
2733 CALL raise_error()
2734 RETURN
2735 ELSE
2736 this%val1 = maskbounds(1)
2737 this%val2 = maskbounds(SIZE(maskbounds))
2738#ifdef DEBUG
2739 CALL l4f_category_log(this%category, l4f_debug, &
2740 "grid_transform_init setting to invalid interval ]"//t2c(this%val1)//','// &
2741 t2c(this%val2)//']')
2742#endif
2743 ENDIF
2744
2745 CALL metamorphosis_all_setup()
2746
2747 ENDIF
2748ENDIF
2749
2750CONTAINS
2751
2752! common code to metamorphosis transformations conserving the number
2753! of points
2754SUBROUTINE metamorphosis_all_setup()
2755
2756this%outnx = SIZE(v7d_in%ana)
2757this%outny = 1
2758this%point_index(:,1) = (/(i,i=1,this%innx)/)
2759CALL vol7d_alloc(v7d_out, nana=SIZE(v7d_in%ana))
2760v7d_out%ana = v7d_in%ana
2761
2762this%valid = .true.
2763
2764END SUBROUTINE metamorphosis_all_setup
2765
2766END SUBROUTINE grid_transform_vol7d_vol7d_init
2767
2768
2769! Private subroutine for performing operations common to all constructors
2770SUBROUTINE grid_transform_init_common(this, trans, categoryappend)
2771TYPE(grid_transform),INTENT(inout) :: this
2772TYPE(transform_def),INTENT(in) :: trans
2773CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend
2774
2775CHARACTER(len=512) :: a_name
2776
2777IF (PRESENT(categoryappend)) THEN
2778 CALL l4f_launcher(a_name,a_name_append=trim(subcategory)//"."// &
2779 trim(categoryappend))
2780ELSE
2781 CALL l4f_launcher(a_name,a_name_append=trim(subcategory))
2782ENDIF
2783this%category=l4f_category_get(a_name)
2784
2785#ifdef DEBUG
2786CALL l4f_category_log(this%category,l4f_debug,"start init_grid_transform")
2787#endif
2788
2789this%trans=trans
2790
2791END SUBROUTINE grid_transform_init_common
2792
2793! internal subroutine to correctly initialise the output coordinates
2794! with polygon centroid coordinates
2795SUBROUTINE poly_to_coordinates(poly, v7d_out)
2796TYPE(arrayof_georef_coord_array),intent(in) :: poly
2797TYPE(vol7d),INTENT(inout) :: v7d_out
2798
2799INTEGER :: n, sz
2800DOUBLE PRECISION,ALLOCATABLE :: lon(:), lat(:)
2801
2802DO n = 1, poly%arraysize
2803 CALL getval(poly%array(n), x=lon, y=lat)
2804 sz = min(SIZE(lon), SIZE(lat))
2805 IF (lon(1) == lon(sz) .AND. lat(1) == lat(sz)) THEN ! closed polygon
2806 sz = sz - 1
2807 ENDIF
2808 CALL init(v7d_out%ana(n), lon=stat_average(lon(1:sz)), lat=stat_average(lat(1:sz)))
2809ENDDO
2810
2811END SUBROUTINE poly_to_coordinates
2812
2816SUBROUTINE grid_transform_delete(this)
2817TYPE(grid_transform),INTENT(inout) :: this
2818
2819CALL delete(this%trans)
2820
2821this%innx=imiss
2822this%inny=imiss
2823this%outnx=imiss
2824this%outny=imiss
2825this%iniox=imiss
2826this%inioy=imiss
2827this%infox=imiss
2828this%infoy=imiss
2829this%outinx=imiss
2830this%outiny=imiss
2831this%outfnx=imiss
2832this%outfny=imiss
2833
2834if (associated(this%inter_index_x)) deallocate (this%inter_index_x)
2835if (associated(this%inter_index_y)) deallocate (this%inter_index_y)
2836if (associated(this%inter_index_z)) deallocate (this%inter_index_z)
2837if (associated(this%point_index)) deallocate (this%point_index)
2838
2839if (associated(this%inter_x)) deallocate (this%inter_x)
2840if (associated(this%inter_y)) deallocate (this%inter_y)
2841
2842if (associated(this%inter_xp)) deallocate (this%inter_xp)
2843if (associated(this%inter_yp)) deallocate (this%inter_yp)
2844if (associated(this%inter_zp)) deallocate (this%inter_zp)
2845if (associated(this%vcoord_in)) deallocate (this%vcoord_in)
2846if (associated(this%vcoord_out)) deallocate (this%vcoord_out)
2847if (associated(this%point_mask)) deallocate (this%point_mask)
2848if (associated(this%stencil)) deallocate (this%stencil)
2849if (associated(this%output_level_auto)) deallocate (this%output_level_auto)
2850IF (ALLOCATED(this%coord_3d_in)) DEALLOCATE(this%coord_3d_in)
2851this%valid = .false.
2852
2853! close the logger
2854call l4f_category_delete(this%category)
2855
2856END SUBROUTINE grid_transform_delete
2857
2858
2863SUBROUTINE grid_transform_get_val(this, output_level_auto, point_mask, &
2864 point_index, output_point_index, levshift, levused)
2865TYPE(grid_transform),INTENT(in) :: this
2866TYPE(vol7d_level),POINTER,OPTIONAL :: output_level_auto(:)
2867LOGICAL,INTENT(out),ALLOCATABLE,OPTIONAL :: point_mask(:)
2868INTEGER,INTENT(out),ALLOCATABLE,OPTIONAL :: point_index(:)
2869INTEGER,INTENT(out),ALLOCATABLE,OPTIONAL :: output_point_index(:)
2870INTEGER,INTENT(out),OPTIONAL :: levshift
2871INTEGER,INTENT(out),OPTIONAL :: levused
2872
2873INTEGER :: i
2874
2875IF (PRESENT(output_level_auto)) output_level_auto => this%output_level_auto
2876IF (PRESENT(point_mask)) THEN
2877 IF (ASSOCIATED(this%point_index)) THEN
2878 point_mask = c_e(reshape(this%point_index, (/SIZE(this%point_index)/)))
2879 ENDIF
2880ENDIF
2881IF (PRESENT(point_index)) THEN
2882 IF (ASSOCIATED(this%point_index)) THEN
2883 point_index = reshape(this%point_index, (/SIZE(this%point_index)/))
2884 ENDIF
2885ENDIF
2886IF (PRESENT(output_point_index)) THEN
2887 IF (ASSOCIATED(this%point_index)) THEN
2888! metamorphosis, index is computed from input origin of output point
2889 output_point_index = pack(this%point_index(:,:), c_e(this%point_index))
2890 ELSE IF (this%trans%trans_type == 'polyinter' .OR. &
2891 this%trans%trans_type == 'maskinter') THEN
2892! other cases, index is order of output point
2893 output_point_index = (/(i,i=1,this%outnx)/)
2894 ENDIF
2895ENDIF
2896IF (PRESENT(levshift)) levshift = this%levshift
2897IF (PRESENT(levused)) levused = this%levused
2898
2899END SUBROUTINE grid_transform_get_val
2900
2901
2904FUNCTION grid_transform_c_e(this)
2905TYPE(grid_transform),INTENT(in) :: this
2906LOGICAL :: grid_transform_c_e
2907
2908grid_transform_c_e = this%valid
2909
2910END FUNCTION grid_transform_c_e
2911
2912
2922RECURSIVE SUBROUTINE grid_transform_compute(this, field_in, field_out, var, &
2923 coord_3d_in)
2924TYPE(grid_transform),INTENT(in),TARGET :: this
2925REAL,INTENT(in) :: field_in(:,:,:)
2926REAL,INTENT(out) :: field_out(:,:,:)
2927TYPE(vol7d_var),INTENT(in),OPTIONAL :: var
2928REAL,INTENT(in),OPTIONAL,TARGET :: coord_3d_in(:,:,:)
2929
2930INTEGER :: i, j, k, l, m, s, ii, jj, ie, je, n, navg, kk, kkcache, kkup, kkdown, &
2931 kfound, kfoundin, inused, i1, i2, j1, j2, np, ns, ix, iy
2932INTEGER,ALLOCATABLE :: nval(:,:)
2933REAL :: z1,z2,z3,z4,z(4)
2934DOUBLE PRECISION :: x1,x3,y1,y3,xp,yp, disttmp, dist
2935INTEGER :: innx, inny, innz, outnx, outny, outnz, vartype, nearcount
2936REAL,ALLOCATABLE :: coord_in(:)
2937LOGICAL,ALLOCATABLE :: mask_in(:)
2938REAL,ALLOCATABLE :: val_in(:), field_tmp(:,:,:)
2939REAL,POINTER :: coord_3d_in_act(:,:,:)
2940TYPE(grid_transform) :: likethis
2941LOGICAL :: alloc_coord_3d_in_act, nm1, optsearch, farenough
2942CHARACTER(len=4) :: env_var
2943
2944
2945#ifdef DEBUG
2946CALL l4f_category_log(this%category,l4f_debug,"start grid_transform_compute")

Generated with Doxygen.