libsim Versione 7.1.11
|
◆ arrayof_doubleprecision_delete()
Destructor for finalizing an array object. If defined, calls the destructor for every element of the array object; finally it deallocates all the space occupied.
Definizione alla linea 6253 del file array_utilities.F90. 6258! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6259! authors:
6260! Davide Cesari <dcesari@arpa.emr.it>
6261! Paolo Patruno <ppatruno@arpa.emr.it>
6262
6263! This program is free software; you can redistribute it and/or
6264! modify it under the terms of the GNU General Public License as
6265! published by the Free Software Foundation; either version 2 of
6266! the License, or (at your option) any later version.
6267
6268! This program is distributed in the hope that it will be useful,
6269! but WITHOUT ANY WARRANTY; without even the implied warranty of
6270! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6271! GNU General Public License for more details.
6272
6273! You should have received a copy of the GNU General Public License
6274! along with this program. If not, see <http://www.gnu.org/licenses/>.
6275
6276
6277
6280#include "config.h"
6282
6283IMPLICIT NONE
6284
6285! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6286!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6287
6288#undef VOL7D_POLY_TYPE_AUTO
6289
6290#undef VOL7D_POLY_TYPE
6291#undef VOL7D_POLY_TYPES
6292#define VOL7D_POLY_TYPE INTEGER
6293#define VOL7D_POLY_TYPES _i
6294#define ENABLE_SORT
6295#include "array_utilities_pre.F90"
6296#undef ENABLE_SORT
6297
6298#undef VOL7D_POLY_TYPE
6299#undef VOL7D_POLY_TYPES
6300#define VOL7D_POLY_TYPE REAL
6301#define VOL7D_POLY_TYPES _r
6302#define ENABLE_SORT
6303#include "array_utilities_pre.F90"
6304#undef ENABLE_SORT
6305
6306#undef VOL7D_POLY_TYPE
6307#undef VOL7D_POLY_TYPES
6308#define VOL7D_POLY_TYPE DOUBLEPRECISION
6309#define VOL7D_POLY_TYPES _d
6310#define ENABLE_SORT
6311#include "array_utilities_pre.F90"
6312#undef ENABLE_SORT
6313
6314#define VOL7D_NO_PACK
6315#undef VOL7D_POLY_TYPE
6316#undef VOL7D_POLY_TYPES
6317#define VOL7D_POLY_TYPE CHARACTER(len=*)
6318#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6319#define VOL7D_POLY_TYPES _c
6320#define ENABLE_SORT
6321#include "array_utilities_pre.F90"
6322#undef VOL7D_POLY_TYPE_AUTO
6323#undef ENABLE_SORT
6324
6325
6326#define ARRAYOF_ORIGEQ 1
6327
6328#define ARRAYOF_ORIGTYPE INTEGER
6329#define ARRAYOF_TYPE arrayof_integer
6330#include "arrayof_pre.F90"
6331
6332#undef ARRAYOF_ORIGTYPE
6333#undef ARRAYOF_TYPE
6334#define ARRAYOF_ORIGTYPE REAL
6335#define ARRAYOF_TYPE arrayof_real
6336#include "arrayof_pre.F90"
6337
6338#undef ARRAYOF_ORIGTYPE
6339#undef ARRAYOF_TYPE
6340#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6341#define ARRAYOF_TYPE arrayof_doubleprecision
6342#include "arrayof_pre.F90"
6343
6344#undef ARRAYOF_ORIGEQ
6345
6346#undef ARRAYOF_ORIGTYPE
6347#undef ARRAYOF_TYPE
6348#define ARRAYOF_ORIGTYPE LOGICAL
6349#define ARRAYOF_TYPE arrayof_logical
6350#include "arrayof_pre.F90"
6351
6352PRIVATE
6353! from arrayof
6355PUBLIC insert_unique, append_unique
6356
6358 count_distinct_sorted, pack_distinct_sorted, &
6359 count_distinct, pack_distinct, count_and_pack_distinct, &
6360 map_distinct, map_inv_distinct, &
6361 firsttrue, lasttrue, pack_distinct_c, map
6362
6363CONTAINS
6364
6365
6368FUNCTION firsttrue(v) RESULT(i)
6369LOGICAL,INTENT(in) :: v(:)
6370INTEGER :: i
6371
6372DO i = 1, SIZE(v)
6373 IF (v(i)) RETURN
6374ENDDO
6375i = 0
6376
6377END FUNCTION firsttrue
6378
6379
6382FUNCTION lasttrue(v) RESULT(i)
6383LOGICAL,INTENT(in) :: v(:)
6384INTEGER :: i
6385
6386DO i = SIZE(v), 1, -1
6387 IF (v(i)) RETURN
6388ENDDO
6389
6390END FUNCTION lasttrue
6391
6392
6393! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6394#undef VOL7D_POLY_TYPE_AUTO
6395#undef VOL7D_NO_PACK
6396
6397#undef VOL7D_POLY_TYPE
6398#undef VOL7D_POLY_TYPES
6399#define VOL7D_POLY_TYPE INTEGER
6400#define VOL7D_POLY_TYPES _i
6401#define ENABLE_SORT
6402#include "array_utilities_inc.F90"
6403#undef ENABLE_SORT
6404
6405#undef VOL7D_POLY_TYPE
6406#undef VOL7D_POLY_TYPES
6407#define VOL7D_POLY_TYPE REAL
6408#define VOL7D_POLY_TYPES _r
6409#define ENABLE_SORT
6410#include "array_utilities_inc.F90"
6411#undef ENABLE_SORT
6412
6413#undef VOL7D_POLY_TYPE
6414#undef VOL7D_POLY_TYPES
6415#define VOL7D_POLY_TYPE DOUBLEPRECISION
6416#define VOL7D_POLY_TYPES _d
6417#define ENABLE_SORT
6418#include "array_utilities_inc.F90"
6419#undef ENABLE_SORT
6420
6421#define VOL7D_NO_PACK
6422#undef VOL7D_POLY_TYPE
6423#undef VOL7D_POLY_TYPES
6424#define VOL7D_POLY_TYPE CHARACTER(len=*)
6425#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6426#define VOL7D_POLY_TYPES _c
6427#define ENABLE_SORT
6428#include "array_utilities_inc.F90"
6429#undef VOL7D_POLY_TYPE_AUTO
6430#undef ENABLE_SORT
6431
6432SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6433CHARACTER(len=*),INTENT(in) :: vect(:)
6434LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6435CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6436
6437INTEGER :: count_distinct
6438INTEGER :: i, j, dim
6439LOGICAL :: lback
6440
6441dim = SIZE(pack_distinct)
6442IF (PRESENT(back)) THEN
6443 lback = back
6444ELSE
6445 lback = .false.
6446ENDIF
6447count_distinct = 0
6448
6449IF (PRESENT (mask)) THEN
6450 IF (lback) THEN
6451 vectm1: DO i = 1, SIZE(vect)
6452 IF (.NOT.mask(i)) cycle vectm1
6453! DO j = i-1, 1, -1
6454! IF (vect(j) == vect(i)) CYCLE vectm1
6455 DO j = count_distinct, 1, -1
6456 IF (pack_distinct(j) == vect(i)) cycle vectm1
6457 ENDDO
6458 count_distinct = count_distinct + 1
6459 IF (count_distinct > dim) EXIT
6460 pack_distinct(count_distinct) = vect(i)
6461 ENDDO vectm1
6462 ELSE
6463 vectm2: DO i = 1, SIZE(vect)
6464 IF (.NOT.mask(i)) cycle vectm2
6465! DO j = 1, i-1
6466! IF (vect(j) == vect(i)) CYCLE vectm2
6467 DO j = 1, count_distinct
6468 IF (pack_distinct(j) == vect(i)) cycle vectm2
6469 ENDDO
6470 count_distinct = count_distinct + 1
6471 IF (count_distinct > dim) EXIT
6472 pack_distinct(count_distinct) = vect(i)
6473 ENDDO vectm2
6474 ENDIF
6475ELSE
6476 IF (lback) THEN
6477 vect1: DO i = 1, SIZE(vect)
6478! DO j = i-1, 1, -1
6479! IF (vect(j) == vect(i)) CYCLE vect1
6480 DO j = count_distinct, 1, -1
6481 IF (pack_distinct(j) == vect(i)) cycle vect1
6482 ENDDO
6483 count_distinct = count_distinct + 1
6484 IF (count_distinct > dim) EXIT
6485 pack_distinct(count_distinct) = vect(i)
6486 ENDDO vect1
6487 ELSE
6488 vect2: DO i = 1, SIZE(vect)
6489! DO j = 1, i-1
6490! IF (vect(j) == vect(i)) CYCLE vect2
6491 DO j = 1, count_distinct
6492 IF (pack_distinct(j) == vect(i)) cycle vect2
6493 ENDDO
6494 count_distinct = count_distinct + 1
6495 IF (count_distinct > dim) EXIT
6496 pack_distinct(count_distinct) = vect(i)
6497 ENDDO vect2
6498 ENDIF
6499ENDIF
6500
6501END SUBROUTINE pack_distinct_c
6502
6504FUNCTION map(mask) RESULT(mapidx)
6505LOGICAL,INTENT(in) :: mask(:)
6506INTEGER :: mapidx(count(mask))
6507
6508INTEGER :: i,j
6509
6510j = 0
6511DO i=1, SIZE(mask)
6512 j = j + 1
6513 IF (mask(i)) mapidx(j)=i
6514ENDDO
6515
6516END FUNCTION map
6517
6518#define ARRAYOF_ORIGEQ 1
6519
6520#undef ARRAYOF_ORIGTYPE
6521#undef ARRAYOF_TYPE
6522#define ARRAYOF_ORIGTYPE INTEGER
6523#define ARRAYOF_TYPE arrayof_integer
6524#include "arrayof_post.F90"
6525
6526#undef ARRAYOF_ORIGTYPE
6527#undef ARRAYOF_TYPE
6528#define ARRAYOF_ORIGTYPE REAL
6529#define ARRAYOF_TYPE arrayof_real
6530#include "arrayof_post.F90"
6531
6532#undef ARRAYOF_ORIGTYPE
6533#undef ARRAYOF_TYPE
6534#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6535#define ARRAYOF_TYPE arrayof_doubleprecision
6536#include "arrayof_post.F90"
6537
6538#undef ARRAYOF_ORIGEQ
6539
6540#undef ARRAYOF_ORIGTYPE
6541#undef ARRAYOF_TYPE
6542#define ARRAYOF_ORIGTYPE LOGICAL
6543#define ARRAYOF_TYPE arrayof_logical
6544#include "arrayof_post.F90"
6545
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 |