libsim Versione 7.1.11
|
◆ arrayof_real_remove()
Method for removing elements of the array at a desired position. If necessary, the array is reallocated to reduce space.
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"
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
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
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 |