libsim  Versione7.2.6

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

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

Generated with Doxygen.