Fortran For Fun多态之class(*)

发表于 | 分类于

多态是面向对象程序设计(OOP)的一个重要特征，是指同样的操作作用于不同的数据类型，这些数据类型通常继承自同一个父类。fortran 中存在一种任意数据类型 class(*)，以该类型作为子程序的形参，实参可以是任意类型，只需要在子程序中定义实参的实际操作。

将任意数据类型转换为字符串

以下模块可以将任意常用的数据类型转换为字符串类型，通过 str 函数可以将 integer, real, logical, character(*) 的标量，向量，矩阵都转化为字符串，其中将向量和矩阵转化为字符串时可以指定字符间的分隔符号，向量元素之间默认为 “,”，矩阵中向量之间默认为 “;”，还可以指定是否通过中括号将数组括起来 (默认有中括号)。数组默认转换为 matlab 形式， 通过可选参数的指定可以转换为 python 以及 java 的数组形式。

to_string

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
module to_string
  implicit none
  interface str
    module procedure :: scalar_to_string, vector_to_string, matrix_to_string
  end interface str
contians
  !=============================================================================
  pure function scalar_to_string(value) result(s)
    !< convert any scalar type (integer, real, logical, character(*)) to string
    class(*), intent(in)      :: value
    character(:), allocatable :: s
    integer, parameter        :: max_num_len_ = 32
    character(max_num_len_)   :: ls
    select type(v_p => value)
    type is(integer)
      write(ls,'(i0)') v_p
      s = trim(adjustl(ls))
    type is(real)
      write(ls,fmt=*) v_p
      s = trim(adjustl(ls))
    type is(logical)
      if (v_p) then
        write(ls,'(a)') 'true'
      else
        write(ls,'(a)') 'false'
      end if
      s = trim(adjustl(ls))
    type is(character(*))
      s = trim(adjustl(v_p))
    class default
      write(ls,'(a)') '***'
      s = trim(adjustl(ls))
    end select
  end function scalar_to_string
  !=============================================================================
  pure function vector_to_string(value, vsep, shell) result(s)
    !< convert any vector type (integer, real, logical, character(*)) to string
    class(*), intent(in) :: value(:)
    character(*), intent(in), optional :: vsep   !< vector separator ',', ' '
    logical,intent(in), optional :: shell        !< if have the shell []
    character(:), allocatable :: s
    character(:),allocatable :: lsep
    logical :: lshell
    integer :: n
    lsep = ','      !< default vector separator
    lshell = .TRUE. !< default shell = true
    if(present(vsep)) lsep = vsep !< local optional argument
    if(present(shell)) lshell = shell !< another local argument
    s = ''
    if(lshell) s = '['
    do n = 1, size(value)
      if (n > 1) s = s//lsep
      s = s // str(value(n))    !< str => scalar_to_string
    end do
    if(lshell) s = s// ']'
  end function vector_to_string
  !=============================================================================
  pure function matrix_to_string(value, vsep, msep, shell) result(s)
    class(*), intent(in) :: value(:,:)
    character(*), intent(in), optional :: vsep  !< vector separator ',', ' '
    character(*), intent(in), optional :: msep  !< matrix separator ';', new_line('a')
    logical,intent(in), optional :: shell       !< if have the shell []
    character(:), allocatable :: s
    character(:),allocatable :: lvsep, lmsep
    logical :: lshell
    integer   :: n, m
    lvsep = ','
    lmsep = ';'
    lshell = .TRUE.
    if(present(vsep)) lvsep = vsep
    if(present(msep)) lmsep = msep
    if(present(shell)) lshell = shell
    s = ''
    if(lshell) s = '['
    do n = 1, size(value,2)
      if (n > 1) s = s//lmsep
      if(lshell) s = s//'['
      do m = 1, size(value, 1)
        if (m > 1) s = s//lvsep
        s = s // str(value(m,n))    !< str => scalar_to_string
      enddo
      if(lshell) s = s//']'
    enddo
    if(lshell) s = s//']'
  end function matrix_to_string
end module to_string

测试

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
program main
  use to_string, only: str
  implicit none
  real :: r = 1., rv(4) = [1.,2.,3.,4.], rm(2,2) = reshape([1.,2.,3.,4.],[2,2])
  character(2) :: c = 'a ', cv(4) = ['a ','b ','c ','d '], cm(2,2) = reshape(['a ','b ','c ','d '],[2,2])
  integer :: i = 1, iv(4) = [1,2,3,4], im(2,2) = reshape([1,2,3,4],[2,2])
  logical :: l = .TRUE.,lv(4) = [.TRUE.,.FALSE.,.FALSE.,.TRUE.], lm(2,2) = reshape([.TRUE.,.FALSE.,.FALSE.,.TRUE.],[2,2])
  print*,'r  = '//str(r)
  print*,'rv = '//str(rv)
  print*,'rm = '//str(rm)
  print*,'i  = '//str(i)
  print*,'iv = '//str(iv)
  print*,'im = '//str(im)
  print*,'c  = '//str(c)
  print*,'cv = '//str(cv)
  print*,'cm = '//str(cm)
  print*,'l  = '//str(l)
  print*,'lv = '//str(lv)
  print*,'lm = '//str(lm)
end program main

测试结果

1
2
3
4
5
6
7
8
9
10
11
12
r  = 1.0000000000000000
rv = [1.0000000000000000,2.0000000000000000,3.0000000000000000,4.0000000000000000]
rm = [[1.0000000000000000,2.0000000000000000];[3.0000000000000000,4.0000000000000000]]
i  = 1
iv = [1,2,3,4]
im = [[1,2];[3,4]]
c  = a
cv = [a,b,b,c]
cm = [[a,b];[b,c]]
l  = true
lv = [true,false,false,true]
lm = [[true,false];[false,true]]