libsim  Versione7.2.6

◆ transform_init()

subroutine transform_init ( type(transform_def), intent(out)  this,
character(len=*)  trans_type,
character(len=*)  sub_type,
integer, intent(in), optional  ix,
integer, intent(in), optional  iy,
integer, intent(in), optional  fx,
integer, intent(in), optional  fy,
doubleprecision, intent(in), optional  ilon,
doubleprecision, intent(in), optional  ilat,
doubleprecision, intent(in), optional  flon,
doubleprecision, intent(in), optional  flat,
integer, intent(in), optional  npx,
integer, intent(in), optional  npy,
doubleprecision, intent(in), optional  boxdx,
doubleprecision, intent(in), optional  boxdy,
doubleprecision, intent(in), optional  radius,
type(arrayof_georef_coord_array), optional  poly,
doubleprecision, intent(in), optional  percentile,
real, intent(in), optional  interv_gt,
real, intent(in), optional  interv_ge,
real, intent(in), optional  interv_lt,
real, intent(in), optional  interv_le,
logical, intent(in), optional  extrap,
integer, intent(in), optional  time_definition,
type(vol7d_level), intent(in), optional  input_levtype,
type(vol7d_var), intent(in), optional  input_coordvar,
type(vol7d_level), intent(in), optional  output_levtype,
character(len=*), intent(in), optional  categoryappend 
)

Constructor for a transform_def object, defining an abstract transformation between gridded and/or sparse point data.

The parameters trans_type and sub_type define the type of transformation, while all the other following parameters are optional, they have to be passed in keyword mode and those required by the transformation type and subtype chosen have to be present.

Parametri
[out]thistransformation object
trans_typetype of transformation, can be 'zoom', 'boxregrid', 'interp', 'vertint' ...
sub_typesub type of transformation, it depends on trans_type
[in]ixindex of initial point of new grid on x (for zoom)
[in]iyindex of initial point of new grid on y (for zoom)
[in]fxindex of final point of new grid on x (for zoom)
[in]fyindex of final point of new grid on y (for zoom)
[in]iloncoordinate of initial point of new grid or of bounding box on x (for zoom and metamorphosis)
[in]ilatcoordinate of initial point of new grid or of bounding box on y (for zoom and metamorphosis)
[in]floncoordinate of final point of new grid or of bounding box on x (for zoom and metamorphosis)
[in]flatcoordinate of final point of new grid or of bounding box on y (for zoom and metamorphosis)
[in]npxnumber of points to average along x direction (for boxregrid)
[in]npynumber of points to average along y direction (for boxregrid)
[in]boxdxlongitudinal/x extension of the box for box interpolation, default the target x grid step (unimplemented !)
[in]boxdylatitudinal/y extension of the box for box interpolation, default the target y grid step (unimplemented !)
[in]radiusradius of stencil in grid points (also fractionary values) for stencil interpolation
polyarray of polygons indicating areas over which to interpolate (for transformations 'polyinter' or 'metamorphosis:poly')
[in]percentilepercentile [0,100.] of the distribution of points in the box to use as interpolated value for 'percentile' subtype
[in]interv_gtgreater than condition for defining interval
[in]interv_gegreater equal condition for defining interval
[in]interv_ltless than condition for defining interval
[in]interv_leless equal condition for defining interval
[in]extrapactivate extrapolation outside input domain (use with care!)
[in]time_definitiontime definition for output vol7d object 0=time is reference time ; 1=time is validity time
[in]input_levtypetype of vertical level of input data to be vertically interpolated (only type of first and second surface are used, level values are ignored)
[in]input_coordvarvariable that defines the vertical coordinate in the input volume for vertical interpolation, if missing, the value of the vertical level defined with input_levtype is used
[in]output_levtypetype of vertical level to which data should be vertically interpolated (only type of first and second surface are used, level values are ignored)
[in]categoryappendsuffix to append to log4fortran namespace category

Definizione alla linea 666 del file grid_transform_class.F90.

