libsim Versione 7.2.4

◆ array

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

array of REAL

Definizione alla linea 606 del file array_utilities.F90.

606! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
607! authors:
608! Davide Cesari <dcesari@arpa.emr.it>
609! Paolo Patruno <ppatruno@arpa.emr.it>
610
611! This program is free software; you can redistribute it and/or
612! modify it under the terms of the GNU General Public License as
613! published by the Free Software Foundation; either version 2 of
614! the License, or (at your option) any later version.
615
616! This program is distributed in the hope that it will be useful,
617! but WITHOUT ANY WARRANTY; without even the implied warranty of
618! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
619! GNU General Public License for more details.
620
621! You should have received a copy of the GNU General Public License
622! along with this program. If not, see <http://www.gnu.org/licenses/>.
623
624
625
628#include "config.h"
629MODULE array_utilities
630
631IMPLICIT NONE
632
633! la routine per i char non puo' essere sviluppata in macro perche` si deve scrivere diversa
634!cosi' esiste la function count_distinctc (senza _ ) e la subroutine pack_distinctc qui ivi scritte
635
636#undef VOL7D_POLY_TYPE_AUTO
637
638#undef VOL7D_POLY_TYPE
639#undef VOL7D_POLY_TYPES
640#define VOL7D_POLY_TYPE INTEGER
641#define VOL7D_POLY_TYPES _i
642#define ENABLE_SORT
643#include "array_utilities_pre.F90"
644#undef ENABLE_SORT
645
646#undef VOL7D_POLY_TYPE
647#undef VOL7D_POLY_TYPES
648#define VOL7D_POLY_TYPE REAL
649#define VOL7D_POLY_TYPES _r
650#define ENABLE_SORT
651#include "array_utilities_pre.F90"
652#undef ENABLE_SORT
653
654#undef VOL7D_POLY_TYPE
655#undef VOL7D_POLY_TYPES
656#define VOL7D_POLY_TYPE DOUBLEPRECISION
657#define VOL7D_POLY_TYPES _d
658#define ENABLE_SORT
659#include "array_utilities_pre.F90"
660#undef ENABLE_SORT
661
662#define VOL7D_NO_PACK
663#undef VOL7D_POLY_TYPE
664#undef VOL7D_POLY_TYPES
665#define VOL7D_POLY_TYPE CHARACTER(len=*)
666#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
667#define VOL7D_POLY_TYPES _c
668#define ENABLE_SORT
669#include "array_utilities_pre.F90"
670#undef VOL7D_POLY_TYPE_AUTO
671#undef ENABLE_SORT
672
673
674#define ARRAYOF_ORIGEQ 1
675
676#define ARRAYOF_ORIGTYPE INTEGER
677#define ARRAYOF_TYPE arrayof_integer
678#include "arrayof_pre.F90"
679
680#undef ARRAYOF_ORIGTYPE
681#undef ARRAYOF_TYPE
682#define ARRAYOF_ORIGTYPE REAL
683#define ARRAYOF_TYPE arrayof_real
684#include "arrayof_pre.F90"
685
686#undef ARRAYOF_ORIGTYPE
687#undef ARRAYOF_TYPE
688#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
689#define ARRAYOF_TYPE arrayof_doubleprecision
690#include "arrayof_pre.F90"
691
692#undef ARRAYOF_ORIGEQ
693
694#undef ARRAYOF_ORIGTYPE
695#undef ARRAYOF_TYPE
696#define ARRAYOF_ORIGTYPE LOGICAL
697#define ARRAYOF_TYPE arrayof_logical
698#include "arrayof_pre.F90"
699
700PRIVATE
701! from arrayof
703PUBLIC insert_unique, append_unique
704
705PUBLIC sort, index, index_c, &
706 count_distinct_sorted, pack_distinct_sorted, &
707 count_distinct, pack_distinct, count_and_pack_distinct, &
708 map_distinct, map_inv_distinct, &
709 firsttrue, lasttrue, pack_distinct_c, map
710
711CONTAINS
712
713
716FUNCTION firsttrue(v) RESULT(i)
717LOGICAL,INTENT(in) :: v(:)
718INTEGER :: i
719
720DO i = 1, SIZE(v)
721 IF (v(i)) RETURN
722ENDDO
723i = 0
724
725END FUNCTION firsttrue
726
727
730FUNCTION lasttrue(v) RESULT(i)
731LOGICAL,INTENT(in) :: v(:)
732INTEGER :: i
733
734DO i = SIZE(v), 1, -1
735 IF (v(i)) RETURN
736ENDDO
737
738END FUNCTION lasttrue
739
740
741! Definisce le funzioni count_distinct(_sorted) e pack_distinct(_sorted)
742#undef VOL7D_POLY_TYPE_AUTO
743#undef VOL7D_NO_PACK
744
745#undef VOL7D_POLY_TYPE
746#undef VOL7D_POLY_TYPES
747#define VOL7D_POLY_TYPE INTEGER
748#define VOL7D_POLY_TYPES _i
749#define ENABLE_SORT
750#include "array_utilities_inc.F90"
751#undef ENABLE_SORT
752
753#undef VOL7D_POLY_TYPE
754#undef VOL7D_POLY_TYPES
755#define VOL7D_POLY_TYPE REAL
756#define VOL7D_POLY_TYPES _r
757#define ENABLE_SORT
758#include "array_utilities_inc.F90"
759#undef ENABLE_SORT
760
761#undef VOL7D_POLY_TYPE
762#undef VOL7D_POLY_TYPES
763#define VOL7D_POLY_TYPE DOUBLEPRECISION
764#define VOL7D_POLY_TYPES _d
765#define ENABLE_SORT
766#include "array_utilities_inc.F90"
767#undef ENABLE_SORT
768
769#define VOL7D_NO_PACK
770#undef VOL7D_POLY_TYPE
771#undef VOL7D_POLY_TYPES
772#define VOL7D_POLY_TYPE CHARACTER(len=*)
773#define VOL7D_POLY_TYPE_AUTO(var) CHARACTER(len=LEN(var))
774#define VOL7D_POLY_TYPES _c
775#define ENABLE_SORT
776#include "array_utilities_inc.F90"
777#undef VOL7D_POLY_TYPE_AUTO
778#undef ENABLE_SORT
779
780SUBROUTINE pack_distinct_c(vect, pack_distinct, mask, back) !RESULT(pack_distinct)
781CHARACTER(len=*),INTENT(in) :: vect(:)
782LOGICAL,INTENT(in),OPTIONAL :: mask(:), back
783CHARACTER(len=LEN(vect)) :: pack_distinct(:)
784
785INTEGER :: count_distinct
786INTEGER :: i, j, dim
787LOGICAL :: lback
788
789dim = SIZE(pack_distinct)
790IF (PRESENT(back)) THEN
791 lback = back
792ELSE
793 lback = .false.
794ENDIF
795count_distinct = 0
796
797IF (PRESENT (mask)) THEN
798 IF (lback) THEN
799 vectm1: DO i = 1, SIZE(vect)
800 IF (.NOT.mask(i)) cycle vectm1
801! DO j = i-1, 1, -1
802! IF (vect(j) == vect(i)) CYCLE vectm1
803 DO j = count_distinct, 1, -1
804 IF (pack_distinct(j) == vect(i)) cycle vectm1
805 ENDDO
806 count_distinct = count_distinct + 1
807 IF (count_distinct > dim) EXIT
808 pack_distinct(count_distinct) = vect(i)
809 ENDDO vectm1
810 ELSE
811 vectm2: DO i = 1, SIZE(vect)
812 IF (.NOT.mask(i)) cycle vectm2
813! DO j = 1, i-1
814! IF (vect(j) == vect(i)) CYCLE vectm2
815 DO j = 1, count_distinct
816 IF (pack_distinct(j) == vect(i)) cycle vectm2
817 ENDDO
818 count_distinct = count_distinct + 1
819 IF (count_distinct > dim) EXIT
820 pack_distinct(count_distinct) = vect(i)
821 ENDDO vectm2
822 ENDIF
823ELSE
824 IF (lback) THEN
825 vect1: DO i = 1, SIZE(vect)
826! DO j = i-1, 1, -1
827! IF (vect(j) == vect(i)) CYCLE vect1
828 DO j = count_distinct, 1, -1
829 IF (pack_distinct(j) == vect(i)) cycle vect1
830 ENDDO
831 count_distinct = count_distinct + 1
832 IF (count_distinct > dim) EXIT
833 pack_distinct(count_distinct) = vect(i)
834 ENDDO vect1
835 ELSE
836 vect2: DO i = 1, SIZE(vect)
837! DO j = 1, i-1
838! IF (vect(j) == vect(i)) CYCLE vect2
839 DO j = 1, count_distinct
840 IF (pack_distinct(j) == vect(i)) cycle vect2
841 ENDDO
842 count_distinct = count_distinct + 1
843 IF (count_distinct > dim) EXIT
844 pack_distinct(count_distinct) = vect(i)
845 ENDDO vect2
846 ENDIF
847ENDIF
848
849END SUBROUTINE pack_distinct_c
850
852FUNCTION map(mask) RESULT(mapidx)
853LOGICAL,INTENT(in) :: mask(:)
854INTEGER :: mapidx(count(mask))
855
856INTEGER :: i,j
857
858j = 0
859DO i=1, SIZE(mask)
860 j = j + 1
861 IF (mask(i)) mapidx(j)=i
862ENDDO
863
864END FUNCTION map
865
866#define ARRAYOF_ORIGEQ 1
867
868#undef ARRAYOF_ORIGTYPE
869#undef ARRAYOF_TYPE
870#define ARRAYOF_ORIGTYPE INTEGER
871#define ARRAYOF_TYPE arrayof_integer
872#include "arrayof_post.F90"
873
874#undef ARRAYOF_ORIGTYPE
875#undef ARRAYOF_TYPE
876#define ARRAYOF_ORIGTYPE REAL
877#define ARRAYOF_TYPE arrayof_real
878#include "arrayof_post.F90"
879
880#undef ARRAYOF_ORIGTYPE
881#undef ARRAYOF_TYPE
882#define ARRAYOF_ORIGTYPE DOUBLEPRECISION
883#define ARRAYOF_TYPE arrayof_doubleprecision
884#include "arrayof_post.F90"
885
886#undef ARRAYOF_ORIGEQ
887
888#undef ARRAYOF_ORIGTYPE
889#undef ARRAYOF_TYPE
890#define ARRAYOF_ORIGTYPE LOGICAL
891#define ARRAYOF_TYPE arrayof_logical
892#include "arrayof_post.F90"
893
894END 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.