libsim Versione 7.1.11

◆ sort_c()

subroutine sort_c ( character(len=*), dimension (:), intent(inout)  xdont)
private

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.

Parametri
[in,out]xdontvector to sort inline

Definizione alla linea 4963 del file array_utilities.F90.

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

Generated with Doxygen.