2011-12-06 26 views
7

Alokacyjne tablice są możliwe w Fortranie 90 i wyżej. możliwe sąJak zadeklarować tablicę alokowanych skalarów w Fortranie?

INTEGER, ALLOCATABLE, DIMENSION(:) :: test_int_array 

Allocatable skalary takie jak znaki allocatable w Fortran 2003

CHARACTER(LEN=:), ALLOCATABLE :: test_str 

Zastanawiam się czy jest możliwe aby zadeklarować tablicę, stałe lub allocatable, znaków allocatable? (Być może coś jak poniżej, które nie kompiluje niestety.)

CHARACTER(LEN=:), ALLOCATABLE, DIMENSION(4) :: test_str_array 

Odpowiedz

6
program test_alloc 

    character (len=:), allocatable :: string 

    character(len=:), allocatable :: string_array(:) 

    type my_type 
     character (len=:), allocatable :: my_string 
    end type my_type 
    type (my_type), dimension (:), allocatable :: my_type_array 

    string = "123" 
    write (*, *) string, len (string) 
    string = "abcd" 
    write (*, *) string, len (string) 

    allocate(character(5) :: string_array(2)) 
    string_array (1) = "1234" 
    string_array (2) = "abcde" 
    write (*, *) string_array (1), len (string_array (1)) 
    write (*, *) string_array (2), len (string_array (2)) 

    allocate (my_type_array (2)) 
    my_type_array (1) % my_string = "XYZ" 
    my_type_array (2) % my_string = "QWER" 
    write (*, *) my_type_array (1) % my_string, len (my_type_array (1) % my_string) 
    write (*, *) my_type_array (2) % my_string, len (my_type_array (2) % my_string) 

end program test_alloc 

znalazłem składni w http://software.intel.com/en-us/forums/showthread.php?t=77823. Działa z ifortem 12.1, ale nie z gfortran 4.6.1. Próba obejścia procesu tworzenia typu zdefiniowanego przez użytkownika również nie działa.

+0

Gfortran miał błąd w wymaganiu stałej czasowej kompilacji w instrukcji alokacji dla znaków. W przeciwnym razie przydzielane tablice z wyprowadzonymi typami z alokowanymi komponentami działają przez krótki czas. –

+0

Dziękuję bardzo za poświęcony czas i pomoc! Wydaje się, że jak wspominasz uprzejmie, 'string_array' jest w istocie tablicą alokowanych alokacji łańcuchów znaków. Jednakże ciągi muszą być zadeklarowane, aby miały równą długość później. Czy możesz pomóc w komentowaniu, czy rozumiem ten limit, prawda? Inne obejście, które wymaga typu zdefiniowanego przez użytkownika, który sam zawiera przydzielany ciąg znaków, działa, ale wydaje się wprowadzać więcej komplikacji. Jeśli ten sposób zdefiniowany przez użytkownika jest jedynym obejściem problemu, być może trzymałbym się ciągów znaków o stałej długości. – SOUser

+0

Masz rację, tablica musi składać się z tych samych elementów. W tym przypadku możesz sobie wyobrazić tablicę alokowalną jako rodzaj lepszego wskaźnika. –

0

Opracowałem niedawno klasę do obsługi ciągów o zmiennym rozmiarze. Nie testowałem go zbyt wiele, ale wydaje się, że kompiluje się dobrze. Zasadniczo stworzyłem klasę, która przechowuje pojedynczy znak, a ponieważ możesz mieć przydzielany typ pochodny wewnątrz typu pochodnego, jest on o jeden poziom głębszy niż to, czego chciałbyś najbardziej. Tak czy inaczej, najprawdopodobniej zamierzasz używać tylko interfejsów. Oto kod:

