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