libsim Versione 7.2.6
|
◆ count_distinct_level()
conta gli elementi distinti in vect Definizione alla linea 699 del file vol7d_level_class.F90. 700! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
701! authors:
702! Davide Cesari <dcesari@arpa.emr.it>
703! Paolo Patruno <ppatruno@arpa.emr.it>
704
705! This program is free software; you can redistribute it and/or
706! modify it under the terms of the GNU General Public License as
707! published by the Free Software Foundation; either version 2 of
708! the License, or (at your option) any later version.
709
710! This program is distributed in the hope that it will be useful,
711! but WITHOUT ANY WARRANTY; without even the implied warranty of
712! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
713! GNU General Public License for more details.
714
715! You should have received a copy of the GNU General Public License
716! along with this program. If not, see <http://www.gnu.org/licenses/>.
717#include "config.h"
718
719!> Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
720!! Questo modulo definisce una classe per rappresentare la localizzazione
721!! verticale di un'osservazione meteorologica, prendendo in prestito
722!! concetti dal formato grib.
723!! \ingroup vol7d
728IMPLICIT NONE
729
730!> Definisce il livello verticale di un'osservazione.
731!! I membri di \a vol7d_level sono pubblici e quindi liberamente
732!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
733!! il costruttore ::init.
735 INTEGER :: level1 !< tipo di livello o strato verticale (vedi tabella 4.5 formato grib2 WMO http://www.wmo.int/pages/prog/www/WMOCodes/WMO306_vI2/LatestVERSION/WMO306_vI2_GRIB2_CodeFlag_en.pdf)
736 INTEGER :: l1 !< valore numerico del primo livello, se previsto da \a level1
737 INTEGER :: level2 !< tipo di livello o strato verticale (vedi tabella 4.5 formato grib2 WMO http://www.wmo.int/pages/prog/www/WMOCodes/WMO306_vI2/LatestVERSION/WMO306_vI2_GRIB2_CodeFlag_en.pdf)
738 INTEGER :: l2 !< valore numerico del secondo livello, se previsto da \a level2
740
741!> Valore mancante per vol7d_level.
743
744!> Costruttore per la classe vol7d_level.
745!! Deve essere richiamato
746!! per tutti gli oggetti di questo tipo definiti in un programma.
748 MODULE PROCEDURE vol7d_level_init
749END INTERFACE
750
751!> Distruttore per la classe vol7d_level.
752!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
754 MODULE PROCEDURE vol7d_level_delete
755END INTERFACE
756
757!> Logical equality operator for objects of \a vol7d_level class.
758!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
759!! of any shape.
760INTERFACE OPERATOR (==)
761 MODULE PROCEDURE vol7d_level_eq
762END INTERFACE
763
764!> Logical inequality operator for objects of \a vol7d_level class.
765!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
766!! of any shape.
767INTERFACE OPERATOR (/=)
768 MODULE PROCEDURE vol7d_level_ne
769END INTERFACE
770
771!> Logical greater-than operator for objects of \a vol7d_level class.
772!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
773!! of any shape.
774!! Comparison is performed first on \a level, then, then on \l1, then
775!! on \l2 if defined.
776INTERFACE OPERATOR (>)
777 MODULE PROCEDURE vol7d_level_gt
778END INTERFACE
779
780!> Logical less-than operator for objects of \a vol7d_level class.
781!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
782!! of any shape.
783!! Comparison is performed first on \a level, then, then on \l1, then
784!! on \l2 if defined.
785INTERFACE OPERATOR (<)
786 MODULE PROCEDURE vol7d_level_lt
787END INTERFACE
788
789!> Logical greater-equal operator for objects of \a vol7d_level class.
790!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
791!! of any shape.
792!! Comparison is performed first on \a level, then, then on \l1, then
793!! on \l2 if defined.
794INTERFACE OPERATOR (>=)
795 MODULE PROCEDURE vol7d_level_ge
796END INTERFACE
797
798!> Logical less-equal operator for objects of \a vol7d_level class.
799!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
800!! of any shape.
801!! Comparison is performed first on \a level, then, then on \l1, then
802!! on \l2 if defined.
803INTERFACE OPERATOR (<=)
804 MODULE PROCEDURE vol7d_level_le
805END INTERFACE
806
807!> Logical almost equality operators for objects of the class \a
808!! vol7d_level
809!! If one component is missing it is not used in comparison
810INTERFACE OPERATOR (.almosteq.)
811 MODULE PROCEDURE vol7d_level_almost_eq
812END INTERFACE
813
814
815! da documentare in inglese assieme al resto
816!> to be documented
818 MODULE PROCEDURE vol7d_level_c_e
819END INTERFACE
820
821#define VOL7D_POLY_TYPE TYPE(vol7d_level)
822#define VOL7D_POLY_TYPES _level
823#define ENABLE_SORT
824#include "array_utilities_pre.F90"
825
826!>Print object
828 MODULE PROCEDURE display_level
829END INTERFACE
830
831!>Represent level object in a pretty string
833 MODULE PROCEDURE to_char_level
834END INTERFACE
835
836!> Convert a level type to a physical variable
838 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
840
841!> Return the conversion factor for multiplying the level value when converting to variable
843 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
845
846!> Return the scale value (base 10 log of conversion factor) for multiplying the level value when converting to variable
848 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
850
851type(vol7d_level) :: almost_equal_levels(3)=(/&
852 vol7d_level( 1,imiss,imiss,imiss),&
853 vol7d_level(103,imiss,imiss,imiss),&
854 vol7d_level(106,imiss,imiss,imiss)/)
855
856! levels requiring conversion from internal to physical representation
857INTEGER, PARAMETER :: &
858 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
859 thermo_level(3) = (/20,107,235/), & ! 10**-1
860 sigma_level(2) = (/104,111/) ! 10**-4
861
862TYPE level_var
863 INTEGER :: level
864 CHARACTER(len=10) :: btable
865END TYPE level_var
866
867! Conversion table from GRIB2 vertical level codes to corresponding
868! BUFR B table variables
869TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
870 level_var(20, 'B12101'), & ! isothermal (K)
871 level_var(100, 'B10004'), & ! isobaric (Pa)
872 level_var(102, 'B10007'), & ! height over sea level (m)
873 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
874 level_var(107, 'B12192'), & ! isentropical (K)
875 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
876 level_var(161, 'B22195') /) ! depth below sea surface
877
878PRIVATE level_var, level_var_converter
879
880CONTAINS
881
882!> Inizializza un oggetto \a vol7d_level con i parametri opzionali forniti.
883!! Questa è la versione \c FUNCTION, in stile F2003, del costruttore, da preferire
884!! rispetto alla versione \c SUBROUTINE \c init.
885!! Se non viene passato nessun parametro opzionale l'oggetto è
886!! inizializzato a valore mancante.
887FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
888INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
889INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
890INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
891INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
892
893TYPE(vol7d_level) :: this !< object to initialize
894
896
897END FUNCTION vol7d_level_new
898
899
900!> Inizializza un oggetto \a vol7d_level con i parametri opzionali forniti.
901!! Se non viene passato nessun parametro opzionale l'oggetto è
902!! inizializzato a valore mancante.
903SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
904TYPE(vol7d_level),INTENT(INOUT) :: this !< oggetto da inizializzare
905INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
906INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
907INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
908INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
909
910this%level1 = imiss
911this%l1 = imiss
912this%level2 = imiss
913this%l2 = imiss
914
915IF (PRESENT(level1)) THEN
916 this%level1 = level1
917ELSE
918 RETURN
919END IF
920
921IF (PRESENT(l1)) this%l1 = l1
922
923IF (PRESENT(level2)) THEN
924 this%level2 = level2
925ELSE
926 RETURN
927END IF
928
929IF (PRESENT(l2)) this%l2 = l2
930
931END SUBROUTINE vol7d_level_init
932
933
934!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
935SUBROUTINE vol7d_level_delete(this)
936TYPE(vol7d_level),INTENT(INOUT) :: this !< oggetto da distruggre
937
938this%level1 = imiss
939this%l1 = imiss
940this%level2 = imiss
941this%l2 = imiss
942
943END SUBROUTINE vol7d_level_delete
944
945
946SUBROUTINE display_level(this)
947TYPE(vol7d_level),INTENT(in) :: this
948
949print*,trim(to_char(this))
950
951END SUBROUTINE display_level
952
953
954FUNCTION to_char_level(this)
955#ifdef HAVE_DBALLE
956USE dballef
957#endif
958TYPE(vol7d_level),INTENT(in) :: this
959CHARACTER(len=255) :: to_char_level
960
961#ifdef HAVE_DBALLE
962INTEGER :: handle, ier
963
964handle = 0
965ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
966ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
967ier = idba_fatto(handle)
968
969to_char_level="LEVEL: "//to_char_level
970
971#else
972
973to_char_level="LEVEL: "//&
976
977#endif
978
979END FUNCTION to_char_level
980
981
982ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
983TYPE(vol7d_level),INTENT(IN) :: this, that
984LOGICAL :: res
985
986res = &
987 this%level1 == that%level1 .AND. &
988 this%level2 == that%level2 .AND. &
989 this%l1 == that%l1 .AND. this%l2 == that%l2
990
991END FUNCTION vol7d_level_eq
992
993
994ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
995TYPE(vol7d_level),INTENT(IN) :: this, that
996LOGICAL :: res
997
998res = .NOT.(this == that)
999
1000END FUNCTION vol7d_level_ne
1001
1002
1003ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
1004TYPE(vol7d_level),INTENT(IN) :: this, that
1005LOGICAL :: res
1006
1011 res = .true.
1012ELSE
1013 res = .false.
1014ENDIF
1015
1016END FUNCTION vol7d_level_almost_eq
1017
1018
1019ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
1020TYPE(vol7d_level),INTENT(IN) :: this, that
1021LOGICAL :: res
1022
1023IF (&
1024 this%level1 > that%level1 .OR. &
1025 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
1026 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1027 (&
1028 this%level2 > that%level2 .OR. &
1029 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1030 ))) THEN
1031 res = .true.
1032ELSE
1033 res = .false.
1034ENDIF
1035
1036END FUNCTION vol7d_level_gt
1037
1038
1039ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1040TYPE(vol7d_level),INTENT(IN) :: this, that
1041LOGICAL :: res
1042
1043IF (&
1044 this%level1 < that%level1 .OR. &
1045 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1046 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1047 (&
1048 this%level2 < that%level2 .OR. &
1049 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1050 ))) THEN
1051 res = .true.
1052ELSE
1053 res = .false.
1054ENDIF
1055
1056END FUNCTION vol7d_level_lt
1057
1058
1059ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1060TYPE(vol7d_level),INTENT(IN) :: this, that
1061LOGICAL :: res
1062
1063IF (this == that) THEN
1064 res = .true.
1065ELSE IF (this > that) THEN
1066 res = .true.
1067ELSE
1068 res = .false.
1069ENDIF
1070
1071END FUNCTION vol7d_level_ge
1072
1073
1074ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1075TYPE(vol7d_level),INTENT(IN) :: this, that
1076LOGICAL :: res
1077
1078IF (this == that) THEN
1079 res = .true.
1080ELSE IF (this < that) THEN
1081 res = .true.
1082ELSE
1083 res = .false.
1084ENDIF
1085
1086END FUNCTION vol7d_level_le
1087
1088
1089ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1090TYPE(vol7d_level),INTENT(IN) :: this
1091LOGICAL :: c_e
1092c_e = this /= vol7d_level_miss
1093END FUNCTION vol7d_level_c_e
1094
1095
1096#include "array_utilities_inc.F90"
1097
1098
1099FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1100TYPE(vol7d_level),INTENT(in) :: level
1101CHARACTER(len=10) :: btable
1102
1103btable = vol7d_level_to_var_int(level%level1)
1104
1105END FUNCTION vol7d_level_to_var_lev
1106
1107FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1108INTEGER,INTENT(in) :: level
1109CHARACTER(len=10) :: btable
1110
1111INTEGER :: i
1112
1113DO i = 1, SIZE(level_var_converter)
1114 IF (level_var_converter(i)%level == level) THEN
1115 btable = level_var_converter(i)%btable
1116 RETURN
1117 ENDIF
1118ENDDO
1119
1120btable = cmiss
1121
1122END FUNCTION vol7d_level_to_var_int
1123
1124
1125FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1126TYPE(vol7d_level),INTENT(in) :: level
1127REAL :: factor
1128
1129factor = vol7d_level_to_var_factor_int(level%level1)
1130
1131END FUNCTION vol7d_level_to_var_factor_lev
1132
1133FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1134INTEGER,INTENT(in) :: level
1135REAL :: factor
1136
1137factor = 1.
1138IF (any(level == height_level)) THEN
1139 factor = 1.e-3
1140ELSE IF (any(level == thermo_level)) THEN
1141 factor = 1.e-1
1142ELSE IF (any(level == sigma_level)) THEN
1143 factor = 1.e-4
1144ENDIF
1145
1146END FUNCTION vol7d_level_to_var_factor_int
1147
1148
1149FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1150TYPE(vol7d_level),INTENT(in) :: level
1151REAL :: log10
1152
1153log10 = vol7d_level_to_var_log10_int(level%level1)
1154
1155END FUNCTION vol7d_level_to_var_log10_lev
1156
1157FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1158INTEGER,INTENT(in) :: level
1159REAL :: log10
1160
1161log10 = 0.
1162IF (any(level == height_level)) THEN
1163 log10 = -3.
1164ELSE IF (any(level == thermo_level)) THEN
1165 log10 = -1.
1166ELSE IF (any(level == sigma_level)) THEN
1167 log10 = -4.
1168ENDIF
1169
1170END FUNCTION vol7d_level_to_var_log10_int
1171
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 |