libsim Versione 7.1.11
|
◆ grid_transform_vol7d_vol7d_init()
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:
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.
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
2722ENDIF
2723
2724CONTAINS
2725
2726! common code to metamorphosis transformations conserving the number
2727! of points
2728SUBROUTINE metamorphosis_all_setup()
2729
2730this%outnx = SIZE(v7d_in%ana)
2731this%outny = 1
2732this%point_index(:,1) = (/(i,i=1,this%innx)/)
2733CALL vol7d_alloc(v7d_out, nana=SIZE(v7d_in%ana))
2734v7d_out%ana = v7d_in%ana
2735
2736this%valid = .true.
2737
2738END SUBROUTINE metamorphosis_all_setup
2739
2740END SUBROUTINE grid_transform_vol7d_vol7d_init
2741
2742
2743! Private subroutine for performing operations common to all constructors
2744SUBROUTINE grid_transform_init_common(this, trans, categoryappend)
2745TYPE(grid_transform),INTENT(inout) :: this
2746TYPE(transform_def),INTENT(in) :: trans
2747CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend
2748
2749CHARACTER(len=512) :: a_name
2750
2751IF (PRESENT(categoryappend)) THEN
2752 CALL l4f_launcher(a_name,a_name_append=trim(subcategory)//"."// &
2753 trim(categoryappend))
2754ELSE
2755 CALL l4f_launcher(a_name,a_name_append=trim(subcategory))
2756ENDIF
2757this%category=l4f_category_get(a_name)
2758
2759#ifdef DEBUG
2760CALL l4f_category_log(this%category,l4f_debug,"start init_grid_transform")
2761#endif
2762
2763this%trans=trans
2764
2765END SUBROUTINE grid_transform_init_common
2766
2767! internal subroutine to correctly initialise the output coordinates
2768! with polygon centroid coordinates
2769SUBROUTINE poly_to_coordinates(poly, v7d_out)
2770TYPE(arrayof_georef_coord_array),intent(in) :: poly
2771TYPE(vol7d),INTENT(inout) :: v7d_out
2772
2773INTEGER :: n, sz
2774DOUBLE PRECISION,ALLOCATABLE :: lon(:), lat(:)
2775
2776DO 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)))
2783ENDDO
2784
2785END SUBROUTINE poly_to_coordinates
2786
2790SUBROUTINE grid_transform_delete(this)
2791TYPE(grid_transform),INTENT(inout) :: this
2792
2793CALL delete(this%trans)
2794
2795this%innx=imiss
2796this%inny=imiss
2797this%outnx=imiss
2798this%outny=imiss
2799this%iniox=imiss
2800this%inioy=imiss
2801this%infox=imiss
2802this%infoy=imiss
2803this%outinx=imiss
2804this%outiny=imiss
2805this%outfnx=imiss
2806this%outfny=imiss
2807
2808if (associated(this%inter_index_x)) deallocate (this%inter_index_x)
2809if (associated(this%inter_index_y)) deallocate (this%inter_index_y)
2810if (associated(this%inter_index_z)) deallocate (this%inter_index_z)
2811if (associated(this%point_index)) deallocate (this%point_index)
2812
2813if (associated(this%inter_x)) deallocate (this%inter_x)
2814if (associated(this%inter_y)) deallocate (this%inter_y)
2815
2816if (associated(this%inter_xp)) deallocate (this%inter_xp)
2817if (associated(this%inter_yp)) deallocate (this%inter_yp)
2818if (associated(this%inter_zp)) deallocate (this%inter_zp)
2819if (associated(this%vcoord_in)) deallocate (this%vcoord_in)
2820if (associated(this%vcoord_out)) deallocate (this%vcoord_out)
2821if (associated(this%point_mask)) deallocate (this%point_mask)
2822if (associated(this%stencil)) deallocate (this%stencil)
2823if (associated(this%output_level_auto)) deallocate (this%output_level_auto)
2824IF (ALLOCATED(this%coord_3d_in)) DEALLOCATE(this%coord_3d_in)
2825this%valid = .false.
2826
2827! close the logger
2828call l4f_category_delete(this%category)
2829
2830END SUBROUTINE grid_transform_delete
2831
2832
2837SUBROUTINE grid_transform_get_val(this, output_level_auto, point_mask, &
2838 point_index, output_point_index, levshift, levused)
2839TYPE(grid_transform),INTENT(in) :: this
2840TYPE(vol7d_level),POINTER,OPTIONAL :: output_level_auto(:)
2841LOGICAL,INTENT(out),ALLOCATABLE,OPTIONAL :: point_mask(:)
2842INTEGER,INTENT(out),ALLOCATABLE,OPTIONAL :: point_index(:)
2843INTEGER,INTENT(out),ALLOCATABLE,OPTIONAL :: output_point_index(:)
2844INTEGER,INTENT(out),OPTIONAL :: levshift
2845INTEGER,INTENT(out),OPTIONAL :: levused
2846
2847INTEGER :: i
2848
2849IF (PRESENT(output_level_auto)) output_level_auto => this%output_level_auto
2850IF (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
2854ENDIF
2855IF (PRESENT(point_index)) THEN
2856 IF (ASSOCIATED(this%point_index)) THEN
2857 point_index = reshape(this%point_index, (/SIZE(this%point_index)/))
2858 ENDIF
2859ENDIF
2860IF (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
2869ENDIF
2870IF (PRESENT(levshift)) levshift = this%levshift
2871IF (PRESENT(levused)) levused = this%levused
2872
2873END SUBROUTINE grid_transform_get_val
2874
2875
2878FUNCTION grid_transform_c_e(this)
2879TYPE(grid_transform),INTENT(in) :: this
2880LOGICAL :: grid_transform_c_e
2881
2882grid_transform_c_e = this%valid
2883
2884END FUNCTION grid_transform_c_e
2885
2886
2896RECURSIVE SUBROUTINE grid_transform_compute(this, field_in, field_out, var, &
2897 coord_3d_in)
2898TYPE(grid_transform),INTENT(in),TARGET :: this
2899REAL,INTENT(in) :: field_in(:,:,:)
2900REAL,INTENT(out) :: field_out(:,:,:)
2901TYPE(vol7d_var),INTENT(in),OPTIONAL :: var
2902REAL,INTENT(in),OPTIONAL,TARGET :: coord_3d_in(:,:,:)
2903
2904INTEGER :: i, j, k, ii, jj, ie, je, n, navg, kk, kkcache, kkup, kkdown, &
2905 kfound, kfoundin, inused, i1, i2, j1, j2, np, ns
2906INTEGER,ALLOCATABLE :: nval(:,:)
2907REAL :: z1,z2,z3,z4,z(4)
2908DOUBLE PRECISION :: x1,x3,y1,y3,xp,yp
2909INTEGER :: innx, inny, innz, outnx, outny, outnz, vartype
2910REAL,ALLOCATABLE :: coord_in(:)
2911LOGICAL,ALLOCATABLE :: mask_in(:)
2912REAL,ALLOCATABLE :: val_in(:), field_tmp(:,:,:)
2913REAL,POINTER :: coord_3d_in_act(:,:,:)
2914TYPE(grid_transform) :: likethis
2915LOGICAL :: alloc_coord_3d_in_act, nm1
2916
2917
2918#ifdef DEBUG
2919CALL l4f_category_log(this%category,l4f_debug,"start grid_transform_compute")
2920#endif
2921
2922field_out(:,:,:) = rmiss
2923
2924IF (.NOT.this%valid) THEN
2925 CALL l4f_category_log(this%category,l4f_error, &
2926 "refusing to perform a non valid transformation")
|