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