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