libsim Versione 7.2.4
|
◆ count_distinct_level()
conta gli elementi distinti in vect Definizione alla linea 699 del file vol7d_level_class.F90. 700! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
701! authors:
702! Davide Cesari <dcesari@arpa.emr.it>
703! Paolo Patruno <ppatruno@arpa.emr.it>
704
705! This program is free software; you can redistribute it and/or
706! modify it under the terms of the GNU General Public License as
707! published by the Free Software Foundation; either version 2 of
708! the License, or (at your option) any later version.
709
710! This program is distributed in the hope that it will be useful,
711! but WITHOUT ANY WARRANTY; without even the implied warranty of
712! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
713! GNU General Public License for more details.
714
715! You should have received a copy of the GNU General Public License
716! along with this program. If not, see <http://www.gnu.org/licenses/>.
717#include "config.h"
718
728IMPLICIT NONE
729
735 INTEGER :: level1
736 INTEGER :: l1
737 INTEGER :: level2
738 INTEGER :: l2
740
743
748 MODULE PROCEDURE vol7d_level_init
749END INTERFACE
750
754 MODULE PROCEDURE vol7d_level_delete
755END INTERFACE
756
760INTERFACE OPERATOR (==)
761 MODULE PROCEDURE vol7d_level_eq
762END INTERFACE
763
767INTERFACE OPERATOR (/=)
768 MODULE PROCEDURE vol7d_level_ne
769END INTERFACE
770
776INTERFACE OPERATOR (>)
777 MODULE PROCEDURE vol7d_level_gt
778END INTERFACE
779
785INTERFACE OPERATOR (<)
786 MODULE PROCEDURE vol7d_level_lt
787END INTERFACE
788
794INTERFACE OPERATOR (>=)
795 MODULE PROCEDURE vol7d_level_ge
796END INTERFACE
797
803INTERFACE OPERATOR (<=)
804 MODULE PROCEDURE vol7d_level_le
805END INTERFACE
806
810INTERFACE OPERATOR (.almosteq.)
811 MODULE PROCEDURE vol7d_level_almost_eq
812END INTERFACE
813
814
815! da documentare in inglese assieme al resto
818 MODULE PROCEDURE vol7d_level_c_e
819END INTERFACE
820
821#define VOL7D_POLY_TYPE TYPE(vol7d_level)
822#define VOL7D_POLY_TYPES _level
823#define ENABLE_SORT
824#include "array_utilities_pre.F90"
825
828 MODULE PROCEDURE display_level
829END INTERFACE
830
833 MODULE PROCEDURE to_char_level
834END INTERFACE
835
838 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
840
843 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
845
848 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
850
851type(vol7d_level) :: almost_equal_levels(3)=(/&
852 vol7d_level( 1,imiss,imiss,imiss),&
853 vol7d_level(103,imiss,imiss,imiss),&
854 vol7d_level(106,imiss,imiss,imiss)/)
855
856! levels requiring conversion from internal to physical representation
857INTEGER, PARAMETER :: &
858 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
859 thermo_level(3) = (/20,107,235/), & ! 10**-1
860 sigma_level(2) = (/104,111/) ! 10**-4
861
862TYPE level_var
863 INTEGER :: level
864 CHARACTER(len=10) :: btable
865END TYPE level_var
866
867! Conversion table from GRIB2 vertical level codes to corresponding
868! BUFR B table variables
869TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
870 level_var(20, 'B12101'), & ! isothermal (K)
871 level_var(100, 'B10004'), & ! isobaric (Pa)
872 level_var(102, 'B10007'), & ! height over sea level (m)
873 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
874 level_var(107, 'B12192'), & ! isentropical (K)
875 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
876 level_var(161, 'B22195') /) ! depth below sea surface
877
878PRIVATE level_var, level_var_converter
879
880CONTAINS
881
887FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
888INTEGER,INTENT(IN),OPTIONAL :: level1
889INTEGER,INTENT(IN),OPTIONAL :: l1
890INTEGER,INTENT(IN),OPTIONAL :: level2
891INTEGER,INTENT(IN),OPTIONAL :: l2
892
893TYPE(vol7d_level) :: this
894
896
897END FUNCTION vol7d_level_new
898
899
903SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
904TYPE(vol7d_level),INTENT(INOUT) :: this
905INTEGER,INTENT(IN),OPTIONAL :: level1
906INTEGER,INTENT(IN),OPTIONAL :: l1
907INTEGER,INTENT(IN),OPTIONAL :: level2
908INTEGER,INTENT(IN),OPTIONAL :: l2
909
910this%level1 = imiss
911this%l1 = imiss
912this%level2 = imiss
913this%l2 = imiss
914
915IF (PRESENT(level1)) THEN
916 this%level1 = level1
917ELSE
918 RETURN
919END IF
920
921IF (PRESENT(l1)) this%l1 = l1
922
923IF (PRESENT(level2)) THEN
924 this%level2 = level2
925ELSE
926 RETURN
927END IF
928
929IF (PRESENT(l2)) this%l2 = l2
930
931END SUBROUTINE vol7d_level_init
932
933
935SUBROUTINE vol7d_level_delete(this)
936TYPE(vol7d_level),INTENT(INOUT) :: this
937
938this%level1 = imiss
939this%l1 = imiss
940this%level2 = imiss
941this%l2 = imiss
942
943END SUBROUTINE vol7d_level_delete
944
945
946SUBROUTINE display_level(this)
947TYPE(vol7d_level),INTENT(in) :: this
948
949print*,trim(to_char(this))
950
951END SUBROUTINE display_level
952
953
954FUNCTION to_char_level(this)
955#ifdef HAVE_DBALLE
956USE dballef
957#endif
958TYPE(vol7d_level),INTENT(in) :: this
959CHARACTER(len=255) :: to_char_level
960
961#ifdef HAVE_DBALLE
962INTEGER :: handle, ier
963
964handle = 0
965ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
966ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
967ier = idba_fatto(handle)
968
969to_char_level="LEVEL: "//to_char_level
970
971#else
972
973to_char_level="LEVEL: "//&
976
977#endif
978
979END FUNCTION to_char_level
980
981
982ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
983TYPE(vol7d_level),INTENT(IN) :: this, that
984LOGICAL :: res
985
986res = &
987 this%level1 == that%level1 .AND. &
988 this%level2 == that%level2 .AND. &
989 this%l1 == that%l1 .AND. this%l2 == that%l2
990
991END FUNCTION vol7d_level_eq
992
993
994ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
995TYPE(vol7d_level),INTENT(IN) :: this, that
996LOGICAL :: res
997
998res = .NOT.(this == that)
999
1000END FUNCTION vol7d_level_ne
1001
1002
1003ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1004TYPE(vol7d_level),INTENT(IN) :: this, that
1005LOGICAL :: res
1006
1011 res = .true.
1012ELSE
1013 res = .false.
1014ENDIF
1015
1016END FUNCTION vol7d_level_almost_eq
1017
1018
1019ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1020TYPE(vol7d_level),INTENT(IN) :: this, that
1021LOGICAL :: res
1022
1023IF (&
1024 this%level1 > that%level1 .OR. &
1025 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1026 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1027 (&
1028 this%level2 > that%level2 .OR. &
1029 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1030 ))) THEN
1031 res = .true.
1032ELSE
1033 res = .false.
1034ENDIF
1035
1036END FUNCTION vol7d_level_gt
1037
1038
1039ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1040TYPE(vol7d_level),INTENT(IN) :: this, that
1041LOGICAL :: res
1042
1043IF (&
1044 this%level1 < that%level1 .OR. &
1045 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1046 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1047 (&
1048 this%level2 < that%level2 .OR. &
1049 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1050 ))) THEN
1051 res = .true.
1052ELSE
1053 res = .false.
1054ENDIF
1055
1056END FUNCTION vol7d_level_lt
1057
1058
1059ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1060TYPE(vol7d_level),INTENT(IN) :: this, that
1061LOGICAL :: res
1062
1063IF (this == that) THEN
1064 res = .true.
1065ELSE IF (this > that) THEN
1066 res = .true.
1067ELSE
1068 res = .false.
1069ENDIF
1070
1071END FUNCTION vol7d_level_ge
1072
1073
1074ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1075TYPE(vol7d_level),INTENT(IN) :: this, that
1076LOGICAL :: res
1077
1078IF (this == that) THEN
1079 res = .true.
1080ELSE IF (this < that) THEN
1081 res = .true.
1082ELSE
1083 res = .false.
1084ENDIF
1085
1086END FUNCTION vol7d_level_le
1087
1088
1089ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1090TYPE(vol7d_level),INTENT(IN) :: this
1091LOGICAL :: c_e
1092c_e = this /= vol7d_level_miss
1093END FUNCTION vol7d_level_c_e
1094
1095
1096#include "array_utilities_inc.F90"
1097
1098
1099FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1100TYPE(vol7d_level),INTENT(in) :: level
1101CHARACTER(len=10) :: btable
1102
1103btable = vol7d_level_to_var_int(level%level1)
1104
1105END FUNCTION vol7d_level_to_var_lev
1106
1107FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1108INTEGER,INTENT(in) :: level
1109CHARACTER(len=10) :: btable
1110
1111INTEGER :: i
1112
1113DO i = 1, SIZE(level_var_converter)
1114 IF (level_var_converter(i)%level == level) THEN
1115 btable = level_var_converter(i)%btable
1116 RETURN
1117 ENDIF
1118ENDDO
1119
1120btable = cmiss
1121
1122END FUNCTION vol7d_level_to_var_int
1123
1124
1125FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1126TYPE(vol7d_level),INTENT(in) :: level
1127REAL :: factor
1128
1129factor = vol7d_level_to_var_factor_int(level%level1)
1130
1131END FUNCTION vol7d_level_to_var_factor_lev
1132
1133FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1134INTEGER,INTENT(in) :: level
1135REAL :: factor
1136
1137factor = 1.
1138IF (any(level == height_level)) THEN
1139 factor = 1.e-3
1140ELSE IF (any(level == thermo_level)) THEN
1141 factor = 1.e-1
1142ELSE IF (any(level == sigma_level)) THEN
1143 factor = 1.e-4
1144ENDIF
1145
1146END FUNCTION vol7d_level_to_var_factor_int
1147
1148
1149FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1150TYPE(vol7d_level),INTENT(in) :: level
1151REAL :: log10
1152
1153log10 = vol7d_level_to_var_log10_int(level%level1)
1154
1155END FUNCTION vol7d_level_to_var_log10_lev
1156
1157FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1158INTEGER,INTENT(in) :: level
1159REAL :: log10
1160
1161log10 = 0.
1162IF (any(level == height_level)) THEN
1163 log10 = -3.
1164ELSE IF (any(level == thermo_level)) THEN
1165 log10 = -1.
1166ELSE IF (any(level == sigma_level)) THEN
1167 log10 = -4.
1168ENDIF
1169
1170END FUNCTION vol7d_level_to_var_log10_int
1171
Represent level object in a pretty string. Definition vol7d_level_class.F90:376 Return the conversion factor for multiplying the level value when converting to variable. Definition vol7d_level_class.F90:386 Return the scale value (base 10 log of conversion factor) for multiplying the level value when conver... Definition vol7d_level_class.F90:391 Convert a level type to a physical variable. Definition vol7d_level_class.F90:381 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. Definition missing_values.f90:50 Classe per la gestione dei livelli verticali in osservazioni meteo e affini. Definition vol7d_level_class.F90:213 Definisce il livello verticale di un'osservazione. Definition vol7d_level_class.F90:223 |