libsim Versione 7.1.11
|
◆ 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 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"
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
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
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 |