libsim Versione 7.2.1

◆ arrayof_real_insert_array()

subroutine, private arrayof_real_insert_array ( type(arrayof_real) this,
real, dimension(:), intent(in), optional content,
integer, intent(in), optional nelem,
integer, intent(in), optional pos )
private

Method for inserting a number of elements of the array at a desired position.

If necessary, the array is reallocated to accomodate the new elements.

Parametri
thisarray object to extend
[in]contentobject of TYPE REAL to insert, if not provided, space is reserved but not initialized
[in]nelemnumber of elements to add, mutually exclusive with the previous parameter, if both are not provided, a single element is added without initialization
[in]posposition where to insert, if it is out of range, it is clipped, if it is not provided, the object is appended

Definizione alla linea 5801 del file array_utilities.F90.

5802! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
5803! authors:
5804! Davide Cesari <dcesari@arpa.emr.it>
5805! Paolo Patruno <ppatruno@arpa.emr.it>
5806
5807! This program is free software; you can redistribute it and/or
5808! modify it under the terms of the GNU General Public License as
5809! published by the Free Software Foundation; either version 2 of
5810! the License, or (at your option) any later version.
5811
5812! This program is distributed in the hope that it will be useful,
5813! but WITHOUT ANY WARRANTY; without even the implied warranty of
5814! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5815! GNU General Public License for more details.
5816
5817! You should have received a copy of the GNU General Public License
5818! along with this program. If not, see <http://www.gnu.org/licenses/>.
5819
5820
5821
5824#include "config.h"
5825MODULE array_utilities
5826
5827IMPLICIT NONE
5828
5829! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
5830!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
5831
5832#undef VOL7D_POLY_TYPE_AUTO
5833
5834#undef VOL7D_POLY_TYPE
5835#undef VOL7D_POLY_TYPES
5836#define VOL7D_POLY_TYPE INTEGER
5837#define VOL7D_POLY_TYPES _i
5838#define ENABLE_SORT
5839#include "array_utilities_pre.F90"
5840#undef ENABLE_SORT
5841
5842#undef VOL7D_POLY_TYPE
5843#undef VOL7D_POLY_TYPES
5844#define VOL7D_POLY_TYPE REAL
5845#define VOL7D_POLY_TYPES _r
5846#define ENABLE_SORT
5847#include "array_utilities_pre.F90"
5848#undef ENABLE_SORT
5849
5850#undef VOL7D_POLY_TYPE
5851#undef VOL7D_POLY_TYPES
5852#define VOL7D_POLY_TYPE DOUBLEPRECISION
5853#define VOL7D_POLY_TYPES _d
5854#define ENABLE_SORT
5855#include "array_utilities_pre.F90"
5856#undef ENABLE_SORT
5857
5858#define VOL7D_NO_PACK
5859#undef VOL7D_POLY_TYPE
5860#undef VOL7D_POLY_TYPES
5861#define VOL7D_POLY_TYPE CHARACTER(len=*)
5862#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5863#define VOL7D_POLY_TYPES _c
5864#define ENABLE_SORT
5865#include "array_utilities_pre.F90"
5866#undef VOL7D_POLY_TYPE_AUTO
5867#undef ENABLE_SORT
5868
5869
5870#define ARRAYOF_ORIGEQ 1
5871
5872#define ARRAYOF_ORIGTYPE INTEGER
5873#define ARRAYOF_TYPE arrayof_integer
5874#include "arrayof_pre.F90"
5875
5876#undef ARRAYOF_ORIGTYPE
5877#undef ARRAYOF_TYPE
5878#define ARRAYOF_ORIGTYPE REAL
5879#define ARRAYOF_TYPE arrayof_real
5880#include "arrayof_pre.F90"
5881
5882#undef ARRAYOF_ORIGTYPE
5883#undef ARRAYOF_TYPE
5884#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5885#define ARRAYOF_TYPE arrayof_doubleprecision
5886#include "arrayof_pre.F90"
5887
5888#undef ARRAYOF_ORIGEQ
5889
5890#undef ARRAYOF_ORIGTYPE
5891#undef ARRAYOF_TYPE
5892#define ARRAYOF_ORIGTYPE LOGICAL
5893#define ARRAYOF_TYPE arrayof_logical
5894#include "arrayof_pre.F90"
5895
5896PRIVATE
5897! from arrayof
5899PUBLIC insert_unique, append_unique
5900
5901PUBLIC sort, index, index_c, &
5902 count_distinct_sorted, pack_distinct_sorted, &
5903 count_distinct, pack_distinct, count_and_pack_distinct, &
5904 map_distinct, map_inv_distinct, &
5905 firsttrue, lasttrue, pack_distinct_c, map
5906
5907CONTAINS
5908
5909
5912FUNCTION firsttrue(v) RESULT(i)
5913LOGICAL,INTENT(in) :: v(:)
5914INTEGER :: i
5915
5916DO i = 1, SIZE(v)
5917 IF (v(i)) RETURN
5918ENDDO
5919i = 0
5920
5921END FUNCTION firsttrue
5922
5923
5926FUNCTION lasttrue(v) RESULT(i)
5927LOGICAL,INTENT(in) :: v(:)
5928INTEGER :: i
5929
5930DO i = SIZE(v), 1, -1
5931 IF (v(i)) RETURN
5932ENDDO
5933
5934END FUNCTION lasttrue
5935
5936
5937! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
5938#undef VOL7D_POLY_TYPE_AUTO
5939#undef VOL7D_NO_PACK
5940
5941#undef VOL7D_POLY_TYPE
5942#undef VOL7D_POLY_TYPES
5943#define VOL7D_POLY_TYPE INTEGER
5944#define VOL7D_POLY_TYPES _i
5945#define ENABLE_SORT
5946#include "array_utilities_inc.F90"
5947#undef ENABLE_SORT
5948
5949#undef VOL7D_POLY_TYPE
5950#undef VOL7D_POLY_TYPES
5951#define VOL7D_POLY_TYPE REAL
5952#define VOL7D_POLY_TYPES _r
5953#define ENABLE_SORT
5954#include "array_utilities_inc.F90"
5955#undef ENABLE_SORT
5956
5957#undef VOL7D_POLY_TYPE
5958#undef VOL7D_POLY_TYPES
5959#define VOL7D_POLY_TYPE DOUBLEPRECISION
5960#define VOL7D_POLY_TYPES _d
5961#define ENABLE_SORT
5962#include "array_utilities_inc.F90"
5963#undef ENABLE_SORT
5964
5965#define VOL7D_NO_PACK
5966#undef VOL7D_POLY_TYPE
5967#undef VOL7D_POLY_TYPES
5968#define VOL7D_POLY_TYPE CHARACTER(len=*)
5969#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5970#define VOL7D_POLY_TYPES _c
5971#define ENABLE_SORT
5972#include "array_utilities_inc.F90"
5973#undef VOL7D_POLY_TYPE_AUTO
5974#undef ENABLE_SORT
5975
5976SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
5977CHARACTER(len=*),INTENT(in) :: vect(:)
5978LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
5979CHARACTER(len=LEN(vect)) :: pack_distinct(:)
5980
5981INTEGER :: count_distinct
5982INTEGER :: i, j, dim
5983LOGICAL :: lback
5984
5985dim = SIZE(pack_distinct)
5986IF (PRESENT(back)) THEN
5987 lback = back
5988ELSE
5989 lback = .false.
5990ENDIF
5991count_distinct = 0
5992
5993IF (PRESENT (mask)) THEN
5994 IF (lback) THEN
5995 vectm1: DO i = 1, SIZE(vect)
5996 IF (.NOT.mask(i)) cycle vectm1
5997! DO j = i-1, 1, -1
5998! IF (vect(j) == vect(i)) CYCLE vectm1
5999 DO j = count_distinct, 1, -1
6000 IF (pack_distinct(j) == vect(i)) cycle vectm1
6001 ENDDO
6002 count_distinct = count_distinct + 1
6003 IF (count_distinct > dim) EXIT
6004 pack_distinct(count_distinct) = vect(i)
6005 ENDDO vectm1
6006 ELSE
6007 vectm2: DO i = 1, SIZE(vect)
6008 IF (.NOT.mask(i)) cycle vectm2
6009! DO j = 1, i-1
6010! IF (vect(j) == vect(i)) CYCLE vectm2
6011 DO j = 1, count_distinct
6012 IF (pack_distinct(j) == vect(i)) cycle vectm2
6013 ENDDO
6014 count_distinct = count_distinct + 1
6015 IF (count_distinct > dim) EXIT
6016 pack_distinct(count_distinct) = vect(i)
6017 ENDDO vectm2
6018 ENDIF
6019ELSE
6020 IF (lback) THEN
6021 vect1: DO i = 1, SIZE(vect)
6022! DO j = i-1, 1, -1
6023! IF (vect(j) == vect(i)) CYCLE vect1
6024 DO j = count_distinct, 1, -1
6025 IF (pack_distinct(j) == vect(i)) cycle vect1
6026 ENDDO
6027 count_distinct = count_distinct + 1
6028 IF (count_distinct > dim) EXIT
6029 pack_distinct(count_distinct) = vect(i)
6030 ENDDO vect1
6031 ELSE
6032 vect2: DO i = 1, SIZE(vect)
6033! DO j = 1, i-1
6034! IF (vect(j) == vect(i)) CYCLE vect2
6035 DO j = 1, count_distinct
6036 IF (pack_distinct(j) == vect(i)) cycle vect2
6037 ENDDO
6038 count_distinct = count_distinct + 1
6039 IF (count_distinct > dim) EXIT
6040 pack_distinct(count_distinct) = vect(i)
6041 ENDDO vect2
6042 ENDIF
6043ENDIF
6044
6045END SUBROUTINE pack_distinct_c
6046
6048FUNCTION map(mask) RESULT(mapidx)
6049LOGICAL,INTENT(in) :: mask(:)
6050INTEGER :: mapidx(count(mask))
6051
6052INTEGER :: i,j
6053
6054j = 0
6055DO i=1, SIZE(mask)
6056 j = j + 1
6057 IF (mask(i)) mapidx(j)=i
6058ENDDO
6059
6060END FUNCTION map
6061
6062#define ARRAYOF_ORIGEQ 1
6063
6064#undef ARRAYOF_ORIGTYPE
6065#undef ARRAYOF_TYPE
6066#define ARRAYOF_ORIGTYPE INTEGER
6067#define ARRAYOF_TYPE arrayof_integer
6068#include "arrayof_post.F90"
6069
6070#undef ARRAYOF_ORIGTYPE
6071#undef ARRAYOF_TYPE
6072#define ARRAYOF_ORIGTYPE REAL
6073#define ARRAYOF_TYPE arrayof_real
6074#include "arrayof_post.F90"
6075
6076#undef ARRAYOF_ORIGTYPE
6077#undef ARRAYOF_TYPE
6078#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6079#define ARRAYOF_TYPE arrayof_doubleprecision
6080#include "arrayof_post.F90"
6081
6082#undef ARRAYOF_ORIGEQ
6083
6084#undef ARRAYOF_ORIGTYPE
6085#undef ARRAYOF_TYPE
6086#define ARRAYOF_ORIGTYPE LOGICAL
6087#define ARRAYOF_TYPE arrayof_logical
6088#include "arrayof_post.F90"
6089
6090END MODULE array_utilities
Quick method to append an element to the array.
Destructor for finalizing an array object.
Method for inserting elements of the array at a desired position.
Method for packing the array object reducing at a minimum the memory occupation, without destroying i...
Method for removing elements of the array at a desired position.
Index method.
This module defines usefull general purpose function and subroutine.

Generated with Doxygen.