我最近开发了一个处理可变大小字符串的类。虽然我没有进行过太多测试,但它似乎可以编译通过。我基本上创建了一个只存储单个字符的类,由于你可以在派生类型中拥有可分配的派生类型,所以它比理想情况深一级。无论如何,你可能只会使用接口。以下是代码:
module string_mod
implicit none
private
public :: string
public :: init,delete
public :: get_str,str
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
integer :: n
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
string_array
确实是一组可分配的可分配字符字符串数组。然而,这些字符串在之后必须被声明为具有相等的长度。请问您能否帮忙评论一下我是否正确理解了这个限制?另一个解决方法,需要使用一个包含可分配字符串的用户定义类型,确实可以运行,但似乎会引入更多复杂性。如果这种用户定义类型的方式是唯一的解决方法,也许我会坚持使用固定长度的字符串。 - SOUser