libsim Versione 7.2.4

◆ arrayof_doubleprecision_insert()

subroutine, private arrayof_doubleprecision_insert ( type(arrayof_doubleprecision) this,
doubleprecision, intent(in) content,
integer, intent(in), optional pos )
private

Method for inserting an element of the array at a desired position.

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

Parametri
thisarray object to extend
[in]contentobject of TYPE DOUBLEPRECISION to insert
[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 6122 del file array_utilities.F90.

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