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