libsim Versione 7.1.11
|
◆ count_distinct_sorted_level()
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
700IMPLICIT NONE
701
707 INTEGER :: level1
708 INTEGER :: l1
709 INTEGER :: level2
710 INTEGER :: l2
712
715
720 MODULE PROCEDURE vol7d_level_init
721END INTERFACE
722
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
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
800 MODULE PROCEDURE display_level
801END INTERFACE
802
805 MODULE PROCEDURE to_char_level
806END INTERFACE
807
810 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
812
815 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
817
820 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
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
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: "//&
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
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
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 |