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