libsim Versione 7.1.11
|
◆ arrayof_logical_insert_array()
Method for inserting a number of elements of the array at a desired position. If necessary, the array is reallocated to accomodate the new elements.
Definizione alla linea 6371 del file array_utilities.F90. 6372! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6373! authors:
6374! Davide Cesari <dcesari@arpa.emr.it>
6375! Paolo Patruno <ppatruno@arpa.emr.it>
6376
6377! This program is free software; you can redistribute it and/or
6378! modify it under the terms of the GNU General Public License as
6379! published by the Free Software Foundation; either version 2 of
6380! the License, or (at your option) any later version.
6381
6382! This program is distributed in the hope that it will be useful,
6383! but WITHOUT ANY WARRANTY; without even the implied warranty of
6384! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6385! GNU General Public License for more details.
6386
6387! You should have received a copy of the GNU General Public License
6388! along with this program. If not, see <http://www.gnu.org/licenses/>.
6389
6390
6391
6394#include "config.h"
6396
6397IMPLICIT NONE
6398
6399! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6400!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6401
6402#undef VOL7D_POLY_TYPE_AUTO
6403
6404#undef VOL7D_POLY_TYPE
6405#undef VOL7D_POLY_TYPES
6406#define VOL7D_POLY_TYPE INTEGER
6407#define VOL7D_POLY_TYPES _i
6408#define ENABLE_SORT
6409#include "array_utilities_pre.F90"
6410#undef ENABLE_SORT
6411
6412#undef VOL7D_POLY_TYPE
6413#undef VOL7D_POLY_TYPES
6414#define VOL7D_POLY_TYPE REAL
6415#define VOL7D_POLY_TYPES _r
6416#define ENABLE_SORT
6417#include "array_utilities_pre.F90"
6418#undef ENABLE_SORT
6419
6420#undef VOL7D_POLY_TYPE
6421#undef VOL7D_POLY_TYPES
6422#define VOL7D_POLY_TYPE DOUBLEPRECISION
6423#define VOL7D_POLY_TYPES _d
6424#define ENABLE_SORT
6425#include "array_utilities_pre.F90"
6426#undef ENABLE_SORT
6427
6428#define VOL7D_NO_PACK
6429#undef VOL7D_POLY_TYPE
6430#undef VOL7D_POLY_TYPES
6431#define VOL7D_POLY_TYPE CHARACTER(len=*)
6432#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6433#define VOL7D_POLY_TYPES _c
6434#define ENABLE_SORT
6435#include "array_utilities_pre.F90"
6436#undef VOL7D_POLY_TYPE_AUTO
6437#undef ENABLE_SORT
6438
6439
6440#define ARRAYOF_ORIGEQ 1
6441
6442#define ARRAYOF_ORIGTYPE INTEGER
6443#define ARRAYOF_TYPE arrayof_integer
6444#include "arrayof_pre.F90"
6445
6446#undef ARRAYOF_ORIGTYPE
6447#undef ARRAYOF_TYPE
6448#define ARRAYOF_ORIGTYPE REAL
6449#define ARRAYOF_TYPE arrayof_real
6450#include "arrayof_pre.F90"
6451
6452#undef ARRAYOF_ORIGTYPE
6453#undef ARRAYOF_TYPE
6454#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6455#define ARRAYOF_TYPE arrayof_doubleprecision
6456#include "arrayof_pre.F90"
6457
6458#undef ARRAYOF_ORIGEQ
6459
6460#undef ARRAYOF_ORIGTYPE
6461#undef ARRAYOF_TYPE
6462#define ARRAYOF_ORIGTYPE LOGICAL
6463#define ARRAYOF_TYPE arrayof_logical
6464#include "arrayof_pre.F90"
6465
6466PRIVATE
6467! from arrayof
6469PUBLIC insert_unique, append_unique
6470
6472 count_distinct_sorted, pack_distinct_sorted, &
6473 count_distinct, pack_distinct, count_and_pack_distinct, &
6474 map_distinct, map_inv_distinct, &
6475 firsttrue, lasttrue, pack_distinct_c, map
6476
6477CONTAINS
6478
6479
6482FUNCTION firsttrue(v) RESULT(i)
6483LOGICAL,INTENT(in) :: v(:)
6484INTEGER :: i
6485
6486DO i = 1, SIZE(v)
6487 IF (v(i)) RETURN
6488ENDDO
6489i = 0
6490
6491END FUNCTION firsttrue
6492
6493
6496FUNCTION lasttrue(v) RESULT(i)
6497LOGICAL,INTENT(in) :: v(:)
6498INTEGER :: i
6499
6500DO i = SIZE(v), 1, -1
6501 IF (v(i)) RETURN
6502ENDDO
6503
6504END FUNCTION lasttrue
6505
6506
6507! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6508#undef VOL7D_POLY_TYPE_AUTO
6509#undef VOL7D_NO_PACK
6510
6511#undef VOL7D_POLY_TYPE
6512#undef VOL7D_POLY_TYPES
6513#define VOL7D_POLY_TYPE INTEGER
6514#define VOL7D_POLY_TYPES _i
6515#define ENABLE_SORT
6516#include "array_utilities_inc.F90"
6517#undef ENABLE_SORT
6518
6519#undef VOL7D_POLY_TYPE
6520#undef VOL7D_POLY_TYPES
6521#define VOL7D_POLY_TYPE REAL
6522#define VOL7D_POLY_TYPES _r
6523#define ENABLE_SORT
6524#include "array_utilities_inc.F90"
6525#undef ENABLE_SORT
6526
6527#undef VOL7D_POLY_TYPE
6528#undef VOL7D_POLY_TYPES
6529#define VOL7D_POLY_TYPE DOUBLEPRECISION
6530#define VOL7D_POLY_TYPES _d
6531#define ENABLE_SORT
6532#include "array_utilities_inc.F90"
6533#undef ENABLE_SORT
6534
6535#define VOL7D_NO_PACK
6536#undef VOL7D_POLY_TYPE
6537#undef VOL7D_POLY_TYPES
6538#define VOL7D_POLY_TYPE CHARACTER(len=*)
6539#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6540#define VOL7D_POLY_TYPES _c
6541#define ENABLE_SORT
6542#include "array_utilities_inc.F90"
6543#undef VOL7D_POLY_TYPE_AUTO
6544#undef ENABLE_SORT
6545
6546SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6547CHARACTER(len=*),INTENT(in) :: vect(:)
6548LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6549CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6550
6551INTEGER :: count_distinct
6552INTEGER :: i, j, dim
6553LOGICAL :: lback
6554
6555dim = SIZE(pack_distinct)
6556IF (PRESENT(back)) THEN
6557 lback = back
6558ELSE
6559 lback = .false.
6560ENDIF
6561count_distinct = 0
6562
6563IF (PRESENT (mask)) THEN
6564 IF (lback) THEN
6565 vectm1: DO i = 1, SIZE(vect)
6566 IF (.NOT.mask(i)) cycle vectm1
6567! DO j = i-1, 1, -1
6568! IF (vect(j) == vect(i)) CYCLE vectm1
6569 DO j = count_distinct, 1, -1
6570 IF (pack_distinct(j) == vect(i)) cycle vectm1
6571 ENDDO
6572 count_distinct = count_distinct + 1
6573 IF (count_distinct > dim) EXIT
6574 pack_distinct(count_distinct) = vect(i)
6575 ENDDO vectm1
6576 ELSE
6577 vectm2: DO i = 1, SIZE(vect)
6578 IF (.NOT.mask(i)) cycle vectm2
6579! DO j = 1, i-1
6580! IF (vect(j) == vect(i)) CYCLE vectm2
6581 DO j = 1, count_distinct
6582 IF (pack_distinct(j) == vect(i)) cycle vectm2
6583 ENDDO
6584 count_distinct = count_distinct + 1
6585 IF (count_distinct > dim) EXIT
6586 pack_distinct(count_distinct) = vect(i)
6587 ENDDO vectm2
6588 ENDIF
6589ELSE
6590 IF (lback) THEN
6591 vect1: DO i = 1, SIZE(vect)
6592! DO j = i-1, 1, -1
6593! IF (vect(j) == vect(i)) CYCLE vect1
6594 DO j = count_distinct, 1, -1
6595 IF (pack_distinct(j) == vect(i)) cycle vect1
6596 ENDDO
6597 count_distinct = count_distinct + 1
6598 IF (count_distinct > dim) EXIT
6599 pack_distinct(count_distinct) = vect(i)
6600 ENDDO vect1
6601 ELSE
6602 vect2: DO i = 1, SIZE(vect)
6603! DO j = 1, i-1
6604! IF (vect(j) == vect(i)) CYCLE vect2
6605 DO j = 1, count_distinct
6606 IF (pack_distinct(j) == vect(i)) cycle vect2
6607 ENDDO
6608 count_distinct = count_distinct + 1
6609 IF (count_distinct > dim) EXIT
6610 pack_distinct(count_distinct) = vect(i)
6611 ENDDO vect2
6612 ENDIF
6613ENDIF
6614
6615END SUBROUTINE pack_distinct_c
6616
6618FUNCTION map(mask) RESULT(mapidx)
6619LOGICAL,INTENT(in) :: mask(:)
6620INTEGER :: mapidx(count(mask))
6621
6622INTEGER :: i,j
6623
6624j = 0
6625DO i=1, SIZE(mask)
6626 j = j + 1
6627 IF (mask(i)) mapidx(j)=i
6628ENDDO
6629
6630END FUNCTION map
6631
6632#define ARRAYOF_ORIGEQ 1
6633
6634#undef ARRAYOF_ORIGTYPE
6635#undef ARRAYOF_TYPE
6636#define ARRAYOF_ORIGTYPE INTEGER
6637#define ARRAYOF_TYPE arrayof_integer
6638#include "arrayof_post.F90"
6639
6640#undef ARRAYOF_ORIGTYPE
6641#undef ARRAYOF_TYPE
6642#define ARRAYOF_ORIGTYPE REAL
6643#define ARRAYOF_TYPE arrayof_real
6644#include "arrayof_post.F90"
6645
6646#undef ARRAYOF_ORIGTYPE
6647#undef ARRAYOF_TYPE
6648#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6649#define ARRAYOF_TYPE arrayof_doubleprecision
6650#include "arrayof_post.F90"
6651
6652#undef ARRAYOF_ORIGEQ
6653
6654#undef ARRAYOF_ORIGTYPE
6655#undef ARRAYOF_TYPE
6656#define ARRAYOF_ORIGTYPE LOGICAL
6657#define ARRAYOF_TYPE arrayof_logical
6658#include "arrayof_post.F90"
6659
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 |