libsim Versione 7.2.1

◆ arrayof_real_remove()

subroutine, private arrayof_real_remove ( type(arrayof_real) this,
integer, intent(in), optional nelem,
integer, intent(in), optional pos )
private

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

5918! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
5919! authors:
5920! Davide Cesari <dcesari@arpa.emr.it>
5921! Paolo Patruno <ppatruno@arpa.emr.it>
5922
5923! This program is free software; you can redistribute it and/or
5924! modify it under the terms of the GNU General Public License as
5925! published by the Free Software Foundation; either version 2 of
5926! the License, or (at your option) any later version.
5927
5928! This program is distributed in the hope that it will be useful,
5929! but WITHOUT ANY WARRANTY; without even the implied warranty of
5930! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5931! GNU General Public License for more details.
5932
5933! You should have received a copy of the GNU General Public License
5934! along with this program. If not, see <http://www.gnu.org/licenses/>.
5935
5936
5937
5940#include "config.h"
5941MODULE array_utilities
5942
5943IMPLICIT NONE
5944
5945! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
5946!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
5947
5948#undef VOL7D_POLY_TYPE_AUTO
5949
5950#undef VOL7D_POLY_TYPE
5951#undef VOL7D_POLY_TYPES
5952#define VOL7D_POLY_TYPE INTEGER
5953#define VOL7D_POLY_TYPES _i
5954#define ENABLE_SORT
5955#include "array_utilities_pre.F90"
5956#undef ENABLE_SORT
5957
5958#undef VOL7D_POLY_TYPE
5959#undef VOL7D_POLY_TYPES
5960#define VOL7D_POLY_TYPE REAL
5961#define VOL7D_POLY_TYPES _r
5962#define ENABLE_SORT
5963#include "array_utilities_pre.F90"
5964#undef ENABLE_SORT
5965
5966#undef VOL7D_POLY_TYPE
5967#undef VOL7D_POLY_TYPES
5968#define VOL7D_POLY_TYPE DOUBLEPRECISION
5969#define VOL7D_POLY_TYPES _d
5970#define ENABLE_SORT
5971#include "array_utilities_pre.F90"
5972#undef ENABLE_SORT
5973
5974#define VOL7D_NO_PACK
5975#undef VOL7D_POLY_TYPE
5976#undef VOL7D_POLY_TYPES
5977#define VOL7D_POLY_TYPE CHARACTER(len=*)
5978#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5979#define VOL7D_POLY_TYPES _c
5980#define ENABLE_SORT
5981#include "array_utilities_pre.F90"
5982#undef VOL7D_POLY_TYPE_AUTO
5983#undef ENABLE_SORT
5984
5985
5986#define ARRAYOF_ORIGEQ 1
5987
5988#define ARRAYOF_ORIGTYPE INTEGER
5989#define ARRAYOF_TYPE arrayof_integer
5990#include "arrayof_pre.F90"
5991
5992#undef ARRAYOF_ORIGTYPE
5993#undef ARRAYOF_TYPE
5994#define ARRAYOF_ORIGTYPE REAL
5995#define ARRAYOF_TYPE arrayof_real
5996#include "arrayof_pre.F90"
5997
5998#undef ARRAYOF_ORIGTYPE
5999#undef ARRAYOF_TYPE
6000#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6001#define ARRAYOF_TYPE arrayof_doubleprecision
6002#include "arrayof_pre.F90"
6003
6004#undef ARRAYOF_ORIGEQ
6005
6006#undef ARRAYOF_ORIGTYPE
6007#undef ARRAYOF_TYPE
6008#define ARRAYOF_ORIGTYPE LOGICAL
6009#define ARRAYOF_TYPE arrayof_logical
6010#include "arrayof_pre.F90"
6011
6012PRIVATE
6013! from arrayof
6015PUBLIC insert_unique, append_unique
6016
6017PUBLIC sort, index, index_c, &
6018 count_distinct_sorted, pack_distinct_sorted, &
6019 count_distinct, pack_distinct, count_and_pack_distinct, &
6020 map_distinct, map_inv_distinct, &
6021 firsttrue, lasttrue, pack_distinct_c, map
6022
6023CONTAINS
6024
6025
6028FUNCTION firsttrue(v) RESULT(i)
6029LOGICAL,INTENT(in) :: v(:)
6030INTEGER :: i
6031
6032DO i = 1, SIZE(v)
6033 IF (v(i)) RETURN
6034ENDDO
6035i = 0
6036
6037END FUNCTION firsttrue
6038
6039
6042FUNCTION lasttrue(v) RESULT(i)
6043LOGICAL,INTENT(in) :: v(:)
6044INTEGER :: i
6045
6046DO i = SIZE(v), 1, -1
6047 IF (v(i)) RETURN
6048ENDDO
6049
6050END FUNCTION lasttrue
6051
6052
6053! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6054#undef VOL7D_POLY_TYPE_AUTO
6055#undef VOL7D_NO_PACK
6056
6057#undef VOL7D_POLY_TYPE
6058#undef VOL7D_POLY_TYPES
6059#define VOL7D_POLY_TYPE INTEGER
6060#define VOL7D_POLY_TYPES _i
6061#define ENABLE_SORT
6062#include "array_utilities_inc.F90"
6063#undef ENABLE_SORT
6064
6065#undef VOL7D_POLY_TYPE
6066#undef VOL7D_POLY_TYPES
6067#define VOL7D_POLY_TYPE REAL
6068#define VOL7D_POLY_TYPES _r
6069#define ENABLE_SORT
6070#include "array_utilities_inc.F90"
6071#undef ENABLE_SORT
6072
6073#undef VOL7D_POLY_TYPE
6074#undef VOL7D_POLY_TYPES
6075#define VOL7D_POLY_TYPE DOUBLEPRECISION
6076#define VOL7D_POLY_TYPES _d
6077#define ENABLE_SORT
6078#include "array_utilities_inc.F90"
6079#undef ENABLE_SORT
6080
6081#define VOL7D_NO_PACK
6082#undef VOL7D_POLY_TYPE
6083#undef VOL7D_POLY_TYPES
6084#define VOL7D_POLY_TYPE CHARACTER(len=*)
6085#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6086#define VOL7D_POLY_TYPES _c
6087#define ENABLE_SORT
6088#include "array_utilities_inc.F90"
6089#undef VOL7D_POLY_TYPE_AUTO
6090#undef ENABLE_SORT
6091
6092SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6093CHARACTER(len=*),INTENT(in) :: vect(:)
6094LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6095CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6096
6097INTEGER :: count_distinct
6098INTEGER :: i, j, dim
6099LOGICAL :: lback
6100
6101dim = SIZE(pack_distinct)
6102IF (PRESENT(back)) THEN
6103 lback = back
6104ELSE
6105 lback = .false.
6106ENDIF
6107count_distinct = 0
6108
6109IF (PRESENT (mask)) THEN
6110 IF (lback) THEN
6111 vectm1: DO i = 1, SIZE(vect)
6112 IF (.NOT.mask(i)) cycle vectm1
6113! DO j = i-1, 1, -1
6114! IF (vect(j) == vect(i)) CYCLE vectm1
6115 DO j = count_distinct, 1, -1
6116 IF (pack_distinct(j) == vect(i)) cycle vectm1
6117 ENDDO
6118 count_distinct = count_distinct + 1
6119 IF (count_distinct > dim) EXIT
6120 pack_distinct(count_distinct) = vect(i)
6121 ENDDO vectm1
6122 ELSE
6123 vectm2: DO i = 1, SIZE(vect)
6124 IF (.NOT.mask(i)) cycle vectm2
6125! DO j = 1, i-1
6126! IF (vect(j) == vect(i)) CYCLE vectm2
6127 DO j = 1, count_distinct
6128 IF (pack_distinct(j) == vect(i)) cycle vectm2
6129 ENDDO
6130 count_distinct = count_distinct + 1
6131 IF (count_distinct > dim) EXIT
6132 pack_distinct(count_distinct) = vect(i)
6133 ENDDO vectm2
6134 ENDIF
6135ELSE
6136 IF (lback) THEN
6137 vect1: DO i = 1, SIZE(vect)
6138! DO j = i-1, 1, -1
6139! IF (vect(j) == vect(i)) CYCLE vect1
6140 DO j = count_distinct, 1, -1
6141 IF (pack_distinct(j) == vect(i)) cycle vect1
6142 ENDDO
6143 count_distinct = count_distinct + 1
6144 IF (count_distinct > dim) EXIT
6145 pack_distinct(count_distinct) = vect(i)
6146 ENDDO vect1
6147 ELSE
6148 vect2: DO i = 1, SIZE(vect)
6149! DO j = 1, i-1
6150! IF (vect(j) == vect(i)) CYCLE vect2
6151 DO j = 1, count_distinct
6152 IF (pack_distinct(j) == vect(i)) cycle vect2
6153 ENDDO
6154 count_distinct = count_distinct + 1
6155 IF (count_distinct > dim) EXIT
6156 pack_distinct(count_distinct) = vect(i)
6157 ENDDO vect2
6158 ENDIF
6159ENDIF
6160
6161END SUBROUTINE pack_distinct_c
6162
6164FUNCTION map(mask) RESULT(mapidx)
6165LOGICAL,INTENT(in) :: mask(:)
6166INTEGER :: mapidx(count(mask))
6167
6168INTEGER :: i,j
6169
6170j = 0
6171DO i=1, SIZE(mask)
6172 j = j + 1
6173 IF (mask(i)) mapidx(j)=i
6174ENDDO
6175
6176END FUNCTION map
6177
6178#define ARRAYOF_ORIGEQ 1
6179
6180#undef ARRAYOF_ORIGTYPE
6181#undef ARRAYOF_TYPE
6182#define ARRAYOF_ORIGTYPE INTEGER
6183#define ARRAYOF_TYPE arrayof_integer
6184#include "arrayof_post.F90"
6185
6186#undef ARRAYOF_ORIGTYPE
6187#undef ARRAYOF_TYPE
6188#define ARRAYOF_ORIGTYPE REAL
6189#define ARRAYOF_TYPE arrayof_real
6190#include "arrayof_post.F90"
6191
6192#undef ARRAYOF_ORIGTYPE
6193#undef ARRAYOF_TYPE
6194#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6195#define ARRAYOF_TYPE arrayof_doubleprecision
6196#include "arrayof_post.F90"
6197
6198#undef ARRAYOF_ORIGEQ
6199
6200#undef ARRAYOF_ORIGTYPE
6201#undef ARRAYOF_TYPE
6202#define ARRAYOF_ORIGTYPE LOGICAL
6203#define ARRAYOF_TYPE arrayof_logical
6204#include "arrayof_post.F90"
6205
6206END 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.