libsim Versione 7.2.1
|
◆ arrayof_integer_insert_array()
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.
Definizione alla linea 5520 del file array_utilities.F90. 5521! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
5522! authors:
5523! Davide Cesari <dcesari@arpa.emr.it>
5524! Paolo Patruno <ppatruno@arpa.emr.it>
5525
5526! This program is free software; you can redistribute it and/or
5527! modify it under the terms of the GNU General Public License as
5528! published by the Free Software Foundation; either version 2 of
5529! the License, or (at your option) any later version.
5530
5531! This program is distributed in the hope that it will be useful,
5532! but WITHOUT ANY WARRANTY; without even the implied warranty of
5533! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5534! GNU General Public License for more details.
5535
5536! You should have received a copy of the GNU General Public License
5537! along with this program. If not, see <http://www.gnu.org/licenses/>.
5538
5539
5540
5543#include "config.h"
5545
5546IMPLICIT NONE
5547
5548! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
5549!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
5550
5551#undef VOL7D_POLY_TYPE_AUTO
5552
5553#undef VOL7D_POLY_TYPE
5554#undef VOL7D_POLY_TYPES
5555#define VOL7D_POLY_TYPE INTEGER
5556#define VOL7D_POLY_TYPES _i
5557#define ENABLE_SORT
5558#include "array_utilities_pre.F90"
5559#undef ENABLE_SORT
5560
5561#undef VOL7D_POLY_TYPE
5562#undef VOL7D_POLY_TYPES
5563#define VOL7D_POLY_TYPE REAL
5564#define VOL7D_POLY_TYPES _r
5565#define ENABLE_SORT
5566#include "array_utilities_pre.F90"
5567#undef ENABLE_SORT
5568
5569#undef VOL7D_POLY_TYPE
5570#undef VOL7D_POLY_TYPES
5571#define VOL7D_POLY_TYPE DOUBLEPRECISION
5572#define VOL7D_POLY_TYPES _d
5573#define ENABLE_SORT
5574#include "array_utilities_pre.F90"
5575#undef ENABLE_SORT
5576
5577#define VOL7D_NO_PACK
5578#undef VOL7D_POLY_TYPE
5579#undef VOL7D_POLY_TYPES
5580#define VOL7D_POLY_TYPE CHARACTER(len=*)
5581#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5582#define VOL7D_POLY_TYPES _c
5583#define ENABLE_SORT
5584#include "array_utilities_pre.F90"
5585#undef VOL7D_POLY_TYPE_AUTO
5586#undef ENABLE_SORT
5587
5588
5589#define ARRAYOF_ORIGEQ 1
5590
5591#define ARRAYOF_ORIGTYPE INTEGER
5592#define ARRAYOF_TYPE arrayof_integer
5593#include "arrayof_pre.F90"
5594
5595#undef ARRAYOF_ORIGTYPE
5596#undef ARRAYOF_TYPE
5597#define ARRAYOF_ORIGTYPE REAL
5598#define ARRAYOF_TYPE arrayof_real
5599#include "arrayof_pre.F90"
5600
5601#undef ARRAYOF_ORIGTYPE
5602#undef ARRAYOF_TYPE
5603#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5604#define ARRAYOF_TYPE arrayof_doubleprecision
5605#include "arrayof_pre.F90"
5606
5607#undef ARRAYOF_ORIGEQ
5608
5609#undef ARRAYOF_ORIGTYPE
5610#undef ARRAYOF_TYPE
5611#define ARRAYOF_ORIGTYPE LOGICAL
5612#define ARRAYOF_TYPE arrayof_logical
5613#include "arrayof_pre.F90"
5614
5615PRIVATE
5616! from arrayof
5618PUBLIC insert_unique, append_unique
5619
5621 count_distinct_sorted, pack_distinct_sorted, &
5622 count_distinct, pack_distinct, count_and_pack_distinct, &
5623 map_distinct, map_inv_distinct, &
5624 firsttrue, lasttrue, pack_distinct_c, map
5625
5626CONTAINS
5627
5628
5631FUNCTION firsttrue(v) RESULT(i)
5632LOGICAL,INTENT(in) :: v(:)
5633INTEGER :: i
5634
5635DO i = 1, SIZE(v)
5636 IF (v(i)) RETURN
5637ENDDO
5638i = 0
5639
5640END FUNCTION firsttrue
5641
5642
5645FUNCTION lasttrue(v) RESULT(i)
5646LOGICAL,INTENT(in) :: v(:)
5647INTEGER :: i
5648
5649DO i = SIZE(v), 1, -1
5650 IF (v(i)) RETURN
5651ENDDO
5652
5653END FUNCTION lasttrue
5654
5655
5656! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
5657#undef VOL7D_POLY_TYPE_AUTO
5658#undef VOL7D_NO_PACK
5659
5660#undef VOL7D_POLY_TYPE
5661#undef VOL7D_POLY_TYPES
5662#define VOL7D_POLY_TYPE INTEGER
5663#define VOL7D_POLY_TYPES _i
5664#define ENABLE_SORT
5665#include "array_utilities_inc.F90"
5666#undef ENABLE_SORT
5667
5668#undef VOL7D_POLY_TYPE
5669#undef VOL7D_POLY_TYPES
5670#define VOL7D_POLY_TYPE REAL
5671#define VOL7D_POLY_TYPES _r
5672#define ENABLE_SORT
5673#include "array_utilities_inc.F90"
5674#undef ENABLE_SORT
5675
5676#undef VOL7D_POLY_TYPE
5677#undef VOL7D_POLY_TYPES
5678#define VOL7D_POLY_TYPE DOUBLEPRECISION
5679#define VOL7D_POLY_TYPES _d
5680#define ENABLE_SORT
5681#include "array_utilities_inc.F90"
5682#undef ENABLE_SORT
5683
5684#define VOL7D_NO_PACK
5685#undef VOL7D_POLY_TYPE
5686#undef VOL7D_POLY_TYPES
5687#define VOL7D_POLY_TYPE CHARACTER(len=*)
5688#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5689#define VOL7D_POLY_TYPES _c
5690#define ENABLE_SORT
5691#include "array_utilities_inc.F90"
5692#undef VOL7D_POLY_TYPE_AUTO
5693#undef ENABLE_SORT
5694
5695SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
5696CHARACTER(len=*),INTENT(in) :: vect(:)
5697LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
5698CHARACTER(len=LEN(vect)) :: pack_distinct(:)
5699
5700INTEGER :: count_distinct
5701INTEGER :: i, j, dim
5702LOGICAL :: lback
5703
5704dim = SIZE(pack_distinct)
5705IF (PRESENT(back)) THEN
5706 lback = back
5707ELSE
5708 lback = .false.
5709ENDIF
5710count_distinct = 0
5711
5712IF (PRESENT (mask)) THEN
5713 IF (lback) THEN
5714 vectm1: DO i = 1, SIZE(vect)
5715 IF (.NOT.mask(i)) cycle vectm1
5716! DO j = i-1, 1, -1
5717! IF (vect(j) == vect(i)) CYCLE vectm1
5718 DO j = count_distinct, 1, -1
5719 IF (pack_distinct(j) == vect(i)) cycle vectm1
5720 ENDDO
5721 count_distinct = count_distinct + 1
5722 IF (count_distinct > dim) EXIT
5723 pack_distinct(count_distinct) = vect(i)
5724 ENDDO vectm1
5725 ELSE
5726 vectm2: DO i = 1, SIZE(vect)
5727 IF (.NOT.mask(i)) cycle vectm2
5728! DO j = 1, i-1
5729! IF (vect(j) == vect(i)) CYCLE vectm2
5730 DO j = 1, count_distinct
5731 IF (pack_distinct(j) == vect(i)) cycle vectm2
5732 ENDDO
5733 count_distinct = count_distinct + 1
5734 IF (count_distinct > dim) EXIT
5735 pack_distinct(count_distinct) = vect(i)
5736 ENDDO vectm2
5737 ENDIF
5738ELSE
5739 IF (lback) THEN
5740 vect1: DO i = 1, SIZE(vect)
5741! DO j = i-1, 1, -1
5742! IF (vect(j) == vect(i)) CYCLE vect1
5743 DO j = count_distinct, 1, -1
5744 IF (pack_distinct(j) == vect(i)) cycle vect1
5745 ENDDO
5746 count_distinct = count_distinct + 1
5747 IF (count_distinct > dim) EXIT
5748 pack_distinct(count_distinct) = vect(i)
5749 ENDDO vect1
5750 ELSE
5751 vect2: DO i = 1, SIZE(vect)
5752! DO j = 1, i-1
5753! IF (vect(j) == vect(i)) CYCLE vect2
5754 DO j = 1, count_distinct
5755 IF (pack_distinct(j) == vect(i)) cycle vect2
5756 ENDDO
5757 count_distinct = count_distinct + 1
5758 IF (count_distinct > dim) EXIT
5759 pack_distinct(count_distinct) = vect(i)
5760 ENDDO vect2
5761 ENDIF
5762ENDIF
5763
5764END SUBROUTINE pack_distinct_c
5765
5767FUNCTION map(mask) RESULT(mapidx)
5768LOGICAL,INTENT(in) :: mask(:)
5769INTEGER :: mapidx(count(mask))
5770
5771INTEGER :: i,j
5772
5773j = 0
5774DO i=1, SIZE(mask)
5775 j = j + 1
5776 IF (mask(i)) mapidx(j)=i
5777ENDDO
5778
5779END FUNCTION map
5780
5781#define ARRAYOF_ORIGEQ 1
5782
5783#undef ARRAYOF_ORIGTYPE
5784#undef ARRAYOF_TYPE
5785#define ARRAYOF_ORIGTYPE INTEGER
5786#define ARRAYOF_TYPE arrayof_integer
5787#include "arrayof_post.F90"
5788
5789#undef ARRAYOF_ORIGTYPE
5790#undef ARRAYOF_TYPE
5791#define ARRAYOF_ORIGTYPE REAL
5792#define ARRAYOF_TYPE arrayof_real
5793#include "arrayof_post.F90"
5794
5795#undef ARRAYOF_ORIGTYPE
5796#undef ARRAYOF_TYPE
5797#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5798#define ARRAYOF_TYPE arrayof_doubleprecision
5799#include "arrayof_post.F90"
5800
5801#undef ARRAYOF_ORIGEQ
5802
5803#undef ARRAYOF_ORIGTYPE
5804#undef ARRAYOF_TYPE
5805#define ARRAYOF_ORIGTYPE LOGICAL
5806#define ARRAYOF_TYPE arrayof_logical
5807#include "arrayof_post.F90"
5808
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 |