libsim Versione 7.1.11

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

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