libsim Versione 7.1.11

◆ count_distinct_level()

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

conta gli elementi distinti in vect

Definizione alla linea 705 del file vol7d_level_class.F90.

706! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
707! authors:
708! Davide Cesari <dcesari@arpa.emr.it>
709! Paolo Patruno <ppatruno@arpa.emr.it>
710
711! This program is free software; you can redistribute it and/or
712! modify it under the terms of the GNU General Public License as
713! published by the Free Software Foundation; either version 2 of
714! the License, or (at your option) any later version.
715
716! This program is distributed in the hope that it will be useful,
717! but WITHOUT ANY WARRANTY; without even the implied warranty of
718! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
719! GNU General Public License for more details.
720
721! You should have received a copy of the GNU General Public License
722! along with this program. If not, see <http://www.gnu.org/licenses/>.
723#include "config.h"
724
731USE kinds
734IMPLICIT NONE
735
740TYPE vol7d_level
741 INTEGER :: level1
742 INTEGER :: l1
743 INTEGER :: level2
744 INTEGER :: l2
745END TYPE vol7d_level
746
748TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
749
753INTERFACE init
754 MODULE PROCEDURE vol7d_level_init
755END INTERFACE
756
759INTERFACE delete
760 MODULE PROCEDURE vol7d_level_delete
761END INTERFACE
762
766INTERFACE OPERATOR (==)
767 MODULE PROCEDURE vol7d_level_eq
768END INTERFACE
769
773INTERFACE OPERATOR (/=)
774 MODULE PROCEDURE vol7d_level_ne
775END INTERFACE
776
782INTERFACE OPERATOR (>)
783 MODULE PROCEDURE vol7d_level_gt
784END INTERFACE
785
791INTERFACE OPERATOR (<)
792 MODULE PROCEDURE vol7d_level_lt
793END INTERFACE
794
800INTERFACE OPERATOR (>=)
801 MODULE PROCEDURE vol7d_level_ge
802END INTERFACE
803
809INTERFACE OPERATOR (<=)
810 MODULE PROCEDURE vol7d_level_le
811END INTERFACE
812
816INTERFACE OPERATOR (.almosteq.)
817 MODULE PROCEDURE vol7d_level_almost_eq
818END INTERFACE
819
820
821! da documentare in inglese assieme al resto
823INTERFACE c_e
824 MODULE PROCEDURE vol7d_level_c_e
825END INTERFACE
826
827#define VOL7D_POLY_TYPE TYPE(vol7d_level)
828#define VOL7D_POLY_TYPES _level
829#define ENABLE_SORT
830#include "array_utilities_pre.F90"
831
833INTERFACE display
834 MODULE PROCEDURE display_level
835END INTERFACE
836
838INTERFACE to_char
839 MODULE PROCEDURE to_char_level
840END INTERFACE
841
843INTERFACE vol7d_level_to_var
844 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
845END INTERFACE vol7d_level_to_var
846
849 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
850END INTERFACE vol7d_level_to_var_factor
851
854 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
855END INTERFACE vol7d_level_to_var_log10
856
857type(vol7d_level) :: almost_equal_levels(3)=(/&
858 vol7d_level( 1,imiss,imiss,imiss),&
859 vol7d_level(103,imiss,imiss,imiss),&
860 vol7d_level(106,imiss,imiss,imiss)/)
861
862! levels requiring conversion from internal to physical representation
863INTEGER, PARAMETER :: &
864 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
865 thermo_level(3) = (/20,107,235/), & ! 10**-1
866 sigma_level(2) = (/104,111/) ! 10**-4
867
868TYPE level_var
869 INTEGER :: level
870 CHARACTER(len=10) :: btable
871END TYPE level_var
872
873! Conversion table from GRIB2 vertical level codes to corresponding
874! BUFR B table variables
875TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
876 level_var(20, 'B12101'), & ! isothermal (K)
877 level_var(100, 'B10004'), & ! isobaric (Pa)
878 level_var(102, 'B10007'), & ! height over sea level (m)
879 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
880 level_var(107, 'B12192'), & ! isentropical (K)
881 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
882 level_var(161, 'B22195') /) ! depth below sea surface
883
884PRIVATE level_var, level_var_converter
885
886CONTAINS
887
893FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
894INTEGER,INTENT(IN),OPTIONAL :: level1
895INTEGER,INTENT(IN),OPTIONAL :: l1
896INTEGER,INTENT(IN),OPTIONAL :: level2
897INTEGER,INTENT(IN),OPTIONAL :: l2
898
899TYPE(vol7d_level) :: this
900
901CALL init(this, level1, l1, level2, l2)
902
903END FUNCTION vol7d_level_new
904
905
909SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
910TYPE(vol7d_level),INTENT(INOUT) :: this
911INTEGER,INTENT(IN),OPTIONAL :: level1
912INTEGER,INTENT(IN),OPTIONAL :: l1
913INTEGER,INTENT(IN),OPTIONAL :: level2
914INTEGER,INTENT(IN),OPTIONAL :: l2
915
916this%level1 = imiss
917this%l1 = imiss
918this%level2 = imiss
919this%l2 = imiss
920
921IF (PRESENT(level1)) THEN
922 this%level1 = level1
923ELSE
924 RETURN
925END IF
926
927IF (PRESENT(l1)) this%l1 = l1
928
929IF (PRESENT(level2)) THEN
930 this%level2 = level2
931ELSE
932 RETURN
933END IF
934
935IF (PRESENT(l2)) this%l2 = l2
936
937END SUBROUTINE vol7d_level_init
938
939
941SUBROUTINE vol7d_level_delete(this)
942TYPE(vol7d_level),INTENT(INOUT) :: this
943
944this%level1 = imiss
945this%l1 = imiss
946this%level2 = imiss
947this%l2 = imiss
948
949END SUBROUTINE vol7d_level_delete
950
951
952SUBROUTINE display_level(this)
953TYPE(vol7d_level),INTENT(in) :: this
954
955print*,trim(to_char(this))
956
957END SUBROUTINE display_level
958
959
960FUNCTION to_char_level(this)
961#ifdef HAVE_DBALLE
962USE dballef
963#endif
964TYPE(vol7d_level),INTENT(in) :: this
965CHARACTER(len=255) :: to_char_level
966
967#ifdef HAVE_DBALLE
968INTEGER :: handle, ier
969
970handle = 0
971ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
972ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
973ier = idba_fatto(handle)
974
975to_char_level="LEVEL: "//to_char_level
976
977#else
978
979to_char_level="LEVEL: "//&
980 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
981 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
982
983#endif
984
985END FUNCTION to_char_level
986
987
988ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
989TYPE(vol7d_level),INTENT(IN) :: this, that
990LOGICAL :: res
991
992res = &
993 this%level1 == that%level1 .AND. &
994 this%level2 == that%level2 .AND. &
995 this%l1 == that%l1 .AND. this%l2 == that%l2
996
997END FUNCTION vol7d_level_eq
998
999
1000ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
1001TYPE(vol7d_level),INTENT(IN) :: this, that
1002LOGICAL :: res
1003
1004res = .NOT.(this == that)
1005
1006END FUNCTION vol7d_level_ne
1007
1008
1009ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1010TYPE(vol7d_level),INTENT(IN) :: this, that
1011LOGICAL :: res
1012
1013IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
1014 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
1015 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
1016 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
1017 res = .true.
1018ELSE
1019 res = .false.
1020ENDIF
1021
1022END FUNCTION vol7d_level_almost_eq
1023
1024
1025ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1026TYPE(vol7d_level),INTENT(IN) :: this, that
1027LOGICAL :: res
1028
1029IF (&
1030 this%level1 > that%level1 .OR. &
1031 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1032 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1033 (&
1034 this%level2 > that%level2 .OR. &
1035 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1036 ))) THEN
1037 res = .true.
1038ELSE
1039 res = .false.
1040ENDIF
1041
1042END FUNCTION vol7d_level_gt
1043
1044
1045ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1046TYPE(vol7d_level),INTENT(IN) :: this, that
1047LOGICAL :: res
1048
1049IF (&
1050 this%level1 < that%level1 .OR. &
1051 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1052 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1053 (&
1054 this%level2 < that%level2 .OR. &
1055 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1056 ))) THEN
1057 res = .true.
1058ELSE
1059 res = .false.
1060ENDIF
1061
1062END FUNCTION vol7d_level_lt
1063
1064
1065ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1066TYPE(vol7d_level),INTENT(IN) :: this, that
1067LOGICAL :: res
1068
1069IF (this == that) THEN
1070 res = .true.
1071ELSE IF (this > that) THEN
1072 res = .true.
1073ELSE
1074 res = .false.
1075ENDIF
1076
1077END FUNCTION vol7d_level_ge
1078
1079
1080ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1081TYPE(vol7d_level),INTENT(IN) :: this, that
1082LOGICAL :: res
1083
1084IF (this == that) THEN
1085 res = .true.
1086ELSE IF (this < that) THEN
1087 res = .true.
1088ELSE
1089 res = .false.
1090ENDIF
1091
1092END FUNCTION vol7d_level_le
1093
1094
1095ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1096TYPE(vol7d_level),INTENT(IN) :: this
1097LOGICAL :: c_e
1098c_e = this /= vol7d_level_miss
1099END FUNCTION vol7d_level_c_e
1100
1101
1102#include "array_utilities_inc.F90"
1103
1104
1105FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1106TYPE(vol7d_level),INTENT(in) :: level
1107CHARACTER(len=10) :: btable
1108
1109btable = vol7d_level_to_var_int(level%level1)
1110
1111END FUNCTION vol7d_level_to_var_lev
1112
1113FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1114INTEGER,INTENT(in) :: level
1115CHARACTER(len=10) :: btable
1116
1117INTEGER :: i
1118
1119DO i = 1, SIZE(level_var_converter)
1120 IF (level_var_converter(i)%level == level) THEN
1121 btable = level_var_converter(i)%btable
1122 RETURN
1123 ENDIF
1124ENDDO
1125
1126btable = cmiss
1127
1128END FUNCTION vol7d_level_to_var_int
1129
1130
1131FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1132TYPE(vol7d_level),INTENT(in) :: level
1133REAL :: factor
1134
1135factor = vol7d_level_to_var_factor_int(level%level1)
1136
1137END FUNCTION vol7d_level_to_var_factor_lev
1138
1139FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1140INTEGER,INTENT(in) :: level
1141REAL :: factor
1142
1143factor = 1.
1144IF (any(level == height_level)) THEN
1145 factor = 1.e-3
1146ELSE IF (any(level == thermo_level)) THEN
1147 factor = 1.e-1
1148ELSE IF (any(level == sigma_level)) THEN
1149 factor = 1.e-4
1150ENDIF
1151
1152END FUNCTION vol7d_level_to_var_factor_int
1153
1154
1155FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1156TYPE(vol7d_level),INTENT(in) :: level
1157REAL :: log10
1158
1159log10 = vol7d_level_to_var_log10_int(level%level1)
1160
1161END FUNCTION vol7d_level_to_var_log10_lev
1162
1163FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1164INTEGER,INTENT(in) :: level
1165REAL :: log10
1166
1167log10 = 0.
1168IF (any(level == height_level)) THEN
1169 log10 = -3.
1170ELSE IF (any(level == thermo_level)) THEN
1171 log10 = -1.
1172ELSE IF (any(level == sigma_level)) THEN
1173 log10 = -4.
1174ENDIF
1175
1176END FUNCTION vol7d_level_to_var_log10_int
1177
1178END 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:251
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.