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