libsim Versione 7.2.1

◆ 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 6418 del file array_utilities.F90.

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