libsim Versione 7.1.11

◆ arrayof_real_append_unique()

integer function, private arrayof_real_append_unique ( type(arrayof_real this,
real, intent(in)  content 
)
private

Quick function to append an element to the array only if it is not present in the array yet.

The return value is the position at which the element has been appended or at which it has been found.

Parametri
thisarray object to extend
[in]contentobject of TYPE REAL to append

Definizione alla linea 5897 del file array_utilities.F90.

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