libsim Versione 7.1.11

◆ pack_distinct_level()

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

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
842USE kinds
845IMPLICIT NONE
846
851TYPE vol7d_level
852 INTEGER :: level1
853 INTEGER :: l1
854 INTEGER :: level2
855 INTEGER :: l2
856END TYPE vol7d_level
857
859TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
860
864INTERFACE init
865 MODULE PROCEDURE vol7d_level_init
866END INTERFACE
867
870INTERFACE delete
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
934INTERFACE c_e
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
944INTERFACE display
945 MODULE PROCEDURE display_level
946END INTERFACE
947
949INTERFACE to_char
950 MODULE PROCEDURE to_char_level
951END INTERFACE
952
954INTERFACE vol7d_level_to_var
955 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
956END INTERFACE vol7d_level_to_var
957
960 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
961END INTERFACE vol7d_level_to_var_factor
962
965 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
966END INTERFACE vol7d_level_to_var_log10
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
1012CALL init(this, level1, l1, level2, l2)
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: "//&
1091 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
1092 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
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
1124IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
1125 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
1126 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
1127 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
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
1289END 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.