libsim Versione 7.2.0

◆ pack_distinct_timerange()

type(vol7d_timerange) function, dimension(dim) pack_distinct_timerange ( type(vol7d_timerange), dimension(:), intent(in)  vect,
integer, intent(in)  dim,
logical, dimension(:), intent(in), optional  mask,
logical, intent(in), optional  back 
)

compatta gli elementi distinti di vect in un array

Definizione alla linea 883 del file vol7d_timerange_class.F90.

885! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
886! authors:
887! Davide Cesari <dcesari@arpa.emr.it>
888! Paolo Patruno <ppatruno@arpa.emr.it>
889
890! This program is free software; you can redistribute it and/or
891! modify it under the terms of the GNU General Public License as
892! published by the Free Software Foundation; either version 2 of
893! the License, or (at your option) any later version.
894
895! This program is distributed in the hope that it will be useful,
896! but WITHOUT ANY WARRANTY; without even the implied warranty of
897! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
898! GNU General Public License for more details.
899
900! You should have received a copy of the GNU General Public License
901! along with this program. If not, see <http://www.gnu.org/licenses/>.
902#include "config.h"
903
912USE kinds
915IMPLICIT NONE
916
922 INTEGER :: timerange
923 INTEGER :: p1
924 INTEGER :: p2
925END TYPE vol7d_timerange
926
928TYPE(vol7d_timerange),PARAMETER :: vol7d_timerange_miss= &
929 vol7d_timerange(imiss,imiss,imiss)
930
934INTERFACE init
935 MODULE PROCEDURE vol7d_timerange_init
936END INTERFACE
937
940INTERFACE delete
941 MODULE PROCEDURE vol7d_timerange_delete
942END INTERFACE
943
947INTERFACE OPERATOR (==)
948 MODULE PROCEDURE vol7d_timerange_eq
949END INTERFACE
950
954INTERFACE OPERATOR (/=)
955 MODULE PROCEDURE vol7d_timerange_ne
956END INTERFACE
957
961INTERFACE OPERATOR (>)
962 MODULE PROCEDURE vol7d_timerange_gt
963END INTERFACE
964
968INTERFACE OPERATOR (<)
969 MODULE PROCEDURE vol7d_timerange_lt
970END INTERFACE
971
975INTERFACE OPERATOR (>=)
976 MODULE PROCEDURE vol7d_timerange_ge
977END INTERFACE
978
982INTERFACE OPERATOR (<=)
983 MODULE PROCEDURE vol7d_timerange_le
984END INTERFACE
985
988INTERFACE OPERATOR (.almosteq.)
989 MODULE PROCEDURE vol7d_timerange_almost_eq
990END INTERFACE
991
992
993! da documentare in inglese assieme al resto
995INTERFACE c_e
996 MODULE PROCEDURE vol7d_timerange_c_e
997END INTERFACE
998
999#define VOL7D_POLY_TYPE TYPE(vol7d_timerange)
1000#define VOL7D_POLY_TYPES _timerange
1001#define ENABLE_SORT
1002#include "array_utilities_pre.F90"
1003
1005INTERFACE display
1006 MODULE PROCEDURE display_timerange
1007END INTERFACE
1008
1010INTERFACE to_char
1011 MODULE PROCEDURE to_char_timerange
1012END INTERFACE
1013
1014#define ARRAYOF_ORIGTYPE TYPE(vol7d_timerange)
1015#define ARRAYOF_TYPE arrayof_vol7d_timerange
1016#define ARRAYOF_ORIGEQ 1
1017#include "arrayof_pre.F90"
1018
1019
1020type(vol7d_timerange) :: almost_equal_timeranges(2)=(/&
1021 vol7d_timerange(254,0,imiss),&
1022 vol7d_timerange(3,0,3600)/)
1023
1024
1025! from arrayof
1026PUBLIC insert, append, remove, packarray
1027PUBLIC insert_unique, append_unique
1028PUBLIC almost_equal_timeranges
1029
1030CONTAINS
1031
1032
1038FUNCTION vol7d_timerange_new(timerange, p1, p2) RESULT(this)
1039INTEGER,INTENT(IN),OPTIONAL :: timerange
1040INTEGER,INTENT(IN),OPTIONAL :: p1
1041INTEGER,INTENT(IN),OPTIONAL :: p2
1042
1043TYPE(vol7d_timerange) :: this
1044
1045CALL init(this, timerange, p1, p2)
1046
1047END FUNCTION vol7d_timerange_new
1048
1049
1053SUBROUTINE vol7d_timerange_init(this, timerange, p1, p2)
1054TYPE(vol7d_timerange),INTENT(INOUT) :: this
1055INTEGER,INTENT(IN),OPTIONAL :: timerange
1056INTEGER,INTENT(IN),OPTIONAL :: p1
1057INTEGER,INTENT(IN),OPTIONAL :: p2
1058
1059IF (PRESENT(timerange)) THEN
1060 this%timerange = timerange
1061ELSE
1062 this%timerange = imiss
1063 this%p1 = imiss
1064 this%p2 = imiss
1065 RETURN
1066ENDIF
1067!!$IF (timerange == 1) THEN ! p1 sempre 0
1068!!$ this%p1 = 0
1069!!$ this%p2 = imiss
1070!!$ELSE IF (timerange == 0 .OR. timerange == 10) THEN ! solo p1
1071!!$ IF (PRESENT(p1)) THEN
1072!!$ this%p1 = p1
1073!!$ ELSE
1074!!$ this%p1 = 0
1075!!$ ENDIF
1076!!$ this%p2 = imiss
1077!!$ELSE ! tutti gli altri
1078 IF (PRESENT(p1)) THEN
1079 this%p1 = p1
1080 ELSE
1081 this%p1 = imiss
1082 ENDIF
1083 IF (PRESENT(p2)) THEN
1084 this%p2 = p2
1085 ELSE
1086 this%p2 = imiss
1087 ENDIF
1088!!$END IF
1089
1090END SUBROUTINE vol7d_timerange_init
1091
1092
1094SUBROUTINE vol7d_timerange_delete(this)
1095TYPE(vol7d_timerange),INTENT(INOUT) :: this
1096
1097this%timerange = imiss
1098this%p1 = imiss
1099this%p2 = imiss
1100
1101END SUBROUTINE vol7d_timerange_delete
1102
1103
1104SUBROUTINE display_timerange(this)
1105TYPE(vol7d_timerange),INTENT(in) :: this
1106
1107print*,to_char_timerange(this)
1108
1109END SUBROUTINE display_timerange
1110
1111
1112FUNCTION to_char_timerange(this)
1113#ifdef HAVE_DBALLE
1114USE dballef
1115#endif
1116TYPE(vol7d_timerange),INTENT(in) :: this
1117CHARACTER(len=80) :: to_char_timerange
1118
1119#ifdef HAVE_DBALLE
1120INTEGER :: handle, ier
1121
1122handle = 0
1123ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
1124ier = idba_spiegat(handle,this%timerange,this%p1,this%p2,to_char_timerange)
1125ier = idba_fatto(handle)
1126
1127to_char_timerange="Timerange: "//to_char_timerange
1128
1129#else
1130
1131to_char_timerange="Timerange: "//trim(to_char(this%timerange))//" P1: "//&
1132 trim(to_char(this%p1))//" P2: "//trim(to_char(this%p2))
1133
1134#endif
1135
1136END FUNCTION to_char_timerange
1137
1138
1139ELEMENTAL FUNCTION vol7d_timerange_eq(this, that) RESULT(res)
1140TYPE(vol7d_timerange),INTENT(IN) :: this, that
1141LOGICAL :: res
1142
1143
1144res = &
1145 this%timerange == that%timerange .AND. &
1146 this%p1 == that%p1 .AND. (this%p2 == that%p2 .OR. &
1147 this%timerange == 254)
1148
1149END FUNCTION vol7d_timerange_eq
1150
1151
1152ELEMENTAL FUNCTION vol7d_timerange_almost_eq(this, that) RESULT(res)
1153TYPE(vol7d_timerange),INTENT(IN) :: this, that
1154LOGICAL :: res
1155
1156IF (.not. c_e(this%timerange) .or. .not. c_e(that%timerange) .or. this%timerange == that%timerange .AND. &
1157 this%p1 == that%p1 .AND. &
1158 this%p2 == that%p2) THEN
1159 res = .true.
1160ELSE
1161 res = .false.
1162ENDIF
1163
1164END FUNCTION vol7d_timerange_almost_eq
1165
1166
1167ELEMENTAL FUNCTION vol7d_timerange_ne(this, that) RESULT(res)
1168TYPE(vol7d_timerange),INTENT(IN) :: this, that
1169LOGICAL :: res
1170
1171res = .NOT.(this == that)
1172
1173END FUNCTION vol7d_timerange_ne
1174
1175
1176ELEMENTAL FUNCTION vol7d_timerange_gt(this, that) RESULT(res)
1177TYPE(vol7d_timerange),INTENT(IN) :: this, that
1178LOGICAL :: res
1179
1180IF (this%timerange > that%timerange .OR. &
1181 (this%timerange == that%timerange .AND. this%p1 > that%p1) .OR. &
1182 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1183 this%p2 > that%p2)) THEN
1184 res = .true.
1185ELSE
1186 res = .false.
1187ENDIF
1188
1189END FUNCTION vol7d_timerange_gt
1190
1191
1192ELEMENTAL FUNCTION vol7d_timerange_lt(this, that) RESULT(res)
1193TYPE(vol7d_timerange),INTENT(IN) :: this, that
1194LOGICAL :: res
1195
1196IF (this%timerange < that%timerange .OR. &
1197 (this%timerange == that%timerange .AND. this%p1 < that%p1) .OR. &
1198 (this%timerange == that%timerange .AND. this%p1 == that%p1 .AND. &
1199 this%p2 < that%p2)) THEN
1200 res = .true.
1201ELSE
1202 res = .false.
1203ENDIF
1204
1205END FUNCTION vol7d_timerange_lt
1206
1207
1208ELEMENTAL FUNCTION vol7d_timerange_ge(this, that) RESULT(res)
1209TYPE(vol7d_timerange),INTENT(IN) :: this, that
1210LOGICAL :: res
1211
1212IF (this == that) THEN
1213 res = .true.
1214ELSE IF (this > that) THEN
1215 res = .true.
1216ELSE
1217 res = .false.
1218ENDIF
1219
1220END FUNCTION vol7d_timerange_ge
1221
1222
1223ELEMENTAL FUNCTION vol7d_timerange_le(this, that) RESULT(res)
1224TYPE(vol7d_timerange),INTENT(IN) :: this, that
1225LOGICAL :: res
1226
1227IF (this == that) THEN
1228 res = .true.
1229ELSE IF (this < that) THEN
1230 res = .true.
1231ELSE
1232 res = .false.
1233ENDIF
1234
1235END FUNCTION vol7d_timerange_le
1236
1237
1238ELEMENTAL FUNCTION vol7d_timerange_c_e(this) RESULT(c_e)
1239TYPE(vol7d_timerange),INTENT(IN) :: this
1240LOGICAL :: c_e
1241c_e = this /= vol7d_timerange_miss
1242END FUNCTION vol7d_timerange_c_e
1243
1244
1245#include "array_utilities_inc.F90"
1246
1247#include "arrayof_post.F90"
1248
1249
1250END MODULE vol7d_timerange_class
Quick method to append an element to the array.
Distruttore per la classe vol7d_timerange.
Costruttore per la classe vol7d_timerange.
Method for inserting elements of the array at a desired position.
Method for packing the array object reducing at a minimum the memory occupation, without destroying i...
Method for removing elements of the array at a desired position.
Represent timerange object in a pretty string.
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 degli intervalli temporali di osservazioni meteo e affini.
Definisce l'intervallo temporale di un'osservazione meteo.

Generated with Doxygen.