libsim Versione 7.1.11
|
◆ overalloc
overallocation factor, values close to 1 determine more calls to the system alloc function (decreased performances) at the advantage of less memory consumption, the default is 2; the results are not affected by the value of this member Definizione alla linea 500 del file array_utilities.F90. 500! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
501! authors:
502! Davide Cesari <dcesari@arpa.emr.it>
503! Paolo Patruno <ppatruno@arpa.emr.it>
504
505! This program is free software; you can redistribute it and/or
506! modify it under the terms of the GNU General Public License as
507! published by the Free Software Foundation; either version 2 of
508! the License, or (at your option) any later version.
509
510! This program is distributed in the hope that it will be useful,
511! but WITHOUT ANY WARRANTY; without even the implied warranty of
512! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
513! GNU General Public License for more details.
514
515! You should have received a copy of the GNU General Public License
516! along with this program. If not, see <http://www.gnu.org/licenses/>.
517
518
519
522#include "config.h"
524
525IMPLICIT NONE
526
527! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
528!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
529
530#undef VOL7D_POLY_TYPE_AUTO
531
532#undef VOL7D_POLY_TYPE
533#undef VOL7D_POLY_TYPES
534#define VOL7D_POLY_TYPE INTEGER
535#define VOL7D_POLY_TYPES _i
536#define ENABLE_SORT
537#include "array_utilities_pre.F90"
538#undef ENABLE_SORT
539
540#undef VOL7D_POLY_TYPE
541#undef VOL7D_POLY_TYPES
542#define VOL7D_POLY_TYPE REAL
543#define VOL7D_POLY_TYPES _r
544#define ENABLE_SORT
545#include "array_utilities_pre.F90"
546#undef ENABLE_SORT
547
548#undef VOL7D_POLY_TYPE
549#undef VOL7D_POLY_TYPES
550#define VOL7D_POLY_TYPE DOUBLEPRECISION
551#define VOL7D_POLY_TYPES _d
552#define ENABLE_SORT
553#include "array_utilities_pre.F90"
554#undef ENABLE_SORT
555
556#define VOL7D_NO_PACK
557#undef VOL7D_POLY_TYPE
558#undef VOL7D_POLY_TYPES
559#define VOL7D_POLY_TYPE CHARACTER(len=*)
560#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
561#define VOL7D_POLY_TYPES _c
562#define ENABLE_SORT
563#include "array_utilities_pre.F90"
564#undef VOL7D_POLY_TYPE_AUTO
565#undef ENABLE_SORT
566
567
568#define ARRAYOF_ORIGEQ 1
569
570#define ARRAYOF_ORIGTYPE INTEGER
571#define ARRAYOF_TYPE arrayof_integer
572#include "arrayof_pre.F90"
573
574#undef ARRAYOF_ORIGTYPE
575#undef ARRAYOF_TYPE
576#define ARRAYOF_ORIGTYPE REAL
577#define ARRAYOF_TYPE arrayof_real
578#include "arrayof_pre.F90"
579
580#undef ARRAYOF_ORIGTYPE
581#undef ARRAYOF_TYPE
582#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
583#define ARRAYOF_TYPE arrayof_doubleprecision
584#include "arrayof_pre.F90"
585
586#undef ARRAYOF_ORIGEQ
587
588#undef ARRAYOF_ORIGTYPE
589#undef ARRAYOF_TYPE
590#define ARRAYOF_ORIGTYPE LOGICAL
591#define ARRAYOF_TYPE arrayof_logical
592#include "arrayof_pre.F90"
593
594PRIVATE
595! from arrayof
597PUBLIC insert_unique, append_unique
598
600 count_distinct_sorted, pack_distinct_sorted, &
601 count_distinct, pack_distinct, count_and_pack_distinct, &
602 map_distinct, map_inv_distinct, &
603 firsttrue, lasttrue, pack_distinct_c, map
604
605CONTAINS
606
607
610FUNCTION firsttrue(v) RESULT(i)
611LOGICAL,INTENT(in) :: v(:)
612INTEGER :: i
613
614DO i = 1, SIZE(v)
615 IF (v(i)) RETURN
616ENDDO
617i = 0
618
619END FUNCTION firsttrue
620
621
624FUNCTION lasttrue(v) RESULT(i)
625LOGICAL,INTENT(in) :: v(:)
626INTEGER :: i
627
628DO i = SIZE(v), 1, -1
629 IF (v(i)) RETURN
630ENDDO
631
632END FUNCTION lasttrue
633
634
635! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
636#undef VOL7D_POLY_TYPE_AUTO
637#undef VOL7D_NO_PACK
638
639#undef VOL7D_POLY_TYPE
640#undef VOL7D_POLY_TYPES
641#define VOL7D_POLY_TYPE INTEGER
642#define VOL7D_POLY_TYPES _i
643#define ENABLE_SORT
644#include "array_utilities_inc.F90"
645#undef ENABLE_SORT
646
647#undef VOL7D_POLY_TYPE
648#undef VOL7D_POLY_TYPES
649#define VOL7D_POLY_TYPE REAL
650#define VOL7D_POLY_TYPES _r
651#define ENABLE_SORT
652#include "array_utilities_inc.F90"
653#undef ENABLE_SORT
654
655#undef VOL7D_POLY_TYPE
656#undef VOL7D_POLY_TYPES
657#define VOL7D_POLY_TYPE DOUBLEPRECISION
658#define VOL7D_POLY_TYPES _d
659#define ENABLE_SORT
660#include "array_utilities_inc.F90"
661#undef ENABLE_SORT
662
663#define VOL7D_NO_PACK
664#undef VOL7D_POLY_TYPE
665#undef VOL7D_POLY_TYPES
666#define VOL7D_POLY_TYPE CHARACTER(len=*)
667#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
668#define VOL7D_POLY_TYPES _c
669#define ENABLE_SORT
670#include "array_utilities_inc.F90"
671#undef VOL7D_POLY_TYPE_AUTO
672#undef ENABLE_SORT
673
674SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
675CHARACTER(len=*),INTENT(in) :: vect(:)
676LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
677CHARACTER(len=LEN(vect)) :: pack_distinct(:)
678
679INTEGER :: count_distinct
680INTEGER :: i, j, dim
681LOGICAL :: lback
682
683dim = SIZE(pack_distinct)
684IF (PRESENT(back)) THEN
685 lback = back
686ELSE
687 lback = .false.
688ENDIF
689count_distinct = 0
690
691IF (PRESENT (mask)) THEN
692 IF (lback) THEN
693 vectm1: DO i = 1, SIZE(vect)
694 IF (.NOT.mask(i)) cycle vectm1
695! DO j = i-1, 1, -1
696! IF (vect(j) == vect(i)) CYCLE vectm1
697 DO j = count_distinct, 1, -1
698 IF (pack_distinct(j) == vect(i)) cycle vectm1
699 ENDDO
700 count_distinct = count_distinct + 1
701 IF (count_distinct > dim) EXIT
702 pack_distinct(count_distinct) = vect(i)
703 ENDDO vectm1
704 ELSE
705 vectm2: DO i = 1, SIZE(vect)
706 IF (.NOT.mask(i)) cycle vectm2
707! DO j = 1, i-1
708! IF (vect(j) == vect(i)) CYCLE vectm2
709 DO j = 1, count_distinct
710 IF (pack_distinct(j) == vect(i)) cycle vectm2
711 ENDDO
712 count_distinct = count_distinct + 1
713 IF (count_distinct > dim) EXIT
714 pack_distinct(count_distinct) = vect(i)
715 ENDDO vectm2
716 ENDIF
717ELSE
718 IF (lback) THEN
719 vect1: DO i = 1, SIZE(vect)
720! DO j = i-1, 1, -1
721! IF (vect(j) == vect(i)) CYCLE vect1
722 DO j = count_distinct, 1, -1
723 IF (pack_distinct(j) == vect(i)) cycle vect1
724 ENDDO
725 count_distinct = count_distinct + 1
726 IF (count_distinct > dim) EXIT
727 pack_distinct(count_distinct) = vect(i)
728 ENDDO vect1
729 ELSE
730 vect2: DO i = 1, SIZE(vect)
731! DO j = 1, i-1
732! IF (vect(j) == vect(i)) CYCLE vect2
733 DO j = 1, count_distinct
734 IF (pack_distinct(j) == vect(i)) cycle vect2
735 ENDDO
736 count_distinct = count_distinct + 1
737 IF (count_distinct > dim) EXIT
738 pack_distinct(count_distinct) = vect(i)
739 ENDDO vect2
740 ENDIF
741ENDIF
742
743END SUBROUTINE pack_distinct_c
744
746FUNCTION map(mask) RESULT(mapidx)
747LOGICAL,INTENT(in) :: mask(:)
748INTEGER :: mapidx(count(mask))
749
750INTEGER :: i,j
751
752j = 0
753DO i=1, SIZE(mask)
754 j = j + 1
755 IF (mask(i)) mapidx(j)=i
756ENDDO
757
758END FUNCTION map
759
760#define ARRAYOF_ORIGEQ 1
761
762#undef ARRAYOF_ORIGTYPE
763#undef ARRAYOF_TYPE
764#define ARRAYOF_ORIGTYPE INTEGER
765#define ARRAYOF_TYPE arrayof_integer
766#include "arrayof_post.F90"
767
768#undef ARRAYOF_ORIGTYPE
769#undef ARRAYOF_TYPE
770#define ARRAYOF_ORIGTYPE REAL
771#define ARRAYOF_TYPE arrayof_real
772#include "arrayof_post.F90"
773
774#undef ARRAYOF_ORIGTYPE
775#undef ARRAYOF_TYPE
776#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
777#define ARRAYOF_TYPE arrayof_doubleprecision
778#include "arrayof_post.F90"
779
780#undef ARRAYOF_ORIGEQ
781
782#undef ARRAYOF_ORIGTYPE
783#undef ARRAYOF_TYPE
784#define ARRAYOF_ORIGTYPE LOGICAL
785#define ARRAYOF_TYPE arrayof_logical
786#include "arrayof_post.F90"
787
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 |