libsim Versione 7.2.0

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

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

Generated with Doxygen.