libsim  Versione8.0.0

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

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

Generated with Doxygen.