libsim Versione 7.1.11
|
◆ arrayof_doubleprecision_insert()
Method for inserting an element of the array at a desired position. If necessary, the array is reallocated to accomodate the new element.
Definizione alla linea 6128 del file array_utilities.F90. 6129! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6130! authors:
6131! Davide Cesari <dcesari@arpa.emr.it>
6132! Paolo Patruno <ppatruno@arpa.emr.it>
6133
6134! This program is free software; you can redistribute it and/or
6135! modify it under the terms of the GNU General Public License as
6136! published by the Free Software Foundation; either version 2 of
6137! the License, or (at your option) any later version.
6138
6139! This program is distributed in the hope that it will be useful,
6140! but WITHOUT ANY WARRANTY; without even the implied warranty of
6141! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6142! GNU General Public License for more details.
6143
6144! You should have received a copy of the GNU General Public License
6145! along with this program. If not, see <http://www.gnu.org/licenses/>.
6146
6147
6148
6151#include "config.h"
6153
6154IMPLICIT NONE
6155
6156! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6157!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6158
6159#undef VOL7D_POLY_TYPE_AUTO
6160
6161#undef VOL7D_POLY_TYPE
6162#undef VOL7D_POLY_TYPES
6163#define VOL7D_POLY_TYPE INTEGER
6164#define VOL7D_POLY_TYPES _i
6165#define ENABLE_SORT
6166#include "array_utilities_pre.F90"
6167#undef ENABLE_SORT
6168
6169#undef VOL7D_POLY_TYPE
6170#undef VOL7D_POLY_TYPES
6171#define VOL7D_POLY_TYPE REAL
6172#define VOL7D_POLY_TYPES _r
6173#define ENABLE_SORT
6174#include "array_utilities_pre.F90"
6175#undef ENABLE_SORT
6176
6177#undef VOL7D_POLY_TYPE
6178#undef VOL7D_POLY_TYPES
6179#define VOL7D_POLY_TYPE DOUBLEPRECISION
6180#define VOL7D_POLY_TYPES _d
6181#define ENABLE_SORT
6182#include "array_utilities_pre.F90"
6183#undef ENABLE_SORT
6184
6185#define VOL7D_NO_PACK
6186#undef VOL7D_POLY_TYPE
6187#undef VOL7D_POLY_TYPES
6188#define VOL7D_POLY_TYPE CHARACTER(len=*)
6189#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6190#define VOL7D_POLY_TYPES _c
6191#define ENABLE_SORT
6192#include "array_utilities_pre.F90"
6193#undef VOL7D_POLY_TYPE_AUTO
6194#undef ENABLE_SORT
6195
6196
6197#define ARRAYOF_ORIGEQ 1
6198
6199#define ARRAYOF_ORIGTYPE INTEGER
6200#define ARRAYOF_TYPE arrayof_integer
6201#include "arrayof_pre.F90"
6202
6203#undef ARRAYOF_ORIGTYPE
6204#undef ARRAYOF_TYPE
6205#define ARRAYOF_ORIGTYPE REAL
6206#define ARRAYOF_TYPE arrayof_real
6207#include "arrayof_pre.F90"
6208
6209#undef ARRAYOF_ORIGTYPE
6210#undef ARRAYOF_TYPE
6211#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6212#define ARRAYOF_TYPE arrayof_doubleprecision
6213#include "arrayof_pre.F90"
6214
6215#undef ARRAYOF_ORIGEQ
6216
6217#undef ARRAYOF_ORIGTYPE
6218#undef ARRAYOF_TYPE
6219#define ARRAYOF_ORIGTYPE LOGICAL
6220#define ARRAYOF_TYPE arrayof_logical
6221#include "arrayof_pre.F90"
6222
6223PRIVATE
6224! from arrayof
6226PUBLIC insert_unique, append_unique
6227
6229 count_distinct_sorted, pack_distinct_sorted, &
6230 count_distinct, pack_distinct, count_and_pack_distinct, &
6231 map_distinct, map_inv_distinct, &
6232 firsttrue, lasttrue, pack_distinct_c, map
6233
6234CONTAINS
6235
6236
6239FUNCTION firsttrue(v) RESULT(i)
6240LOGICAL,INTENT(in) :: v(:)
6241INTEGER :: i
6242
6243DO i = 1, SIZE(v)
6244 IF (v(i)) RETURN
6245ENDDO
6246i = 0
6247
6248END FUNCTION firsttrue
6249
6250
6253FUNCTION lasttrue(v) RESULT(i)
6254LOGICAL,INTENT(in) :: v(:)
6255INTEGER :: i
6256
6257DO i = SIZE(v), 1, -1
6258 IF (v(i)) RETURN
6259ENDDO
6260
6261END FUNCTION lasttrue
6262
6263
6264! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6265#undef VOL7D_POLY_TYPE_AUTO
6266#undef VOL7D_NO_PACK
6267
6268#undef VOL7D_POLY_TYPE
6269#undef VOL7D_POLY_TYPES
6270#define VOL7D_POLY_TYPE INTEGER
6271#define VOL7D_POLY_TYPES _i
6272#define ENABLE_SORT
6273#include "array_utilities_inc.F90"
6274#undef ENABLE_SORT
6275
6276#undef VOL7D_POLY_TYPE
6277#undef VOL7D_POLY_TYPES
6278#define VOL7D_POLY_TYPE REAL
6279#define VOL7D_POLY_TYPES _r
6280#define ENABLE_SORT
6281#include "array_utilities_inc.F90"
6282#undef ENABLE_SORT
6283
6284#undef VOL7D_POLY_TYPE
6285#undef VOL7D_POLY_TYPES
6286#define VOL7D_POLY_TYPE DOUBLEPRECISION
6287#define VOL7D_POLY_TYPES _d
6288#define ENABLE_SORT
6289#include "array_utilities_inc.F90"
6290#undef ENABLE_SORT
6291
6292#define VOL7D_NO_PACK
6293#undef VOL7D_POLY_TYPE
6294#undef VOL7D_POLY_TYPES
6295#define VOL7D_POLY_TYPE CHARACTER(len=*)
6296#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6297#define VOL7D_POLY_TYPES _c
6298#define ENABLE_SORT
6299#include "array_utilities_inc.F90"
6300#undef VOL7D_POLY_TYPE_AUTO
6301#undef ENABLE_SORT
6302
6303SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6304CHARACTER(len=*),INTENT(in) :: vect(:)
6305LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6306CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6307
6308INTEGER :: count_distinct
6309INTEGER :: i, j, dim
6310LOGICAL :: lback
6311
6312dim = SIZE(pack_distinct)
6313IF (PRESENT(back)) THEN
6314 lback = back
6315ELSE
6316 lback = .false.
6317ENDIF
6318count_distinct = 0
6319
6320IF (PRESENT (mask)) THEN
6321 IF (lback) THEN
6322 vectm1: DO i = 1, SIZE(vect)
6323 IF (.NOT.mask(i)) cycle vectm1
6324! DO j = i-1, 1, -1
6325! IF (vect(j) == vect(i)) CYCLE vectm1
6326 DO j = count_distinct, 1, -1
6327 IF (pack_distinct(j) == vect(i)) cycle vectm1
6328 ENDDO
6329 count_distinct = count_distinct + 1
6330 IF (count_distinct > dim) EXIT
6331 pack_distinct(count_distinct) = vect(i)
6332 ENDDO vectm1
6333 ELSE
6334 vectm2: DO i = 1, SIZE(vect)
6335 IF (.NOT.mask(i)) cycle vectm2
6336! DO j = 1, i-1
6337! IF (vect(j) == vect(i)) CYCLE vectm2
6338 DO j = 1, count_distinct
6339 IF (pack_distinct(j) == vect(i)) cycle vectm2
6340 ENDDO
6341 count_distinct = count_distinct + 1
6342 IF (count_distinct > dim) EXIT
6343 pack_distinct(count_distinct) = vect(i)
6344 ENDDO vectm2
6345 ENDIF
6346ELSE
6347 IF (lback) THEN
6348 vect1: DO i = 1, SIZE(vect)
6349! DO j = i-1, 1, -1
6350! IF (vect(j) == vect(i)) CYCLE vect1
6351 DO j = count_distinct, 1, -1
6352 IF (pack_distinct(j) == vect(i)) cycle vect1
6353 ENDDO
6354 count_distinct = count_distinct + 1
6355 IF (count_distinct > dim) EXIT
6356 pack_distinct(count_distinct) = vect(i)
6357 ENDDO vect1
6358 ELSE
6359 vect2: DO i = 1, SIZE(vect)
6360! DO j = 1, i-1
6361! IF (vect(j) == vect(i)) CYCLE vect2
6362 DO j = 1, count_distinct
6363 IF (pack_distinct(j) == vect(i)) cycle vect2
6364 ENDDO
6365 count_distinct = count_distinct + 1
6366 IF (count_distinct > dim) EXIT
6367 pack_distinct(count_distinct) = vect(i)
6368 ENDDO vect2
6369 ENDIF
6370ENDIF
6371
6372END SUBROUTINE pack_distinct_c
6373
6375FUNCTION map(mask) RESULT(mapidx)
6376LOGICAL,INTENT(in) :: mask(:)
6377INTEGER :: mapidx(count(mask))
6378
6379INTEGER :: i,j
6380
6381j = 0
6382DO i=1, SIZE(mask)
6383 j = j + 1
6384 IF (mask(i)) mapidx(j)=i
6385ENDDO
6386
6387END FUNCTION map
6388
6389#define ARRAYOF_ORIGEQ 1
6390
6391#undef ARRAYOF_ORIGTYPE
6392#undef ARRAYOF_TYPE
6393#define ARRAYOF_ORIGTYPE INTEGER
6394#define ARRAYOF_TYPE arrayof_integer
6395#include "arrayof_post.F90"
6396
6397#undef ARRAYOF_ORIGTYPE
6398#undef ARRAYOF_TYPE
6399#define ARRAYOF_ORIGTYPE REAL
6400#define ARRAYOF_TYPE arrayof_real
6401#include "arrayof_post.F90"
6402
6403#undef ARRAYOF_ORIGTYPE
6404#undef ARRAYOF_TYPE
6405#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6406#define ARRAYOF_TYPE arrayof_doubleprecision
6407#include "arrayof_post.F90"
6408
6409#undef ARRAYOF_ORIGEQ
6410
6411#undef ARRAYOF_ORIGTYPE
6412#undef ARRAYOF_TYPE
6413#define ARRAYOF_ORIGTYPE LOGICAL
6414#define ARRAYOF_TYPE arrayof_logical
6415#include "arrayof_post.F90"
6416
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 |