libsim Versione 7.1.11

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

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