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