libsim Versione 7.1.11

◆ arrayof_logical_append()

integer function arrayof_logical_append ( type(arrayof_logical this,
logical, intent(in)  content 
)

Quick method to append an element to the array.

The return value is the position at which the element has been appended.

Parametri
thisarray object to extend
[in]contentobject of TYPE LOGICAL to append

Definizione alla linea 6424 del file array_utilities.F90.

6425! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6426! authors:
6427! Davide Cesari <dcesari@arpa.emr.it>
6428! Paolo Patruno <ppatruno@arpa.emr.it>
6429
6430! This program is free software; you can redistribute it and/or
6431! modify it under the terms of the GNU General Public License as
6432! published by the Free Software Foundation; either version 2 of
6433! the License, or (at your option) any later version.
6434
6435! This program is distributed in the hope that it will be useful,
6436! but WITHOUT ANY WARRANTY; without even the implied warranty of
6437! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6438! GNU General Public License for more details.
6439
6440! You should have received a copy of the GNU General Public License
6441! along with this program. If not, see <http://www.gnu.org/licenses/>.
6442
6443
6444
6447#include "config.h"
6448MODULE array_utilities
6449
6450IMPLICIT NONE
6451
6452! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6453!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6454
6455#undef VOL7D_POLY_TYPE_AUTO
6456
6457#undef VOL7D_POLY_TYPE
6458#undef VOL7D_POLY_TYPES
6459#define VOL7D_POLY_TYPE INTEGER
6460#define VOL7D_POLY_TYPES _i
6461#define ENABLE_SORT
6462#include "array_utilities_pre.F90"
6463#undef ENABLE_SORT
6464
6465#undef VOL7D_POLY_TYPE
6466#undef VOL7D_POLY_TYPES
6467#define VOL7D_POLY_TYPE REAL
6468#define VOL7D_POLY_TYPES _r
6469#define ENABLE_SORT
6470#include "array_utilities_pre.F90"
6471#undef ENABLE_SORT
6472
6473#undef VOL7D_POLY_TYPE
6474#undef VOL7D_POLY_TYPES
6475#define VOL7D_POLY_TYPE DOUBLEPRECISION
6476#define VOL7D_POLY_TYPES _d
6477#define ENABLE_SORT
6478#include "array_utilities_pre.F90"
6479#undef ENABLE_SORT
6480
6481#define VOL7D_NO_PACK
6482#undef VOL7D_POLY_TYPE
6483#undef VOL7D_POLY_TYPES
6484#define VOL7D_POLY_TYPE CHARACTER(len=*)
6485#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6486#define VOL7D_POLY_TYPES _c
6487#define ENABLE_SORT
6488#include "array_utilities_pre.F90"
6489#undef VOL7D_POLY_TYPE_AUTO
6490#undef ENABLE_SORT
6491
6492
6493#define ARRAYOF_ORIGEQ 1
6494
6495#define ARRAYOF_ORIGTYPE INTEGER
6496#define ARRAYOF_TYPE arrayof_integer
6497#include "arrayof_pre.F90"
6498
6499#undef ARRAYOF_ORIGTYPE
6500#undef ARRAYOF_TYPE
6501#define ARRAYOF_ORIGTYPE REAL
6502#define ARRAYOF_TYPE arrayof_real
6503#include "arrayof_pre.F90"
6504
6505#undef ARRAYOF_ORIGTYPE
6506#undef ARRAYOF_TYPE
6507#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6508#define ARRAYOF_TYPE arrayof_doubleprecision
6509#include "arrayof_pre.F90"
6510
6511#undef ARRAYOF_ORIGEQ
6512
6513#undef ARRAYOF_ORIGTYPE
6514#undef ARRAYOF_TYPE
6515#define ARRAYOF_ORIGTYPE LOGICAL
6516#define ARRAYOF_TYPE arrayof_logical
6517#include "arrayof_pre.F90"
6518
6519PRIVATE
6520! from arrayof
6522PUBLIC insert_unique, append_unique
6523
6524PUBLIC sort, index, index_c, &
6525 count_distinct_sorted, pack_distinct_sorted, &
6526 count_distinct, pack_distinct, count_and_pack_distinct, &
6527 map_distinct, map_inv_distinct, &
6528 firsttrue, lasttrue, pack_distinct_c, map
6529
6530CONTAINS
6531
6532
6535FUNCTION firsttrue(v) RESULT(i)
6536LOGICAL,INTENT(in) :: v(:)
6537INTEGER :: i
6538
6539DO i = 1, SIZE(v)
6540 IF (v(i)) RETURN
6541ENDDO
6542i = 0
6543
6544END FUNCTION firsttrue
6545
6546
6549FUNCTION lasttrue(v) RESULT(i)
6550LOGICAL,INTENT(in) :: v(:)
6551INTEGER :: i
6552
6553DO i = SIZE(v), 1, -1
6554 IF (v(i)) RETURN
6555ENDDO
6556
6557END FUNCTION lasttrue
6558
6559
6560! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6561#undef VOL7D_POLY_TYPE_AUTO
6562#undef VOL7D_NO_PACK
6563
6564#undef VOL7D_POLY_TYPE
6565#undef VOL7D_POLY_TYPES
6566#define VOL7D_POLY_TYPE INTEGER
6567#define VOL7D_POLY_TYPES _i
6568#define ENABLE_SORT
6569#include "array_utilities_inc.F90"
6570#undef ENABLE_SORT
6571
6572#undef VOL7D_POLY_TYPE
6573#undef VOL7D_POLY_TYPES
6574#define VOL7D_POLY_TYPE REAL
6575#define VOL7D_POLY_TYPES _r
6576#define ENABLE_SORT
6577#include "array_utilities_inc.F90"
6578#undef ENABLE_SORT
6579
6580#undef VOL7D_POLY_TYPE
6581#undef VOL7D_POLY_TYPES
6582#define VOL7D_POLY_TYPE DOUBLEPRECISION
6583#define VOL7D_POLY_TYPES _d
6584#define ENABLE_SORT
6585#include "array_utilities_inc.F90"
6586#undef ENABLE_SORT
6587
6588#define VOL7D_NO_PACK
6589#undef VOL7D_POLY_TYPE
6590#undef VOL7D_POLY_TYPES
6591#define VOL7D_POLY_TYPE CHARACTER(len=*)
6592#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6593#define VOL7D_POLY_TYPES _c
6594#define ENABLE_SORT
6595#include "array_utilities_inc.F90"
6596#undef VOL7D_POLY_TYPE_AUTO
6597#undef ENABLE_SORT
6598
6599SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6600CHARACTER(len=*),INTENT(in) :: vect(:)
6601LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6602CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6603
6604INTEGER :: count_distinct
6605INTEGER :: i, j, dim
6606LOGICAL :: lback
6607
6608dim = SIZE(pack_distinct)
6609IF (PRESENT(back)) THEN
6610 lback = back
6611ELSE
6612 lback = .false.
6613ENDIF
6614count_distinct = 0
6615
6616IF (PRESENT (mask)) THEN
6617 IF (lback) THEN
6618 vectm1: DO i = 1, SIZE(vect)
6619 IF (.NOT.mask(i)) cycle vectm1
6620! DO j = i-1, 1, -1
6621! IF (vect(j) == vect(i)) CYCLE vectm1
6622 DO j = count_distinct, 1, -1
6623 IF (pack_distinct(j) == vect(i)) cycle vectm1
6624 ENDDO
6625 count_distinct = count_distinct + 1
6626 IF (count_distinct > dim) EXIT
6627 pack_distinct(count_distinct) = vect(i)
6628 ENDDO vectm1
6629 ELSE
6630 vectm2: DO i = 1, SIZE(vect)
6631 IF (.NOT.mask(i)) cycle vectm2
6632! DO j = 1, i-1
6633! IF (vect(j) == vect(i)) CYCLE vectm2
6634 DO j = 1, count_distinct
6635 IF (pack_distinct(j) == vect(i)) cycle vectm2
6636 ENDDO
6637 count_distinct = count_distinct + 1
6638 IF (count_distinct > dim) EXIT
6639 pack_distinct(count_distinct) = vect(i)
6640 ENDDO vectm2
6641 ENDIF
6642ELSE
6643 IF (lback) THEN
6644 vect1: DO i = 1, SIZE(vect)
6645! DO j = i-1, 1, -1
6646! IF (vect(j) == vect(i)) CYCLE vect1
6647 DO j = count_distinct, 1, -1
6648 IF (pack_distinct(j) == vect(i)) cycle vect1
6649 ENDDO
6650 count_distinct = count_distinct + 1
6651 IF (count_distinct > dim) EXIT
6652 pack_distinct(count_distinct) = vect(i)
6653 ENDDO vect1
6654 ELSE
6655 vect2: DO i = 1, SIZE(vect)
6656! DO j = 1, i-1
6657! IF (vect(j) == vect(i)) CYCLE vect2
6658 DO j = 1, count_distinct
6659 IF (pack_distinct(j) == vect(i)) cycle vect2
6660 ENDDO
6661 count_distinct = count_distinct + 1
6662 IF (count_distinct > dim) EXIT
6663 pack_distinct(count_distinct) = vect(i)
6664 ENDDO vect2
6665 ENDIF
6666ENDIF
6667
6668END SUBROUTINE pack_distinct_c
6669
6671FUNCTION map(mask) RESULT(mapidx)
6672LOGICAL,INTENT(in) :: mask(:)
6673INTEGER :: mapidx(count(mask))
6674
6675INTEGER :: i,j
6676
6677j = 0
6678DO i=1, SIZE(mask)
6679 j = j + 1
6680 IF (mask(i)) mapidx(j)=i
6681ENDDO
6682
6683END FUNCTION map
6684
6685#define ARRAYOF_ORIGEQ 1
6686
6687#undef ARRAYOF_ORIGTYPE
6688#undef ARRAYOF_TYPE
6689#define ARRAYOF_ORIGTYPE INTEGER
6690#define ARRAYOF_TYPE arrayof_integer
6691#include "arrayof_post.F90"
6692
6693#undef ARRAYOF_ORIGTYPE
6694#undef ARRAYOF_TYPE
6695#define ARRAYOF_ORIGTYPE REAL
6696#define ARRAYOF_TYPE arrayof_real
6697#include "arrayof_post.F90"
6698
6699#undef ARRAYOF_ORIGTYPE
6700#undef ARRAYOF_TYPE
6701#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6702#define ARRAYOF_TYPE arrayof_doubleprecision
6703#include "arrayof_post.F90"
6704
6705#undef ARRAYOF_ORIGEQ
6706
6707#undef ARRAYOF_ORIGTYPE
6708#undef ARRAYOF_TYPE
6709#define ARRAYOF_ORIGTYPE LOGICAL
6710#define ARRAYOF_TYPE arrayof_logical
6711#include "arrayof_post.F90"
6712
6713END 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.