libsim Versione 7.2.6

◆ count_distinct_sorted_level()

integer function count_distinct_sorted_level ( type(vol7d_level), dimension(:), intent(in) vect,
logical, dimension(:), intent(in), optional mask )

conta gli elementi distinti in un sorted array

Definizione alla linea 665 del file vol7d_level_class.F90.

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