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