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