libsim  Versione7.2.1

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

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 
694 ELSE 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 
711 ELSE 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 
732 ELSE 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 
765 ELSE
766  CALL trans_type_error()
767  RETURN
768 ENDIF
769 
770 CONTAINS
771 
772 SUBROUTINE sub_type_error()
773 
774 CALL l4f_category_log(this%category, l4f_error, trim(this%trans_type) &
775  //': sub_type '//trim(this%sub_type)//' is not defined')
776 CALL raise_fatal_error()
777 
778 END SUBROUTINE sub_type_error
779 
780 SUBROUTINE trans_type_error()
781 
782 CALL l4f_category_log(this%category, l4f_error, 'trans_type '//this%trans_type &
783  //' is not defined')
784 CALL raise_fatal_error()
785 
786 END SUBROUTINE trans_type_error
787 
788 
789 END SUBROUTINE transform_init
790 
791 
795 SUBROUTINE transform_delete(this)
796 TYPE(transform_def),INTENT(inout) :: this
797 
798 this%trans_type=cmiss
799 this%sub_type=cmiss
800 
801 this%rect_ind%ix=imiss
802 this%rect_ind%iy=imiss
803 this%rect_ind%fx=imiss
804 this%rect_ind%fy=imiss
805 
806 this%rect_coo%ilon=dmiss
807 this%rect_coo%ilat=dmiss
808 this%rect_coo%flon=dmiss
809 this%rect_coo%flat=dmiss
810 
811 this%box_info%npx=imiss
812 this%box_info%npy=imiss
813 
814 this%extrap=.false.
815 
816 !chiudo il logger
817 CALL l4f_category_delete(this%category)
818 
819 END SUBROUTINE transform_delete
820 
821 
823 SUBROUTINE transform_get_val(this, time_definition, trans_type, sub_type, &
824  input_levtype, output_levtype)
825 type(transform_def),intent(in) :: this
826 INTEGER,INTENT(out),OPTIONAL :: time_definition
827 CHARACTER(len=*),INTENT(out),OPTIONAL :: trans_type
828 CHARACTER(len=*),INTENT(out),OPTIONAL :: sub_type
829 TYPE(vol7d_level),INTENT(out),OPTIONAL :: input_levtype
830 
831 TYPE(vol7d_level),INTENT(out),OPTIONAL :: output_levtype
832 
833 
834 IF (PRESENT(time_definition)) time_definition=this%time_definition
835 IF (PRESENT(trans_type)) trans_type = this%trans_type
836 IF (PRESENT(sub_type)) sub_type = this%sub_type
837 IF (PRESENT(input_levtype)) input_levtype = this%vertint%input_levtype
838 IF (PRESENT(output_levtype)) output_levtype = this%vertint%output_levtype
839 
840 
841 END SUBROUTINE transform_get_val
842 
843 
887 SUBROUTINE grid_transform_levtype_levtype_init(this, trans, lev_in, lev_out, &
888  coord_3d_in, categoryappend)
889 TYPE(grid_transform),INTENT(out) :: this
890 TYPE(transform_def),INTENT(in) :: trans
891 TYPE(vol7d_level),INTENT(in) :: lev_in(:)
892 TYPE(vol7d_level),INTENT(in) :: lev_out(:)
893 REAL,INTENT(inout),OPTIONAL,ALLOCATABLE :: coord_3d_in(:,:,:)
894 CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend
895 
896 DOUBLE PRECISION :: coord_in(SIZE(lev_in))
897 DOUBLE PRECISION,ALLOCATABLE :: coord_out(:)
898 LOGICAL :: mask_in(SIZE(lev_in))
899 LOGICAL,ALLOCATABLE :: mask_out(:)
900 LOGICAL :: dolog
901 INTEGER :: i, j, icache, inused, istart, iend, ostart, oend
902 
903 
904 CALL grid_transform_init_common(this, trans, categoryappend)
905 #ifdef DEBUG
906 CALL l4f_category_log(this%category, l4f_debug, "grid_transform vertint")
907 #endif
908 
909 IF (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
977  ENDIF
978 
979  CALL move_alloc(coord_3d_in, this%coord_3d_in) ! steal allocation
980  IF (dolog) THEN
981  WHERE(c_e(this%coord_3d_in) .AND. this%coord_3d_in > 0.0)
982  this%coord_3d_in = log(this%coord_3d_in)
983  ELSE WHERE
984  this%coord_3d_in = rmiss
985  END WHERE
986  ENDIF

Generated with Doxygen.