libsim Versione 7.2.1

◆ 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 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
836USE kinds
839IMPLICIT NONE
840
845TYPE vol7d_level
846 INTEGER :: level1
847 INTEGER :: l1
848 INTEGER :: level2
849 INTEGER :: l2
850END TYPE vol7d_level
851
853TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
854
858INTERFACE init
859 MODULE PROCEDURE vol7d_level_init
860END INTERFACE
861
864INTERFACE delete
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
928INTERFACE c_e
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
938INTERFACE display
939 MODULE PROCEDURE display_level
940END INTERFACE
941
943INTERFACE to_char
944 MODULE PROCEDURE to_char_level
945END INTERFACE
946
948INTERFACE vol7d_level_to_var
949 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
950END INTERFACE vol7d_level_to_var
951
954 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
955END INTERFACE vol7d_level_to_var_factor
956
959 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
960END INTERFACE vol7d_level_to_var_log10
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
1006CALL init(this, level1, l1, level2, l2)
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: "//&
1085 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
1086 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
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
1118IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
1119 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
1120 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
1121 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
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
1283END 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.