libsim Versione 7.1.11
|
◆ pack_distinct_sorted_level()
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
812IMPLICIT NONE
813
819 INTEGER :: level1
820 INTEGER :: l1
821 INTEGER :: level2
822 INTEGER :: l2
824
827
832 MODULE PROCEDURE vol7d_level_init
833END INTERFACE
834
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
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
912 MODULE PROCEDURE display_level
913END INTERFACE
914
917 MODULE PROCEDURE to_char_level
918END INTERFACE
919
922 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
924
927 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
929
932 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
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
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: "//&
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
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
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 |