libsim Versione 7.2.1
|
◆ 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 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"
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
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
Quick method to append an element to the array. Definition array_utilities.F90:508 Method for inserting elements of the array at a desired position. Definition array_utilities.F90:499 Method for packing the array object reducing at a minimum the memory occupation, without destroying i... Definition array_utilities.F90:531 Method for removing elements of the array at a desired position. Definition array_utilities.F90:514 This module defines usefull general purpose function and subroutine. Definition array_utilities.F90:212 |