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