libsim  Versione 7.1.9

◆ 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]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 2691 del file grid_transform_class.F90.

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

Generated with Doxygen.