libsim Versione 7.2.0

◆ arrayof_integer_remove()

subroutine arrayof_integer_remove ( type(arrayof_integer this,
integer, intent(in), optional  nelem,
integer, intent(in), optional  pos 
)

Method for removing elements of the array at a desired position.

If necessary, the array is reallocated to reduce space.

Parametri
thisarray object in which an element has to be removed
[in]nelemnumber of elements to remove, if not provided, a single element is removed
[in]posposition of the element to be removed, if it is out of range, it is clipped, if it is not provided, objects are removed at the end

Definizione alla linea 5632 del file array_utilities.F90.

5637! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
5638! authors:
5639! Davide Cesari <dcesari@arpa.emr.it>
5640! Paolo Patruno <ppatruno@arpa.emr.it>
5641
5642! This program is free software; you can redistribute it and/or
5643! modify it under the terms of the GNU General Public License as
5644! published by the Free Software Foundation; either version 2 of
5645! the License, or (at your option) any later version.
5646
5647! This program is distributed in the hope that it will be useful,
5648! but WITHOUT ANY WARRANTY; without even the implied warranty of
5649! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5650! GNU General Public License for more details.
5651
5652! You should have received a copy of the GNU General Public License
5653! along with this program. If not, see <http://www.gnu.org/licenses/>.
5654
5655
5656
5659#include "config.h"
5660MODULE array_utilities
5661
5662IMPLICIT NONE
5663
5664! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
5665!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
5666
5667#undef VOL7D_POLY_TYPE_AUTO
5668
5669#undef VOL7D_POLY_TYPE
5670#undef VOL7D_POLY_TYPES
5671#define VOL7D_POLY_TYPE INTEGER
5672#define VOL7D_POLY_TYPES _i
5673#define ENABLE_SORT
5674#include "array_utilities_pre.F90"
5675#undef ENABLE_SORT
5676
5677#undef VOL7D_POLY_TYPE
5678#undef VOL7D_POLY_TYPES
5679#define VOL7D_POLY_TYPE REAL
5680#define VOL7D_POLY_TYPES _r
5681#define ENABLE_SORT
5682#include "array_utilities_pre.F90"
5683#undef ENABLE_SORT
5684
5685#undef VOL7D_POLY_TYPE
5686#undef VOL7D_POLY_TYPES
5687#define VOL7D_POLY_TYPE DOUBLEPRECISION
5688#define VOL7D_POLY_TYPES _d
5689#define ENABLE_SORT
5690#include "array_utilities_pre.F90"
5691#undef ENABLE_SORT
5692
5693#define VOL7D_NO_PACK
5694#undef VOL7D_POLY_TYPE
5695#undef VOL7D_POLY_TYPES
5696#define VOL7D_POLY_TYPE CHARACTER(len=*)
5697#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5698#define VOL7D_POLY_TYPES _c
5699#define ENABLE_SORT
5700#include "array_utilities_pre.F90"
5701#undef VOL7D_POLY_TYPE_AUTO
5702#undef ENABLE_SORT
5703
5704
5705#define ARRAYOF_ORIGEQ 1
5706
5707#define ARRAYOF_ORIGTYPE INTEGER
5708#define ARRAYOF_TYPE arrayof_integer
5709#include "arrayof_pre.F90"
5710
5711#undef ARRAYOF_ORIGTYPE
5712#undef ARRAYOF_TYPE
5713#define ARRAYOF_ORIGTYPE REAL
5714#define ARRAYOF_TYPE arrayof_real
5715#include "arrayof_pre.F90"
5716
5717#undef ARRAYOF_ORIGTYPE
5718#undef ARRAYOF_TYPE
5719#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5720#define ARRAYOF_TYPE arrayof_doubleprecision
5721#include "arrayof_pre.F90"
5722
5723#undef ARRAYOF_ORIGEQ
5724
5725#undef ARRAYOF_ORIGTYPE
5726#undef ARRAYOF_TYPE
5727#define ARRAYOF_ORIGTYPE LOGICAL
5728#define ARRAYOF_TYPE arrayof_logical
5729#include "arrayof_pre.F90"
5730
5731PRIVATE
5732! from arrayof
5734PUBLIC insert_unique, append_unique
5735
5736PUBLIC sort, index, index_c, &
5737 count_distinct_sorted, pack_distinct_sorted, &
5738 count_distinct, pack_distinct, count_and_pack_distinct, &
5739 map_distinct, map_inv_distinct, &
5740 firsttrue, lasttrue, pack_distinct_c, map
5741
5742CONTAINS
5743
5744
5747FUNCTION firsttrue(v) RESULT(i)
5748LOGICAL,INTENT(in) :: v(:)
5749INTEGER :: i
5750
5751DO i = 1, SIZE(v)
5752 IF (v(i)) RETURN
5753ENDDO
5754i = 0
5755
5756END FUNCTION firsttrue
5757
5758
5761FUNCTION lasttrue(v) RESULT(i)
5762LOGICAL,INTENT(in) :: v(:)
5763INTEGER :: i
5764
5765DO i = SIZE(v), 1, -1
5766 IF (v(i)) RETURN
5767ENDDO
5768
5769END FUNCTION lasttrue
5770
5771
5772! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
5773#undef VOL7D_POLY_TYPE_AUTO
5774#undef VOL7D_NO_PACK
5775
5776#undef VOL7D_POLY_TYPE
5777#undef VOL7D_POLY_TYPES
5778#define VOL7D_POLY_TYPE INTEGER
5779#define VOL7D_POLY_TYPES _i
5780#define ENABLE_SORT
5781#include "array_utilities_inc.F90"
5782#undef ENABLE_SORT
5783
5784#undef VOL7D_POLY_TYPE
5785#undef VOL7D_POLY_TYPES
5786#define VOL7D_POLY_TYPE REAL
5787#define VOL7D_POLY_TYPES _r
5788#define ENABLE_SORT
5789#include "array_utilities_inc.F90"
5790#undef ENABLE_SORT
5791
5792#undef VOL7D_POLY_TYPE
5793#undef VOL7D_POLY_TYPES
5794#define VOL7D_POLY_TYPE DOUBLEPRECISION
5795#define VOL7D_POLY_TYPES _d
5796#define ENABLE_SORT
5797#include "array_utilities_inc.F90"
5798#undef ENABLE_SORT
5799
5800#define VOL7D_NO_PACK
5801#undef VOL7D_POLY_TYPE
5802#undef VOL7D_POLY_TYPES
5803#define VOL7D_POLY_TYPE CHARACTER(len=*)
5804#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5805#define VOL7D_POLY_TYPES _c
5806#define ENABLE_SORT
5807#include "array_utilities_inc.F90"
5808#undef VOL7D_POLY_TYPE_AUTO
5809#undef ENABLE_SORT
5810
5811SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
5812CHARACTER(len=*),INTENT(in) :: vect(:)
5813LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
5814CHARACTER(len=LEN(vect)) :: pack_distinct(:)
5815
5816INTEGER :: count_distinct
5817INTEGER :: i, j, dim
5818LOGICAL :: lback
5819
5820dim = SIZE(pack_distinct)
5821IF (PRESENT(back)) THEN
5822 lback = back
5823ELSE
5824 lback = .false.
5825ENDIF
5826count_distinct = 0
5827
5828IF (PRESENT (mask)) THEN
5829 IF (lback) THEN
5830 vectm1: DO i = 1, SIZE(vect)
5831 IF (.NOT.mask(i)) cycle vectm1
5832! DO j = i-1, 1, -1
5833! IF (vect(j) == vect(i)) CYCLE vectm1
5834 DO j = count_distinct, 1, -1
5835 IF (pack_distinct(j) == vect(i)) cycle vectm1
5836 ENDDO
5837 count_distinct = count_distinct + 1
5838 IF (count_distinct > dim) EXIT
5839 pack_distinct(count_distinct) = vect(i)
5840 ENDDO vectm1
5841 ELSE
5842 vectm2: DO i = 1, SIZE(vect)
5843 IF (.NOT.mask(i)) cycle vectm2
5844! DO j = 1, i-1
5845! IF (vect(j) == vect(i)) CYCLE vectm2
5846 DO j = 1, count_distinct
5847 IF (pack_distinct(j) == vect(i)) cycle vectm2
5848 ENDDO
5849 count_distinct = count_distinct + 1
5850 IF (count_distinct > dim) EXIT
5851 pack_distinct(count_distinct) = vect(i)
5852 ENDDO vectm2
5853 ENDIF
5854ELSE
5855 IF (lback) THEN
5856 vect1: DO i = 1, SIZE(vect)
5857! DO j = i-1, 1, -1
5858! IF (vect(j) == vect(i)) CYCLE vect1
5859 DO j = count_distinct, 1, -1
5860 IF (pack_distinct(j) == vect(i)) cycle vect1
5861 ENDDO
5862 count_distinct = count_distinct + 1
5863 IF (count_distinct > dim) EXIT
5864 pack_distinct(count_distinct) = vect(i)
5865 ENDDO vect1
5866 ELSE
5867 vect2: DO i = 1, SIZE(vect)
5868! DO j = 1, i-1
5869! IF (vect(j) == vect(i)) CYCLE vect2
5870 DO j = 1, count_distinct
5871 IF (pack_distinct(j) == vect(i)) cycle vect2
5872 ENDDO
5873 count_distinct = count_distinct + 1
5874 IF (count_distinct > dim) EXIT
5875 pack_distinct(count_distinct) = vect(i)
5876 ENDDO vect2
5877 ENDIF
5878ENDIF
5879
5880END SUBROUTINE pack_distinct_c
5881
5883FUNCTION map(mask) RESULT(mapidx)
5884LOGICAL,INTENT(in) :: mask(:)
5885INTEGER :: mapidx(count(mask))
5886
5887INTEGER :: i,j
5888
5889j = 0
5890DO i=1, SIZE(mask)
5891 j = j + 1
5892 IF (mask(i)) mapidx(j)=i
5893ENDDO
5894
5895END FUNCTION map
5896
5897#define ARRAYOF_ORIGEQ 1
5898
5899#undef ARRAYOF_ORIGTYPE
5900#undef ARRAYOF_TYPE
5901#define ARRAYOF_ORIGTYPE INTEGER
5902#define ARRAYOF_TYPE arrayof_integer
5903#include "arrayof_post.F90"
5904
5905#undef ARRAYOF_ORIGTYPE
5906#undef ARRAYOF_TYPE
5907#define ARRAYOF_ORIGTYPE REAL
5908#define ARRAYOF_TYPE arrayof_real
5909#include "arrayof_post.F90"
5910
5911#undef ARRAYOF_ORIGTYPE
5912#undef ARRAYOF_TYPE
5913#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5914#define ARRAYOF_TYPE arrayof_doubleprecision
5915#include "arrayof_post.F90"
5916
5917#undef ARRAYOF_ORIGEQ
5918
5919#undef ARRAYOF_ORIGTYPE
5920#undef ARRAYOF_TYPE
5921#define ARRAYOF_ORIGTYPE LOGICAL
5922#define ARRAYOF_TYPE arrayof_logical
5923#include "arrayof_post.F90"
5924
5925END 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.