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