libsim Versione 7.1.11
|
◆ arrayof_doubleprecision_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 6088 del file array_utilities.F90. 6089! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6090! authors:
6091! Davide Cesari <dcesari@arpa.emr.it>
6092! Paolo Patruno <ppatruno@arpa.emr.it>
6093
6094! This program is free software; you can redistribute it and/or
6095! modify it under the terms of the GNU General Public License as
6096! published by the Free Software Foundation; either version 2 of
6097! the License, or (at your option) any later version.
6098
6099! This program is distributed in the hope that it will be useful,
6100! but WITHOUT ANY WARRANTY; without even the implied warranty of
6101! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6102! GNU General Public License for more details.
6103
6104! You should have received a copy of the GNU General Public License
6105! along with this program. If not, see <http://www.gnu.org/licenses/>.
6106
6107
6108
6111#include "config.h"
6113
6114IMPLICIT NONE
6115
6116! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6117!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6118
6119#undef VOL7D_POLY_TYPE_AUTO
6120
6121#undef VOL7D_POLY_TYPE
6122#undef VOL7D_POLY_TYPES
6123#define VOL7D_POLY_TYPE INTEGER
6124#define VOL7D_POLY_TYPES _i
6125#define ENABLE_SORT
6126#include "array_utilities_pre.F90"
6127#undef ENABLE_SORT
6128
6129#undef VOL7D_POLY_TYPE
6130#undef VOL7D_POLY_TYPES
6131#define VOL7D_POLY_TYPE REAL
6132#define VOL7D_POLY_TYPES _r
6133#define ENABLE_SORT
6134#include "array_utilities_pre.F90"
6135#undef ENABLE_SORT
6136
6137#undef VOL7D_POLY_TYPE
6138#undef VOL7D_POLY_TYPES
6139#define VOL7D_POLY_TYPE DOUBLEPRECISION
6140#define VOL7D_POLY_TYPES _d
6141#define ENABLE_SORT
6142#include "array_utilities_pre.F90"
6143#undef ENABLE_SORT
6144
6145#define VOL7D_NO_PACK
6146#undef VOL7D_POLY_TYPE
6147#undef VOL7D_POLY_TYPES
6148#define VOL7D_POLY_TYPE CHARACTER(len=*)
6149#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6150#define VOL7D_POLY_TYPES _c
6151#define ENABLE_SORT
6152#include "array_utilities_pre.F90"
6153#undef VOL7D_POLY_TYPE_AUTO
6154#undef ENABLE_SORT
6155
6156
6157#define ARRAYOF_ORIGEQ 1
6158
6159#define ARRAYOF_ORIGTYPE INTEGER
6160#define ARRAYOF_TYPE arrayof_integer
6161#include "arrayof_pre.F90"
6162
6163#undef ARRAYOF_ORIGTYPE
6164#undef ARRAYOF_TYPE
6165#define ARRAYOF_ORIGTYPE REAL
6166#define ARRAYOF_TYPE arrayof_real
6167#include "arrayof_pre.F90"
6168
6169#undef ARRAYOF_ORIGTYPE
6170#undef ARRAYOF_TYPE
6171#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6172#define ARRAYOF_TYPE arrayof_doubleprecision
6173#include "arrayof_pre.F90"
6174
6175#undef ARRAYOF_ORIGEQ
6176
6177#undef ARRAYOF_ORIGTYPE
6178#undef ARRAYOF_TYPE
6179#define ARRAYOF_ORIGTYPE LOGICAL
6180#define ARRAYOF_TYPE arrayof_logical
6181#include "arrayof_pre.F90"
6182
6183PRIVATE
6184! from arrayof
6186PUBLIC insert_unique, append_unique
6187
6189 count_distinct_sorted, pack_distinct_sorted, &
6190 count_distinct, pack_distinct, count_and_pack_distinct, &
6191 map_distinct, map_inv_distinct, &
6192 firsttrue, lasttrue, pack_distinct_c, map
6193
6194CONTAINS
6195
6196
6199FUNCTION firsttrue(v) RESULT(i)
6200LOGICAL,INTENT(in) :: v(:)
6201INTEGER :: i
6202
6203DO i = 1, SIZE(v)
6204 IF (v(i)) RETURN
6205ENDDO
6206i = 0
6207
6208END FUNCTION firsttrue
6209
6210
6213FUNCTION lasttrue(v) RESULT(i)
6214LOGICAL,INTENT(in) :: v(:)
6215INTEGER :: i
6216
6217DO i = SIZE(v), 1, -1
6218 IF (v(i)) RETURN
6219ENDDO
6220
6221END FUNCTION lasttrue
6222
6223
6224! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6225#undef VOL7D_POLY_TYPE_AUTO
6226#undef VOL7D_NO_PACK
6227
6228#undef VOL7D_POLY_TYPE
6229#undef VOL7D_POLY_TYPES
6230#define VOL7D_POLY_TYPE INTEGER
6231#define VOL7D_POLY_TYPES _i
6232#define ENABLE_SORT
6233#include "array_utilities_inc.F90"
6234#undef ENABLE_SORT
6235
6236#undef VOL7D_POLY_TYPE
6237#undef VOL7D_POLY_TYPES
6238#define VOL7D_POLY_TYPE REAL
6239#define VOL7D_POLY_TYPES _r
6240#define ENABLE_SORT
6241#include "array_utilities_inc.F90"
6242#undef ENABLE_SORT
6243
6244#undef VOL7D_POLY_TYPE
6245#undef VOL7D_POLY_TYPES
6246#define VOL7D_POLY_TYPE DOUBLEPRECISION
6247#define VOL7D_POLY_TYPES _d
6248#define ENABLE_SORT
6249#include "array_utilities_inc.F90"
6250#undef ENABLE_SORT
6251
6252#define VOL7D_NO_PACK
6253#undef VOL7D_POLY_TYPE
6254#undef VOL7D_POLY_TYPES
6255#define VOL7D_POLY_TYPE CHARACTER(len=*)
6256#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6257#define VOL7D_POLY_TYPES _c
6258#define ENABLE_SORT
6259#include "array_utilities_inc.F90"
6260#undef VOL7D_POLY_TYPE_AUTO
6261#undef ENABLE_SORT
6262
6263SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6264CHARACTER(len=*),INTENT(in) :: vect(:)
6265LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6266CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6267
6268INTEGER :: count_distinct
6269INTEGER :: i, j, dim
6270LOGICAL :: lback
6271
6272dim = SIZE(pack_distinct)
6273IF (PRESENT(back)) THEN
6274 lback = back
6275ELSE
6276 lback = .false.
6277ENDIF
6278count_distinct = 0
6279
6280IF (PRESENT (mask)) THEN
6281 IF (lback) THEN
6282 vectm1: DO i = 1, SIZE(vect)
6283 IF (.NOT.mask(i)) cycle vectm1
6284! DO j = i-1, 1, -1
6285! IF (vect(j) == vect(i)) CYCLE vectm1
6286 DO j = count_distinct, 1, -1
6287 IF (pack_distinct(j) == vect(i)) cycle vectm1
6288 ENDDO
6289 count_distinct = count_distinct + 1
6290 IF (count_distinct > dim) EXIT
6291 pack_distinct(count_distinct) = vect(i)
6292 ENDDO vectm1
6293 ELSE
6294 vectm2: DO i = 1, SIZE(vect)
6295 IF (.NOT.mask(i)) cycle vectm2
6296! DO j = 1, i-1
6297! IF (vect(j) == vect(i)) CYCLE vectm2
6298 DO j = 1, count_distinct
6299 IF (pack_distinct(j) == vect(i)) cycle vectm2
6300 ENDDO
6301 count_distinct = count_distinct + 1
6302 IF (count_distinct > dim) EXIT
6303 pack_distinct(count_distinct) = vect(i)
6304 ENDDO vectm2
6305 ENDIF
6306ELSE
6307 IF (lback) THEN
6308 vect1: DO i = 1, SIZE(vect)
6309! DO j = i-1, 1, -1
6310! IF (vect(j) == vect(i)) CYCLE vect1
6311 DO j = count_distinct, 1, -1
6312 IF (pack_distinct(j) == vect(i)) cycle vect1
6313 ENDDO
6314 count_distinct = count_distinct + 1
6315 IF (count_distinct > dim) EXIT
6316 pack_distinct(count_distinct) = vect(i)
6317 ENDDO vect1
6318 ELSE
6319 vect2: DO i = 1, SIZE(vect)
6320! DO j = 1, i-1
6321! IF (vect(j) == vect(i)) CYCLE vect2
6322 DO j = 1, count_distinct
6323 IF (pack_distinct(j) == vect(i)) cycle vect2
6324 ENDDO
6325 count_distinct = count_distinct + 1
6326 IF (count_distinct > dim) EXIT
6327 pack_distinct(count_distinct) = vect(i)
6328 ENDDO vect2
6329 ENDIF
6330ENDIF
6331
6332END SUBROUTINE pack_distinct_c
6333
6335FUNCTION map(mask) RESULT(mapidx)
6336LOGICAL,INTENT(in) :: mask(:)
6337INTEGER :: mapidx(count(mask))
6338
6339INTEGER :: i,j
6340
6341j = 0
6342DO i=1, SIZE(mask)
6343 j = j + 1
6344 IF (mask(i)) mapidx(j)=i
6345ENDDO
6346
6347END FUNCTION map
6348
6349#define ARRAYOF_ORIGEQ 1
6350
6351#undef ARRAYOF_ORIGTYPE
6352#undef ARRAYOF_TYPE
6353#define ARRAYOF_ORIGTYPE INTEGER
6354#define ARRAYOF_TYPE arrayof_integer
6355#include "arrayof_post.F90"
6356
6357#undef ARRAYOF_ORIGTYPE
6358#undef ARRAYOF_TYPE
6359#define ARRAYOF_ORIGTYPE REAL
6360#define ARRAYOF_TYPE arrayof_real
6361#include "arrayof_post.F90"
6362
6363#undef ARRAYOF_ORIGTYPE
6364#undef ARRAYOF_TYPE
6365#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6366#define ARRAYOF_TYPE arrayof_doubleprecision
6367#include "arrayof_post.F90"
6368
6369#undef ARRAYOF_ORIGEQ
6370
6371#undef ARRAYOF_ORIGTYPE
6372#undef ARRAYOF_TYPE
6373#define ARRAYOF_ORIGTYPE LOGICAL
6374#define ARRAYOF_TYPE arrayof_logical
6375#include "arrayof_post.F90"
6376
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 |