libsim  Versione 7.1.6

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

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

Generated with Doxygen.