module string_mod 
    implicit none 
    ! Implimentation: 

    ! program test_string 
    ! use string_mod 
    ! implicit none 
    ! type(string) :: s 
    ! call init(s,'This is');   write(*,*) 'string = ',str(s) 
    ! call append(s,' a variable');  write(*,*) 'string = ',str(s) 
    ! call append(s,' sized string!'); write(*,*) 'string = ',str(s) 
    ! call compress(s);     write(*,*) 'string, no spaces = ',str(s) 
    ! call delete(s) 
    ! end program 

    private 
    public :: string 
    public :: init,delete 
    public :: get_str,str ! str does not require length 
    public :: compress,append 
    public :: print,export 

    interface init;  module procedure init_size;   end interface 
    interface init;  module procedure init_string;   end interface 
    interface init;  module procedure init_copy;   end interface 
    interface append; module procedure app_string_char;  end interface 
    interface append; module procedure app_string_string; end interface 
    interface compress; module procedure compress_string;  end interface 
    interface str;  module procedure get_str_short;  end interface 
    interface get_str; module procedure get_str_string;  end interface 
    interface delete; module procedure delete_string;  end interface 
    interface print;  module procedure print_string;   end interface 
    interface export; module procedure export_string;  end interface 

    type char 
    private 
    character(len=1) :: c 
    end type 

    type string 
    private 
    type(char),dimension(:),allocatable :: s ! string 
    integer :: n        ! string length 
    end type 

    contains 

    subroutine init_size(st,n) 
    implicit none 
    type(string),intent(inout) :: st 
    integer,intent(in) :: n 
    if (n.lt.1) stop 'Error: string must be of size > 1 in string.f90' 
    call delete(st) 
    allocate(st%s(n)) 
    st%n = n 
    end subroutine 

    subroutine init_string(st,s) 
    implicit none 
    type(string),intent(inout) :: st 
    character(len=*),intent(in) :: s 
    integer :: i 
    call init(st,len(s)) 
    do i=1,st%n 
     call init_char(st%s(i),s(i:i)) 
    enddo 
    end subroutine 

    subroutine init_copy(a,b) 
    implicit none 
    type(string),intent(inout) :: a 
    type(string),intent(in) :: b 
    integer :: i 
    call check_allocated(b,'init_copy') 
    call init(a,b%n) 
    do i=1,b%n 
    call init_copy_char(a%s(i),b%s(i)) 
    enddo 
    a%n = b%n 
    end subroutine 

    subroutine check_allocated(st,s) 
    implicit none 
    type(string),intent(in) :: st 
    character(len=*),intent(in) :: s 
    if (.not.allocated(st%s)) then 
     write(*,*) 'Error: string must be allocated in '//s//' in string.f90' 
    endif 
    end subroutine 

    subroutine delete_string(st) 
    implicit none 
    type(string),intent(inout) :: st 
    if (allocated(st%s)) deallocate(st%s) 
    st%n = 0 
    end subroutine 

    subroutine print_string(st) 
    implicit none 
    type(string),intent(in) :: st 
    call export(st,6) 
    end subroutine 

    subroutine export_string(st,un) 
    implicit none 
    type(string),intent(in) :: st 
    integer,intent(in) :: un 
    integer :: i 
    call check_allocated(st,'export_string') 
    do i=1,st%n 
     write(un,'(A1)',advance='no') st%s(i)%c 
    enddo 
    end subroutine 

    subroutine app_string_char(st,s) 
    implicit none 
    type(string),intent(inout) :: st 
    character(len=*),intent(in) :: s 
    type(string) :: temp 
    integer :: i,n 
    n = len(s) 
    call init(temp,st) 
    call init(st,temp%n+n) 
    do i=1,temp%n 
     call init_copy_char(st%s(i),temp%s(i)) 
    enddo 
    do i=1,n 
     call init_char(st%s(temp%n+i),s(i:i)) 
    enddo 
    call delete(temp) 
    end subroutine 

    subroutine app_string_string(a,b) 
    implicit none 
    type(string),intent(inout) :: a 
    type(string),intent(in) :: b 
    call append(a,str(b)) 
    end subroutine 

    subroutine compress_string(st) 
    implicit none 
    type(string),intent(inout) :: st 
    type(string) :: temp 
    integer :: i,n_spaces 
    if (st%n.lt.1) stop 'Error: input string must be > 1 in string.f90' 
    n_spaces = 0 
    do i=1,st%n 
     if (st%s(i)%c.eq.' ') n_spaces = n_spaces + 1 
    enddo 
    call init(temp,st%n-n_spaces) 
    if (temp%n.lt.1) stop 'Error: output string must be > 1 in string.f90' 
    do i=1,temp%n 
     if (st%s(i)%c.ne.' ') temp%s(i)%c = st%s(i)%c 
    enddo 
    call init(st,temp) 
    call delete(temp) 
    end subroutine 

    function get_str_short(st) result(str) 
    type(string),intent(in) :: st 
    character(len=st%n) :: str 
    str = get_str_string(st,st%n) 
    end function 

    function get_str_string(st,n) result(str) 
    implicit none 
    type(string),intent(in) :: st 
    integer,intent(in) :: n 
    character(len=n) :: str 
    integer :: i 
    call check_allocated(st,'get_str_string') 
    do i=1,st%n 
     str(i:i) = st%s(i)%c 
    enddo 
    end function 

    subroutine init_char(CH,c) 
    implicit none 
    type(char),intent(inout) :: CH 
    character(len=1),intent(in) :: c 
    CH%c = c 
    end subroutine 

    subroutine init_copy_char(a,b) 
    implicit none 
    type(char),intent(inout) :: a 
    type(char),intent(in) :: b 
    a%c = b%c 
    end subroutine 

    end module 
+0

Jest to interesujące, ale staram się zrozumieć, jak odpowiada na to pytanie. Tak, możesz utworzyć tablicę tych typów, ale możesz utworzyć tablicę prostego typu z ciągiem znaków Fortran o przedłużonej długości. Ale nawet nie pokazujesz takiej tablicy, a pytanie dotyczy ich. –

+0

Tak, zgadzam się, że nie rozwiązuje to bezpośrednio problemu, jest to raczej obejście. Miałem problemy z tym problemem w przeszłości i znalazłem kod, który dołączałem do kompilacji bez żadnych skarg kompilatora dotyczących Fortran 2003 lub czegokolwiek. – Charlie

Powiązane problemy