libsim Versione 7.1.11
|
◆ arrayof_integer_insert_unique()
Method for inserting an element of the array at a desired position only if it is not present in the array yet. If necessary, the array is reallocated to accomodate the new element.
Definizione alla linea 5596 del file array_utilities.F90. 5597! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
5598! authors:
5599! Davide Cesari <dcesari@arpa.emr.it>
5600! Paolo Patruno <ppatruno@arpa.emr.it>
5601
5602! This program is free software; you can redistribute it and/or
5603! modify it under the terms of the GNU General Public License as
5604! published by the Free Software Foundation; either version 2 of
5605! the License, or (at your option) any later version.
5606
5607! This program is distributed in the hope that it will be useful,
5608! but WITHOUT ANY WARRANTY; without even the implied warranty of
5609! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5610! GNU General Public License for more details.
5611
5612! You should have received a copy of the GNU General Public License
5613! along with this program. If not, see <http://www.gnu.org/licenses/>.
5614
5615
5616
5619#include "config.h"
5621
5622IMPLICIT NONE
5623
5624! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
5625!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
5626
5627#undef VOL7D_POLY_TYPE_AUTO
5628
5629#undef VOL7D_POLY_TYPE
5630#undef VOL7D_POLY_TYPES
5631#define VOL7D_POLY_TYPE INTEGER
5632#define VOL7D_POLY_TYPES _i
5633#define ENABLE_SORT
5634#include "array_utilities_pre.F90"
5635#undef ENABLE_SORT
5636
5637#undef VOL7D_POLY_TYPE
5638#undef VOL7D_POLY_TYPES
5639#define VOL7D_POLY_TYPE REAL
5640#define VOL7D_POLY_TYPES _r
5641#define ENABLE_SORT
5642#include "array_utilities_pre.F90"
5643#undef ENABLE_SORT
5644
5645#undef VOL7D_POLY_TYPE
5646#undef VOL7D_POLY_TYPES
5647#define VOL7D_POLY_TYPE DOUBLEPRECISION
5648#define VOL7D_POLY_TYPES _d
5649#define ENABLE_SORT
5650#include "array_utilities_pre.F90"
5651#undef ENABLE_SORT
5652
5653#define VOL7D_NO_PACK
5654#undef VOL7D_POLY_TYPE
5655#undef VOL7D_POLY_TYPES
5656#define VOL7D_POLY_TYPE CHARACTER(len=*)
5657#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5658#define VOL7D_POLY_TYPES _c
5659#define ENABLE_SORT
5660#include "array_utilities_pre.F90"
5661#undef VOL7D_POLY_TYPE_AUTO
5662#undef ENABLE_SORT
5663
5664
5665#define ARRAYOF_ORIGEQ 1
5666
5667#define ARRAYOF_ORIGTYPE INTEGER
5668#define ARRAYOF_TYPE arrayof_integer
5669#include "arrayof_pre.F90"
5670
5671#undef ARRAYOF_ORIGTYPE
5672#undef ARRAYOF_TYPE
5673#define ARRAYOF_ORIGTYPE REAL
5674#define ARRAYOF_TYPE arrayof_real
5675#include "arrayof_pre.F90"
5676
5677#undef ARRAYOF_ORIGTYPE
5678#undef ARRAYOF_TYPE
5679#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5680#define ARRAYOF_TYPE arrayof_doubleprecision
5681#include "arrayof_pre.F90"
5682
5683#undef ARRAYOF_ORIGEQ
5684
5685#undef ARRAYOF_ORIGTYPE
5686#undef ARRAYOF_TYPE
5687#define ARRAYOF_ORIGTYPE LOGICAL
5688#define ARRAYOF_TYPE arrayof_logical
5689#include "arrayof_pre.F90"
5690
5691PRIVATE
5692! from arrayof
5694PUBLIC insert_unique, append_unique
5695
5697 count_distinct_sorted, pack_distinct_sorted, &
5698 count_distinct, pack_distinct, count_and_pack_distinct, &
5699 map_distinct, map_inv_distinct, &
5700 firsttrue, lasttrue, pack_distinct_c, map
5701
5702CONTAINS
5703
5704
5707FUNCTION firsttrue(v) RESULT(i)
5708LOGICAL,INTENT(in) :: v(:)
5709INTEGER :: i
5710
5711DO i = 1, SIZE(v)
5712 IF (v(i)) RETURN
5713ENDDO
5714i = 0
5715
5716END FUNCTION firsttrue
5717
5718
5721FUNCTION lasttrue(v) RESULT(i)
5722LOGICAL,INTENT(in) :: v(:)
5723INTEGER :: i
5724
5725DO i = SIZE(v), 1, -1
5726 IF (v(i)) RETURN
5727ENDDO
5728
5729END FUNCTION lasttrue
5730
5731
5732! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
5733#undef VOL7D_POLY_TYPE_AUTO
5734#undef VOL7D_NO_PACK
5735
5736#undef VOL7D_POLY_TYPE
5737#undef VOL7D_POLY_TYPES
5738#define VOL7D_POLY_TYPE INTEGER
5739#define VOL7D_POLY_TYPES _i
5740#define ENABLE_SORT
5741#include "array_utilities_inc.F90"
5742#undef ENABLE_SORT
5743
5744#undef VOL7D_POLY_TYPE
5745#undef VOL7D_POLY_TYPES
5746#define VOL7D_POLY_TYPE REAL
5747#define VOL7D_POLY_TYPES _r
5748#define ENABLE_SORT
5749#include "array_utilities_inc.F90"
5750#undef ENABLE_SORT
5751
5752#undef VOL7D_POLY_TYPE
5753#undef VOL7D_POLY_TYPES
5754#define VOL7D_POLY_TYPE DOUBLEPRECISION
5755#define VOL7D_POLY_TYPES _d
5756#define ENABLE_SORT
5757#include "array_utilities_inc.F90"
5758#undef ENABLE_SORT
5759
5760#define VOL7D_NO_PACK
5761#undef VOL7D_POLY_TYPE
5762#undef VOL7D_POLY_TYPES
5763#define VOL7D_POLY_TYPE CHARACTER(len=*)
5764#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5765#define VOL7D_POLY_TYPES _c
5766#define ENABLE_SORT
5767#include "array_utilities_inc.F90"
5768#undef VOL7D_POLY_TYPE_AUTO
5769#undef ENABLE_SORT
5770
5771SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
5772CHARACTER(len=*),INTENT(in) :: vect(:)
5773LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
5774CHARACTER(len=LEN(vect)) :: pack_distinct(:)
5775
5776INTEGER :: count_distinct
5777INTEGER :: i, j, dim
5778LOGICAL :: lback
5779
5780dim = SIZE(pack_distinct)
5781IF (PRESENT(back)) THEN
5782 lback = back
5783ELSE
5784 lback = .false.
5785ENDIF
5786count_distinct = 0
5787
5788IF (PRESENT (mask)) THEN
5789 IF (lback) THEN
5790 vectm1: DO i = 1, SIZE(vect)
5791 IF (.NOT.mask(i)) cycle vectm1
5792! DO j = i-1, 1, -1
5793! IF (vect(j) == vect(i)) CYCLE vectm1
5794 DO j = count_distinct, 1, -1
5795 IF (pack_distinct(j) == vect(i)) cycle vectm1
5796 ENDDO
5797 count_distinct = count_distinct + 1
5798 IF (count_distinct > dim) EXIT
5799 pack_distinct(count_distinct) = vect(i)
5800 ENDDO vectm1
5801 ELSE
5802 vectm2: DO i = 1, SIZE(vect)
5803 IF (.NOT.mask(i)) cycle vectm2
5804! DO j = 1, i-1
5805! IF (vect(j) == vect(i)) CYCLE vectm2
5806 DO j = 1, count_distinct
5807 IF (pack_distinct(j) == vect(i)) cycle vectm2
5808 ENDDO
5809 count_distinct = count_distinct + 1
5810 IF (count_distinct > dim) EXIT
5811 pack_distinct(count_distinct) = vect(i)
5812 ENDDO vectm2
5813 ENDIF
5814ELSE
5815 IF (lback) THEN
5816 vect1: DO i = 1, SIZE(vect)
5817! DO j = i-1, 1, -1
5818! IF (vect(j) == vect(i)) CYCLE vect1
5819 DO j = count_distinct, 1, -1
5820 IF (pack_distinct(j) == vect(i)) cycle vect1
5821 ENDDO
5822 count_distinct = count_distinct + 1
5823 IF (count_distinct > dim) EXIT
5824 pack_distinct(count_distinct) = vect(i)
5825 ENDDO vect1
5826 ELSE
5827 vect2: DO i = 1, SIZE(vect)
5828! DO j = 1, i-1
5829! IF (vect(j) == vect(i)) CYCLE vect2
5830 DO j = 1, count_distinct
5831 IF (pack_distinct(j) == vect(i)) cycle vect2
5832 ENDDO
5833 count_distinct = count_distinct + 1
5834 IF (count_distinct > dim) EXIT
5835 pack_distinct(count_distinct) = vect(i)
5836 ENDDO vect2
5837 ENDIF
5838ENDIF
5839
5840END SUBROUTINE pack_distinct_c
5841
5843FUNCTION map(mask) RESULT(mapidx)
5844LOGICAL,INTENT(in) :: mask(:)
5845INTEGER :: mapidx(count(mask))
5846
5847INTEGER :: i,j
5848
5849j = 0
5850DO i=1, SIZE(mask)
5851 j = j + 1
5852 IF (mask(i)) mapidx(j)=i
5853ENDDO
5854
5855END FUNCTION map
5856
5857#define ARRAYOF_ORIGEQ 1
5858
5859#undef ARRAYOF_ORIGTYPE
5860#undef ARRAYOF_TYPE
5861#define ARRAYOF_ORIGTYPE INTEGER
5862#define ARRAYOF_TYPE arrayof_integer
5863#include "arrayof_post.F90"
5864
5865#undef ARRAYOF_ORIGTYPE
5866#undef ARRAYOF_TYPE
5867#define ARRAYOF_ORIGTYPE REAL
5868#define ARRAYOF_TYPE arrayof_real
5869#include "arrayof_post.F90"
5870
5871#undef ARRAYOF_ORIGTYPE
5872#undef ARRAYOF_TYPE
5873#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5874#define ARRAYOF_TYPE arrayof_doubleprecision
5875#include "arrayof_post.F90"
5876
5877#undef ARRAYOF_ORIGEQ
5878
5879#undef ARRAYOF_ORIGTYPE
5880#undef ARRAYOF_TYPE
5881#define ARRAYOF_ORIGTYPE LOGICAL
5882#define ARRAYOF_TYPE arrayof_logical
5883#include "arrayof_post.F90"
5884
Quick method to append an element to the array. Definition: array_utilities.F90:514 Destructor for finalizing an array object. Definition: array_utilities.F90:527 Method for inserting elements of the array at a desired position. Definition: array_utilities.F90:505 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition: array_utilities.F90:537 Method for removing elements of the array at a desired position. Definition: array_utilities.F90:520 This module defines usefull general purpose function and subroutine. Definition: array_utilities.F90:218 |