libsim Versione 7.1.11

◆ array

integer, dimension(:), pointer array =>NULL()

array of INTEGER

Definizione alla linea 496 del file array_utilities.F90.

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

Generated with Doxygen.