666  IF (this%trans_type == 'stencilinter') THEN
667  IF (.NOT.c_e(this%area_info%radius)) THEN
668  CALL l4f_category_log(this%category,l4f_error, &
669  "stencilinter: radius parameter missing")
670  CALL raise_fatal_error()
671  ENDIF
672  ENDIF
673 
674  IF (this%sub_type == 'average' .OR. this%sub_type == 'stddev' &
675  .OR. this%sub_type == 'stddevnm1') THEN
676  this%stat_info%percentile = rmiss
677  ELSE IF (this%sub_type == 'max') THEN
678  this%stat_info%percentile = 101.
679  ELSE IF (this%sub_type == 'min') THEN
680  this%stat_info%percentile = -1.
681  ELSE IF (this%sub_type == 'percentile') THEN
682  IF (.NOT.c_e(this%stat_info%percentile)) THEN
683  CALL l4f_category_log(this%category,l4f_error,trim(this%trans_type)// &
684  ':percentile: percentile value not provided')
685  CALL raise_fatal_error()
686  ELSE IF (this%stat_info%percentile >= 100.) THEN
687  this%sub_type = 'max'
688  ELSE IF (this%stat_info%percentile <= 0.) THEN
689  this%sub_type = 'min'
690  ENDIF
691  ELSE IF (this%sub_type == 'frequency') THEN
692  IF (.NOT.c_e(this%interval_info%gt) .AND. .NOT.c_e(this%interval_info%gt)) THEN
693  CALL l4f_category_log(this%category,l4f_error,trim(this%trans_type)// &
694  ':frequency: lower and/or upper limit not provided')
695  CALL raise_fatal_error()
696  ENDIF
697  ELSE
698  CALL sub_type_error()
699  RETURN
700  ENDIF
701 
702 ELSE IF (this%trans_type == 'maskgen')THEN
703 
704  IF (this%sub_type == 'poly') THEN
705 
706  IF (this%poly%arraysize <= 0) THEN
707  CALL l4f_category_log(this%category,l4f_error,"maskgen:poly poly parameter missing or empty")
708  CALL raise_fatal_error()
709  ENDIF
710 
711  ELSE IF (this%sub_type == 'grid') THEN
712 ! nothing to do for now
713 
714  ELSE
715  CALL sub_type_error()
716  RETURN
717  ENDIF
718 
719 ELSE IF (this%trans_type == 'vertint') THEN
720 
721  IF (this%vertint%input_levtype == vol7d_level_miss) THEN
722  CALL l4f_category_log(this%category,l4f_error, &
723  'vertint parameter input_levtype not provided')
724  CALL raise_fatal_error()
725  ENDIF
726 
727  IF (this%vertint%output_levtype == vol7d_level_miss) THEN
728  CALL l4f_category_log(this%category,l4f_error, &
729  'vertint parameter output_levtype not provided')
730  CALL raise_fatal_error()
731  ENDIF
732 
733  IF (this%sub_type == 'linear' .OR. this%sub_type == 'linearsparse') THEN
734 ! nothing to do here
735  ELSE
736  CALL sub_type_error()
737  RETURN
738  ENDIF
739 
740 ELSE IF (this%trans_type == 'metamorphosis') THEN
741 
742  IF (this%sub_type == 'all') THEN
743 ! nothing to do here
744  ELSE IF (this%sub_type == 'coordbb')THEN
745 
746  IF (c_e(this%rect_coo%ilon) .AND. c_e(this%rect_coo%ilat) .AND. &
747  c_e(this%rect_coo%flon) .AND. c_e(this%rect_coo%flat)) THEN ! coordinates given
748  ELSE
749 
750  CALL l4f_category_log(this%category,l4f_error,"metamorphosis: coordbb parameters missing")
751  CALL raise_fatal_error()
752 
753  ENDIF
754 
755  ELSE IF (this%sub_type == 'poly')THEN
756 
757  IF (this%poly%arraysize <= 0) THEN
758  CALL l4f_category_log(this%category,l4f_error,"metamorphosis:poly: poly parameter missing or empty")
759  CALL raise_fatal_error()
760  ENDIF
761 
762  ELSE IF (this%sub_type == 'mask' .OR. this%sub_type == 'maskvalid' .OR. &
763  this%sub_type == 'maskinvalid' .OR. this%sub_type == 'setinvalidto' .OR. &
764  this%sub_type == 'settoinvalid' .OR. this%sub_type == 'lemaskinvalid' .OR. &
765  this%sub_type == 'ltmaskinvalid' .OR. this%sub_type == 'gemaskinvalid' .OR. &
766  this%sub_type == 'gtmaskinvalid') THEN
767 ! nothing to do here
768  ELSE
769  CALL sub_type_error()
770  RETURN
771  ENDIF
772 
773 ELSE
774  CALL trans_type_error()
775  RETURN
776 ENDIF
777 
778 CONTAINS
779 
780 SUBROUTINE sub_type_error()
781 
782 CALL l4f_category_log(this%category, l4f_error, trim(this%trans_type) &
783  //': sub_type '//trim(this%sub_type)//' is not defined')
784 CALL raise_fatal_error()
785 
786 END SUBROUTINE sub_type_error
787 
788 SUBROUTINE trans_type_error()
789 
790 CALL l4f_category_log(this%category, l4f_error, 'trans_type '//this%trans_type &
791  //' is not defined')
792 CALL raise_fatal_error()
793 
794 END SUBROUTINE trans_type_error
795 
796 
797 END SUBROUTINE transform_init
798 
799 
803 SUBROUTINE transform_delete(this)
804 TYPE(transform_def),INTENT(inout) :: this
805 
806 this%trans_type=cmiss
807 this%sub_type=cmiss
808 
809 this%rect_ind%ix=imiss
810 this%rect_ind%iy=imiss
811 this%rect_ind%fx=imiss
812 this%rect_ind%fy=imiss
813 
814 this%rect_coo%ilon=dmiss
815 this%rect_coo%ilat=dmiss
816 this%rect_coo%flon=dmiss
817 this%rect_coo%flat=dmiss
818 
819 this%box_info%npx=imiss
820 this%box_info%npy=imiss
821 
822 this%extrap=.false.
823 
824 !chiudo il logger
825 CALL l4f_category_delete(this%category)
826 
827 END SUBROUTINE transform_delete
828 
829 
831 SUBROUTINE transform_get_val(this, time_definition, trans_type, sub_type, &
832  input_levtype, output_levtype)
833 type(transform_def),intent(in) :: this
834 INTEGER,INTENT(out),OPTIONAL :: time_definition
835 CHARACTER(len=*),INTENT(out),OPTIONAL :: trans_type
836 CHARACTER(len=*),INTENT(out),OPTIONAL :: sub_type
837 TYPE(vol7d_level),INTENT(out),OPTIONAL :: input_levtype
838 
839 TYPE(vol7d_level),INTENT(out),OPTIONAL :: output_levtype
840 
841 
842 IF (PRESENT(time_definition)) time_definition=this%time_definition
843 IF (PRESENT(trans_type)) trans_type = this%trans_type
844 IF (PRESENT(sub_type)) sub_type = this%sub_type
845 IF (PRESENT(input_levtype)) input_levtype = this%vertint%input_levtype
846 IF (PRESENT(output_levtype)) output_levtype = this%vertint%output_levtype
847 
848 
849 END SUBROUTINE transform_get_val
850 
851 
895 SUBROUTINE grid_transform_levtype_levtype_init(this, trans, lev_in, lev_out, &
896  coord_3d_in, categoryappend)
897 TYPE(grid_transform),INTENT(out) :: this
898 TYPE(transform_def),INTENT(in) :: trans
899 TYPE(vol7d_level),INTENT(in) :: lev_in(:)
900 TYPE(vol7d_level),INTENT(in) :: lev_out(:)
901 REAL,INTENT(inout),OPTIONAL,ALLOCATABLE :: coord_3d_in(:,:,:)
902 CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend
903 
904 DOUBLE PRECISION :: coord_in(SIZE(lev_in))
905 DOUBLE PRECISION,ALLOCATABLE :: coord_out(:)
906 LOGICAL :: mask_in(SIZE(lev_in))
907 LOGICAL,ALLOCATABLE :: mask_out(:)
908 LOGICAL :: dolog
909 INTEGER :: i, j, icache, inused, istart, iend, ostart, oend
910 
911 
912 CALL grid_transform_init_common(this, trans, categoryappend)
913 #ifdef DEBUG
914 CALL l4f_category_log(this%category, l4f_debug, "grid_transform vertint")
915 #endif
916 
917 IF (this%trans%trans_type == 'vertint') THEN
918 
919  IF (c_e(trans%vertint%input_levtype%level2) .AND. &
920  trans%vertint%input_levtype%level1 /= trans%vertint%input_levtype%level2) THEN
921  CALL l4f_category_log(this%category, l4f_error, &
922  'vertint: input upper and lower surface must be of the same type, '// &
923  t2c(trans%vertint%input_levtype%level1)//'/='// &
924  t2c(trans%vertint%input_levtype%level2))
925  CALL raise_error()
926  RETURN
927  ENDIF
928  IF (c_e(trans%vertint%output_levtype%level2) .AND. &
929  trans%vertint%output_levtype%level1 /= trans%vertint%output_levtype%level2) THEN
930  CALL l4f_category_log(this%category, l4f_error, &
931  'vertint: output upper and lower surface must be of the same type'// &
932  t2c(trans%vertint%output_levtype%level1)//'/='// &
933  t2c(trans%vertint%output_levtype%level2))
934  CALL raise_error()
935  RETURN
936  ENDIF
937 
938  mask_in(:) = (lev_in(:)%level1 == trans%vertint%input_levtype%level1) .AND. &
939  (lev_in(:)%level2 == trans%vertint%input_levtype%level2)
940  CALL make_vert_coord(lev_in, mask_in, coord_in, dolog)
941  this%innz = SIZE(lev_in)
942  istart = firsttrue(mask_in)
943  iend = lasttrue(mask_in)
944  inused = iend - istart + 1
945  IF (inused /= count(mask_in)) THEN
946  CALL l4f_category_log(this%category, l4f_error, &
947  'grid_transform_levtype_levtype_init: input levels badly sorted '//&
948  t2c(inused)//'/'//t2c(count(mask_in)))
949  CALL raise_error()
950  RETURN
951  ENDIF
952  this%levshift = istart-1
953  this%levused = inused
954 
955  IF (trans%vertint%input_levtype%level1 /= trans%vertint%output_levtype%level1) THEN
956 #ifdef DEBUG
957  CALL l4f_category_log(this%category, l4f_debug, &
958  'vertint: different input and output level types '// &
959  t2c(trans%vertint%input_levtype%level1)//' '// &
960  t2c(trans%vertint%output_levtype%level1))
961 #endif
962 
963  ALLOCATE(mask_out(SIZE(lev_out)), this%vcoord_out(SIZE(lev_out)))
964  mask_out(:) = (lev_out(:)%level1 == trans%vertint%output_levtype%level1) .AND. &
965  (lev_out(:)%level2 == trans%vertint%output_levtype%level2)
966  CALL make_vert_coord(lev_out, mask_out, this%vcoord_out, dolog)
967  this%outnz = SIZE(mask_out)
968  DEALLOCATE(mask_out)
969 
970  IF (.NOT.PRESENT(coord_3d_in)) THEN
971  CALL l4f_category_log(this%category, l4f_warn, &
972  'vertint: different input and output level types &
973  &and no coord_3d_in, expecting vert. coord. in volume')
974  this%dolog = dolog ! a little bit dirty, I must compute log later
975  ELSE
976  IF (SIZE(coord_3d_in,3) /= inused) THEN
977  CALL l4f_category_log(this%category, l4f_error, &
978  'vertint: vertical size of coord_3d_in (vertical coordinate) &
979  &different from number of input levels suitable for interpolation')
980  CALL l4f_category_log(this%category, l4f_error, &
981  'coord_3d_in: '//t2c(SIZE(coord_3d_in,3))// &
982  ', input levels for interpolation: '//t2c(inused))
983  CALL raise_error()
984  RETURN
985  ENDIF
986 
987  CALL move_alloc(coord_3d_in, this%coord_3d_in) ! steal allocation
988  IF (dolog) THEN
989  WHERE(c_e(this%coord_3d_in) .AND. this%coord_3d_in > 0.0)
990  this%coord_3d_in = log(this%coord_3d_in)
991  ELSE WHERE
992  this%coord_3d_in = rmiss
993  END WHERE
994  ENDIF

Generated with Doxygen.