libsim Versione 7.1.11
|
◆ count_distinct_level()
conta gli elementi distinti in vect Definizione alla linea 705 del file vol7d_level_class.F90. 706! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
707! authors:
708! Davide Cesari <dcesari@arpa.emr.it>
709! Paolo Patruno <ppatruno@arpa.emr.it>
710
711! This program is free software; you can redistribute it and/or
712! modify it under the terms of the GNU General Public License as
713! published by the Free Software Foundation; either version 2 of
714! the License, or (at your option) any later version.
715
716! This program is distributed in the hope that it will be useful,
717! but WITHOUT ANY WARRANTY; without even the implied warranty of
718! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
719! GNU General Public License for more details.
720
721! You should have received a copy of the GNU General Public License
722! along with this program. If not, see <http://www.gnu.org/licenses/>.
723#include "config.h"
724
734IMPLICIT NONE
735
741 INTEGER :: level1
742 INTEGER :: l1
743 INTEGER :: level2
744 INTEGER :: l2
746
749
754 MODULE PROCEDURE vol7d_level_init
755END INTERFACE
756
760 MODULE PROCEDURE vol7d_level_delete
761END INTERFACE
762
766INTERFACE OPERATOR (==)
767 MODULE PROCEDURE vol7d_level_eq
768END INTERFACE
769
773INTERFACE OPERATOR (/=)
774 MODULE PROCEDURE vol7d_level_ne
775END INTERFACE
776
782INTERFACE OPERATOR (>)
783 MODULE PROCEDURE vol7d_level_gt
784END INTERFACE
785
791INTERFACE OPERATOR (<)
792 MODULE PROCEDURE vol7d_level_lt
793END INTERFACE
794
800INTERFACE OPERATOR (>=)
801 MODULE PROCEDURE vol7d_level_ge
802END INTERFACE
803
809INTERFACE OPERATOR (<=)
810 MODULE PROCEDURE vol7d_level_le
811END INTERFACE
812
816INTERFACE OPERATOR (.almosteq.)
817 MODULE PROCEDURE vol7d_level_almost_eq
818END INTERFACE
819
820
821! da documentare in inglese assieme al resto
824 MODULE PROCEDURE vol7d_level_c_e
825END INTERFACE
826
827#define VOL7D_POLY_TYPE TYPE(vol7d_level)
828#define VOL7D_POLY_TYPES _level
829#define ENABLE_SORT
830#include "array_utilities_pre.F90"
831
834 MODULE PROCEDURE display_level
835END INTERFACE
836
839 MODULE PROCEDURE to_char_level
840END INTERFACE
841
844 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
846
849 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
851
854 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
856
857type(vol7d_level) :: almost_equal_levels(3)=(/&
858 vol7d_level( 1,imiss,imiss,imiss),&
859 vol7d_level(103,imiss,imiss,imiss),&
860 vol7d_level(106,imiss,imiss,imiss)/)
861
862! levels requiring conversion from internal to physical representation
863INTEGER, PARAMETER :: &
864 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
865 thermo_level(3) = (/20,107,235/), & ! 10**-1
866 sigma_level(2) = (/104,111/) ! 10**-4
867
868TYPE level_var
869 INTEGER :: level
870 CHARACTER(len=10) :: btable
871END TYPE level_var
872
873! Conversion table from GRIB2 vertical level codes to corresponding
874! BUFR B table variables
875TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
876 level_var(20, 'B12101'), & ! isothermal (K)
877 level_var(100, 'B10004'), & ! isobaric (Pa)
878 level_var(102, 'B10007'), & ! height over sea level (m)
879 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
880 level_var(107, 'B12192'), & ! isentropical (K)
881 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
882 level_var(161, 'B22195') /) ! depth below sea surface
883
884PRIVATE level_var, level_var_converter
885
886CONTAINS
887
893FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
894INTEGER,INTENT(IN),OPTIONAL :: level1
895INTEGER,INTENT(IN),OPTIONAL :: l1
896INTEGER,INTENT(IN),OPTIONAL :: level2
897INTEGER,INTENT(IN),OPTIONAL :: l2
898
899TYPE(vol7d_level) :: this
900
902
903END FUNCTION vol7d_level_new
904
905
909SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
910TYPE(vol7d_level),INTENT(INOUT) :: this
911INTEGER,INTENT(IN),OPTIONAL :: level1
912INTEGER,INTENT(IN),OPTIONAL :: l1
913INTEGER,INTENT(IN),OPTIONAL :: level2
914INTEGER,INTENT(IN),OPTIONAL :: l2
915
916this%level1 = imiss
917this%l1 = imiss
918this%level2 = imiss
919this%l2 = imiss
920
921IF (PRESENT(level1)) THEN
922 this%level1 = level1
923ELSE
924 RETURN
925END IF
926
927IF (PRESENT(l1)) this%l1 = l1
928
929IF (PRESENT(level2)) THEN
930 this%level2 = level2
931ELSE
932 RETURN
933END IF
934
935IF (PRESENT(l2)) this%l2 = l2
936
937END SUBROUTINE vol7d_level_init
938
939
941SUBROUTINE vol7d_level_delete(this)
942TYPE(vol7d_level),INTENT(INOUT) :: this
943
944this%level1 = imiss
945this%l1 = imiss
946this%level2 = imiss
947this%l2 = imiss
948
949END SUBROUTINE vol7d_level_delete
950
951
952SUBROUTINE display_level(this)
953TYPE(vol7d_level),INTENT(in) :: this
954
955print*,trim(to_char(this))
956
957END SUBROUTINE display_level
958
959
960FUNCTION to_char_level(this)
961#ifdef HAVE_DBALLE
962USE dballef
963#endif
964TYPE(vol7d_level),INTENT(in) :: this
965CHARACTER(len=255) :: to_char_level
966
967#ifdef HAVE_DBALLE
968INTEGER :: handle, ier
969
970handle = 0
971ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
972ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
973ier = idba_fatto(handle)
974
975to_char_level="LEVEL: "//to_char_level
976
977#else
978
979to_char_level="LEVEL: "//&
982
983#endif
984
985END FUNCTION to_char_level
986
987
988ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
989TYPE(vol7d_level),INTENT(IN) :: this, that
990LOGICAL :: res
991
992res = &
993 this%level1 == that%level1 .AND. &
994 this%level2 == that%level2 .AND. &
995 this%l1 == that%l1 .AND. this%l2 == that%l2
996
997END FUNCTION vol7d_level_eq
998
999
1000ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
1001TYPE(vol7d_level),INTENT(IN) :: this, that
1002LOGICAL :: res
1003
1004res = .NOT.(this == that)
1005
1006END FUNCTION vol7d_level_ne
1007
1008
1009ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1010TYPE(vol7d_level),INTENT(IN) :: this, that
1011LOGICAL :: res
1012
1017 res = .true.
1018ELSE
1019 res = .false.
1020ENDIF
1021
1022END FUNCTION vol7d_level_almost_eq
1023
1024
1025ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1026TYPE(vol7d_level),INTENT(IN) :: this, that
1027LOGICAL :: res
1028
1029IF (&
1030 this%level1 > that%level1 .OR. &
1031 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1032 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1033 (&
1034 this%level2 > that%level2 .OR. &
1035 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1036 ))) THEN
1037 res = .true.
1038ELSE
1039 res = .false.
1040ENDIF
1041
1042END FUNCTION vol7d_level_gt
1043
1044
1045ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1046TYPE(vol7d_level),INTENT(IN) :: this, that
1047LOGICAL :: res
1048
1049IF (&
1050 this%level1 < that%level1 .OR. &
1051 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1052 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1053 (&
1054 this%level2 < that%level2 .OR. &
1055 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1056 ))) THEN
1057 res = .true.
1058ELSE
1059 res = .false.
1060ENDIF
1061
1062END FUNCTION vol7d_level_lt
1063
1064
1065ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1066TYPE(vol7d_level),INTENT(IN) :: this, that
1067LOGICAL :: res
1068
1069IF (this == that) THEN
1070 res = .true.
1071ELSE IF (this > that) THEN
1072 res = .true.
1073ELSE
1074 res = .false.
1075ENDIF
1076
1077END FUNCTION vol7d_level_ge
1078
1079
1080ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1081TYPE(vol7d_level),INTENT(IN) :: this, that
1082LOGICAL :: res
1083
1084IF (this == that) THEN
1085 res = .true.
1086ELSE IF (this < that) THEN
1087 res = .true.
1088ELSE
1089 res = .false.
1090ENDIF
1091
1092END FUNCTION vol7d_level_le
1093
1094
1095ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1096TYPE(vol7d_level),INTENT(IN) :: this
1097LOGICAL :: c_e
1098c_e = this /= vol7d_level_miss
1099END FUNCTION vol7d_level_c_e
1100
1101
1102#include "array_utilities_inc.F90"
1103
1104
1105FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1106TYPE(vol7d_level),INTENT(in) :: level
1107CHARACTER(len=10) :: btable
1108
1109btable = vol7d_level_to_var_int(level%level1)
1110
1111END FUNCTION vol7d_level_to_var_lev
1112
1113FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1114INTEGER,INTENT(in) :: level
1115CHARACTER(len=10) :: btable
1116
1117INTEGER :: i
1118
1119DO i = 1, SIZE(level_var_converter)
1120 IF (level_var_converter(i)%level == level) THEN
1121 btable = level_var_converter(i)%btable
1122 RETURN
1123 ENDIF
1124ENDDO
1125
1126btable = cmiss
1127
1128END FUNCTION vol7d_level_to_var_int
1129
1130
1131FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1132TYPE(vol7d_level),INTENT(in) :: level
1133REAL :: factor
1134
1135factor = vol7d_level_to_var_factor_int(level%level1)
1136
1137END FUNCTION vol7d_level_to_var_factor_lev
1138
1139FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1140INTEGER,INTENT(in) :: level
1141REAL :: factor
1142
1143factor = 1.
1144IF (any(level == height_level)) THEN
1145 factor = 1.e-3
1146ELSE IF (any(level == thermo_level)) THEN
1147 factor = 1.e-1
1148ELSE IF (any(level == sigma_level)) THEN
1149 factor = 1.e-4
1150ENDIF
1151
1152END FUNCTION vol7d_level_to_var_factor_int
1153
1154
1155FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1156TYPE(vol7d_level),INTENT(in) :: level
1157REAL :: log10
1158
1159log10 = vol7d_level_to_var_log10_int(level%level1)
1160
1161END FUNCTION vol7d_level_to_var_log10_lev
1162
1163FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1164INTEGER,INTENT(in) :: level
1165REAL :: log10
1166
1167log10 = 0.
1168IF (any(level == height_level)) THEN
1169 log10 = -3.
1170ELSE IF (any(level == thermo_level)) THEN
1171 log10 = -1.
1172ELSE IF (any(level == sigma_level)) THEN
1173 log10 = -4.
1174ENDIF
1175
1176END FUNCTION vol7d_level_to_var_log10_int
1177
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 |