libsim Versione 7.1.11

◆ map()

integer function, dimension(count(mask)), public map ( logical, dimension(:), intent(in)  mask)

Return the index of the array only where the mask is true

Definizione alla linea 5497 del file array_utilities.F90.

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