libsim Versione 7.2.1

◆ count_distinct_sorted_level()

integer function count_distinct_sorted_level ( type(vol7d_level), dimension(:), intent(in)  vect,
logical, dimension(:), intent(in), optional  mask 
)

conta gli elementi distinti in un sorted array

Definizione alla linea 665 del file vol7d_level_class.F90.

666! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
667! authors:
668! Davide Cesari <dcesari@arpa.emr.it>
669! Paolo Patruno <ppatruno@arpa.emr.it>
670
671! This program is free software; you can redistribute it and/or
672! modify it under the terms of the GNU General Public License as
673! published by the Free Software Foundation; either version 2 of
674! the License, or (at your option) any later version.
675
676! This program is distributed in the hope that it will be useful,
677! but WITHOUT ANY WARRANTY; without even the implied warranty of
678! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
679! GNU General Public License for more details.
680
681! You should have received a copy of the GNU General Public License
682! along with this program. If not, see <http://www.gnu.org/licenses/>.
683#include "config.h"
684
691USE kinds
694IMPLICIT NONE
695
700TYPE vol7d_level
701 INTEGER :: level1
702 INTEGER :: l1
703 INTEGER :: level2
704 INTEGER :: l2
705END TYPE vol7d_level
706
708TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
709
713INTERFACE init
714 MODULE PROCEDURE vol7d_level_init
715END INTERFACE
716
719INTERFACE delete
720 MODULE PROCEDURE vol7d_level_delete
721END INTERFACE
722
726INTERFACE OPERATOR (==)
727 MODULE PROCEDURE vol7d_level_eq
728END INTERFACE
729
733INTERFACE OPERATOR (/=)
734 MODULE PROCEDURE vol7d_level_ne
735END INTERFACE
736
742INTERFACE OPERATOR (>)
743 MODULE PROCEDURE vol7d_level_gt
744END INTERFACE
745
751INTERFACE OPERATOR (<)
752 MODULE PROCEDURE vol7d_level_lt
753END INTERFACE
754
760INTERFACE OPERATOR (>=)
761 MODULE PROCEDURE vol7d_level_ge
762END INTERFACE
763
769INTERFACE OPERATOR (<=)
770 MODULE PROCEDURE vol7d_level_le
771END INTERFACE
772
776INTERFACE OPERATOR (.almosteq.)
777 MODULE PROCEDURE vol7d_level_almost_eq
778END INTERFACE
779
780
781! da documentare in inglese assieme al resto
783INTERFACE c_e
784 MODULE PROCEDURE vol7d_level_c_e
785END INTERFACE
786
787#define VOL7D_POLY_TYPE TYPE(vol7d_level)
788#define VOL7D_POLY_TYPES _level
789#define ENABLE_SORT
790#include "array_utilities_pre.F90"
791
793INTERFACE display
794 MODULE PROCEDURE display_level
795END INTERFACE
796
798INTERFACE to_char
799 MODULE PROCEDURE to_char_level
800END INTERFACE
801
803INTERFACE vol7d_level_to_var
804 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
805END INTERFACE vol7d_level_to_var
806
809 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
810END INTERFACE vol7d_level_to_var_factor
811
814 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
815END INTERFACE vol7d_level_to_var_log10
816
817type(vol7d_level) :: almost_equal_levels(3)=(/&
818 vol7d_level( 1,imiss,imiss,imiss),&
819 vol7d_level(103,imiss,imiss,imiss),&
820 vol7d_level(106,imiss,imiss,imiss)/)
821
822! levels requiring conversion from internal to physical representation
823INTEGER, PARAMETER :: &
824 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
825 thermo_level(3) = (/20,107,235/), & ! 10**-1
826 sigma_level(2) = (/104,111/) ! 10**-4
827
828TYPE level_var
829 INTEGER :: level
830 CHARACTER(len=10) :: btable
831END TYPE level_var
832
833! Conversion table from GRIB2 vertical level codes to corresponding
834! BUFR B table variables
835TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
836 level_var(20, 'B12101'), & ! isothermal (K)
837 level_var(100, 'B10004'), & ! isobaric (Pa)
838 level_var(102, 'B10007'), & ! height over sea level (m)
839 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
840 level_var(107, 'B12192'), & ! isentropical (K)
841 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
842 level_var(161, 'B22195') /) ! depth below sea surface
843
844PRIVATE level_var, level_var_converter
845
846CONTAINS
847
853FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
854INTEGER,INTENT(IN),OPTIONAL :: level1
855INTEGER,INTENT(IN),OPTIONAL :: l1
856INTEGER,INTENT(IN),OPTIONAL :: level2
857INTEGER,INTENT(IN),OPTIONAL :: l2
858
859TYPE(vol7d_level) :: this
860
861CALL init(this, level1, l1, level2, l2)
862
863END FUNCTION vol7d_level_new
864
865
869SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
870TYPE(vol7d_level),INTENT(INOUT) :: this
871INTEGER,INTENT(IN),OPTIONAL :: level1
872INTEGER,INTENT(IN),OPTIONAL :: l1
873INTEGER,INTENT(IN),OPTIONAL :: level2
874INTEGER,INTENT(IN),OPTIONAL :: l2
875
876this%level1 = imiss
877this%l1 = imiss
878this%level2 = imiss
879this%l2 = imiss
880
881IF (PRESENT(level1)) THEN
882 this%level1 = level1
883ELSE
884 RETURN
885END IF
886
887IF (PRESENT(l1)) this%l1 = l1
888
889IF (PRESENT(level2)) THEN
890 this%level2 = level2
891ELSE
892 RETURN
893END IF
894
895IF (PRESENT(l2)) this%l2 = l2
896
897END SUBROUTINE vol7d_level_init
898
899
901SUBROUTINE vol7d_level_delete(this)
902TYPE(vol7d_level),INTENT(INOUT) :: this
903
904this%level1 = imiss
905this%l1 = imiss
906this%level2 = imiss
907this%l2 = imiss
908
909END SUBROUTINE vol7d_level_delete
910
911
912SUBROUTINE display_level(this)
913TYPE(vol7d_level),INTENT(in) :: this
914
915print*,trim(to_char(this))
916
917END SUBROUTINE display_level
918
919
920FUNCTION to_char_level(this)
921#ifdef HAVE_DBALLE
922USE dballef
923#endif
924TYPE(vol7d_level),INTENT(in) :: this
925CHARACTER(len=255) :: to_char_level
926
927#ifdef HAVE_DBALLE
928INTEGER :: handle, ier
929
930handle = 0
931ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
932ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
933ier = idba_fatto(handle)
934
935to_char_level="LEVEL: "//to_char_level
936
937#else
938
939to_char_level="LEVEL: "//&
940 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
941 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
942
943#endif
944
945END FUNCTION to_char_level
946
947
948ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
949TYPE(vol7d_level),INTENT(IN) :: this, that
950LOGICAL :: res
951
952res = &
953 this%level1 == that%level1 .AND. &
954 this%level2 == that%level2 .AND. &
955 this%l1 == that%l1 .AND. this%l2 == that%l2
956
957END FUNCTION vol7d_level_eq
958
959
960ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
961TYPE(vol7d_level),INTENT(IN) :: this, that
962LOGICAL :: res
963
964res = .NOT.(this == that)
965
966END FUNCTION vol7d_level_ne
967
968
969ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
970TYPE(vol7d_level),INTENT(IN) :: this, that
971LOGICAL :: res
972
973IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
974 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
975 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
976 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
977 res = .true.
978ELSE
979 res = .false.
980ENDIF
981
982END FUNCTION vol7d_level_almost_eq
983
984
985ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
986TYPE(vol7d_level),INTENT(IN) :: this, that
987LOGICAL :: res
988
989IF (&
990 this%level1 > that%level1 .OR. &
991 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
992 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
993 (&
994 this%level2 > that%level2 .OR. &
995 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
996 ))) THEN
997 res = .true.
998ELSE
999 res = .false.
1000ENDIF
1001
1002END FUNCTION vol7d_level_gt
1003
1004
1005ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1006TYPE(vol7d_level),INTENT(IN) :: this, that
1007LOGICAL :: res
1008
1009IF (&
1010 this%level1 < that%level1 .OR. &
1011 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1012 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1013 (&
1014 this%level2 < that%level2 .OR. &
1015 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1016 ))) THEN
1017 res = .true.
1018ELSE
1019 res = .false.
1020ENDIF
1021
1022END FUNCTION vol7d_level_lt
1023
1024
1025ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1026TYPE(vol7d_level),INTENT(IN) :: this, that
1027LOGICAL :: res
1028
1029IF (this == that) THEN
1030 res = .true.
1031ELSE IF (this > that) THEN
1032 res = .true.
1033ELSE
1034 res = .false.
1035ENDIF
1036
1037END FUNCTION vol7d_level_ge
1038
1039
1040ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1041TYPE(vol7d_level),INTENT(IN) :: this, that
1042LOGICAL :: res
1043
1044IF (this == that) THEN
1045 res = .true.
1046ELSE IF (this < that) THEN
1047 res = .true.
1048ELSE
1049 res = .false.
1050ENDIF
1051
1052END FUNCTION vol7d_level_le
1053
1054
1055ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1056TYPE(vol7d_level),INTENT(IN) :: this
1057LOGICAL :: c_e
1058c_e = this /= vol7d_level_miss
1059END FUNCTION vol7d_level_c_e
1060
1061
1062#include "array_utilities_inc.F90"
1063
1064
1065FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1066TYPE(vol7d_level),INTENT(in) :: level
1067CHARACTER(len=10) :: btable
1068
1069btable = vol7d_level_to_var_int(level%level1)
1070
1071END FUNCTION vol7d_level_to_var_lev
1072
1073FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1074INTEGER,INTENT(in) :: level
1075CHARACTER(len=10) :: btable
1076
1077INTEGER :: i
1078
1079DO i = 1, SIZE(level_var_converter)
1080 IF (level_var_converter(i)%level == level) THEN
1081 btable = level_var_converter(i)%btable
1082 RETURN
1083 ENDIF
1084ENDDO
1085
1086btable = cmiss
1087
1088END FUNCTION vol7d_level_to_var_int
1089
1090
1091FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1092TYPE(vol7d_level),INTENT(in) :: level
1093REAL :: factor
1094
1095factor = vol7d_level_to_var_factor_int(level%level1)
1096
1097END FUNCTION vol7d_level_to_var_factor_lev
1098
1099FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1100INTEGER,INTENT(in) :: level
1101REAL :: factor
1102
1103factor = 1.
1104IF (any(level == height_level)) THEN
1105 factor = 1.e-3
1106ELSE IF (any(level == thermo_level)) THEN
1107 factor = 1.e-1
1108ELSE IF (any(level == sigma_level)) THEN
1109 factor = 1.e-4
1110ENDIF
1111
1112END FUNCTION vol7d_level_to_var_factor_int
1113
1114
1115FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1116TYPE(vol7d_level),INTENT(in) :: level
1117REAL :: log10
1118
1119log10 = vol7d_level_to_var_log10_int(level%level1)
1120
1121END FUNCTION vol7d_level_to_var_log10_lev
1122
1123FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1124INTEGER,INTENT(in) :: level
1125REAL :: log10
1126
1127log10 = 0.
1128IF (any(level == height_level)) THEN
1129 log10 = -3.
1130ELSE IF (any(level == thermo_level)) THEN
1131 log10 = -1.
1132ELSE IF (any(level == sigma_level)) THEN
1133 log10 = -4.
1134ENDIF
1135
1136END FUNCTION vol7d_level_to_var_log10_int
1137
1138END MODULE vol7d_level_class
Distruttore per la classe vol7d_level.
Costruttore per la classe vol7d_level.
Represent level object in a pretty string.
Return the conversion factor for multiplying the level value when converting to variable.
Return the scale value (base 10 log of conversion factor) for multiplying the level value when conver...
Convert a level type to a physical variable.
Utilities for CHARACTER variables.
Definition of constants to be used for declaring variables of a desired type.
Definition: kinds.F90:245
Definitions of constants and functions for working with missing values.
Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
Definisce il livello verticale di un'osservazione.

Generated with Doxygen.