libsim  Versione 7.1.7

◆ transform_init()

subroutine grid_transform_class::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 
)
private

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

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

Generated with Doxygen.