libsim Versione 7.2.4
|
◆ count_distinct_sorted_level()
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
694IMPLICIT NONE
695
701 INTEGER :: level1
702 INTEGER :: l1
703 INTEGER :: level2
704 INTEGER :: l2
706
709
714 MODULE PROCEDURE vol7d_level_init
715END INTERFACE
716
720 MODULE PROCEDURE vol7d_level_delete
721END INTERFACE
722
726INTERFACE OPERATOR (==)
727 MODULE PROCEDURE vol7d_level_eq
728END INTERFACE
729
733INTERFACE OPERATOR (/=)
734 MODULE PROCEDURE vol7d_level_ne
735END INTERFACE
736
742INTERFACE OPERATOR (>)
743 MODULE PROCEDURE vol7d_level_gt
744END INTERFACE
745
751INTERFACE OPERATOR (<)
752 MODULE PROCEDURE vol7d_level_lt
753END INTERFACE
754
760INTERFACE OPERATOR (>=)
761 MODULE PROCEDURE vol7d_level_ge
762END INTERFACE
763
769INTERFACE OPERATOR (<=)
770 MODULE PROCEDURE vol7d_level_le
771END INTERFACE
772
776INTERFACE OPERATOR (.almosteq.)
777 MODULE PROCEDURE vol7d_level_almost_eq
778END INTERFACE
779
780
781! da documentare in inglese assieme al resto
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
794 MODULE PROCEDURE display_level
795END INTERFACE
796
799 MODULE PROCEDURE to_char_level
800END INTERFACE
801
804 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
806
809 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
811
814 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
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
853FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
854INTEGER,INTENT(IN),OPTIONAL :: level1
855INTEGER,INTENT(IN),OPTIONAL :: l1
856INTEGER,INTENT(IN),OPTIONAL :: level2
857INTEGER,INTENT(IN),OPTIONAL :: l2
858
859TYPE(vol7d_level) :: this
860
862
863END FUNCTION vol7d_level_new
864
865
869SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
870TYPE(vol7d_level),INTENT(INOUT) :: this
871INTEGER,INTENT(IN),OPTIONAL :: level1
872INTEGER,INTENT(IN),OPTIONAL :: l1
873INTEGER,INTENT(IN),OPTIONAL :: level2
874INTEGER,INTENT(IN),OPTIONAL :: l2
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
901SUBROUTINE vol7d_level_delete(this)
902TYPE(vol7d_level),INTENT(INOUT) :: this
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: "//&
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
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
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 |