可分配数组在 Fortran 90 及更高版本中是可能的。
INTEGER, ALLOCATABLE, DIMENSION(:) :: test_int_array
在 Fortran 2003 中可以使用可分配的标量，例如可分配的字符。
CHARACTER(LEN=:), ALLOCATABLE :: test_str
我想知道是否可以声明一个可分配字符的固定或可分配数组？ （可能像下面的东西，不幸的是没有编译。）
CHARACTER(LEN=:), ALLOCATABLE, DIMENSION(4) :: test_str_array
【问题讨论】：
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
我在http://software.intel.com/en-us/forums/showthread.php?t=77823 找到了语法。它适用于 ifort 12.1，但不适用于 gfortran 4.6.1。尝试创建用户定义类型的工作也没有奏效。
【讨论】：
string_array 似乎确实是可分配字符串的可分配数组。但是，必须在之后声明字符串具有相等的长度。你能帮忙评论一下我是否理解这个限制吗？另一种解决方法需要用户定义的类型，该类型本身包含可分配的字符串，确实有效，但似乎引入了更多复杂性。如果这种用户定义的类型方式是唯一的解决方法，也许我会坚持使用固定长度的字符串。
我最近开发了一个类来处理可变大小的字符串。我没有对其进行太多测试，但它似乎编译得很好。我基本上创建了一个只存储单个字符的类，并且由于您可以在派生类型中拥有可分配的派生类型，因此它只比您理想中想要的更深一层。无论哪种方式，您都可能只会使用接口。代码如下：
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
【讨论】：