libsim Versione 7.1.11
|
◆ arrayof_doubleprecision_append()
Quick method to append an element to the array. The return value is the position at which the element has been appended.
Definizione alla linea 6141 del file array_utilities.F90. 6142! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6143! authors:
6144! Davide Cesari <dcesari@arpa.emr.it>
6145! Paolo Patruno <ppatruno@arpa.emr.it>
6146
6147! This program is free software; you can redistribute it and/or
6148! modify it under the terms of the GNU General Public License as
6149! published by the Free Software Foundation; either version 2 of
6150! the License, or (at your option) any later version.
6151
6152! This program is distributed in the hope that it will be useful,
6153! but WITHOUT ANY WARRANTY; without even the implied warranty of
6154! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6155! GNU General Public License for more details.
6156
6157! You should have received a copy of the GNU General Public License
6158! along with this program. If not, see <http://www.gnu.org/licenses/>.
6159
6160
6161
6164#include "config.h"
6166
6167IMPLICIT NONE
6168
6169! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
6170!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
6171
6172#undef VOL7D_POLY_TYPE_AUTO
6173
6174#undef VOL7D_POLY_TYPE
6175#undef VOL7D_POLY_TYPES
6176#define VOL7D_POLY_TYPE INTEGER
6177#define VOL7D_POLY_TYPES _i
6178#define ENABLE_SORT
6179#include "array_utilities_pre.F90"
6180#undef ENABLE_SORT
6181
6182#undef VOL7D_POLY_TYPE
6183#undef VOL7D_POLY_TYPES
6184#define VOL7D_POLY_TYPE REAL
6185#define VOL7D_POLY_TYPES _r
6186#define ENABLE_SORT
6187#include "array_utilities_pre.F90"
6188#undef ENABLE_SORT
6189
6190#undef VOL7D_POLY_TYPE
6191#undef VOL7D_POLY_TYPES
6192#define VOL7D_POLY_TYPE DOUBLEPRECISION
6193#define VOL7D_POLY_TYPES _d
6194#define ENABLE_SORT
6195#include "array_utilities_pre.F90"
6196#undef ENABLE_SORT
6197
6198#define VOL7D_NO_PACK
6199#undef VOL7D_POLY_TYPE
6200#undef VOL7D_POLY_TYPES
6201#define VOL7D_POLY_TYPE CHARACTER(len=*)
6202#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6203#define VOL7D_POLY_TYPES _c
6204#define ENABLE_SORT
6205#include "array_utilities_pre.F90"
6206#undef VOL7D_POLY_TYPE_AUTO
6207#undef ENABLE_SORT
6208
6209
6210#define ARRAYOF_ORIGEQ 1
6211
6212#define ARRAYOF_ORIGTYPE INTEGER
6213#define ARRAYOF_TYPE arrayof_integer
6214#include "arrayof_pre.F90"
6215
6216#undef ARRAYOF_ORIGTYPE
6217#undef ARRAYOF_TYPE
6218#define ARRAYOF_ORIGTYPE REAL
6219#define ARRAYOF_TYPE arrayof_real
6220#include "arrayof_pre.F90"
6221
6222#undef ARRAYOF_ORIGTYPE
6223#undef ARRAYOF_TYPE
6224#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6225#define ARRAYOF_TYPE arrayof_doubleprecision
6226#include "arrayof_pre.F90"
6227
6228#undef ARRAYOF_ORIGEQ
6229
6230#undef ARRAYOF_ORIGTYPE
6231#undef ARRAYOF_TYPE
6232#define ARRAYOF_ORIGTYPE LOGICAL
6233#define ARRAYOF_TYPE arrayof_logical
6234#include "arrayof_pre.F90"
6235
6236PRIVATE
6237! from arrayof
6239PUBLIC insert_unique, append_unique
6240
6242 count_distinct_sorted, pack_distinct_sorted, &
6243 count_distinct, pack_distinct, count_and_pack_distinct, &
6244 map_distinct, map_inv_distinct, &
6245 firsttrue, lasttrue, pack_distinct_c, map
6246
6247CONTAINS
6248
6249
6252FUNCTION firsttrue(v) RESULT(i)
6253LOGICAL,INTENT(in) :: v(:)
6254INTEGER :: i
6255
6256DO i = 1, SIZE(v)
6257 IF (v(i)) RETURN
6258ENDDO
6259i = 0
6260
6261END FUNCTION firsttrue
6262
6263
6266FUNCTION lasttrue(v) RESULT(i)
6267LOGICAL,INTENT(in) :: v(:)
6268INTEGER :: i
6269
6270DO i = SIZE(v), 1, -1
6271 IF (v(i)) RETURN
6272ENDDO
6273
6274END FUNCTION lasttrue
6275
6276
6277! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
6278#undef VOL7D_POLY_TYPE_AUTO
6279#undef VOL7D_NO_PACK
6280
6281#undef VOL7D_POLY_TYPE
6282#undef VOL7D_POLY_TYPES
6283#define VOL7D_POLY_TYPE INTEGER
6284#define VOL7D_POLY_TYPES _i
6285#define ENABLE_SORT
6286#include "array_utilities_inc.F90"
6287#undef ENABLE_SORT
6288
6289#undef VOL7D_POLY_TYPE
6290#undef VOL7D_POLY_TYPES
6291#define VOL7D_POLY_TYPE REAL
6292#define VOL7D_POLY_TYPES _r
6293#define ENABLE_SORT
6294#include "array_utilities_inc.F90"
6295#undef ENABLE_SORT
6296
6297#undef VOL7D_POLY_TYPE
6298#undef VOL7D_POLY_TYPES
6299#define VOL7D_POLY_TYPE DOUBLEPRECISION
6300#define VOL7D_POLY_TYPES _d
6301#define ENABLE_SORT
6302#include "array_utilities_inc.F90"
6303#undef ENABLE_SORT
6304
6305#define VOL7D_NO_PACK
6306#undef VOL7D_POLY_TYPE
6307#undef VOL7D_POLY_TYPES
6308#define VOL7D_POLY_TYPE CHARACTER(len=*)
6309#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
6310#define VOL7D_POLY_TYPES _c
6311#define ENABLE_SORT
6312#include "array_utilities_inc.F90"
6313#undef VOL7D_POLY_TYPE_AUTO
6314#undef ENABLE_SORT
6315
6316SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
6317CHARACTER(len=*),INTENT(in) :: vect(:)
6318LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
6319CHARACTER(len=LEN(vect)) :: pack_distinct(:)
6320
6321INTEGER :: count_distinct
6322INTEGER :: i, j, dim
6323LOGICAL :: lback
6324
6325dim = SIZE(pack_distinct)
6326IF (PRESENT(back)) THEN
6327 lback = back
6328ELSE
6329 lback = .false.
6330ENDIF
6331count_distinct = 0
6332
6333IF (PRESENT (mask)) THEN
6334 IF (lback) THEN
6335 vectm1: DO i = 1, SIZE(vect)
6336 IF (.NOT.mask(i)) cycle vectm1
6337! DO j = i-1, 1, -1
6338! IF (vect(j) == vect(i)) CYCLE vectm1
6339 DO j = count_distinct, 1, -1
6340 IF (pack_distinct(j) == vect(i)) cycle vectm1
6341 ENDDO
6342 count_distinct = count_distinct + 1
6343 IF (count_distinct > dim) EXIT
6344 pack_distinct(count_distinct) = vect(i)
6345 ENDDO vectm1
6346 ELSE
6347 vectm2: DO i = 1, SIZE(vect)
6348 IF (.NOT.mask(i)) cycle vectm2
6349! DO j = 1, i-1
6350! IF (vect(j) == vect(i)) CYCLE vectm2
6351 DO j = 1, count_distinct
6352 IF (pack_distinct(j) == vect(i)) cycle vectm2
6353 ENDDO
6354 count_distinct = count_distinct + 1
6355 IF (count_distinct > dim) EXIT
6356 pack_distinct(count_distinct) = vect(i)
6357 ENDDO vectm2
6358 ENDIF
6359ELSE
6360 IF (lback) THEN
6361 vect1: DO i = 1, SIZE(vect)
6362! DO j = i-1, 1, -1
6363! IF (vect(j) == vect(i)) CYCLE vect1
6364 DO j = count_distinct, 1, -1
6365 IF (pack_distinct(j) == vect(i)) cycle vect1
6366 ENDDO
6367 count_distinct = count_distinct + 1
6368 IF (count_distinct > dim) EXIT
6369 pack_distinct(count_distinct) = vect(i)
6370 ENDDO vect1
6371 ELSE
6372 vect2: DO i = 1, SIZE(vect)
6373! DO j = 1, i-1
6374! IF (vect(j) == vect(i)) CYCLE vect2
6375 DO j = 1, count_distinct
6376 IF (pack_distinct(j) == vect(i)) cycle vect2
6377 ENDDO
6378 count_distinct = count_distinct + 1
6379 IF (count_distinct > dim) EXIT
6380 pack_distinct(count_distinct) = vect(i)
6381 ENDDO vect2
6382 ENDIF
6383ENDIF
6384
6385END SUBROUTINE pack_distinct_c
6386
6388FUNCTION map(mask) RESULT(mapidx)
6389LOGICAL,INTENT(in) :: mask(:)
6390INTEGER :: mapidx(count(mask))
6391
6392INTEGER :: i,j
6393
6394j = 0
6395DO i=1, SIZE(mask)
6396 j = j + 1
6397 IF (mask(i)) mapidx(j)=i
6398ENDDO
6399
6400END FUNCTION map
6401
6402#define ARRAYOF_ORIGEQ 1
6403
6404#undef ARRAYOF_ORIGTYPE
6405#undef ARRAYOF_TYPE
6406#define ARRAYOF_ORIGTYPE INTEGER
6407#define ARRAYOF_TYPE arrayof_integer
6408#include "arrayof_post.F90"
6409
6410#undef ARRAYOF_ORIGTYPE
6411#undef ARRAYOF_TYPE
6412#define ARRAYOF_ORIGTYPE REAL
6413#define ARRAYOF_TYPE arrayof_real
6414#include "arrayof_post.F90"
6415
6416#undef ARRAYOF_ORIGTYPE
6417#undef ARRAYOF_TYPE
6418#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
6419#define ARRAYOF_TYPE arrayof_doubleprecision
6420#include "arrayof_post.F90"
6421
6422#undef ARRAYOF_ORIGEQ
6423
6424#undef ARRAYOF_ORIGTYPE
6425#undef ARRAYOF_TYPE
6426#define ARRAYOF_ORIGTYPE LOGICAL
6427#define ARRAYOF_TYPE arrayof_logical
6428#include "arrayof_post.F90"
6429
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 |