diff --git a/test_vect_type/a.f90 b/test_vect_type/a.f90 new file mode 100644 index 0000000000000000000000000000000000000000..a35529c4b063991d0db6d37ef9a7dc5251c51ee3 --- /dev/null +++ b/test_vect_type/a.f90 @@ -0,0 +1,141 @@ +module alpha + +type general + + integer :: int_ + real :: float_ + character :: char_ + class(*), allocatable :: unknown_ + + contains + + procedure :: SINT => set_integer + procedure :: SFLOAT => set_real + procedure :: SCHAR => set_character + procedure :: SUNKNOWN => set_unknown + procedure :: PUNKNOWN => print_unknown + +end type general + +contains + +subroutine set_integer(self, int_) + class(general), intent(inout) :: self + integer, intent(inout) :: int_ + self%int_ = int_ +end subroutine set_integer + +subroutine set_real(self, float_) + class(general), intent(inout) :: self + real, intent(inout) :: float_ + self%float_ = float_ +end subroutine set_real + +subroutine set_character(self, char_) + class(general), intent(inout) :: self + character, intent(inout) :: char_ + self%char_ = char_ +end subroutine set_character + +subroutine set_unknown(self, unknown_) + class(general), intent(inout) :: self + class(*), intent(inout), pointer :: unknown_ + self%unknown_ = unknown_ +end subroutine set_unknown + +subroutine print_unknown(self) + class(general), intent(inout) :: self + class(*), intent(inout), pointer :: unknown_ + + SELECT TYPE(unknown_) + TYPE IS(INTEGER) + unknown_ => self%unknown_ + print*,unknown_ + TYPE IS(REAL) + unknown_ => self%unknown_ + print*,unknown_ + END SELECT + + !ptr => self%unknown_ + !ptrr => self%unknown_ + + !ptr <= self%unknown_ + !ptrr <= self%unknown_ + + !SELECT TYPE(self%unknown_) + !SELECT TYPE(ptr) + !SELECT TYPE(ptrr) + ! TYPE IS(INTEGER) + ! !print*,self%unknown_ + ! !print*,ptr + ! print*,ptrr + ! TYPE IS(REAL) + ! !print*,self%unknown_ + ! !print*,ptr + ! print*,ptrr + ! !TYPE IS(CHARACTER*1) + ! ! print*,self%unknown_ + !END SELECT +end subroutine print_unknown + +end module alpha + +!_______________________ + +program a + +use alpha + +implicit none + +type(general) :: test +integer :: int_1, int_2 +real :: float_1, float_2 +character :: char_1, char_2 + +integer, target :: int_3 +real, target :: float_3 + + class(*),pointer :: unknown_1, unknown_2, ptr + +int_1 = 10 +int_2 = 20 +float_1 = 15.0 +float_2 = 25.0 +char_1 = 'a' +char_2 = 'b' + +test = general(int_=int_1, float_=float_1, char_=char_1) + +unknown_1 => int_3 +unknown_2 => float_3 + +print*,test%int_, test%float_, test%char_ + +call test % SINT(int_2) +call test % SFLOAT(float_2) +call test % SCHAR(char_2) + +print*,test%int_, test%float_, test%char_ + +call test % SUNKNOWN(unknown_1) + +print*,test%unknown_ + + + + +end program a + + + + + + + + + + + + + diff --git a/test_vect_type/progGeneral b/test_vect_type/progGeneral new file mode 100755 index 0000000000000000000000000000000000000000..98d4edd79a5300fba6eed985c8e77ac5baec0eac Binary files /dev/null and b/test_vect_type/progGeneral differ diff --git a/test_vect_type/test b/test_vect_type/test new file mode 100755 index 0000000000000000000000000000000000000000..5949588062bf0a1fc1563ded8c5910811fd42f9d Binary files /dev/null and b/test_vect_type/test differ diff --git a/test_vect_type/test.f90 b/test_vect_type/test.f90 new file mode 100644 index 0000000000000000000000000000000000000000..53b966f577e59b791e913fc8893a659b454d0388 --- /dev/null +++ b/test_vect_type/test.f90 @@ -0,0 +1,42 @@ +MODULE VECTOR + + IMPLICIT NONE + + TYPE STD_VECTOR + CLASS(*), DIMENSION(:), POINTER :: v_ptr + INTEGER :: v_size_in_array + INTEGER :: v_size_in_memory + integer, dimension(:), allocatable, target :: ptr_int + + CONTAINS + + PROCEDURE :: ALLOC => ALLOCATE_STD_VECTOR + !PROCEDURE :: MODIF => MODIF_STD_VECTOR + !PROCEDURE :: DEALLOC => DEALLOCATE_STD_VECTOR + END TYPE STD_VECTOR + + CONTAINS + + SUBROUTINE ALLOCATE_STD_VECTOR(self, array) + + CLASS(STD_VECTOR), intent(inout) :: self + CLASS(*), intent(in), dimension(:) :: array + + SELECT TYPE(ARRAY) + TYPE IS(INTEGER) + print*,"hello" + ALLOCATE(self%ptr_int, SOURCE=array) + self%v_ptr => ptr_int + SELECT TYPE(self%v_ptr) + TYPE IS(INTEGER) + print*,self%v_ptr + !self%v_ptr = self%v_ptr * 1 + !print*,self%v_ptr + END SELECT + + CLASS DEFAULT + print*,"error, no type" + END SELECT + END SUBROUTINE ALLOCATE_STD_VECTOR + +END MODULE VECTOR diff --git a/test_vect_type/test.o b/test_vect_type/test.o new file mode 100644 index 0000000000000000000000000000000000000000..93eadf953d7493b361fe60a19cb38717677df517 Binary files /dev/null and b/test_vect_type/test.o differ diff --git a/test_vect_type/test_prog.f90 b/test_vect_type/test_prog.f90 new file mode 100644 index 0000000000000000000000000000000000000000..e9e08919a576d2e09cfe85e1457ac9f0dbf4c41f --- /dev/null +++ b/test_vect_type/test_prog.f90 @@ -0,0 +1,26 @@ +program test + +use VECTOR + +implicit none + +integer, dimension(:), allocatable, TARGET :: tester +class(*), dimension(:), pointer :: tester_ptr +type(STD_VECTOR) :: v_tester + +allocate(tester(10)) + +tester_ptr => tester + +!tester(:) = [(i, i=1,10,2)] +tester(:) = (/1,2,3,4,5,6,7,8,9,10/) +!print*,tester + +!v_tester.alloc(tester) +!call alloc(v_tester, tester) +call v_tester%alloc(tester_ptr) + +tester <= v_tester%v_ptr +print*,tester + +end program test diff --git a/test_vect_type/toto.f90 b/test_vect_type/toto.f90 new file mode 100644 index 0000000000000000000000000000000000000000..63d94263be96cd765197db4e28ad688e4fc8d36f --- /dev/null +++ b/test_vect_type/toto.f90 @@ -0,0 +1,41 @@ +module toto + + implicit none + + interface totos + + PROCEDURE toto1, toto2 + + end interface totos + + contains + + subroutine toto1(titi) + + integer, intent(inout) :: titi + print*,titi + + end subroutine toto1 + + subroutine toto2(titi) + + real, intent(inout) :: titi + print*,titi + + end subroutine toto2 + +end module toto + +program try + + use toto + + implicit none + + integer :: alpha + real :: beta + + call totos(alpha) + call totos(beta) + +end program try diff --git a/test_vect_type/toto.mod b/test_vect_type/toto.mod new file mode 100644 index 0000000000000000000000000000000000000000..7d8f0f6796e3e49dbd4fc2f08b565b6cc5edca02 Binary files /dev/null and b/test_vect_type/toto.mod differ diff --git a/test_vect_type/try b/test_vect_type/try new file mode 100755 index 0000000000000000000000000000000000000000..f1745c1e9dbf3650dd10a2657b8d3ddc0f8c94cf Binary files /dev/null and b/test_vect_type/try differ diff --git a/test_vect_type/vector.mod b/test_vect_type/vector.mod new file mode 100644 index 0000000000000000000000000000000000000000..7d7f6134ab727e52ac16e371678360f5a4edc132 Binary files /dev/null and b/test_vect_type/vector.mod differ