libsim Versione 7.1.11
|
◆ inssor_c()
Sorts into increasing order (Insertion sort) Sorts XDONT into increasing order (Insertion sort) This subroutine uses insertion sort. It does not use any work array and is faster when XDONT is of very small size (< 20), or already almost sorted, so it is used in a final pass when the partial quicksorting has left a sequence of small subsets and that sorting is only necessary within each subset to complete the process. Michel Olagnon - Apr. 2000 Definizione alla linea 5088 del file array_utilities.F90. 5089! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
5090! authors:
5091! Davide Cesari <dcesari@arpa.emr.it>
5092! Paolo Patruno <ppatruno@arpa.emr.it>
5093
5094! This program is free software; you can redistribute it and/or
5095! modify it under the terms of the GNU General Public License as
5096! published by the Free Software Foundation; either version 2 of
5097! the License, or (at your option) any later version.
5098
5099! This program is distributed in the hope that it will be useful,
5100! but WITHOUT ANY WARRANTY; without even the implied warranty of
5101! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5102! GNU General Public License for more details.
5103
5104! You should have received a copy of the GNU General Public License
5105! along with this program. If not, see <http://www.gnu.org/licenses/>.
5106
5107
5108
5111#include "config.h"
5113
5114IMPLICIT NONE
5115
5116! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
5117!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
5118
5119#undef VOL7D_POLY_TYPE_AUTO
5120
5121#undef VOL7D_POLY_TYPE
5122#undef VOL7D_POLY_TYPES
5123#define VOL7D_POLY_TYPE INTEGER
5124#define VOL7D_POLY_TYPES _i
5125#define ENABLE_SORT
5126#include "array_utilities_pre.F90"
5127#undef ENABLE_SORT
5128
5129#undef VOL7D_POLY_TYPE
5130#undef VOL7D_POLY_TYPES
5131#define VOL7D_POLY_TYPE REAL
5132#define VOL7D_POLY_TYPES _r
5133#define ENABLE_SORT
5134#include "array_utilities_pre.F90"
5135#undef ENABLE_SORT
5136
5137#undef VOL7D_POLY_TYPE
5138#undef VOL7D_POLY_TYPES
5139#define VOL7D_POLY_TYPE DOUBLEPRECISION
5140#define VOL7D_POLY_TYPES _d
5141#define ENABLE_SORT
5142#include "array_utilities_pre.F90"
5143#undef ENABLE_SORT
5144
5145#define VOL7D_NO_PACK
5146#undef VOL7D_POLY_TYPE
5147#undef VOL7D_POLY_TYPES
5148#define VOL7D_POLY_TYPE CHARACTER(len=*)
5149#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5150#define VOL7D_POLY_TYPES _c
5151#define ENABLE_SORT
5152#include "array_utilities_pre.F90"
5153#undef VOL7D_POLY_TYPE_AUTO
5154#undef ENABLE_SORT
5155
5156
5157#define ARRAYOF_ORIGEQ 1
5158
5159#define ARRAYOF_ORIGTYPE INTEGER
5160#define ARRAYOF_TYPE arrayof_integer
5161#include "arrayof_pre.F90"
5162
5163#undef ARRAYOF_ORIGTYPE
5164#undef ARRAYOF_TYPE
5165#define ARRAYOF_ORIGTYPE REAL
5166#define ARRAYOF_TYPE arrayof_real
5167#include "arrayof_pre.F90"
5168
5169#undef ARRAYOF_ORIGTYPE
5170#undef ARRAYOF_TYPE
5171#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5172#define ARRAYOF_TYPE arrayof_doubleprecision
5173#include "arrayof_pre.F90"
5174
5175#undef ARRAYOF_ORIGEQ
5176
5177#undef ARRAYOF_ORIGTYPE
5178#undef ARRAYOF_TYPE
5179#define ARRAYOF_ORIGTYPE LOGICAL
5180#define ARRAYOF_TYPE arrayof_logical
5181#include "arrayof_pre.F90"
5182
5183PRIVATE
5184! from arrayof
5186PUBLIC insert_unique, append_unique
5187
5189 count_distinct_sorted, pack_distinct_sorted, &
5190 count_distinct, pack_distinct, count_and_pack_distinct, &
5191 map_distinct, map_inv_distinct, &
5192 firsttrue, lasttrue, pack_distinct_c, map
5193
5194CONTAINS
5195
5196
5199FUNCTION firsttrue(v) RESULT(i)
5200LOGICAL,INTENT(in) :: v(:)
5201INTEGER :: i
5202
5203DO i = 1, SIZE(v)
5204 IF (v(i)) RETURN
5205ENDDO
5206i = 0
5207
5208END FUNCTION firsttrue
5209
5210
5213FUNCTION lasttrue(v) RESULT(i)
5214LOGICAL,INTENT(in) :: v(:)
5215INTEGER :: i
5216
5217DO i = SIZE(v), 1, -1
5218 IF (v(i)) RETURN
5219ENDDO
5220
5221END FUNCTION lasttrue
5222
5223
5224! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
5225#undef VOL7D_POLY_TYPE_AUTO
5226#undef VOL7D_NO_PACK
5227
5228#undef VOL7D_POLY_TYPE
5229#undef VOL7D_POLY_TYPES
5230#define VOL7D_POLY_TYPE INTEGER
5231#define VOL7D_POLY_TYPES _i
5232#define ENABLE_SORT
5233#include "array_utilities_inc.F90"
5234#undef ENABLE_SORT
5235
5236#undef VOL7D_POLY_TYPE
5237#undef VOL7D_POLY_TYPES
5238#define VOL7D_POLY_TYPE REAL
5239#define VOL7D_POLY_TYPES _r
5240#define ENABLE_SORT
5241#include "array_utilities_inc.F90"
5242#undef ENABLE_SORT
5243
5244#undef VOL7D_POLY_TYPE
5245#undef VOL7D_POLY_TYPES
5246#define VOL7D_POLY_TYPE DOUBLEPRECISION
5247#define VOL7D_POLY_TYPES _d
5248#define ENABLE_SORT
5249#include "array_utilities_inc.F90"
5250#undef ENABLE_SORT
5251
5252#define VOL7D_NO_PACK
5253#undef VOL7D_POLY_TYPE
5254#undef VOL7D_POLY_TYPES
5255#define VOL7D_POLY_TYPE CHARACTER(len=*)
5256#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5257#define VOL7D_POLY_TYPES _c
5258#define ENABLE_SORT
5259#include "array_utilities_inc.F90"
5260#undef VOL7D_POLY_TYPE_AUTO
5261#undef ENABLE_SORT
5262
5263SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
5264CHARACTER(len=*),INTENT(in) :: vect(:)
5265LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
5266CHARACTER(len=LEN(vect)) :: pack_distinct(:)
5267
5268INTEGER :: count_distinct
5269INTEGER :: i, j, dim
5270LOGICAL :: lback
5271
5272dim = SIZE(pack_distinct)
5273IF (PRESENT(back)) THEN
5274 lback = back
5275ELSE
5276 lback = .false.
5277ENDIF
5278count_distinct = 0
5279
5280IF (PRESENT (mask)) THEN
5281 IF (lback) THEN
5282 vectm1: DO i = 1, SIZE(vect)
5283 IF (.NOT.mask(i)) cycle vectm1
5284! DO j = i-1, 1, -1
5285! IF (vect(j) == vect(i)) CYCLE vectm1
5286 DO j = count_distinct, 1, -1
5287 IF (pack_distinct(j) == vect(i)) cycle vectm1
5288 ENDDO
5289 count_distinct = count_distinct + 1
5290 IF (count_distinct > dim) EXIT
5291 pack_distinct(count_distinct) = vect(i)
5292 ENDDO vectm1
5293 ELSE
5294 vectm2: DO i = 1, SIZE(vect)
5295 IF (.NOT.mask(i)) cycle vectm2
5296! DO j = 1, i-1
5297! IF (vect(j) == vect(i)) CYCLE vectm2
5298 DO j = 1, count_distinct
5299 IF (pack_distinct(j) == vect(i)) cycle vectm2
5300 ENDDO
5301 count_distinct = count_distinct + 1
5302 IF (count_distinct > dim) EXIT
5303 pack_distinct(count_distinct) = vect(i)
5304 ENDDO vectm2
5305 ENDIF
5306ELSE
5307 IF (lback) THEN
5308 vect1: DO i = 1, SIZE(vect)
5309! DO j = i-1, 1, -1
5310! IF (vect(j) == vect(i)) CYCLE vect1
5311 DO j = count_distinct, 1, -1
5312 IF (pack_distinct(j) == vect(i)) cycle vect1
5313 ENDDO
5314 count_distinct = count_distinct + 1
5315 IF (count_distinct > dim) EXIT
5316 pack_distinct(count_distinct) = vect(i)
5317 ENDDO vect1
5318 ELSE
5319 vect2: DO i = 1, SIZE(vect)
5320! DO j = 1, i-1
5321! IF (vect(j) == vect(i)) CYCLE vect2
5322 DO j = 1, count_distinct
5323 IF (pack_distinct(j) == vect(i)) cycle vect2
5324 ENDDO
5325 count_distinct = count_distinct + 1
5326 IF (count_distinct > dim) EXIT
5327 pack_distinct(count_distinct) = vect(i)
5328 ENDDO vect2
5329 ENDIF
5330ENDIF
5331
5332END SUBROUTINE pack_distinct_c
5333
5335FUNCTION map(mask) RESULT(mapidx)
5336LOGICAL,INTENT(in) :: mask(:)
5337INTEGER :: mapidx(count(mask))
5338
5339INTEGER :: i,j
5340
5341j = 0
5342DO i=1, SIZE(mask)
5343 j = j + 1
5344 IF (mask(i)) mapidx(j)=i
5345ENDDO
5346
5347END FUNCTION map
5348
5349#define ARRAYOF_ORIGEQ 1
5350
5351#undef ARRAYOF_ORIGTYPE
5352#undef ARRAYOF_TYPE
5353#define ARRAYOF_ORIGTYPE INTEGER
5354#define ARRAYOF_TYPE arrayof_integer
5355#include "arrayof_post.F90"
5356
5357#undef ARRAYOF_ORIGTYPE
5358#undef ARRAYOF_TYPE
5359#define ARRAYOF_ORIGTYPE REAL
5360#define ARRAYOF_TYPE arrayof_real
5361#include "arrayof_post.F90"
5362
5363#undef ARRAYOF_ORIGTYPE
5364#undef ARRAYOF_TYPE
5365#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5366#define ARRAYOF_TYPE arrayof_doubleprecision
5367#include "arrayof_post.F90"
5368
5369#undef ARRAYOF_ORIGEQ
5370
5371#undef ARRAYOF_ORIGTYPE
5372#undef ARRAYOF_TYPE
5373#define ARRAYOF_ORIGTYPE LOGICAL
5374#define ARRAYOF_TYPE arrayof_logical
5375#include "arrayof_post.F90"
5376
Quick method to append an element to the array. Definition: array_utilities.F90:514 Destructor for finalizing an array object. Definition: array_utilities.F90:527 Method for inserting elements of the array at a desired position. Definition: array_utilities.F90:505 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: array_utilities.F90:537 Method for removing elements of the array at a desired position. Definition: array_utilities.F90:520 This module defines usefull general purpose function and subroutine. Definition: array_utilities.F90:218 |