|
libsim Versione 8.0.0
|
◆ transform_init()
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.
Definizione alla linea 651 del file grid_transform_class.F90. 657 ENDIF
658
659 IF (this%trans_type == 'polyinter') THEN
660 IF (this%poly%arraysize <= 0) THEN
661 CALL l4f_category_log(this%category,l4f_error, &
662 "polyinter: poly parameter missing or empty")
663 CALL raise_fatal_error()
664 ENDIF
665 ENDIF
666
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
703ELSE 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
720ELSE 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
741ELSE 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
774ELSE
775 CALL trans_type_error()
776 RETURN
777ENDIF
778
779CONTAINS
780
781SUBROUTINE sub_type_error()
782
783CALL l4f_category_log(this%category, l4f_error, trim(this%trans_type) &
784 //': sub_type '//trim(this%sub_type)//' is not defined')
785CALL raise_fatal_error()
786
787END SUBROUTINE sub_type_error
788
789SUBROUTINE trans_type_error()
790
791CALL l4f_category_log(this%category, l4f_error, 'trans_type '//this%trans_type &
792 //' is not defined')
793CALL raise_fatal_error()
794
795END SUBROUTINE trans_type_error
796
797
798END SUBROUTINE transform_init
799
800
801!> Destructor of \a tranform_def object.
802!! It releases any memory and data associated to the \a transform_def
803!! object \a this, the logger category will be deleted too.
804SUBROUTINE transform_delete(this)
805TYPE(transform_def),INTENT(inout) :: this !< transformation object
806
807this%trans_type=cmiss
808this%sub_type=cmiss
809
810this%rect_ind%ix=imiss
811this%rect_ind%iy=imiss
812this%rect_ind%fx=imiss
813this%rect_ind%fy=imiss
814
815this%rect_coo%ilon=dmiss
816this%rect_coo%ilat=dmiss
817this%rect_coo%flon=dmiss
818this%rect_coo%flat=dmiss
819
820this%box_info%npx=imiss
821this%box_info%npy=imiss
822
823this%extrap=.false.
824
825!chiudo il logger
826CALL l4f_category_delete(this%category)
827
828END SUBROUTINE transform_delete
829
830
831!> Method for returning the contents of the object.
832SUBROUTINE transform_get_val(this, time_definition, trans_type, sub_type, &
833 input_levtype, output_levtype)
834type(transform_def),intent(in) :: this !< object to examine
835INTEGER,INTENT(out),OPTIONAL :: time_definition !< 0=time is reference time, 1=time is validity time
836CHARACTER(len=*),INTENT(out),OPTIONAL :: trans_type !< type of transformation
837CHARACTER(len=*),INTENT(out),OPTIONAL :: sub_type !< subtype of transformation
838TYPE(vol7d_level),INTENT(out),OPTIONAL :: input_levtype
839!< type of vertical level of input data (only type of first and second surface are used, level values are ignored)
840TYPE(vol7d_level),INTENT(out),OPTIONAL :: output_levtype
841!< type of vertical level of output data (only type of first and second surface are used, level values are ignored)
842
843IF (PRESENT(time_definition)) time_definition=this%time_definition
844IF (PRESENT(trans_type)) trans_type = this%trans_type
845IF (PRESENT(sub_type)) sub_type = this%sub_type
846IF (PRESENT(input_levtype)) input_levtype = this%vertint%input_levtype
847IF (PRESENT(output_levtype)) output_levtype = this%vertint%output_levtype
848
849
850END SUBROUTINE transform_get_val
851
852
853!> Constructor for a \a grid_transform object, defining a particular
854!! vertical transformation.
855!! It defines an object describing a transformation involving
856!! operations on the vertical direction only, thus it applies in the
857!! same way to grid-to-grid and to sparse points-to-sparse points
858!! transformations; the abstract type of the transformation is
859!! described in the transformation object \a trans (type
860!! transform_def) which must have been properly initialised. The
861!! additional information required here is the list of input and
862!! output levels and an optional 3-d field indicating the vertical
863!! coordinates of the input dataset.
864!!
865!! The input level list \a lev_in is a 1-d array of \a vol7d_level
866!! type, describing the vertical coordinate system of the whole input
867!! dataset, only the vertical levels or layers matching the level type
868!! indicated when initialising the transformation object \a trans will
869!! be used, the others will be discarded in the vertical
870!! transformation. However the relevant vertical levels must be
871!! contiguous and sorted accordingly to the default \a vol7d_level
872!! sort order. The argument \a lev_out describes the vertical
873!! coordinate system of the output dataset. A particular case to be
874!! considered is when \a SIZE(lev_out)==0, this means that the output
875!! coordinates have to be computed automatically in the current
876!! subroutine, this is supported only for hybrid levels/layers.
877!!
878!! When the input and output level types are different, the \a
879!! coord_3d_in array must be provided, indicating the vertical
880!! coordinate of every input grid point expressed in terms of the
881!! output vertical coordinate system (e.g. height if interpolating to
882!! constant height levels or pressure if interpolating to isobaric
883!! levels). This array must contain, in the 3rd vertical dimension,
884!! only the those levels/layers of \a lev_in that are actually used
885!! for interpolation. The storage space of \a coord_3d_in is "stolen"
886!! by this method, so the array will appear as unallocated and
887!! unusable to the calling procedure after return from this
888!! subroutine.
889!!
890!! Layers in the grib2 sense (i.e. layers between two surfaces) can be
891!! handled by this class only when the upper and lower surfaces are of
892!! the same type; in these cases the coordinate assigned to every
893!! layer fro interpolation is the average (or log-average in case of
894!! isobaric surfaces) between the coordinates of the corresponding
895!! upper and lower surfaces.
896SUBROUTINE grid_transform_levtype_levtype_init(this, trans, lev_in, lev_out, &
897 coord_3d_in, categoryappend)
898TYPE(grid_transform),INTENT(out) :: this !< grid_transformation object
899TYPE(transform_def),INTENT(in) :: trans !< transformation object
900TYPE(vol7d_level),INTENT(in) :: lev_in(:) !< vol7d_level from input object
901TYPE(vol7d_level),INTENT(in) :: lev_out(:) !< vol7d_level object defining target vertical grid
902REAL,INTENT(inout),OPTIONAL,ALLOCATABLE :: coord_3d_in(:,:,:) !< vertical coordinates of each input point in target reference system
903CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend !< append this suffix to log4fortran namespace category
904
905DOUBLE PRECISION :: coord_in(SIZE(lev_in))
906DOUBLE PRECISION,ALLOCATABLE :: coord_out(:)
907LOGICAL :: mask_in(SIZE(lev_in))
908LOGICAL,ALLOCATABLE :: mask_out(:)
909LOGICAL :: dolog
910INTEGER :: i, j, icache, inused, istart, iend, ostart, oend
911
912
913CALL grid_transform_init_common(this, trans, categoryappend)
914#ifdef DEBUG
915CALL l4f_category_log(this%category, l4f_debug, "grid_transform vertint")
916#endif
917
918IF (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
|