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