libsim Versione 7.2.0
|
◆ pack_distinct_sorted_level()
compatta gli elementi distinti di vect in un sorted array Definizione alla linea 776 del file vol7d_level_class.F90. 778! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
779! authors:
780! Davide Cesari <dcesari@arpa.emr.it>
781! Paolo Patruno <ppatruno@arpa.emr.it>
782
783! This program is free software; you can redistribute it and/or
784! modify it under the terms of the GNU General Public License as
785! published by the Free Software Foundation; either version 2 of
786! the License, or (at your option) any later version.
787
788! This program is distributed in the hope that it will be useful,
789! but WITHOUT ANY WARRANTY; without even the implied warranty of
790! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
791! GNU General Public License for more details.
792
793! You should have received a copy of the GNU General Public License
794! along with this program. If not, see <http://www.gnu.org/licenses/>.
795#include "config.h"
796
806IMPLICIT NONE
807
813 INTEGER :: level1
814 INTEGER :: l1
815 INTEGER :: level2
816 INTEGER :: l2
818
821
826 MODULE PROCEDURE vol7d_level_init
827END INTERFACE
828
832 MODULE PROCEDURE vol7d_level_delete
833END INTERFACE
834
838INTERFACE OPERATOR (==)
839 MODULE PROCEDURE vol7d_level_eq
840END INTERFACE
841
845INTERFACE OPERATOR (/=)
846 MODULE PROCEDURE vol7d_level_ne
847END INTERFACE
848
854INTERFACE OPERATOR (>)
855 MODULE PROCEDURE vol7d_level_gt
856END INTERFACE
857
863INTERFACE OPERATOR (<)
864 MODULE PROCEDURE vol7d_level_lt
865END INTERFACE
866
872INTERFACE OPERATOR (>=)
873 MODULE PROCEDURE vol7d_level_ge
874END INTERFACE
875
881INTERFACE OPERATOR (<=)
882 MODULE PROCEDURE vol7d_level_le
883END INTERFACE
884
888INTERFACE OPERATOR (.almosteq.)
889 MODULE PROCEDURE vol7d_level_almost_eq
890END INTERFACE
891
892
893! da documentare in inglese assieme al resto
896 MODULE PROCEDURE vol7d_level_c_e
897END INTERFACE
898
899#define VOL7D_POLY_TYPE TYPE(vol7d_level)
900#define VOL7D_POLY_TYPES _level
901#define ENABLE_SORT
902#include "array_utilities_pre.F90"
903
906 MODULE PROCEDURE display_level
907END INTERFACE
908
911 MODULE PROCEDURE to_char_level
912END INTERFACE
913
916 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
918
921 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
923
926 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
928
929type(vol7d_level) :: almost_equal_levels(3)=(/&
930 vol7d_level( 1,imiss,imiss,imiss),&
931 vol7d_level(103,imiss,imiss,imiss),&
932 vol7d_level(106,imiss,imiss,imiss)/)
933
934! levels requiring conversion from internal to physical representation
935INTEGER, PARAMETER :: &
936 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
937 thermo_level(3) = (/20,107,235/), & ! 10**-1
938 sigma_level(2) = (/104,111/) ! 10**-4
939
940TYPE level_var
941 INTEGER :: level
942 CHARACTER(len=10) :: btable
943END TYPE level_var
944
945! Conversion table from GRIB2 vertical level codes to corresponding
946! BUFR B table variables
947TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
948 level_var(20, 'B12101'), & ! isothermal (K)
949 level_var(100, 'B10004'), & ! isobaric (Pa)
950 level_var(102, 'B10007'), & ! height over sea level (m)
951 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
952 level_var(107, 'B12192'), & ! isentropical (K)
953 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
954 level_var(161, 'B22195') /) ! depth below sea surface
955
956PRIVATE level_var, level_var_converter
957
958CONTAINS
959
965FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
966INTEGER,INTENT(IN),OPTIONAL :: level1
967INTEGER,INTENT(IN),OPTIONAL :: l1
968INTEGER,INTENT(IN),OPTIONAL :: level2
969INTEGER,INTENT(IN),OPTIONAL :: l2
970
971TYPE(vol7d_level) :: this
972
974
975END FUNCTION vol7d_level_new
976
977
981SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
982TYPE(vol7d_level),INTENT(INOUT) :: this
983INTEGER,INTENT(IN),OPTIONAL :: level1
984INTEGER,INTENT(IN),OPTIONAL :: l1
985INTEGER,INTENT(IN),OPTIONAL :: level2
986INTEGER,INTENT(IN),OPTIONAL :: l2
987
988this%level1 = imiss
989this%l1 = imiss
990this%level2 = imiss
991this%l2 = imiss
992
993IF (PRESENT(level1)) THEN
994 this%level1 = level1
995ELSE
996 RETURN
997END IF
998
999IF (PRESENT(l1)) this%l1 = l1
1000
1001IF (PRESENT(level2)) THEN
1002 this%level2 = level2
1003ELSE
1004 RETURN
1005END IF
1006
1007IF (PRESENT(l2)) this%l2 = l2
1008
1009END SUBROUTINE vol7d_level_init
1010
1011
1013SUBROUTINE vol7d_level_delete(this)
1014TYPE(vol7d_level),INTENT(INOUT) :: this
1015
1016this%level1 = imiss
1017this%l1 = imiss
1018this%level2 = imiss
1019this%l2 = imiss
1020
1021END SUBROUTINE vol7d_level_delete
1022
1023
1024SUBROUTINE display_level(this)
1025TYPE(vol7d_level),INTENT(in) :: this
1026
1027print*,trim(to_char(this))
1028
1029END SUBROUTINE display_level
1030
1031
1032FUNCTION to_char_level(this)
1033#ifdef HAVE_DBALLE
1034USE dballef
1035#endif
1036TYPE(vol7d_level),INTENT(in) :: this
1037CHARACTER(len=255) :: to_char_level
1038
1039#ifdef HAVE_DBALLE
1040INTEGER :: handle, ier
1041
1042handle = 0
1043ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1044ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
1045ier = idba_fatto(handle)
1046
1047to_char_level="LEVEL: "//to_char_level
1048
1049#else
1050
1051to_char_level="LEVEL: "//&
1054
1055#endif
1056
1057END FUNCTION to_char_level
1058
1059
1060ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
1061TYPE(vol7d_level),INTENT(IN) :: this, that
1062LOGICAL :: res
1063
1064res = &
1065 this%level1 == that%level1 .AND. &
1066 this%level2 == that%level2 .AND. &
1067 this%l1 == that%l1 .AND. this%l2 == that%l2
1068
1069END FUNCTION vol7d_level_eq
1070
1071
1072ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
1073TYPE(vol7d_level),INTENT(IN) :: this, that
1074LOGICAL :: res
1075
1076res = .NOT.(this == that)
1077
1078END FUNCTION vol7d_level_ne
1079
1080
1081ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1082TYPE(vol7d_level),INTENT(IN) :: this, that
1083LOGICAL :: res
1084
1089 res = .true.
1090ELSE
1091 res = .false.
1092ENDIF
1093
1094END FUNCTION vol7d_level_almost_eq
1095
1096
1097ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1098TYPE(vol7d_level),INTENT(IN) :: this, that
1099LOGICAL :: res
1100
1101IF (&
1102 this%level1 > that%level1 .OR. &
1103 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1104 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1105 (&
1106 this%level2 > that%level2 .OR. &
1107 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1108 ))) THEN
1109 res = .true.
1110ELSE
1111 res = .false.
1112ENDIF
1113
1114END FUNCTION vol7d_level_gt
1115
1116
1117ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1118TYPE(vol7d_level),INTENT(IN) :: this, that
1119LOGICAL :: res
1120
1121IF (&
1122 this%level1 < that%level1 .OR. &
1123 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1124 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1125 (&
1126 this%level2 < that%level2 .OR. &
1127 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1128 ))) THEN
1129 res = .true.
1130ELSE
1131 res = .false.
1132ENDIF
1133
1134END FUNCTION vol7d_level_lt
1135
1136
1137ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1138TYPE(vol7d_level),INTENT(IN) :: this, that
1139LOGICAL :: res
1140
1141IF (this == that) THEN
1142 res = .true.
1143ELSE IF (this > that) THEN
1144 res = .true.
1145ELSE
1146 res = .false.
1147ENDIF
1148
1149END FUNCTION vol7d_level_ge
1150
1151
1152ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1153TYPE(vol7d_level),INTENT(IN) :: this, that
1154LOGICAL :: res
1155
1156IF (this == that) THEN
1157 res = .true.
1158ELSE IF (this < that) THEN
1159 res = .true.
1160ELSE
1161 res = .false.
1162ENDIF
1163
1164END FUNCTION vol7d_level_le
1165
1166
1167ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1168TYPE(vol7d_level),INTENT(IN) :: this
1169LOGICAL :: c_e
1170c_e = this /= vol7d_level_miss
1171END FUNCTION vol7d_level_c_e
1172
1173
1174#include "array_utilities_inc.F90"
1175
1176
1177FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1178TYPE(vol7d_level),INTENT(in) :: level
1179CHARACTER(len=10) :: btable
1180
1181btable = vol7d_level_to_var_int(level%level1)
1182
1183END FUNCTION vol7d_level_to_var_lev
1184
1185FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1186INTEGER,INTENT(in) :: level
1187CHARACTER(len=10) :: btable
1188
1189INTEGER :: i
1190
1191DO i = 1, SIZE(level_var_converter)
1192 IF (level_var_converter(i)%level == level) THEN
1193 btable = level_var_converter(i)%btable
1194 RETURN
1195 ENDIF
1196ENDDO
1197
1198btable = cmiss
1199
1200END FUNCTION vol7d_level_to_var_int
1201
1202
1203FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1204TYPE(vol7d_level),INTENT(in) :: level
1205REAL :: factor
1206
1207factor = vol7d_level_to_var_factor_int(level%level1)
1208
1209END FUNCTION vol7d_level_to_var_factor_lev
1210
1211FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1212INTEGER,INTENT(in) :: level
1213REAL :: factor
1214
1215factor = 1.
1216IF (any(level == height_level)) THEN
1217 factor = 1.e-3
1218ELSE IF (any(level == thermo_level)) THEN
1219 factor = 1.e-1
1220ELSE IF (any(level == sigma_level)) THEN
1221 factor = 1.e-4
1222ENDIF
1223
1224END FUNCTION vol7d_level_to_var_factor_int
1225
1226
1227FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1228TYPE(vol7d_level),INTENT(in) :: level
1229REAL :: log10
1230
1231log10 = vol7d_level_to_var_log10_int(level%level1)
1232
1233END FUNCTION vol7d_level_to_var_log10_lev
1234
1235FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1236INTEGER,INTENT(in) :: level
1237REAL :: log10
1238
1239log10 = 0.
1240IF (any(level == height_level)) THEN
1241 log10 = -3.
1242ELSE IF (any(level == thermo_level)) THEN
1243 log10 = -1.
1244ELSE IF (any(level == sigma_level)) THEN
1245 log10 = -4.
1246ENDIF
1247
1248END FUNCTION vol7d_level_to_var_log10_int
1249
Distruttore per la classe vol7d_level. Definition: vol7d_level_class.F90:242 Represent level object in a pretty string. Definition: vol7d_level_class.F90:376 Return the conversion factor for multiplying the level value when converting to variable. Definition: vol7d_level_class.F90:386 Return the scale value (base 10 log of conversion factor) for multiplying the level value when conver... Definition: vol7d_level_class.F90:391 Convert a level type to a physical variable. Definition: vol7d_level_class.F90:381 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. Definition: missing_values.f90:50 Classe per la gestione dei livelli verticali in osservazioni meteo e affini. Definition: vol7d_level_class.F90:213 Definisce il livello verticale di un'osservazione. Definition: vol7d_level_class.F90:223 |