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