libsim  Versione6.3.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 661 del file grid_transform_class.F90.

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

Generated with Doxygen.