libsim Versione 7.1.11

◆ 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 671 del file vol7d_level_class.F90.

672! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
673! authors:
674! Davide Cesari <dcesari@arpa.emr.it>
675! Paolo Patruno <ppatruno@arpa.emr.it>
676
677! This program is free software; you can redistribute it and/or
678! modify it under the terms of the GNU General Public License as
679! published by the Free Software Foundation; either version 2 of
680! the License, or (at your option) any later version.
681
682! This program is distributed in the hope that it will be useful,
683! but WITHOUT ANY WARRANTY; without even the implied warranty of
684! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
685! GNU General Public License for more details.
686
687! You should have received a copy of the GNU General Public License
688! along with this program. If not, see <http://www.gnu.org/licenses/>.
689#include "config.h"
690
697USE kinds
700IMPLICIT NONE
701
706TYPE vol7d_level
707 INTEGER :: level1
708 INTEGER :: l1
709 INTEGER :: level2
710 INTEGER :: l2
711END TYPE vol7d_level
712
714TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
715
719INTERFACE init
720 MODULE PROCEDURE vol7d_level_init
721END INTERFACE
722
725INTERFACE delete
726 MODULE PROCEDURE vol7d_level_delete
727END INTERFACE
728
732INTERFACE OPERATOR (==)
733 MODULE PROCEDURE vol7d_level_eq
734END INTERFACE
735
739INTERFACE OPERATOR (/=)
740 MODULE PROCEDURE vol7d_level_ne
741END INTERFACE
742
748INTERFACE OPERATOR (>)
749 MODULE PROCEDURE vol7d_level_gt
750END INTERFACE
751
757INTERFACE OPERATOR (<)
758 MODULE PROCEDURE vol7d_level_lt
759END INTERFACE
760
766INTERFACE OPERATOR (>=)
767 MODULE PROCEDURE vol7d_level_ge
768END INTERFACE
769
775INTERFACE OPERATOR (<=)
776 MODULE PROCEDURE vol7d_level_le
777END INTERFACE
778
782INTERFACE OPERATOR (.almosteq.)
783 MODULE PROCEDURE vol7d_level_almost_eq
784END INTERFACE
785
786
787! da documentare in inglese assieme al resto
789INTERFACE c_e
790 MODULE PROCEDURE vol7d_level_c_e
791END INTERFACE
792
793#define VOL7D_POLY_TYPE TYPE(vol7d_level)
794#define VOL7D_POLY_TYPES _level
795#define ENABLE_SORT
796#include "array_utilities_pre.F90"
797
799INTERFACE display
800 MODULE PROCEDURE display_level
801END INTERFACE
802
804INTERFACE to_char
805 MODULE PROCEDURE to_char_level
806END INTERFACE
807
809INTERFACE vol7d_level_to_var
810 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
811END INTERFACE vol7d_level_to_var
812
815 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
816END INTERFACE vol7d_level_to_var_factor
817
820 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
821END INTERFACE vol7d_level_to_var_log10
822
823type(vol7d_level) :: almost_equal_levels(3)=(/&
824 vol7d_level( 1,imiss,imiss,imiss),&
825 vol7d_level(103,imiss,imiss,imiss),&
826 vol7d_level(106,imiss,imiss,imiss)/)
827
828! levels requiring conversion from internal to physical representation
829INTEGER, PARAMETER :: &
830 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
831 thermo_level(3) = (/20,107,235/), & ! 10**-1
832 sigma_level(2) = (/104,111/) ! 10**-4
833
834TYPE level_var
835 INTEGER :: level
836 CHARACTER(len=10) :: btable
837END TYPE level_var
838
839! Conversion table from GRIB2 vertical level codes to corresponding
840! BUFR B table variables
841TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
842 level_var(20, 'B12101'), & ! isothermal (K)
843 level_var(100, 'B10004'), & ! isobaric (Pa)
844 level_var(102, 'B10007'), & ! height over sea level (m)
845 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
846 level_var(107, 'B12192'), & ! isentropical (K)
847 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
848 level_var(161, 'B22195') /) ! depth below sea surface
849
850PRIVATE level_var, level_var_converter
851
852CONTAINS
853
859FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
860INTEGER,INTENT(IN),OPTIONAL :: level1
861INTEGER,INTENT(IN),OPTIONAL :: l1
862INTEGER,INTENT(IN),OPTIONAL :: level2
863INTEGER,INTENT(IN),OPTIONAL :: l2
864
865TYPE(vol7d_level) :: this
866
867CALL init(this, level1, l1, level2, l2)
868
869END FUNCTION vol7d_level_new
870
871
875SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
876TYPE(vol7d_level),INTENT(INOUT) :: this
877INTEGER,INTENT(IN),OPTIONAL :: level1
878INTEGER,INTENT(IN),OPTIONAL :: l1
879INTEGER,INTENT(IN),OPTIONAL :: level2
880INTEGER,INTENT(IN),OPTIONAL :: l2
881
882this%level1 = imiss
883this%l1 = imiss
884this%level2 = imiss
885this%l2 = imiss
886
887IF (PRESENT(level1)) THEN
888 this%level1 = level1
889ELSE
890 RETURN
891END IF
892
893IF (PRESENT(l1)) this%l1 = l1
894
895IF (PRESENT(level2)) THEN
896 this%level2 = level2
897ELSE
898 RETURN
899END IF
900
901IF (PRESENT(l2)) this%l2 = l2
902
903END SUBROUTINE vol7d_level_init
904
905
907SUBROUTINE vol7d_level_delete(this)
908TYPE(vol7d_level),INTENT(INOUT) :: this
909
910this%level1 = imiss
911this%l1 = imiss
912this%level2 = imiss
913this%l2 = imiss
914
915END SUBROUTINE vol7d_level_delete
916
917
918SUBROUTINE display_level(this)
919TYPE(vol7d_level),INTENT(in) :: this
920
921print*,trim(to_char(this))
922
923END SUBROUTINE display_level
924
925
926FUNCTION to_char_level(this)
927#ifdef HAVE_DBALLE
928USE dballef
929#endif
930TYPE(vol7d_level),INTENT(in) :: this
931CHARACTER(len=255) :: to_char_level
932
933#ifdef HAVE_DBALLE
934INTEGER :: handle, ier
935
936handle = 0
937ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
938ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
939ier = idba_fatto(handle)
940
941to_char_level="LEVEL: "//to_char_level
942
943#else
944
945to_char_level="LEVEL: "//&
946 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
947 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
948
949#endif
950
951END FUNCTION to_char_level
952
953
954ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
955TYPE(vol7d_level),INTENT(IN) :: this, that
956LOGICAL :: res
957
958res = &
959 this%level1 == that%level1 .AND. &
960 this%level2 == that%level2 .AND. &
961 this%l1 == that%l1 .AND. this%l2 == that%l2
962
963END FUNCTION vol7d_level_eq
964
965
966ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
967TYPE(vol7d_level),INTENT(IN) :: this, that
968LOGICAL :: res
969
970res = .NOT.(this == that)
971
972END FUNCTION vol7d_level_ne
973
974
975ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
976TYPE(vol7d_level),INTENT(IN) :: this, that
977LOGICAL :: res
978
979IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
980 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
981 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
982 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
983 res = .true.
984ELSE
985 res = .false.
986ENDIF
987
988END FUNCTION vol7d_level_almost_eq
989
990
991ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
992TYPE(vol7d_level),INTENT(IN) :: this, that
993LOGICAL :: res
994
995IF (&
996 this%level1 > that%level1 .OR. &
997 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
998 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
999 (&
1000 this%level2 > that%level2 .OR. &
1001 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
1002 ))) THEN
1003 res = .true.
1004ELSE
1005 res = .false.
1006ENDIF
1007
1008END FUNCTION vol7d_level_gt
1009
1010
1011ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
1012TYPE(vol7d_level),INTENT(IN) :: this, that
1013LOGICAL :: res
1014
1015IF (&
1016 this%level1 < that%level1 .OR. &
1017 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
1018 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
1019 (&
1020 this%level2 < that%level2 .OR. &
1021 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
1022 ))) THEN
1023 res = .true.
1024ELSE
1025 res = .false.
1026ENDIF
1027
1028END FUNCTION vol7d_level_lt
1029
1030
1031ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
1032TYPE(vol7d_level),INTENT(IN) :: this, that
1033LOGICAL :: res
1034
1035IF (this == that) THEN
1036 res = .true.
1037ELSE IF (this > that) THEN
1038 res = .true.
1039ELSE
1040 res = .false.
1041ENDIF
1042
1043END FUNCTION vol7d_level_ge
1044
1045
1046ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
1047TYPE(vol7d_level),INTENT(IN) :: this, that
1048LOGICAL :: res
1049
1050IF (this == that) THEN
1051 res = .true.
1052ELSE IF (this < that) THEN
1053 res = .true.
1054ELSE
1055 res = .false.
1056ENDIF
1057
1058END FUNCTION vol7d_level_le
1059
1060
1061ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
1062TYPE(vol7d_level),INTENT(IN) :: this
1063LOGICAL :: c_e
1064c_e = this /= vol7d_level_miss
1065END FUNCTION vol7d_level_c_e
1066
1067
1068#include "array_utilities_inc.F90"
1069
1070
1071FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
1072TYPE(vol7d_level),INTENT(in) :: level
1073CHARACTER(len=10) :: btable
1074
1075btable = vol7d_level_to_var_int(level%level1)
1076
1077END FUNCTION vol7d_level_to_var_lev
1078
1079FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
1080INTEGER,INTENT(in) :: level
1081CHARACTER(len=10) :: btable
1082
1083INTEGER :: i
1084
1085DO i = 1, SIZE(level_var_converter)
1086 IF (level_var_converter(i)%level == level) THEN
1087 btable = level_var_converter(i)%btable
1088 RETURN
1089 ENDIF
1090ENDDO
1091
1092btable = cmiss
1093
1094END FUNCTION vol7d_level_to_var_int
1095
1096
1097FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
1098TYPE(vol7d_level),INTENT(in) :: level
1099REAL :: factor
1100
1101factor = vol7d_level_to_var_factor_int(level%level1)
1102
1103END FUNCTION vol7d_level_to_var_factor_lev
1104
1105FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
1106INTEGER,INTENT(in) :: level
1107REAL :: factor
1108
1109factor = 1.
1110IF (any(level == height_level)) THEN
1111 factor = 1.e-3
1112ELSE IF (any(level == thermo_level)) THEN
1113 factor = 1.e-1
1114ELSE IF (any(level == sigma_level)) THEN
1115 factor = 1.e-4
1116ENDIF
1117
1118END FUNCTION vol7d_level_to_var_factor_int
1119
1120
1121FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
1122TYPE(vol7d_level),INTENT(in) :: level
1123REAL :: log10
1124
1125log10 = vol7d_level_to_var_log10_int(level%level1)
1126
1127END FUNCTION vol7d_level_to_var_log10_lev
1128
1129FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
1130INTEGER,INTENT(in) :: level
1131REAL :: log10
1132
1133log10 = 0.
1134IF (any(level == height_level)) THEN
1135 log10 = -3.
1136ELSE IF (any(level == thermo_level)) THEN
1137 log10 = -1.
1138ELSE IF (any(level == sigma_level)) THEN
1139 log10 = -4.
1140ENDIF
1141
1142END FUNCTION vol7d_level_to_var_log10_int
1143
1144END 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:251
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.