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