libsim Versione 7.2.1

◆ arrayof_doubleprecision_insert_array()

subroutine arrayof_doubleprecision_insert_array ( type(arrayof_doubleprecision this,
doubleprecision, dimension(:), intent(in), optional  content,
integer, intent(in), optional  nelem,
integer, intent(in), optional  pos 
)

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 DOUBLEPRECISION 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 6082 del file array_utilities.F90.

6083! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6084! authors:
6085! Davide Cesari <dcesari@arpa.emr.it>
6086! Paolo Patruno <ppatruno@arpa.emr.it>
6087
6088! This program is free software; you can redistribute it and/or
6089! modify it under the terms of the GNU General Public License as
6090! published by the Free Software Foundation; either version 2 of
6091! the License, or (at your option) any later version.
6092
6093! This program is distributed in the hope that it will be useful,
6094! but WITHOUT ANY WARRANTY; without even the implied warranty of
6095! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6096! GNU General Public License for more details.
6097
6098! You should have received a copy of the GNU General Public License
6099! along with this program. If not, see <http://www.gnu.org/licenses/>.
6100
6101
6102
6105#include "config.h"
6106MODULE array_utilities
6107
6108IMPLICIT NONE
6109
6110! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6111!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6112
6113#undef VOL7D_POLY_TYPE_AUTO
6114
6115#undef VOL7D_POLY_TYPE
6116#undef VOL7D_POLY_TYPES
6117#define VOL7D_POLY_TYPE INTEGER
6118#define VOL7D_POLY_TYPES _i
6119#define ENABLE_SORT
6120#include "array_utilities_pre.F90"
6121#undef ENABLE_SORT
6122
6123#undef VOL7D_POLY_TYPE
6124#undef VOL7D_POLY_TYPES
6125#define VOL7D_POLY_TYPE REAL
6126#define VOL7D_POLY_TYPES _r
6127#define ENABLE_SORT
6128#include "array_utilities_pre.F90"
6129#undef ENABLE_SORT
6130
6131#undef VOL7D_POLY_TYPE
6132#undef VOL7D_POLY_TYPES
6133#define VOL7D_POLY_TYPE DOUBLEPRECISION
6134#define VOL7D_POLY_TYPES _d
6135#define ENABLE_SORT
6136#include "array_utilities_pre.F90"
6137#undef ENABLE_SORT
6138
6139#define VOL7D_NO_PACK
6140#undef VOL7D_POLY_TYPE
6141#undef VOL7D_POLY_TYPES
6142#define VOL7D_POLY_TYPE CHARACTER(len=*)
6143#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6144#define VOL7D_POLY_TYPES _c
6145#define ENABLE_SORT
6146#include "array_utilities_pre.F90"
6147#undef VOL7D_POLY_TYPE_AUTO
6148#undef ENABLE_SORT
6149
6150
6151#define ARRAYOF_ORIGEQ 1
6152
6153#define ARRAYOF_ORIGTYPE INTEGER
6154#define ARRAYOF_TYPE arrayof_integer
6155#include "arrayof_pre.F90"
6156
6157#undef ARRAYOF_ORIGTYPE
6158#undef ARRAYOF_TYPE
6159#define ARRAYOF_ORIGTYPE REAL
6160#define ARRAYOF_TYPE arrayof_real
6161#include "arrayof_pre.F90"
6162
6163#undef ARRAYOF_ORIGTYPE
6164#undef ARRAYOF_TYPE
6165#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6166#define ARRAYOF_TYPE arrayof_doubleprecision
6167#include "arrayof_pre.F90"
6168
6169#undef ARRAYOF_ORIGEQ
6170
6171#undef ARRAYOF_ORIGTYPE
6172#undef ARRAYOF_TYPE
6173#define ARRAYOF_ORIGTYPE LOGICAL
6174#define ARRAYOF_TYPE arrayof_logical
6175#include "arrayof_pre.F90"
6176
6177PRIVATE
6178! from arrayof
6180PUBLIC insert_unique, append_unique
6181
6182PUBLIC sort, index, index_c, &
6183 count_distinct_sorted, pack_distinct_sorted, &
6184 count_distinct, pack_distinct, count_and_pack_distinct, &
6185 map_distinct, map_inv_distinct, &
6186 firsttrue, lasttrue, pack_distinct_c, map
6187
6188CONTAINS
6189
6190
6193FUNCTION firsttrue(v) RESULT(i)
6194LOGICAL,INTENT(in) :: v(:)
6195INTEGER :: i
6196
6197DO i = 1, SIZE(v)
6198 IF (v(i)) RETURN
6199ENDDO
6200i = 0
6201
6202END FUNCTION firsttrue
6203
6204
6207FUNCTION lasttrue(v) RESULT(i)
6208LOGICAL,INTENT(in) :: v(:)
6209INTEGER :: i
6210
6211DO i = SIZE(v), 1, -1
6212 IF (v(i)) RETURN
6213ENDDO
6214
6215END FUNCTION lasttrue
6216
6217
6218! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6219#undef VOL7D_POLY_TYPE_AUTO
6220#undef VOL7D_NO_PACK
6221
6222#undef VOL7D_POLY_TYPE
6223#undef VOL7D_POLY_TYPES
6224#define VOL7D_POLY_TYPE INTEGER
6225#define VOL7D_POLY_TYPES _i
6226#define ENABLE_SORT
6227#include "array_utilities_inc.F90"
6228#undef ENABLE_SORT
6229
6230#undef VOL7D_POLY_TYPE
6231#undef VOL7D_POLY_TYPES
6232#define VOL7D_POLY_TYPE REAL
6233#define VOL7D_POLY_TYPES _r
6234#define ENABLE_SORT
6235#include "array_utilities_inc.F90"
6236#undef ENABLE_SORT
6237
6238#undef VOL7D_POLY_TYPE
6239#undef VOL7D_POLY_TYPES
6240#define VOL7D_POLY_TYPE DOUBLEPRECISION
6241#define VOL7D_POLY_TYPES _d
6242#define ENABLE_SORT
6243#include "array_utilities_inc.F90"
6244#undef ENABLE_SORT
6245
6246#define VOL7D_NO_PACK
6247#undef VOL7D_POLY_TYPE
6248#undef VOL7D_POLY_TYPES
6249#define VOL7D_POLY_TYPE CHARACTER(len=*)
6250#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6251#define VOL7D_POLY_TYPES _c
6252#define ENABLE_SORT
6253#include "array_utilities_inc.F90"
6254#undef VOL7D_POLY_TYPE_AUTO
6255#undef ENABLE_SORT
6256
6257SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6258CHARACTER(len=*),INTENT(in) :: vect(:)
6259LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6260CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6261
6262INTEGER :: count_distinct
6263INTEGER :: i, j, dim
6264LOGICAL :: lback
6265
6266dim = SIZE(pack_distinct)
6267IF (PRESENT(back)) THEN
6268 lback = back
6269ELSE
6270 lback = .false.
6271ENDIF
6272count_distinct = 0
6273
6274IF (PRESENT (mask)) THEN
6275 IF (lback) THEN
6276 vectm1: DO i = 1, SIZE(vect)
6277 IF (.NOT.mask(i)) cycle vectm1
6278! DO j = i-1, 1, -1
6279! IF (vect(j) == vect(i)) CYCLE vectm1
6280 DO j = count_distinct, 1, -1
6281 IF (pack_distinct(j) == vect(i)) cycle vectm1
6282 ENDDO
6283 count_distinct = count_distinct + 1
6284 IF (count_distinct > dim) EXIT
6285 pack_distinct(count_distinct) = vect(i)
6286 ENDDO vectm1
6287 ELSE
6288 vectm2: DO i = 1, SIZE(vect)
6289 IF (.NOT.mask(i)) cycle vectm2
6290! DO j = 1, i-1
6291! IF (vect(j) == vect(i)) CYCLE vectm2
6292 DO j = 1, count_distinct
6293 IF (pack_distinct(j) == vect(i)) cycle vectm2
6294 ENDDO
6295 count_distinct = count_distinct + 1
6296 IF (count_distinct > dim) EXIT
6297 pack_distinct(count_distinct) = vect(i)
6298 ENDDO vectm2
6299 ENDIF
6300ELSE
6301 IF (lback) THEN
6302 vect1: DO i = 1, SIZE(vect)
6303! DO j = i-1, 1, -1
6304! IF (vect(j) == vect(i)) CYCLE vect1
6305 DO j = count_distinct, 1, -1
6306 IF (pack_distinct(j) == vect(i)) cycle vect1
6307 ENDDO
6308 count_distinct = count_distinct + 1
6309 IF (count_distinct > dim) EXIT
6310 pack_distinct(count_distinct) = vect(i)
6311 ENDDO vect1
6312 ELSE
6313 vect2: DO i = 1, SIZE(vect)
6314! DO j = 1, i-1
6315! IF (vect(j) == vect(i)) CYCLE vect2
6316 DO j = 1, count_distinct
6317 IF (pack_distinct(j) == vect(i)) cycle vect2
6318 ENDDO
6319 count_distinct = count_distinct + 1
6320 IF (count_distinct > dim) EXIT
6321 pack_distinct(count_distinct) = vect(i)
6322 ENDDO vect2
6323 ENDIF
6324ENDIF
6325
6326END SUBROUTINE pack_distinct_c
6327
6329FUNCTION map(mask) RESULT(mapidx)
6330LOGICAL,INTENT(in) :: mask(:)
6331INTEGER :: mapidx(count(mask))
6332
6333INTEGER :: i,j
6334
6335j = 0
6336DO i=1, SIZE(mask)
6337 j = j + 1
6338 IF (mask(i)) mapidx(j)=i
6339ENDDO
6340
6341END FUNCTION map
6342
6343#define ARRAYOF_ORIGEQ 1
6344
6345#undef ARRAYOF_ORIGTYPE
6346#undef ARRAYOF_TYPE
6347#define ARRAYOF_ORIGTYPE INTEGER
6348#define ARRAYOF_TYPE arrayof_integer
6349#include "arrayof_post.F90"
6350
6351#undef ARRAYOF_ORIGTYPE
6352#undef ARRAYOF_TYPE
6353#define ARRAYOF_ORIGTYPE REAL
6354#define ARRAYOF_TYPE arrayof_real
6355#include "arrayof_post.F90"
6356
6357#undef ARRAYOF_ORIGTYPE
6358#undef ARRAYOF_TYPE
6359#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6360#define ARRAYOF_TYPE arrayof_doubleprecision
6361#include "arrayof_post.F90"
6362
6363#undef ARRAYOF_ORIGEQ
6364
6365#undef ARRAYOF_ORIGTYPE
6366#undef ARRAYOF_TYPE
6367#define ARRAYOF_ORIGTYPE LOGICAL
6368#define ARRAYOF_TYPE arrayof_logical
6369#include "arrayof_post.F90"
6370
6371END 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.