libsim Versione 7.1.11
|
◆ arrayof_real_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 5807 del file array_utilities.F90. 5808! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
5809! authors:
5810! Davide Cesari <dcesari@arpa.emr.it>
5811! Paolo Patruno <ppatruno@arpa.emr.it>
5812
5813! This program is free software; you can redistribute it and/or
5814! modify it under the terms of the GNU General Public License as
5815! published by the Free Software Foundation; either version 2 of
5816! the License, or (at your option) any later version.
5817
5818! This program is distributed in the hope that it will be useful,
5819! but WITHOUT ANY WARRANTY; without even the implied warranty of
5820! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5821! GNU General Public License for more details.
5822
5823! You should have received a copy of the GNU General Public License
5824! along with this program. If not, see <http://www.gnu.org/licenses/>.
5825
5826
5827
5830#include "config.h"
5832
5833IMPLICIT NONE
5834
5835! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
5836!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
5837
5838#undef VOL7D_POLY_TYPE_AUTO
5839
5840#undef VOL7D_POLY_TYPE
5841#undef VOL7D_POLY_TYPES
5842#define VOL7D_POLY_TYPE INTEGER
5843#define VOL7D_POLY_TYPES _i
5844#define ENABLE_SORT
5845#include "array_utilities_pre.F90"
5846#undef ENABLE_SORT
5847
5848#undef VOL7D_POLY_TYPE
5849#undef VOL7D_POLY_TYPES
5850#define VOL7D_POLY_TYPE REAL
5851#define VOL7D_POLY_TYPES _r
5852#define ENABLE_SORT
5853#include "array_utilities_pre.F90"
5854#undef ENABLE_SORT
5855
5856#undef VOL7D_POLY_TYPE
5857#undef VOL7D_POLY_TYPES
5858#define VOL7D_POLY_TYPE DOUBLEPRECISION
5859#define VOL7D_POLY_TYPES _d
5860#define ENABLE_SORT
5861#include "array_utilities_pre.F90"
5862#undef ENABLE_SORT
5863
5864#define VOL7D_NO_PACK
5865#undef VOL7D_POLY_TYPE
5866#undef VOL7D_POLY_TYPES
5867#define VOL7D_POLY_TYPE CHARACTER(len=*)
5868#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5869#define VOL7D_POLY_TYPES _c
5870#define ENABLE_SORT
5871#include "array_utilities_pre.F90"
5872#undef VOL7D_POLY_TYPE_AUTO
5873#undef ENABLE_SORT
5874
5875
5876#define ARRAYOF_ORIGEQ 1
5877
5878#define ARRAYOF_ORIGTYPE INTEGER
5879#define ARRAYOF_TYPE arrayof_integer
5880#include "arrayof_pre.F90"
5881
5882#undef ARRAYOF_ORIGTYPE
5883#undef ARRAYOF_TYPE
5884#define ARRAYOF_ORIGTYPE REAL
5885#define ARRAYOF_TYPE arrayof_real
5886#include "arrayof_pre.F90"
5887
5888#undef ARRAYOF_ORIGTYPE
5889#undef ARRAYOF_TYPE
5890#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5891#define ARRAYOF_TYPE arrayof_doubleprecision
5892#include "arrayof_pre.F90"
5893
5894#undef ARRAYOF_ORIGEQ
5895
5896#undef ARRAYOF_ORIGTYPE
5897#undef ARRAYOF_TYPE
5898#define ARRAYOF_ORIGTYPE LOGICAL
5899#define ARRAYOF_TYPE arrayof_logical
5900#include "arrayof_pre.F90"
5901
5902PRIVATE
5903! from arrayof
5905PUBLIC insert_unique, append_unique
5906
5908 count_distinct_sorted, pack_distinct_sorted, &
5909 count_distinct, pack_distinct, count_and_pack_distinct, &
5910 map_distinct, map_inv_distinct, &
5911 firsttrue, lasttrue, pack_distinct_c, map
5912
5913CONTAINS
5914
5915
5918FUNCTION firsttrue(v) RESULT(i)
5919LOGICAL,INTENT(in) :: v(:)
5920INTEGER :: i
5921
5922DO i = 1, SIZE(v)
5923 IF (v(i)) RETURN
5924ENDDO
5925i = 0
5926
5927END FUNCTION firsttrue
5928
5929
5932FUNCTION lasttrue(v) RESULT(i)
5933LOGICAL,INTENT(in) :: v(:)
5934INTEGER :: i
5935
5936DO i = SIZE(v), 1, -1
5937 IF (v(i)) RETURN
5938ENDDO
5939
5940END FUNCTION lasttrue
5941
5942
5943! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
5944#undef VOL7D_POLY_TYPE_AUTO
5945#undef VOL7D_NO_PACK
5946
5947#undef VOL7D_POLY_TYPE
5948#undef VOL7D_POLY_TYPES
5949#define VOL7D_POLY_TYPE INTEGER
5950#define VOL7D_POLY_TYPES _i
5951#define ENABLE_SORT
5952#include "array_utilities_inc.F90"
5953#undef ENABLE_SORT
5954
5955#undef VOL7D_POLY_TYPE
5956#undef VOL7D_POLY_TYPES
5957#define VOL7D_POLY_TYPE REAL
5958#define VOL7D_POLY_TYPES _r
5959#define ENABLE_SORT
5960#include "array_utilities_inc.F90"
5961#undef ENABLE_SORT
5962
5963#undef VOL7D_POLY_TYPE
5964#undef VOL7D_POLY_TYPES
5965#define VOL7D_POLY_TYPE DOUBLEPRECISION
5966#define VOL7D_POLY_TYPES _d
5967#define ENABLE_SORT
5968#include "array_utilities_inc.F90"
5969#undef ENABLE_SORT
5970
5971#define VOL7D_NO_PACK
5972#undef VOL7D_POLY_TYPE
5973#undef VOL7D_POLY_TYPES
5974#define VOL7D_POLY_TYPE CHARACTER(len=*)
5975#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5976#define VOL7D_POLY_TYPES _c
5977#define ENABLE_SORT
5978#include "array_utilities_inc.F90"
5979#undef VOL7D_POLY_TYPE_AUTO
5980#undef ENABLE_SORT
5981
5982SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
5983CHARACTER(len=*),INTENT(in) :: vect(:)
5984LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
5985CHARACTER(len=LEN(vect)) :: pack_distinct(:)
5986
5987INTEGER :: count_distinct
5988INTEGER :: i, j, dim
5989LOGICAL :: lback
5990
5991dim = SIZE(pack_distinct)
5992IF (PRESENT(back)) THEN
5993 lback = back
5994ELSE
5995 lback = .false.
5996ENDIF
5997count_distinct = 0
5998
5999IF (PRESENT (mask)) THEN
6000 IF (lback) THEN
6001 vectm1: DO i = 1, SIZE(vect)
6002 IF (.NOT.mask(i)) cycle vectm1
6003! DO j = i-1, 1, -1
6004! IF (vect(j) == vect(i)) CYCLE vectm1
6005 DO j = count_distinct, 1, -1
6006 IF (pack_distinct(j) == vect(i)) cycle vectm1
6007 ENDDO
6008 count_distinct = count_distinct + 1
6009 IF (count_distinct > dim) EXIT
6010 pack_distinct(count_distinct) = vect(i)
6011 ENDDO vectm1
6012 ELSE
6013 vectm2: DO i = 1, SIZE(vect)
6014 IF (.NOT.mask(i)) cycle vectm2
6015! DO j = 1, i-1
6016! IF (vect(j) == vect(i)) CYCLE vectm2
6017 DO j = 1, count_distinct
6018 IF (pack_distinct(j) == vect(i)) cycle vectm2
6019 ENDDO
6020 count_distinct = count_distinct + 1
6021 IF (count_distinct > dim) EXIT
6022 pack_distinct(count_distinct) = vect(i)
6023 ENDDO vectm2
6024 ENDIF
6025ELSE
6026 IF (lback) THEN
6027 vect1: DO i = 1, SIZE(vect)
6028! DO j = i-1, 1, -1
6029! IF (vect(j) == vect(i)) CYCLE vect1
6030 DO j = count_distinct, 1, -1
6031 IF (pack_distinct(j) == vect(i)) cycle vect1
6032 ENDDO
6033 count_distinct = count_distinct + 1
6034 IF (count_distinct > dim) EXIT
6035 pack_distinct(count_distinct) = vect(i)
6036 ENDDO vect1
6037 ELSE
6038 vect2: DO i = 1, SIZE(vect)
6039! DO j = 1, i-1
6040! IF (vect(j) == vect(i)) CYCLE vect2
6041 DO j = 1, count_distinct
6042 IF (pack_distinct(j) == vect(i)) cycle vect2
6043 ENDDO
6044 count_distinct = count_distinct + 1
6045 IF (count_distinct > dim) EXIT
6046 pack_distinct(count_distinct) = vect(i)
6047 ENDDO vect2
6048 ENDIF
6049ENDIF
6050
6051END SUBROUTINE pack_distinct_c
6052
6054FUNCTION map(mask) RESULT(mapidx)
6055LOGICAL,INTENT(in) :: mask(:)
6056INTEGER :: mapidx(count(mask))
6057
6058INTEGER :: i,j
6059
6060j = 0
6061DO i=1, SIZE(mask)
6062 j = j + 1
6063 IF (mask(i)) mapidx(j)=i
6064ENDDO
6065
6066END FUNCTION map
6067
6068#define ARRAYOF_ORIGEQ 1
6069
6070#undef ARRAYOF_ORIGTYPE
6071#undef ARRAYOF_TYPE
6072#define ARRAYOF_ORIGTYPE INTEGER
6073#define ARRAYOF_TYPE arrayof_integer
6074#include "arrayof_post.F90"
6075
6076#undef ARRAYOF_ORIGTYPE
6077#undef ARRAYOF_TYPE
6078#define ARRAYOF_ORIGTYPE REAL
6079#define ARRAYOF_TYPE arrayof_real
6080#include "arrayof_post.F90"
6081
6082#undef ARRAYOF_ORIGTYPE
6083#undef ARRAYOF_TYPE
6084#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6085#define ARRAYOF_TYPE arrayof_doubleprecision
6086#include "arrayof_post.F90"
6087
6088#undef ARRAYOF_ORIGEQ
6089
6090#undef ARRAYOF_ORIGTYPE
6091#undef ARRAYOF_TYPE
6092#define ARRAYOF_ORIGTYPE LOGICAL
6093#define ARRAYOF_TYPE arrayof_logical
6094#include "arrayof_post.F90"
6095
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 |