libsim Versione 7.2.4

◆ arrayof_real_append()

integer function, private arrayof_real_append ( type(arrayof_real) this,
real, intent(in) content )
private

Quick method to append an element to the array.

The return value is the position at which the element has been appended.

Parametri
thisarray object to extend
[in]contentobject of TYPE REAL to append

Definizione alla linea 5854 del file array_utilities.F90.

5855! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
5856! authors:
5857! Davide Cesari <dcesari@arpa.emr.it>
5858! Paolo Patruno <ppatruno@arpa.emr.it>
5859
5860! This program is free software; you can redistribute it and/or
5861! modify it under the terms of the GNU General Public License as
5862! published by the Free Software Foundation; either version 2 of
5863! the License, or (at your option) any later version.
5864
5865! This program is distributed in the hope that it will be useful,
5866! but WITHOUT ANY WARRANTY; without even the implied warranty of
5867! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5868! GNU General Public License for more details.
5869
5870! You should have received a copy of the GNU General Public License
5871! along with this program. If not, see <http://www.gnu.org/licenses/>.
5872
5873
5874
5877#include "config.h"
5878MODULE array_utilities
5879
5880IMPLICIT NONE
5881
5882! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
5883!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
5884
5885#undef VOL7D_POLY_TYPE_AUTO
5886
5887#undef VOL7D_POLY_TYPE
5888#undef VOL7D_POLY_TYPES
5889#define VOL7D_POLY_TYPE INTEGER
5890#define VOL7D_POLY_TYPES _i
5891#define ENABLE_SORT
5892#include "array_utilities_pre.F90"
5893#undef ENABLE_SORT
5894
5895#undef VOL7D_POLY_TYPE
5896#undef VOL7D_POLY_TYPES
5897#define VOL7D_POLY_TYPE REAL
5898#define VOL7D_POLY_TYPES _r
5899#define ENABLE_SORT
5900#include "array_utilities_pre.F90"
5901#undef ENABLE_SORT
5902
5903#undef VOL7D_POLY_TYPE
5904#undef VOL7D_POLY_TYPES
5905#define VOL7D_POLY_TYPE DOUBLEPRECISION
5906#define VOL7D_POLY_TYPES _d
5907#define ENABLE_SORT
5908#include "array_utilities_pre.F90"
5909#undef ENABLE_SORT
5910
5911#define VOL7D_NO_PACK
5912#undef VOL7D_POLY_TYPE
5913#undef VOL7D_POLY_TYPES
5914#define VOL7D_POLY_TYPE CHARACTER(len=*)
5915#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
5916#define VOL7D_POLY_TYPES _c
5917#define ENABLE_SORT
5918#include "array_utilities_pre.F90"
5919#undef VOL7D_POLY_TYPE_AUTO
5920#undef ENABLE_SORT
5921
5922
5923#define ARRAYOF_ORIGEQ 1
5924
5925#define ARRAYOF_ORIGTYPE INTEGER
5926#define ARRAYOF_TYPE arrayof_integer
5927#include "arrayof_pre.F90"
5928
5929#undef ARRAYOF_ORIGTYPE
5930#undef ARRAYOF_TYPE
5931#define ARRAYOF_ORIGTYPE REAL
5932#define ARRAYOF_TYPE arrayof_real
5933#include "arrayof_pre.F90"
5934
5935#undef ARRAYOF_ORIGTYPE
5936#undef ARRAYOF_TYPE
5937#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
5938#define ARRAYOF_TYPE arrayof_doubleprecision
5939#include "arrayof_pre.F90"
5940
5941#undef ARRAYOF_ORIGEQ
5942
5943#undef ARRAYOF_ORIGTYPE
5944#undef ARRAYOF_TYPE
5945#define ARRAYOF_ORIGTYPE LOGICAL
5946#define ARRAYOF_TYPE arrayof_logical
5947#include "arrayof_pre.F90"
5948
5949PRIVATE
5950! from arrayof
5952PUBLIC insert_unique, append_unique
5953
5954PUBLIC sort, index, index_c, &
5955 count_distinct_sorted, pack_distinct_sorted, &
5956 count_distinct, pack_distinct, count_and_pack_distinct, &
5957 map_distinct, map_inv_distinct, &
5958 firsttrue, lasttrue, pack_distinct_c, map
5959
5960CONTAINS
5961
5962
5965FUNCTION firsttrue(v) RESULT(i)
5966LOGICAL,INTENT(in) :: v(:)
5967INTEGER :: i
5968
5969DO i = 1, SIZE(v)
5970 IF (v(i)) RETURN
5971ENDDO
5972i = 0
5973
5974END FUNCTION firsttrue
5975
5976
5979FUNCTION lasttrue(v) RESULT(i)
5980LOGICAL,INTENT(in) :: v(:)
5981INTEGER :: i
5982
5983DO i = SIZE(v), 1, -1
5984 IF (v(i)) RETURN
5985ENDDO
5986
5987END FUNCTION lasttrue
5988
5989
5990! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
5991#undef VOL7D_POLY_TYPE_AUTO
5992#undef VOL7D_NO_PACK
5993
5994#undef VOL7D_POLY_TYPE
5995#undef VOL7D_POLY_TYPES
5996#define VOL7D_POLY_TYPE INTEGER
5997#define VOL7D_POLY_TYPES _i
5998#define ENABLE_SORT
5999#include "array_utilities_inc.F90"
6000#undef ENABLE_SORT
6001
6002#undef VOL7D_POLY_TYPE
6003#undef VOL7D_POLY_TYPES
6004#define VOL7D_POLY_TYPE REAL
6005#define VOL7D_POLY_TYPES _r
6006#define ENABLE_SORT
6007#include "array_utilities_inc.F90"
6008#undef ENABLE_SORT
6009
6010#undef VOL7D_POLY_TYPE
6011#undef VOL7D_POLY_TYPES
6012#define VOL7D_POLY_TYPE DOUBLEPRECISION
6013#define VOL7D_POLY_TYPES _d
6014#define ENABLE_SORT
6015#include "array_utilities_inc.F90"
6016#undef ENABLE_SORT
6017
6018#define VOL7D_NO_PACK
6019#undef VOL7D_POLY_TYPE
6020#undef VOL7D_POLY_TYPES
6021#define VOL7D_POLY_TYPE CHARACTER(len=*)
6022#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6023#define VOL7D_POLY_TYPES _c
6024#define ENABLE_SORT
6025#include "array_utilities_inc.F90"
6026#undef VOL7D_POLY_TYPE_AUTO
6027#undef ENABLE_SORT
6028
6029SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6030CHARACTER(len=*),INTENT(in) :: vect(:)
6031LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6032CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6033
6034INTEGER :: count_distinct
6035INTEGER :: i, j, dim
6036LOGICAL :: lback
6037
6038dim = SIZE(pack_distinct)
6039IF (PRESENT(back)) THEN
6040 lback = back
6041ELSE
6042 lback = .false.
6043ENDIF
6044count_distinct = 0
6045
6046IF (PRESENT (mask)) THEN
6047 IF (lback) THEN
6048 vectm1: DO i = 1, SIZE(vect)
6049 IF (.NOT.mask(i)) cycle vectm1
6050! DO j = i-1, 1, -1
6051! IF (vect(j) == vect(i)) CYCLE vectm1
6052 DO j = count_distinct, 1, -1
6053 IF (pack_distinct(j) == vect(i)) cycle vectm1
6054 ENDDO
6055 count_distinct = count_distinct + 1
6056 IF (count_distinct > dim) EXIT
6057 pack_distinct(count_distinct) = vect(i)
6058 ENDDO vectm1
6059 ELSE
6060 vectm2: DO i = 1, SIZE(vect)
6061 IF (.NOT.mask(i)) cycle vectm2
6062! DO j = 1, i-1
6063! IF (vect(j) == vect(i)) CYCLE vectm2
6064 DO j = 1, count_distinct
6065 IF (pack_distinct(j) == vect(i)) cycle vectm2
6066 ENDDO
6067 count_distinct = count_distinct + 1
6068 IF (count_distinct > dim) EXIT
6069 pack_distinct(count_distinct) = vect(i)
6070 ENDDO vectm2
6071 ENDIF
6072ELSE
6073 IF (lback) THEN
6074 vect1: DO i = 1, SIZE(vect)
6075! DO j = i-1, 1, -1
6076! IF (vect(j) == vect(i)) CYCLE vect1
6077 DO j = count_distinct, 1, -1
6078 IF (pack_distinct(j) == vect(i)) cycle vect1
6079 ENDDO
6080 count_distinct = count_distinct + 1
6081 IF (count_distinct > dim) EXIT
6082 pack_distinct(count_distinct) = vect(i)
6083 ENDDO vect1
6084 ELSE
6085 vect2: DO i = 1, SIZE(vect)
6086! DO j = 1, i-1
6087! IF (vect(j) == vect(i)) CYCLE vect2
6088 DO j = 1, count_distinct
6089 IF (pack_distinct(j) == vect(i)) cycle vect2
6090 ENDDO
6091 count_distinct = count_distinct + 1
6092 IF (count_distinct > dim) EXIT
6093 pack_distinct(count_distinct) = vect(i)
6094 ENDDO vect2
6095 ENDIF
6096ENDIF
6097
6098END SUBROUTINE pack_distinct_c
6099
6101FUNCTION map(mask) RESULT(mapidx)
6102LOGICAL,INTENT(in) :: mask(:)
6103INTEGER :: mapidx(count(mask))
6104
6105INTEGER :: i,j
6106
6107j = 0
6108DO i=1, SIZE(mask)
6109 j = j + 1
6110 IF (mask(i)) mapidx(j)=i
6111ENDDO
6112
6113END FUNCTION map
6114
6115#define ARRAYOF_ORIGEQ 1
6116
6117#undef ARRAYOF_ORIGTYPE
6118#undef ARRAYOF_TYPE
6119#define ARRAYOF_ORIGTYPE INTEGER
6120#define ARRAYOF_TYPE arrayof_integer
6121#include "arrayof_post.F90"
6122
6123#undef ARRAYOF_ORIGTYPE
6124#undef ARRAYOF_TYPE
6125#define ARRAYOF_ORIGTYPE REAL
6126#define ARRAYOF_TYPE arrayof_real
6127#include "arrayof_post.F90"
6128
6129#undef ARRAYOF_ORIGTYPE
6130#undef ARRAYOF_TYPE
6131#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6132#define ARRAYOF_TYPE arrayof_doubleprecision
6133#include "arrayof_post.F90"
6134
6135#undef ARRAYOF_ORIGEQ
6136
6137#undef ARRAYOF_ORIGTYPE
6138#undef ARRAYOF_TYPE
6139#define ARRAYOF_ORIGTYPE LOGICAL
6140#define ARRAYOF_TYPE arrayof_logical
6141#include "arrayof_post.F90"
6142
6143END 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.