libsim Versione 7.1.11
|
◆ arrayof_real_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 5972 del file array_utilities.F90. 5977! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
5978! authors:
5979! Davide Cesari <dcesari@arpa.emr.it>
5980! Paolo Patruno <ppatruno@arpa.emr.it>
5981
5982! This program is free software; you can redistribute it and/or
5983! modify it under the terms of the GNU General Public License as
5984! published by the Free Software Foundation; either version 2 of
5985! the License, or (at your option) any later version.
5986
5987! This program is distributed in the hope that it will be useful,
5988! but WITHOUT ANY WARRANTY; without even the implied warranty of
5989! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5990! GNU General Public License for more details.
5991
5992! You should have received a copy of the GNU General Public License
5993! along with this program. If not, see <http://www.gnu.org/licenses/>.
5994
5995
5996
5999#include "config.h"
6001
6002IMPLICIT NONE
6003
6004! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6005!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6006
6007#undef VOL7D_POLY_TYPE_AUTO
6008
6009#undef VOL7D_POLY_TYPE
6010#undef VOL7D_POLY_TYPES
6011#define VOL7D_POLY_TYPE INTEGER
6012#define VOL7D_POLY_TYPES _i
6013#define ENABLE_SORT
6014#include "array_utilities_pre.F90"
6015#undef ENABLE_SORT
6016
6017#undef VOL7D_POLY_TYPE
6018#undef VOL7D_POLY_TYPES
6019#define VOL7D_POLY_TYPE REAL
6020#define VOL7D_POLY_TYPES _r
6021#define ENABLE_SORT
6022#include "array_utilities_pre.F90"
6023#undef ENABLE_SORT
6024
6025#undef VOL7D_POLY_TYPE
6026#undef VOL7D_POLY_TYPES
6027#define VOL7D_POLY_TYPE DOUBLEPRECISION
6028#define VOL7D_POLY_TYPES _d
6029#define ENABLE_SORT
6030#include "array_utilities_pre.F90"
6031#undef ENABLE_SORT
6032
6033#define VOL7D_NO_PACK
6034#undef VOL7D_POLY_TYPE
6035#undef VOL7D_POLY_TYPES
6036#define VOL7D_POLY_TYPE CHARACTER(len=*)
6037#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6038#define VOL7D_POLY_TYPES _c
6039#define ENABLE_SORT
6040#include "array_utilities_pre.F90"
6041#undef VOL7D_POLY_TYPE_AUTO
6042#undef ENABLE_SORT
6043
6044
6045#define ARRAYOF_ORIGEQ 1
6046
6047#define ARRAYOF_ORIGTYPE INTEGER
6048#define ARRAYOF_TYPE arrayof_integer
6049#include "arrayof_pre.F90"
6050
6051#undef ARRAYOF_ORIGTYPE
6052#undef ARRAYOF_TYPE
6053#define ARRAYOF_ORIGTYPE REAL
6054#define ARRAYOF_TYPE arrayof_real
6055#include "arrayof_pre.F90"
6056
6057#undef ARRAYOF_ORIGTYPE
6058#undef ARRAYOF_TYPE
6059#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6060#define ARRAYOF_TYPE arrayof_doubleprecision
6061#include "arrayof_pre.F90"
6062
6063#undef ARRAYOF_ORIGEQ
6064
6065#undef ARRAYOF_ORIGTYPE
6066#undef ARRAYOF_TYPE
6067#define ARRAYOF_ORIGTYPE LOGICAL
6068#define ARRAYOF_TYPE arrayof_logical
6069#include "arrayof_pre.F90"
6070
6071PRIVATE
6072! from arrayof
6074PUBLIC insert_unique, append_unique
6075
6077 count_distinct_sorted, pack_distinct_sorted, &
6078 count_distinct, pack_distinct, count_and_pack_distinct, &
6079 map_distinct, map_inv_distinct, &
6080 firsttrue, lasttrue, pack_distinct_c, map
6081
6082CONTAINS
6083
6084
6087FUNCTION firsttrue(v) RESULT(i)
6088LOGICAL,INTENT(in) :: v(:)
6089INTEGER :: i
6090
6091DO i = 1, SIZE(v)
6092 IF (v(i)) RETURN
6093ENDDO
6094i = 0
6095
6096END FUNCTION firsttrue
6097
6098
6101FUNCTION lasttrue(v) RESULT(i)
6102LOGICAL,INTENT(in) :: v(:)
6103INTEGER :: i
6104
6105DO i = SIZE(v), 1, -1
6106 IF (v(i)) RETURN
6107ENDDO
6108
6109END FUNCTION lasttrue
6110
6111
6112! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6113#undef VOL7D_POLY_TYPE_AUTO
6114#undef VOL7D_NO_PACK
6115
6116#undef VOL7D_POLY_TYPE
6117#undef VOL7D_POLY_TYPES
6118#define VOL7D_POLY_TYPE INTEGER
6119#define VOL7D_POLY_TYPES _i
6120#define ENABLE_SORT
6121#include "array_utilities_inc.F90"
6122#undef ENABLE_SORT
6123
6124#undef VOL7D_POLY_TYPE
6125#undef VOL7D_POLY_TYPES
6126#define VOL7D_POLY_TYPE REAL
6127#define VOL7D_POLY_TYPES _r
6128#define ENABLE_SORT
6129#include "array_utilities_inc.F90"
6130#undef ENABLE_SORT
6131
6132#undef VOL7D_POLY_TYPE
6133#undef VOL7D_POLY_TYPES
6134#define VOL7D_POLY_TYPE DOUBLEPRECISION
6135#define VOL7D_POLY_TYPES _d
6136#define ENABLE_SORT
6137#include "array_utilities_inc.F90"
6138#undef ENABLE_SORT
6139
6140#define VOL7D_NO_PACK
6141#undef VOL7D_POLY_TYPE
6142#undef VOL7D_POLY_TYPES
6143#define VOL7D_POLY_TYPE CHARACTER(len=*)
6144#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6145#define VOL7D_POLY_TYPES _c
6146#define ENABLE_SORT
6147#include "array_utilities_inc.F90"
6148#undef VOL7D_POLY_TYPE_AUTO
6149#undef ENABLE_SORT
6150
6151SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6152CHARACTER(len=*),INTENT(in) :: vect(:)
6153LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6154CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6155
6156INTEGER :: count_distinct
6157INTEGER :: i, j, dim
6158LOGICAL :: lback
6159
6160dim = SIZE(pack_distinct)
6161IF (PRESENT(back)) THEN
6162 lback = back
6163ELSE
6164 lback = .false.
6165ENDIF
6166count_distinct = 0
6167
6168IF (PRESENT (mask)) THEN
6169 IF (lback) THEN
6170 vectm1: DO i = 1, SIZE(vect)
6171 IF (.NOT.mask(i)) cycle vectm1
6172! DO j = i-1, 1, -1
6173! IF (vect(j) == vect(i)) CYCLE vectm1
6174 DO j = count_distinct, 1, -1
6175 IF (pack_distinct(j) == vect(i)) cycle vectm1
6176 ENDDO
6177 count_distinct = count_distinct + 1
6178 IF (count_distinct > dim) EXIT
6179 pack_distinct(count_distinct) = vect(i)
6180 ENDDO vectm1
6181 ELSE
6182 vectm2: DO i = 1, SIZE(vect)
6183 IF (.NOT.mask(i)) cycle vectm2
6184! DO j = 1, i-1
6185! IF (vect(j) == vect(i)) CYCLE vectm2
6186 DO j = 1, count_distinct
6187 IF (pack_distinct(j) == vect(i)) cycle vectm2
6188 ENDDO
6189 count_distinct = count_distinct + 1
6190 IF (count_distinct > dim) EXIT
6191 pack_distinct(count_distinct) = vect(i)
6192 ENDDO vectm2
6193 ENDIF
6194ELSE
6195 IF (lback) THEN
6196 vect1: DO i = 1, SIZE(vect)
6197! DO j = i-1, 1, -1
6198! IF (vect(j) == vect(i)) CYCLE vect1
6199 DO j = count_distinct, 1, -1
6200 IF (pack_distinct(j) == vect(i)) cycle vect1
6201 ENDDO
6202 count_distinct = count_distinct + 1
6203 IF (count_distinct > dim) EXIT
6204 pack_distinct(count_distinct) = vect(i)
6205 ENDDO vect1
6206 ELSE
6207 vect2: DO i = 1, SIZE(vect)
6208! DO j = 1, i-1
6209! IF (vect(j) == vect(i)) CYCLE vect2
6210 DO j = 1, count_distinct
6211 IF (pack_distinct(j) == vect(i)) cycle vect2
6212 ENDDO
6213 count_distinct = count_distinct + 1
6214 IF (count_distinct > dim) EXIT
6215 pack_distinct(count_distinct) = vect(i)
6216 ENDDO vect2
6217 ENDIF
6218ENDIF
6219
6220END SUBROUTINE pack_distinct_c
6221
6223FUNCTION map(mask) RESULT(mapidx)
6224LOGICAL,INTENT(in) :: mask(:)
6225INTEGER :: mapidx(count(mask))
6226
6227INTEGER :: i,j
6228
6229j = 0
6230DO i=1, SIZE(mask)
6231 j = j + 1
6232 IF (mask(i)) mapidx(j)=i
6233ENDDO
6234
6235END FUNCTION map
6236
6237#define ARRAYOF_ORIGEQ 1
6238
6239#undef ARRAYOF_ORIGTYPE
6240#undef ARRAYOF_TYPE
6241#define ARRAYOF_ORIGTYPE INTEGER
6242#define ARRAYOF_TYPE arrayof_integer
6243#include "arrayof_post.F90"
6244
6245#undef ARRAYOF_ORIGTYPE
6246#undef ARRAYOF_TYPE
6247#define ARRAYOF_ORIGTYPE REAL
6248#define ARRAYOF_TYPE arrayof_real
6249#include "arrayof_post.F90"
6250
6251#undef ARRAYOF_ORIGTYPE
6252#undef ARRAYOF_TYPE
6253#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6254#define ARRAYOF_TYPE arrayof_doubleprecision
6255#include "arrayof_post.F90"
6256
6257#undef ARRAYOF_ORIGEQ
6258
6259#undef ARRAYOF_ORIGTYPE
6260#undef ARRAYOF_TYPE
6261#define ARRAYOF_ORIGTYPE LOGICAL
6262#define ARRAYOF_TYPE arrayof_logical
6263#include "arrayof_post.F90"
6264
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 |