libsim Versione 7.2.0
|
◆ arrayof_integer_remove()
Method for removing elements of the array at a desired position. If necessary, the array is reallocated to reduce space.
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"
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
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
Quick method to append an element to the array. Definition: array_utilities.F90:508 Destructor for finalizing an array object. Definition: array_utilities.F90:521 Method for inserting elements of the array at a desired position. Definition: array_utilities.F90:499 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: array_utilities.F90:531 Method for removing elements of the array at a desired position. Definition: array_utilities.F90:514 This module defines usefull general purpose function and subroutine. Definition: array_utilities.F90:212 |