libsim Versione 7.2.1
|
◆ arrayof_integer_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 5685 del file array_utilities.F90. 5690! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
5691! authors:
5692! Davide Cesari <dcesari@arpa.emr.it>
5693! Paolo Patruno <ppatruno@arpa.emr.it>
5694
5695! This program is free software; you can redistribute it and/or
5696! modify it under the terms of the GNU General Public License as
5697! published by the Free Software Foundation; either version 2 of
5698! the License, or (at your option) any later version.
5699
5700! This program is distributed in the hope that it will be useful,
5701! but WITHOUT ANY WARRANTY; without even the implied warranty of
5702! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5703! GNU General Public License for more details.
5704
5705! You should have received a copy of the GNU General Public License
5706! along with this program. If not, see <http://www.gnu.org/licenses/>.
5707
5708
5709
5712#include "config.h"
5714
5715IMPLICIT NONE
5716
5717! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
5718!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
5719
5720#undef VOL7D_POLY_TYPE_AUTO
5721
5722#undef VOL7D_POLY_TYPE
5723#undef VOL7D_POLY_TYPES
5724#define VOL7D_POLY_TYPE INTEGER
5725#define VOL7D_POLY_TYPES _i
5726#define ENABLE_SORT
5727#include "array_utilities_pre.F90"
5728#undef ENABLE_SORT
5729
5730#undef VOL7D_POLY_TYPE
5731#undef VOL7D_POLY_TYPES
5732#define VOL7D_POLY_TYPE REAL
5733#define VOL7D_POLY_TYPES _r
5734#define ENABLE_SORT
5735#include "array_utilities_pre.F90"
5736#undef ENABLE_SORT
5737
5738#undef VOL7D_POLY_TYPE
5739#undef VOL7D_POLY_TYPES
5740#define VOL7D_POLY_TYPE DOUBLEPRECISION
5741#define VOL7D_POLY_TYPES _d
5742#define ENABLE_SORT
5743#include "array_utilities_pre.F90"
5744#undef ENABLE_SORT
5745
5746#define VOL7D_NO_PACK
5747#undef VOL7D_POLY_TYPE
5748#undef VOL7D_POLY_TYPES
5749#define VOL7D_POLY_TYPE CHARACTER(len=*)
5750#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5751#define VOL7D_POLY_TYPES _c
5752#define ENABLE_SORT
5753#include "array_utilities_pre.F90"
5754#undef VOL7D_POLY_TYPE_AUTO
5755#undef ENABLE_SORT
5756
5757
5758#define ARRAYOF_ORIGEQ 1
5759
5760#define ARRAYOF_ORIGTYPE INTEGER
5761#define ARRAYOF_TYPE arrayof_integer
5762#include "arrayof_pre.F90"
5763
5764#undef ARRAYOF_ORIGTYPE
5765#undef ARRAYOF_TYPE
5766#define ARRAYOF_ORIGTYPE REAL
5767#define ARRAYOF_TYPE arrayof_real
5768#include "arrayof_pre.F90"
5769
5770#undef ARRAYOF_ORIGTYPE
5771#undef ARRAYOF_TYPE
5772#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5773#define ARRAYOF_TYPE arrayof_doubleprecision
5774#include "arrayof_pre.F90"
5775
5776#undef ARRAYOF_ORIGEQ
5777
5778#undef ARRAYOF_ORIGTYPE
5779#undef ARRAYOF_TYPE
5780#define ARRAYOF_ORIGTYPE LOGICAL
5781#define ARRAYOF_TYPE arrayof_logical
5782#include "arrayof_pre.F90"
5783
5784PRIVATE
5785! from arrayof
5787PUBLIC insert_unique, append_unique
5788
5790 count_distinct_sorted, pack_distinct_sorted, &
5791 count_distinct, pack_distinct, count_and_pack_distinct, &
5792 map_distinct, map_inv_distinct, &
5793 firsttrue, lasttrue, pack_distinct_c, map
5794
5795CONTAINS
5796
5797
5800FUNCTION firsttrue(v) RESULT(i)
5801LOGICAL,INTENT(in) :: v(:)
5802INTEGER :: i
5803
5804DO i = 1, SIZE(v)
5805 IF (v(i)) RETURN
5806ENDDO
5807i = 0
5808
5809END FUNCTION firsttrue
5810
5811
5814FUNCTION lasttrue(v) RESULT(i)
5815LOGICAL,INTENT(in) :: v(:)
5816INTEGER :: i
5817
5818DO i = SIZE(v), 1, -1
5819 IF (v(i)) RETURN
5820ENDDO
5821
5822END FUNCTION lasttrue
5823
5824
5825! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
5826#undef VOL7D_POLY_TYPE_AUTO
5827#undef VOL7D_NO_PACK
5828
5829#undef VOL7D_POLY_TYPE
5830#undef VOL7D_POLY_TYPES
5831#define VOL7D_POLY_TYPE INTEGER
5832#define VOL7D_POLY_TYPES _i
5833#define ENABLE_SORT
5834#include "array_utilities_inc.F90"
5835#undef ENABLE_SORT
5836
5837#undef VOL7D_POLY_TYPE
5838#undef VOL7D_POLY_TYPES
5839#define VOL7D_POLY_TYPE REAL
5840#define VOL7D_POLY_TYPES _r
5841#define ENABLE_SORT
5842#include "array_utilities_inc.F90"
5843#undef ENABLE_SORT
5844
5845#undef VOL7D_POLY_TYPE
5846#undef VOL7D_POLY_TYPES
5847#define VOL7D_POLY_TYPE DOUBLEPRECISION
5848#define VOL7D_POLY_TYPES _d
5849#define ENABLE_SORT
5850#include "array_utilities_inc.F90"
5851#undef ENABLE_SORT
5852
5853#define VOL7D_NO_PACK
5854#undef VOL7D_POLY_TYPE
5855#undef VOL7D_POLY_TYPES
5856#define VOL7D_POLY_TYPE CHARACTER(len=*)
5857#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5858#define VOL7D_POLY_TYPES _c
5859#define ENABLE_SORT
5860#include "array_utilities_inc.F90"
5861#undef VOL7D_POLY_TYPE_AUTO
5862#undef ENABLE_SORT
5863
5864SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
5865CHARACTER(len=*),INTENT(in) :: vect(:)
5866LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
5867CHARACTER(len=LEN(vect)) :: pack_distinct(:)
5868
5869INTEGER :: count_distinct
5870INTEGER :: i, j, dim
5871LOGICAL :: lback
5872
5873dim = SIZE(pack_distinct)
5874IF (PRESENT(back)) THEN
5875 lback = back
5876ELSE
5877 lback = .false.
5878ENDIF
5879count_distinct = 0
5880
5881IF (PRESENT (mask)) THEN
5882 IF (lback) THEN
5883 vectm1: DO i = 1, SIZE(vect)
5884 IF (.NOT.mask(i)) cycle vectm1
5885! DO j = i-1, 1, -1
5886! IF (vect(j) == vect(i)) CYCLE vectm1
5887 DO j = count_distinct, 1, -1
5888 IF (pack_distinct(j) == vect(i)) cycle vectm1
5889 ENDDO
5890 count_distinct = count_distinct + 1
5891 IF (count_distinct > dim) EXIT
5892 pack_distinct(count_distinct) = vect(i)
5893 ENDDO vectm1
5894 ELSE
5895 vectm2: DO i = 1, SIZE(vect)
5896 IF (.NOT.mask(i)) cycle vectm2
5897! DO j = 1, i-1
5898! IF (vect(j) == vect(i)) CYCLE vectm2
5899 DO j = 1, count_distinct
5900 IF (pack_distinct(j) == vect(i)) cycle vectm2
5901 ENDDO
5902 count_distinct = count_distinct + 1
5903 IF (count_distinct > dim) EXIT
5904 pack_distinct(count_distinct) = vect(i)
5905 ENDDO vectm2
5906 ENDIF
5907ELSE
5908 IF (lback) THEN
5909 vect1: DO i = 1, SIZE(vect)
5910! DO j = i-1, 1, -1
5911! IF (vect(j) == vect(i)) CYCLE vect1
5912 DO j = count_distinct, 1, -1
5913 IF (pack_distinct(j) == vect(i)) cycle vect1
5914 ENDDO
5915 count_distinct = count_distinct + 1
5916 IF (count_distinct > dim) EXIT
5917 pack_distinct(count_distinct) = vect(i)
5918 ENDDO vect1
5919 ELSE
5920 vect2: DO i = 1, SIZE(vect)
5921! DO j = 1, i-1
5922! IF (vect(j) == vect(i)) CYCLE vect2
5923 DO j = 1, count_distinct
5924 IF (pack_distinct(j) == vect(i)) cycle vect2
5925 ENDDO
5926 count_distinct = count_distinct + 1
5927 IF (count_distinct > dim) EXIT
5928 pack_distinct(count_distinct) = vect(i)
5929 ENDDO vect2
5930 ENDIF
5931ENDIF
5932
5933END SUBROUTINE pack_distinct_c
5934
5936FUNCTION map(mask) RESULT(mapidx)
5937LOGICAL,INTENT(in) :: mask(:)
5938INTEGER :: mapidx(count(mask))
5939
5940INTEGER :: i,j
5941
5942j = 0
5943DO i=1, SIZE(mask)
5944 j = j + 1
5945 IF (mask(i)) mapidx(j)=i
5946ENDDO
5947
5948END FUNCTION map
5949
5950#define ARRAYOF_ORIGEQ 1
5951
5952#undef ARRAYOF_ORIGTYPE
5953#undef ARRAYOF_TYPE
5954#define ARRAYOF_ORIGTYPE INTEGER
5955#define ARRAYOF_TYPE arrayof_integer
5956#include "arrayof_post.F90"
5957
5958#undef ARRAYOF_ORIGTYPE
5959#undef ARRAYOF_TYPE
5960#define ARRAYOF_ORIGTYPE REAL
5961#define ARRAYOF_TYPE arrayof_real
5962#include "arrayof_post.F90"
5963
5964#undef ARRAYOF_ORIGTYPE
5965#undef ARRAYOF_TYPE
5966#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5967#define ARRAYOF_TYPE arrayof_doubleprecision
5968#include "arrayof_post.F90"
5969
5970#undef ARRAYOF_ORIGEQ
5971
5972#undef ARRAYOF_ORIGTYPE
5973#undef ARRAYOF_TYPE
5974#define ARRAYOF_ORIGTYPE LOGICAL
5975#define ARRAYOF_TYPE arrayof_logical
5976#include "arrayof_post.F90"
5977
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 |