libsim Versione 7.2.1
|
◆ sort_c()
Sorts inline into ascending order - Quicksort Quicksort chooses a "pivot" in the set, and explores the array from both ends, looking for a value > pivot with the increasing index, for a value <= pivot with the decreasing index, and swapping them when it has found one of each. The array is then subdivided in 2 ([3]) subsets: { values <= pivot} {pivot} {values > pivot} One then call recursively the program to sort each subset. When the size of the subarray is small enough or the maximum level of recursion is gained, one uses an insertion sort that is faster for very small sets.
Definizione alla linea 4957 del file array_utilities.F90. 4958! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
4959! authors:
4960! Davide Cesari <dcesari@arpa.emr.it>
4961! Paolo Patruno <ppatruno@arpa.emr.it>
4962
4963! This program is free software; you can redistribute it and/or
4964! modify it under the terms of the GNU General Public License as
4965! published by the Free Software Foundation; either version 2 of
4966! the License, or (at your option) any later version.
4967
4968! This program is distributed in the hope that it will be useful,
4969! but WITHOUT ANY WARRANTY; without even the implied warranty of
4970! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4971! GNU General Public License for more details.
4972
4973! You should have received a copy of the GNU General Public License
4974! along with this program. If not, see <http://www.gnu.org/licenses/>.
4975
4976
4977
4980#include "config.h"
4982
4983IMPLICIT NONE
4984
4985! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
4986!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
4987
4988#undef VOL7D_POLY_TYPE_AUTO
4989
4990#undef VOL7D_POLY_TYPE
4991#undef VOL7D_POLY_TYPES
4992#define VOL7D_POLY_TYPE INTEGER
4993#define VOL7D_POLY_TYPES _i
4994#define ENABLE_SORT
4995#include "array_utilities_pre.F90"
4996#undef ENABLE_SORT
4997
4998#undef VOL7D_POLY_TYPE
4999#undef VOL7D_POLY_TYPES
5000#define VOL7D_POLY_TYPE REAL
5001#define VOL7D_POLY_TYPES _r
5002#define ENABLE_SORT
5003#include "array_utilities_pre.F90"
5004#undef ENABLE_SORT
5005
5006#undef VOL7D_POLY_TYPE
5007#undef VOL7D_POLY_TYPES
5008#define VOL7D_POLY_TYPE DOUBLEPRECISION
5009#define VOL7D_POLY_TYPES _d
5010#define ENABLE_SORT
5011#include "array_utilities_pre.F90"
5012#undef ENABLE_SORT
5013
5014#define VOL7D_NO_PACK
5015#undef VOL7D_POLY_TYPE
5016#undef VOL7D_POLY_TYPES
5017#define VOL7D_POLY_TYPE CHARACTER(len=*)
5018#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5019#define VOL7D_POLY_TYPES _c
5020#define ENABLE_SORT
5021#include "array_utilities_pre.F90"
5022#undef VOL7D_POLY_TYPE_AUTO
5023#undef ENABLE_SORT
5024
5025
5026#define ARRAYOF_ORIGEQ 1
5027
5028#define ARRAYOF_ORIGTYPE INTEGER
5029#define ARRAYOF_TYPE arrayof_integer
5030#include "arrayof_pre.F90"
5031
5032#undef ARRAYOF_ORIGTYPE
5033#undef ARRAYOF_TYPE
5034#define ARRAYOF_ORIGTYPE REAL
5035#define ARRAYOF_TYPE arrayof_real
5036#include "arrayof_pre.F90"
5037
5038#undef ARRAYOF_ORIGTYPE
5039#undef ARRAYOF_TYPE
5040#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5041#define ARRAYOF_TYPE arrayof_doubleprecision
5042#include "arrayof_pre.F90"
5043
5044#undef ARRAYOF_ORIGEQ
5045
5046#undef ARRAYOF_ORIGTYPE
5047#undef ARRAYOF_TYPE
5048#define ARRAYOF_ORIGTYPE LOGICAL
5049#define ARRAYOF_TYPE arrayof_logical
5050#include "arrayof_pre.F90"
5051
5052PRIVATE
5053! from arrayof
5055PUBLIC insert_unique, append_unique
5056
5058 count_distinct_sorted, pack_distinct_sorted, &
5059 count_distinct, pack_distinct, count_and_pack_distinct, &
5060 map_distinct, map_inv_distinct, &
5061 firsttrue, lasttrue, pack_distinct_c, map
5062
5063CONTAINS
5064
5065
5068FUNCTION firsttrue(v) RESULT(i)
5069LOGICAL,INTENT(in) :: v(:)
5070INTEGER :: i
5071
5072DO i = 1, SIZE(v)
5073 IF (v(i)) RETURN
5074ENDDO
5075i = 0
5076
5077END FUNCTION firsttrue
5078
5079
5082FUNCTION lasttrue(v) RESULT(i)
5083LOGICAL,INTENT(in) :: v(:)
5084INTEGER :: i
5085
5086DO i = SIZE(v), 1, -1
5087 IF (v(i)) RETURN
5088ENDDO
5089
5090END FUNCTION lasttrue
5091
5092
5093! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
5094#undef VOL7D_POLY_TYPE_AUTO
5095#undef VOL7D_NO_PACK
5096
5097#undef VOL7D_POLY_TYPE
5098#undef VOL7D_POLY_TYPES
5099#define VOL7D_POLY_TYPE INTEGER
5100#define VOL7D_POLY_TYPES _i
5101#define ENABLE_SORT
5102#include "array_utilities_inc.F90"
5103#undef ENABLE_SORT
5104
5105#undef VOL7D_POLY_TYPE
5106#undef VOL7D_POLY_TYPES
5107#define VOL7D_POLY_TYPE REAL
5108#define VOL7D_POLY_TYPES _r
5109#define ENABLE_SORT
5110#include "array_utilities_inc.F90"
5111#undef ENABLE_SORT
5112
5113#undef VOL7D_POLY_TYPE
5114#undef VOL7D_POLY_TYPES
5115#define VOL7D_POLY_TYPE DOUBLEPRECISION
5116#define VOL7D_POLY_TYPES _d
5117#define ENABLE_SORT
5118#include "array_utilities_inc.F90"
5119#undef ENABLE_SORT
5120
5121#define VOL7D_NO_PACK
5122#undef VOL7D_POLY_TYPE
5123#undef VOL7D_POLY_TYPES
5124#define VOL7D_POLY_TYPE CHARACTER(len=*)
5125#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5126#define VOL7D_POLY_TYPES _c
5127#define ENABLE_SORT
5128#include "array_utilities_inc.F90"
5129#undef VOL7D_POLY_TYPE_AUTO
5130#undef ENABLE_SORT
5131
5132SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
5133CHARACTER(len=*),INTENT(in) :: vect(:)
5134LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
5135CHARACTER(len=LEN(vect)) :: pack_distinct(:)
5136
5137INTEGER :: count_distinct
5138INTEGER :: i, j, dim
5139LOGICAL :: lback
5140
5141dim = SIZE(pack_distinct)
5142IF (PRESENT(back)) THEN
5143 lback = back
5144ELSE
5145 lback = .false.
5146ENDIF
5147count_distinct = 0
5148
5149IF (PRESENT (mask)) THEN
5150 IF (lback) THEN
5151 vectm1: DO i = 1, SIZE(vect)
5152 IF (.NOT.mask(i)) cycle vectm1
5153! DO j = i-1, 1, -1
5154! IF (vect(j) == vect(i)) CYCLE vectm1
5155 DO j = count_distinct, 1, -1
5156 IF (pack_distinct(j) == vect(i)) cycle vectm1
5157 ENDDO
5158 count_distinct = count_distinct + 1
5159 IF (count_distinct > dim) EXIT
5160 pack_distinct(count_distinct) = vect(i)
5161 ENDDO vectm1
5162 ELSE
5163 vectm2: DO i = 1, SIZE(vect)
5164 IF (.NOT.mask(i)) cycle vectm2
5165! DO j = 1, i-1
5166! IF (vect(j) == vect(i)) CYCLE vectm2
5167 DO j = 1, count_distinct
5168 IF (pack_distinct(j) == vect(i)) cycle vectm2
5169 ENDDO
5170 count_distinct = count_distinct + 1
5171 IF (count_distinct > dim) EXIT
5172 pack_distinct(count_distinct) = vect(i)
5173 ENDDO vectm2
5174 ENDIF
5175ELSE
5176 IF (lback) THEN
5177 vect1: DO i = 1, SIZE(vect)
5178! DO j = i-1, 1, -1
5179! IF (vect(j) == vect(i)) CYCLE vect1
5180 DO j = count_distinct, 1, -1
5181 IF (pack_distinct(j) == vect(i)) cycle vect1
5182 ENDDO
5183 count_distinct = count_distinct + 1
5184 IF (count_distinct > dim) EXIT
5185 pack_distinct(count_distinct) = vect(i)
5186 ENDDO vect1
5187 ELSE
5188 vect2: DO i = 1, SIZE(vect)
5189! DO j = 1, i-1
5190! IF (vect(j) == vect(i)) CYCLE vect2
5191 DO j = 1, count_distinct
5192 IF (pack_distinct(j) == vect(i)) cycle vect2
5193 ENDDO
5194 count_distinct = count_distinct + 1
5195 IF (count_distinct > dim) EXIT
5196 pack_distinct(count_distinct) = vect(i)
5197 ENDDO vect2
5198 ENDIF
5199ENDIF
5200
5201END SUBROUTINE pack_distinct_c
5202
5204FUNCTION map(mask) RESULT(mapidx)
5205LOGICAL,INTENT(in) :: mask(:)
5206INTEGER :: mapidx(count(mask))
5207
5208INTEGER :: i,j
5209
5210j = 0
5211DO i=1, SIZE(mask)
5212 j = j + 1
5213 IF (mask(i)) mapidx(j)=i
5214ENDDO
5215
5216END FUNCTION map
5217
5218#define ARRAYOF_ORIGEQ 1
5219
5220#undef ARRAYOF_ORIGTYPE
5221#undef ARRAYOF_TYPE
5222#define ARRAYOF_ORIGTYPE INTEGER
5223#define ARRAYOF_TYPE arrayof_integer
5224#include "arrayof_post.F90"
5225
5226#undef ARRAYOF_ORIGTYPE
5227#undef ARRAYOF_TYPE
5228#define ARRAYOF_ORIGTYPE REAL
5229#define ARRAYOF_TYPE arrayof_real
5230#include "arrayof_post.F90"
5231
5232#undef ARRAYOF_ORIGTYPE
5233#undef ARRAYOF_TYPE
5234#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5235#define ARRAYOF_TYPE arrayof_doubleprecision
5236#include "arrayof_post.F90"
5237
5238#undef ARRAYOF_ORIGEQ
5239
5240#undef ARRAYOF_ORIGTYPE
5241#undef ARRAYOF_TYPE
5242#define ARRAYOF_ORIGTYPE LOGICAL
5243#define ARRAYOF_TYPE arrayof_logical
5244#include "arrayof_post.F90"
5245
Quick method to append an element to the array. Definition: array_utilities.F90:508 Destructor for finalizing an array object. Definition: array_utilities.F90:521 Method for inserting elements of the array at a desired position. Definition: array_utilities.F90:499 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: array_utilities.F90:531 Method for removing elements of the array at a desired position. Definition: array_utilities.F90:514 This module defines usefull general purpose function and subroutine. Definition: array_utilities.F90:212 |