libsim  Versione7.2.3

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

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 2723 del file grid_transform_class.F90.

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
2748 ENDIF
2749 
2750 CONTAINS
2751 
2752 ! common code to metamorphosis transformations conserving the number
2753 ! of points
2754 SUBROUTINE metamorphosis_all_setup()
2755 
2756 this%outnx = SIZE(v7d_in%ana)
2757 this%outny = 1
2758 this%point_index(:,1) = (/(i,i=1,this%innx)/)
2759 CALL vol7d_alloc(v7d_out, nana=SIZE(v7d_in%ana))
2760 v7d_out%ana = v7d_in%ana
2761 
2762 this%valid = .true.
2763 
2764 END SUBROUTINE metamorphosis_all_setup
2765 
2766 END SUBROUTINE grid_transform_vol7d_vol7d_init
2767 
2768 
2769 ! Private subroutine for performing operations common to all constructors
2770 SUBROUTINE grid_transform_init_common(this, trans, categoryappend)
2771 TYPE(grid_transform),INTENT(inout) :: this
2772 TYPE(transform_def),INTENT(in) :: trans
2773 CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend
2774 
2775 CHARACTER(len=512) :: a_name
2776 
2777 IF (PRESENT(categoryappend)) THEN
2778  CALL l4f_launcher(a_name,a_name_append=trim(subcategory)//"."// &
2779  trim(categoryappend))
2780 ELSE
2781  CALL l4f_launcher(a_name,a_name_append=trim(subcategory))
2782 ENDIF
2783 this%category=l4f_category_get(a_name)
2784 
2785 #ifdef DEBUG
2786 CALL l4f_category_log(this%category,l4f_debug,"start init_grid_transform")
2787 #endif
2788 
2789 this%trans=trans
2790 
2791 END SUBROUTINE grid_transform_init_common
2792 
2793 ! internal subroutine to correctly initialise the output coordinates
2794 ! with polygon centroid coordinates
2795 SUBROUTINE poly_to_coordinates(poly, v7d_out)
2796 TYPE(arrayof_georef_coord_array),intent(in) :: poly
2797 TYPE(vol7d),INTENT(inout) :: v7d_out
2798 
2799 INTEGER :: n, sz
2800 DOUBLE PRECISION,ALLOCATABLE :: lon(:), lat(:)
2801 
2802 DO 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)))
2809 ENDDO
2810 
2811 END SUBROUTINE poly_to_coordinates
2812 
2816 SUBROUTINE grid_transform_delete(this)
2817 TYPE(grid_transform),INTENT(inout) :: this
2818 
2819 CALL delete(this%trans)
2820 
2821 this%innx=imiss
2822 this%inny=imiss
2823 this%outnx=imiss
2824 this%outny=imiss
2825 this%iniox=imiss
2826 this%inioy=imiss
2827 this%infox=imiss
2828 this%infoy=imiss
2829 this%outinx=imiss
2830 this%outiny=imiss
2831 this%outfnx=imiss
2832 this%outfny=imiss
2833 
2834 if (associated(this%inter_index_x)) deallocate (this%inter_index_x)
2835 if (associated(this%inter_index_y)) deallocate (this%inter_index_y)
2836 if (associated(this%inter_index_z)) deallocate (this%inter_index_z)
2837 if (associated(this%point_index)) deallocate (this%point_index)
2838 
2839 if (associated(this%inter_x)) deallocate (this%inter_x)
2840 if (associated(this%inter_y)) deallocate (this%inter_y)
2841 
2842 if (associated(this%inter_xp)) deallocate (this%inter_xp)
2843 if (associated(this%inter_yp)) deallocate (this%inter_yp)
2844 if (associated(this%inter_zp)) deallocate (this%inter_zp)
2845 if (associated(this%vcoord_in)) deallocate (this%vcoord_in)
2846 if (associated(this%vcoord_out)) deallocate (this%vcoord_out)
2847 if (associated(this%point_mask)) deallocate (this%point_mask)
2848 if (associated(this%stencil)) deallocate (this%stencil)
2849 if (associated(this%output_level_auto)) deallocate (this%output_level_auto)
2850 IF (ALLOCATED(this%coord_3d_in)) DEALLOCATE(this%coord_3d_in)
2851 this%valid = .false.
2852 
2853 ! close the logger
2854 call l4f_category_delete(this%category)
2855 
2856 END SUBROUTINE grid_transform_delete
2857 
2858 
2863 SUBROUTINE grid_transform_get_val(this, output_level_auto, point_mask, &
2864  point_index, output_point_index, levshift, levused)
2865 TYPE(grid_transform),INTENT(in) :: this
2866 TYPE(vol7d_level),POINTER,OPTIONAL :: output_level_auto(:)
2867 LOGICAL,INTENT(out),ALLOCATABLE,OPTIONAL :: point_mask(:)
2868 INTEGER,INTENT(out),ALLOCATABLE,OPTIONAL :: point_index(:)
2869 INTEGER,INTENT(out),ALLOCATABLE,OPTIONAL :: output_point_index(:)
2870 INTEGER,INTENT(out),OPTIONAL :: levshift
2871 INTEGER,INTENT(out),OPTIONAL :: levused
2872 
2873 INTEGER :: i
2874 
2875 IF (PRESENT(output_level_auto)) output_level_auto => this%output_level_auto
2876 IF (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
2880 ENDIF
2881 IF (PRESENT(point_index)) THEN
2882  IF (ASSOCIATED(this%point_index)) THEN
2883  point_index = reshape(this%point_index, (/SIZE(this%point_index)/))
2884  ENDIF
2885 ENDIF
2886 IF (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
2895 ENDIF
2896 IF (PRESENT(levshift)) levshift = this%levshift
2897 IF (PRESENT(levused)) levused = this%levused
2898 
2899 END SUBROUTINE grid_transform_get_val
2900 
2901 
2904 FUNCTION grid_transform_c_e(this)
2905 TYPE(grid_transform),INTENT(in) :: this
2906 LOGICAL :: grid_transform_c_e
2907 
2908 grid_transform_c_e = this%valid
2909 
2910 END FUNCTION grid_transform_c_e
2911 
2912 
2922 RECURSIVE SUBROUTINE grid_transform_compute(this, field_in, field_out, var, &
2923  coord_3d_in)
2924 TYPE(grid_transform),INTENT(in),TARGET :: this
2925 REAL,INTENT(in) :: field_in(:,:,:)
2926 REAL,INTENT(out) :: field_out(:,:,:)
2927 TYPE(vol7d_var),INTENT(in),OPTIONAL :: var
2928 REAL,INTENT(in),OPTIONAL,TARGET :: coord_3d_in(:,:,:)
2929 
2930 INTEGER :: 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
2932 INTEGER,ALLOCATABLE :: nval(:,:)
2933 REAL :: z1,z2,z3,z4,z(4)
2934 DOUBLE PRECISION :: x1,x3,y1,y3,xp,yp, disttmp, dist
2935 INTEGER :: innx, inny, innz, outnx, outny, outnz, vartype, nearcount
2936 REAL,ALLOCATABLE :: coord_in(:)
2937 LOGICAL,ALLOCATABLE :: mask_in(:)
2938 REAL,ALLOCATABLE :: val_in(:), field_tmp(:,:,:)
2939 REAL,POINTER :: coord_3d_in_act(:,:,:)
2940 TYPE(grid_transform) :: likethis
2941 LOGICAL :: alloc_coord_3d_in_act, nm1, optsearch, farenough
2942 CHARACTER(len=4) :: env_var
2943 
2944 
2945 #ifdef DEBUG
2946 CALL l4f_category_log(this%category,l4f_debug,"start grid_transform_compute")
2947 #endif
2948 
2949 field_out(:,:,:) = rmiss
2950 
2951 IF (.NOT.this%valid) THEN
2952  CALL l4f_category_log(this%category,l4f_error, &
2953  "refusing to perform a non valid transformation")
2954  RETURN
2955 ENDIF
2956 

Generated with Doxygen.