libsim Versione 7.1.11

◆ 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 782 del file vol7d_level_class.F90.

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