libsim Versione 7.2.4
|
◆ pack_distinct_level()
compatta gli elementi distinti di vect in un array Definizione alla linea 809 del file vol7d_level_class.F90. 811! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
812! authors:
813! Davide Cesari <dcesari@arpa.emr.it>
814! Paolo Patruno <ppatruno@arpa.emr.it>
815
816! This program is free software; you can redistribute it and/or
817! modify it under the terms of the GNU General Public License as
818! published by the Free Software Foundation; either version 2 of
819! the License, or (at your option) any later version.
820
821! This program is distributed in the hope that it will be useful,
822! but WITHOUT ANY WARRANTY; without even the implied warranty of
823! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
824! GNU General Public License for more details.
825
826! You should have received a copy of the GNU General Public License
827! along with this program. If not, see <http://www.gnu.org/licenses/>.
828#include "config.h"
829
839IMPLICIT NONE
840
846 INTEGER :: level1
847 INTEGER :: l1
848 INTEGER :: level2
849 INTEGER :: l2
851
854
859 MODULE PROCEDURE vol7d_level_init
860END INTERFACE
861
865 MODULE PROCEDURE vol7d_level_delete
866END INTERFACE
867
871INTERFACE OPERATOR (==)
872 MODULE PROCEDURE vol7d_level_eq
873END INTERFACE
874
878INTERFACE OPERATOR (/=)
879 MODULE PROCEDURE vol7d_level_ne
880END INTERFACE
881
887INTERFACE OPERATOR (>)
888 MODULE PROCEDURE vol7d_level_gt
889END INTERFACE
890
896INTERFACE OPERATOR (<)
897 MODULE PROCEDURE vol7d_level_lt
898END INTERFACE
899
905INTERFACE OPERATOR (>=)
906 MODULE PROCEDURE vol7d_level_ge
907END INTERFACE
908
914INTERFACE OPERATOR (<=)
915 MODULE PROCEDURE vol7d_level_le
916END INTERFACE
917
921INTERFACE OPERATOR (.almosteq.)
922 MODULE PROCEDURE vol7d_level_almost_eq
923END INTERFACE
924
925
926! da documentare in inglese assieme al resto
929 MODULE PROCEDURE vol7d_level_c_e
930END INTERFACE
931
932#define VOL7D_POLY_TYPE TYPE(vol7d_level)
933#define VOL7D_POLY_TYPES _level
934#define ENABLE_SORT
935#include "array_utilities_pre.F90"
936
939 MODULE PROCEDURE display_level
940END INTERFACE
941
944 MODULE PROCEDURE to_char_level
945END INTERFACE
946
949 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
951
954 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
956
959 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
961
962type(vol7d_level) :: almost_equal_levels(3)=(/&
963 vol7d_level( 1,imiss,imiss,imiss),&
964 vol7d_level(103,imiss,imiss,imiss),&
965 vol7d_level(106,imiss,imiss,imiss)/)
966
967! levels requiring conversion from internal to physical representation
968INTEGER, PARAMETER :: &
969 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
970 thermo_level(3) = (/20,107,235/), & ! 10**-1
971 sigma_level(2) = (/104,111/) ! 10**-4
972
973TYPE level_var
974 INTEGER :: level
975 CHARACTER(len=10) :: btable
976END TYPE level_var
977
978! Conversion table from GRIB2 vertical level codes to corresponding
979! BUFR B table variables
980TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
981 level_var(20, 'B12101'), & ! isothermal (K)
982 level_var(100, 'B10004'), & ! isobaric (Pa)
983 level_var(102, 'B10007'), & ! height over sea level (m)
984 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
985 level_var(107, 'B12192'), & ! isentropical (K)
986 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
987 level_var(161, 'B22195') /) ! depth below sea surface
988
989PRIVATE level_var, level_var_converter
990
991CONTAINS
992
998FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
999INTEGER,INTENT(IN),OPTIONAL :: level1
1000INTEGER,INTENT(IN),OPTIONAL :: l1
1001INTEGER,INTENT(IN),OPTIONAL :: level2
1002INTEGER,INTENT(IN),OPTIONAL :: l2
1003
1004TYPE(vol7d_level) :: this
1005
1007
1008END FUNCTION vol7d_level_new
1009
1010
1014SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
1015TYPE(vol7d_level),INTENT(INOUT) :: this
1016INTEGER,INTENT(IN),OPTIONAL :: level1
1017INTEGER,INTENT(IN),OPTIONAL :: l1
1018INTEGER,INTENT(IN),OPTIONAL :: level2
1019INTEGER,INTENT(IN),OPTIONAL :: l2
1020
1021this%level1 = imiss
1022this%l1 = imiss
1023this%level2 = imiss
1024this%l2 = imiss
1025
1026IF (PRESENT(level1)) THEN
1027 this%level1 = level1
1028ELSE
1029 RETURN
1030END IF
1031
1032IF (PRESENT(l1)) this%l1 = l1
1033
1034IF (PRESENT(level2)) THEN
1035 this%level2 = level2
1036ELSE
1037 RETURN
1038END IF
1039
1040IF (PRESENT(l2)) this%l2 = l2
1041
1042END SUBROUTINE vol7d_level_init
1043
1044
1046SUBROUTINE vol7d_level_delete(this)
1047TYPE(vol7d_level),INTENT(INOUT) :: this
1048
1049this%level1 = imiss
1050this%l1 = imiss
1051this%level2 = imiss
1052this%l2 = imiss
1053
1054END SUBROUTINE vol7d_level_delete
1055
1056
1057SUBROUTINE display_level(this)
1058TYPE(vol7d_level),INTENT(in) :: this
1059
1060print*,trim(to_char(this))
1061
1062END SUBROUTINE display_level
1063
1064
1065FUNCTION to_char_level(this)
1066#ifdef HAVE_DBALLE
1067USE dballef
1068#endif
1069TYPE(vol7d_level),INTENT(in) :: this
1070CHARACTER(len=255) :: to_char_level
1071
1072#ifdef HAVE_DBALLE
1073INTEGER :: handle, ier
1074
1075handle = 0
1076ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1077ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
1078ier = idba_fatto(handle)
1079
1080to_char_level="LEVEL: "//to_char_level
1081
1082#else
1083
1084to_char_level="LEVEL: "//&
1087
1088#endif
1089
1090END FUNCTION to_char_level
1091
1092
1093ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
1094TYPE(vol7d_level),INTENT(IN) :: this, that
1095LOGICAL :: res
1096
1097res = &
1098 this%level1 == that%level1 .AND. &
1099 this%level2 == that%level2 .AND. &
1100 this%l1 == that%l1 .AND. this%l2 == that%l2
1101
1102END FUNCTION vol7d_level_eq
1103
1104
1105ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
1106TYPE(vol7d_level),INTENT(IN) :: this, that
1107LOGICAL :: res
1108
1109res = .NOT.(this == that)
1110
1111END FUNCTION vol7d_level_ne
1112
1113
1114ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1115TYPE(vol7d_level),INTENT(IN) :: this, that
1116LOGICAL :: res
1117
1122 res = .true.
1123ELSE
1124 res = .false.
1125ENDIF
1126
1127END FUNCTION vol7d_level_almost_eq
1128
1129
1130ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1131TYPE(vol7d_level),INTENT(IN) :: this, that
1132LOGICAL :: res
1133
1134IF (&
1135 this%level1 > that%level1 .OR. &
1136 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1137 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1138 (&
1139 this%level2 > that%level2 .OR. &
1140 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1141 ))) THEN
1142 res = .true.
1143ELSE
1144 res = .false.
1145ENDIF
1146
1147END FUNCTION vol7d_level_gt
1148
1149
1150ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1151TYPE(vol7d_level),INTENT(IN) :: this, that
1152LOGICAL :: res
1153
1154IF (&
1155 this%level1 < that%level1 .OR. &
1156 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1157 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1158 (&
1159 this%level2 < that%level2 .OR. &
1160 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1161 ))) THEN
1162 res = .true.
1163ELSE
1164 res = .false.
1165ENDIF
1166
1167END FUNCTION vol7d_level_lt
1168
1169
1170ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1171TYPE(vol7d_level),INTENT(IN) :: this, that
1172LOGICAL :: res
1173
1174IF (this == that) THEN
1175 res = .true.
1176ELSE IF (this > that) THEN
1177 res = .true.
1178ELSE
1179 res = .false.
1180ENDIF
1181
1182END FUNCTION vol7d_level_ge
1183
1184
1185ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1186TYPE(vol7d_level),INTENT(IN) :: this, that
1187LOGICAL :: res
1188
1189IF (this == that) THEN
1190 res = .true.
1191ELSE IF (this < that) THEN
1192 res = .true.
1193ELSE
1194 res = .false.
1195ENDIF
1196
1197END FUNCTION vol7d_level_le
1198
1199
1200ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1201TYPE(vol7d_level),INTENT(IN) :: this
1202LOGICAL :: c_e
1203c_e = this /= vol7d_level_miss
1204END FUNCTION vol7d_level_c_e
1205
1206
1207#include "array_utilities_inc.F90"
1208
1209
1210FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1211TYPE(vol7d_level),INTENT(in) :: level
1212CHARACTER(len=10) :: btable
1213
1214btable = vol7d_level_to_var_int(level%level1)
1215
1216END FUNCTION vol7d_level_to_var_lev
1217
1218FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1219INTEGER,INTENT(in) :: level
1220CHARACTER(len=10) :: btable
1221
1222INTEGER :: i
1223
1224DO i = 1, SIZE(level_var_converter)
1225 IF (level_var_converter(i)%level == level) THEN
1226 btable = level_var_converter(i)%btable
1227 RETURN
1228 ENDIF
1229ENDDO
1230
1231btable = cmiss
1232
1233END FUNCTION vol7d_level_to_var_int
1234
1235
1236FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1237TYPE(vol7d_level),INTENT(in) :: level
1238REAL :: factor
1239
1240factor = vol7d_level_to_var_factor_int(level%level1)
1241
1242END FUNCTION vol7d_level_to_var_factor_lev
1243
1244FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1245INTEGER,INTENT(in) :: level
1246REAL :: factor
1247
1248factor = 1.
1249IF (any(level == height_level)) THEN
1250 factor = 1.e-3
1251ELSE IF (any(level == thermo_level)) THEN
1252 factor = 1.e-1
1253ELSE IF (any(level == sigma_level)) THEN
1254 factor = 1.e-4
1255ENDIF
1256
1257END FUNCTION vol7d_level_to_var_factor_int
1258
1259
1260FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1261TYPE(vol7d_level),INTENT(in) :: level
1262REAL :: log10
1263
1264log10 = vol7d_level_to_var_log10_int(level%level1)
1265
1266END FUNCTION vol7d_level_to_var_log10_lev
1267
1268FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1269INTEGER,INTENT(in) :: level
1270REAL :: log10
1271
1272log10 = 0.
1273IF (any(level == height_level)) THEN
1274 log10 = -3.
1275ELSE IF (any(level == thermo_level)) THEN
1276 log10 = -1.
1277ELSE IF (any(level == sigma_level)) THEN
1278 log10 = -4.
1279ENDIF
1280
1281END FUNCTION vol7d_level_to_var_log10_int
1282
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 |