libsim Versione 7.2.1

◆ pack_distinct_sorted_level()

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

compatta gli elementi distinti di vect in un sorted array

Definizione alla linea 776 del file vol7d_level_class.F90.

778! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
779! authors:
780! Davide Cesari <dcesari@arpa.emr.it>
781! Paolo Patruno <ppatruno@arpa.emr.it>
782
783! This program is free software; you can redistribute it and/or
784! modify it under the terms of the GNU General Public License as
785! published by the Free Software Foundation; either version 2 of
786! the License, or (at your option) any later version.
787
788! This program is distributed in the hope that it will be useful,
789! but WITHOUT ANY WARRANTY; without even the implied warranty of
790! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
791! GNU General Public License for more details.
792
793! You should have received a copy of the GNU General Public License
794! along with this program. If not, see <http://www.gnu.org/licenses/>.
795#include "config.h"
796
803USE kinds
806IMPLICIT NONE
807
812TYPE vol7d_level
813 INTEGER :: level1
814 INTEGER :: l1
815 INTEGER :: level2
816 INTEGER :: l2
817END TYPE vol7d_level
818
820TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
821
825INTERFACE init
826 MODULE PROCEDURE vol7d_level_init
827END INTERFACE
828
831INTERFACE delete
832 MODULE PROCEDURE vol7d_level_delete
833END INTERFACE
834
838INTERFACE OPERATOR (==)
839 MODULE PROCEDURE vol7d_level_eq
840END INTERFACE
841
845INTERFACE OPERATOR (/=)
846 MODULE PROCEDURE vol7d_level_ne
847END INTERFACE
848
854INTERFACE OPERATOR (>)
855 MODULE PROCEDURE vol7d_level_gt
856END INTERFACE
857
863INTERFACE OPERATOR (<)
864 MODULE PROCEDURE vol7d_level_lt
865END INTERFACE
866
872INTERFACE OPERATOR (>=)
873 MODULE PROCEDURE vol7d_level_ge
874END INTERFACE
875
881INTERFACE OPERATOR (<=)
882 MODULE PROCEDURE vol7d_level_le
883END INTERFACE
884
888INTERFACE OPERATOR (.almosteq.)
889 MODULE PROCEDURE vol7d_level_almost_eq
890END INTERFACE
891
892
893! da documentare in inglese assieme al resto
895INTERFACE c_e
896 MODULE PROCEDURE vol7d_level_c_e
897END INTERFACE
898
899#define VOL7D_POLY_TYPE TYPE(vol7d_level)
900#define VOL7D_POLY_TYPES _level
901#define ENABLE_SORT
902#include "array_utilities_pre.F90"
903
905INTERFACE display
906 MODULE PROCEDURE display_level
907END INTERFACE
908
910INTERFACE to_char
911 MODULE PROCEDURE to_char_level
912END INTERFACE
913
915INTERFACE vol7d_level_to_var
916 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
917END INTERFACE vol7d_level_to_var
918
921 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
922END INTERFACE vol7d_level_to_var_factor
923
926 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
927END INTERFACE vol7d_level_to_var_log10
928
929type(vol7d_level) :: almost_equal_levels(3)=(/&
930 vol7d_level( 1,imiss,imiss,imiss),&
931 vol7d_level(103,imiss,imiss,imiss),&
932 vol7d_level(106,imiss,imiss,imiss)/)
933
934! levels requiring conversion from internal to physical representation
935INTEGER, PARAMETER :: &
936 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
937 thermo_level(3) = (/20,107,235/), & ! 10**-1
938 sigma_level(2) = (/104,111/) ! 10**-4
939
940TYPE level_var
941 INTEGER :: level
942 CHARACTER(len=10) :: btable
943END TYPE level_var
944
945! Conversion table from GRIB2 vertical level codes to corresponding
946! BUFR B table variables
947TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
948 level_var(20, 'B12101'), & ! isothermal (K)
949 level_var(100, 'B10004'), & ! isobaric (Pa)
950 level_var(102, 'B10007'), & ! height over sea level (m)
951 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
952 level_var(107, 'B12192'), & ! isentropical (K)
953 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
954 level_var(161, 'B22195') /) ! depth below sea surface
955
956PRIVATE level_var, level_var_converter
957
958CONTAINS
959
965FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
966INTEGER,INTENT(IN),OPTIONAL :: level1
967INTEGER,INTENT(IN),OPTIONAL :: l1
968INTEGER,INTENT(IN),OPTIONAL :: level2
969INTEGER,INTENT(IN),OPTIONAL :: l2
970
971TYPE(vol7d_level) :: this
972
973CALL init(this, level1, l1, level2, l2)
974
975END FUNCTION vol7d_level_new
976
977
981SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
982TYPE(vol7d_level),INTENT(INOUT) :: this
983INTEGER,INTENT(IN),OPTIONAL :: level1
984INTEGER,INTENT(IN),OPTIONAL :: l1
985INTEGER,INTENT(IN),OPTIONAL :: level2
986INTEGER,INTENT(IN),OPTIONAL :: l2
987
988this%level1 = imiss
989this%l1 = imiss
990this%level2 = imiss
991this%l2 = imiss
992
993IF (PRESENT(level1)) THEN
994 this%level1 = level1
995ELSE
996 RETURN
997END IF
998
999IF (PRESENT(l1)) this%l1 = l1
1000
1001IF (PRESENT(level2)) THEN
1002 this%level2 = level2
1003ELSE
1004 RETURN
1005END IF
1006
1007IF (PRESENT(l2)) this%l2 = l2
1008
1009END SUBROUTINE vol7d_level_init
1010
1011
1013SUBROUTINE vol7d_level_delete(this)
1014TYPE(vol7d_level),INTENT(INOUT) :: this
1015
1016this%level1 = imiss
1017this%l1 = imiss
1018this%level2 = imiss
1019this%l2 = imiss
1020
1021END SUBROUTINE vol7d_level_delete
1022
1023
1024SUBROUTINE display_level(this)
1025TYPE(vol7d_level),INTENT(in) :: this
1026
1027print*,trim(to_char(this))
1028
1029END SUBROUTINE display_level
1030
1031
1032FUNCTION to_char_level(this)
1033#ifdef HAVE_DBALLE
1034USE dballef
1035#endif
1036TYPE(vol7d_level),INTENT(in) :: this
1037CHARACTER(len=255) :: to_char_level
1038
1039#ifdef HAVE_DBALLE
1040INTEGER :: handle, ier
1041
1042handle = 0
1043ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1044ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
1045ier = idba_fatto(handle)
1046
1047to_char_level="LEVEL: "//to_char_level
1048
1049#else
1050
1051to_char_level="LEVEL: "//&
1052 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
1053 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
1054
1055#endif
1056
1057END FUNCTION to_char_level
1058
1059
1060ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
1061TYPE(vol7d_level),INTENT(IN) :: this, that
1062LOGICAL :: res
1063
1064res = &
1065 this%level1 == that%level1 .AND. &
1066 this%level2 == that%level2 .AND. &
1067 this%l1 == that%l1 .AND. this%l2 == that%l2
1068
1069END FUNCTION vol7d_level_eq
1070
1071
1072ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
1073TYPE(vol7d_level),INTENT(IN) :: this, that
1074LOGICAL :: res
1075
1076res = .NOT.(this == that)
1077
1078END FUNCTION vol7d_level_ne
1079
1080
1081ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1082TYPE(vol7d_level),INTENT(IN) :: this, that
1083LOGICAL :: res
1084
1085IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
1086 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
1087 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
1088 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
1089 res = .true.
1090ELSE
1091 res = .false.
1092ENDIF
1093
1094END FUNCTION vol7d_level_almost_eq
1095
1096
1097ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1098TYPE(vol7d_level),INTENT(IN) :: this, that
1099LOGICAL :: res
1100
1101IF (&
1102 this%level1 > that%level1 .OR. &
1103 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1104 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1105 (&
1106 this%level2 > that%level2 .OR. &
1107 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1108 ))) THEN
1109 res = .true.
1110ELSE
1111 res = .false.
1112ENDIF
1113
1114END FUNCTION vol7d_level_gt
1115
1116
1117ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1118TYPE(vol7d_level),INTENT(IN) :: this, that
1119LOGICAL :: res
1120
1121IF (&
1122 this%level1 < that%level1 .OR. &
1123 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1124 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1125 (&
1126 this%level2 < that%level2 .OR. &
1127 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1128 ))) THEN
1129 res = .true.
1130ELSE
1131 res = .false.
1132ENDIF
1133
1134END FUNCTION vol7d_level_lt
1135
1136
1137ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1138TYPE(vol7d_level),INTENT(IN) :: this, that
1139LOGICAL :: res
1140
1141IF (this == that) THEN
1142 res = .true.
1143ELSE IF (this > that) THEN
1144 res = .true.
1145ELSE
1146 res = .false.
1147ENDIF
1148
1149END FUNCTION vol7d_level_ge
1150
1151
1152ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1153TYPE(vol7d_level),INTENT(IN) :: this, that
1154LOGICAL :: res
1155
1156IF (this == that) THEN
1157 res = .true.
1158ELSE IF (this < that) THEN
1159 res = .true.
1160ELSE
1161 res = .false.
1162ENDIF
1163
1164END FUNCTION vol7d_level_le
1165
1166
1167ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1168TYPE(vol7d_level),INTENT(IN) :: this
1169LOGICAL :: c_e
1170c_e = this /= vol7d_level_miss
1171END FUNCTION vol7d_level_c_e
1172
1173
1174#include "array_utilities_inc.F90"
1175
1176
1177FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1178TYPE(vol7d_level),INTENT(in) :: level
1179CHARACTER(len=10) :: btable
1180
1181btable = vol7d_level_to_var_int(level%level1)
1182
1183END FUNCTION vol7d_level_to_var_lev
1184
1185FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1186INTEGER,INTENT(in) :: level
1187CHARACTER(len=10) :: btable
1188
1189INTEGER :: i
1190
1191DO i = 1, SIZE(level_var_converter)
1192 IF (level_var_converter(i)%level == level) THEN
1193 btable = level_var_converter(i)%btable
1194 RETURN
1195 ENDIF
1196ENDDO
1197
1198btable = cmiss
1199
1200END FUNCTION vol7d_level_to_var_int
1201
1202
1203FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1204TYPE(vol7d_level),INTENT(in) :: level
1205REAL :: factor
1206
1207factor = vol7d_level_to_var_factor_int(level%level1)
1208
1209END FUNCTION vol7d_level_to_var_factor_lev
1210
1211FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1212INTEGER,INTENT(in) :: level
1213REAL :: factor
1214
1215factor = 1.
1216IF (any(level == height_level)) THEN
1217 factor = 1.e-3
1218ELSE IF (any(level == thermo_level)) THEN
1219 factor = 1.e-1
1220ELSE IF (any(level == sigma_level)) THEN
1221 factor = 1.e-4
1222ENDIF
1223
1224END FUNCTION vol7d_level_to_var_factor_int
1225
1226
1227FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1228TYPE(vol7d_level),INTENT(in) :: level
1229REAL :: log10
1230
1231log10 = vol7d_level_to_var_log10_int(level%level1)
1232
1233END FUNCTION vol7d_level_to_var_log10_lev
1234
1235FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1236INTEGER,INTENT(in) :: level
1237REAL :: log10
1238
1239log10 = 0.
1240IF (any(level == height_level)) THEN
1241 log10 = -3.
1242ELSE IF (any(level == thermo_level)) THEN
1243 log10 = -1.
1244ELSE IF (any(level == sigma_level)) THEN
1245 log10 = -4.
1246ENDIF
1247
1248END FUNCTION vol7d_level_to_var_log10_int
1249
1250END 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.