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