libsim  Versione7.2.1

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

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

Generated with Doxygen.