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