Fortran入门.08.各种型 - 北方连萌

Fortran入门.08.各种型

编程 , Fortran · 2021-08-22

高精度（更多位数的）实数型

型宣言

双倍精度

real(8)

四倍精度

real(16)

相对地，单倍精度即

real(4)

也就是平常所写的

real

数字写法

1.12345678999999参与双精度运算时，写成

1.2345678999999d0

输入输出可以不特地指定格式，指定的话可以用这个

dm.n !总位数n位，小数点以下m位

数的写法也有类似科学计数法表示的，1.12345678999999写成

1.2345678999999d+00

此外fm, n和gm, n也可以使用

函数写法

单精度下

sin(x)
cos(x)

之类

双精度下在前面加d就行

dsin(x)
dcos(x)

但也不是必须，在括号里是双精度时不加d也行

Dprod输出双精度积

z = dprod(x, y) !x，y是单精度，z是双精度

对07中的向量夹角计算做微调，可以有

program abc
  implicit none
  real, dimension(3) :: a, b
  real(8) :: s, t !双精度宣言
  interface
    function dp(a, b, n)
      implicit none
      real(8) :: dp !双精度宣言
      real, dimension(*), intent(in) :: a, b
      integer, intent(in) :: n
    end function
  end interface

  print *, 'Enter a 3 dimensional vector a'
  read *, a
  print *, 'Enter a 3 dimensional vector b'
  read *, b
  s = dp(a, b, 3) / sqrt(dp(a, a, 3) * dp(b, b, 3)) 
  t = acos(s) * 180d0 / 3.1415926535897d0 !使用双精度数进行运算
  print *, 'The angle between a and b is', t, 'degree(s).'

  print *,'press any key to continue'
  read *,
    
  stop
    
end

function dp(a, b, n)
  implicit none
  real(8) :: dp !双精度宣言
  real, dimension(*), intent(in) :: a, b
  integer, intent(in) :: n
  integer :: i
  real(8) :: s !双精度宣言

  s = 0.0d0 !使用双精度数
  do i = 1, n
    s = dprod(a(i), b(i)) + s !使用dprod将单精度的两数积双精度化
  end do
  dp = s
  return

end function
 Enter a 3 dimensional vector a
1,0,0
 Enter a 3 dimensional vector b
1,1,0
 The angle between a and b is   45.000000000001343      degree(s).
 press any key to continue

复数型

型宣言

单精度（实部和虚部各为单精度）

complex :: z
complex(4) :: z

双精度（实部和虚部各为双精度）

complex(8) :: z

写法和运算

复数型之间，复数型和实数型之间可以进行四则运算以及乘方运算，整数型只可在乘方中出现

complex :: a, b, c, d
...
a = (2.0 +3.0 * b) ** c / d - b**c

另外，复数常量可以写成实数对的形式参与运算

a = (2, 3) * b

输入输出方面，因为复数是以实数对的形式输入输出的，所以格式没什么特别要求

函数

实数复数通用型，可以在函数名前面加c也可以不加

函数名
sqrt
exp
log
sin
cos
abs

复数专用型

函数意义
cmplx(实数对或实数)实数变换为复数
conjg(复数)求共轭复数
real(复数)取出实部
aimag(复数)取出虚部

注意

反三角函数，双曲线函数，常用对数不可作用于复数

用例

求i的i次方

根据公式，此处输出的应该与e^(-1/2)一致

program abc
  implicit none
  complex :: a, b, c
  real(8) :: f
  
  a = (0, 1)
  b = (0, 1)
  c = a ** b
  f = 2.71828182846 ** (- 3.14159265359 * 0.5)
  print *, 'c=', c, ''
  print *, 'f =         ',f

  print *,'press any key to continue'
  read *,
    
  stop
    
end
 c=            (0.207879573,0.00000000)
 f =           0.20787957310676575
 press any key to continue

卡尔达诺公式

PROGRAM CARDANO
  IMPLICIT NONE
  REAL(8)::A1,A2,A3,Q,R,RR
  COMPLEX(8)::ZR,SR,U,V,X1,X2,X3,W1,W2

  W1=CMPLX(-0.5D0,SQRT(3.0D0)/2.0D0)
  W2=W1**2.0D0
  
  PRINT*, 'X^3+A1*X^2+A2*X+A3=0'
  PRINT*, 'A1,A2,A3='
  READ*, A1,A2,A3

  Q=A2-A1**2.0D0/3.0D0
  R=A3-A1*A2/3.0D0+2.0D0*A1**3.0D0/2.7D1
  RR = R**2.0D0/4.0D0+Q**3.0D0/2.7D1
  ZR=CMPLX(RR)
  SR=SQRT(ZR)

  IF(R>0.0D0) SR=-SR
  U=(-R/2.0D0+SR)**(1.0D0/3.0D0)
  V=-Q/(3.0D0*U)
  X1=U+V-A1/3.0D0
  X2=U*W1+V*W2-CMPLX(A1/3.0D0,0.0D0)
  X3=U*W2+V*W1-CMPLX(A1/3.0D0,0.0D0)

  PRINT*, 'X1=',X1
  PRINT*, 'X2=',X2
  PRINT*, 'X3=',X3

  PRINT *,'PRESS ANY KEY TO CONTINUE'
  READ *,
    
  STOP
    
END
 X^3+A1*X^2+A2*X+A3=0
 A1,A2,A3=
-3,-8,-4
 X1=         (4.8284271247366828,7.39318328779603462E-013)
 X2=      (-0.99999994723863650,-1.30905619677434970E-009)
 X3=       (-0.82842707442780261,1.30831745437376412E-009)
 PRESS ANY KEY TO CONTINUE

逻辑型

常量

只有两种

.true.
.false.

型宣言

logical :: 变量名

因为逻辑值只有是或否

所以

logical(1) :: 变量名

避免浪费空间

运算

写法意义
.not.非
.and.与
.or.或
.eqv.等价
.neqv.不等价

运算优先度：非＞与＞或，一般把想要先处理的打括号所以不用特别在意

If

if(逻辑式) 式值为真时执行的部分

输入输出

不用特地指定格式，惟指定时用ln，n表示位数，在n位中的某处有T或F

用例

与非型半加器

4个与非门，1个非门

program abc
  implicit none
  logical::a,b,s,c,g1,g2,g3
  integer::i,j

  a=.true.
  b=.true.
  print'(1x,a4)', 'ABSC'
  do i=1,2
    do j=1,2
      g1=.not.(a.and.b)
      g2=.not.(a.and.g1)
      g3=.not.(b.and.g1)
      s=.not.(g2.and.g3)
      c=.not.g1
      print'(1x,4l1)', a,b,s,c
      a=.not.a
    end do
    b=.not.b
  end do
  
  print *,'press any key to continue'
  read *,
  
  stop
    
end
 ABSC
 TTFT
 FTTF
 TFTF
 FFFF
 press any key to continue

文字型

常量

用单引号或者双引号括起来

型宣言

character(文字数) :: 变量名, 变量名, ...

或者

character(len = 文字数) :: 变量名, 变量名, ...

超过文字数的字符串被代入时超过部分会被忽略掉

常用操作

program abc
  implicit none
  character(10) :: a, b
  
  print *, '输入一串字符'
  read '(a7, a8)', a, b 
  !将前7个字符作为字符串a的前7位读取，接下来8个字符串作为b的前8位读取
  !若读取完不足宣言中的长度，则将后面的几位补成空格
  print *, '字符串a的第二项到第四项是        ', a(2:4)
  print *, '字符串b长度', len(b)
  print *, '输出d在字符串中首次出现的位置，未出现则输出0', index(a, 'd')
  print *, '输出z在字符串中首次出现的位置，未出现则输出0', index(b, 'z')
  print *, 'a和b连起来是', a//b
  if(a >= b) then
    print *, 'a >= b'
  else
    print *, 'a < b'
  end if

  print *, 'press any key to continue'
  read *,
  
  stop
    
end
 输入一串字符
Trinitrotoluene
 字符串a的第二项到第四项是        rin
 字符串b长度          10
 输出d在字符串中首次出现的位置，未出则输出0           0
 输出z在字符串中首次出现的位置，未出则输出0           0
 a和b连起来是Trinitr   otoluene
 a < b
 press any key to continue

字符串的比较规则

从两个字符串的第一个字符开始比，规则为：0<...<9<A<...<Z

派生型（自定义型）

前面所涉及的

整数型
实数型
高精度实数型
复数型
逻辑型
文字型

都是属于intrinsic type（基本型），系统内置可以直接用的，但是如果想更方便地实现复杂的功能，将基本型进行组合做一些自定义型按需使用会很受用，这样的型也就是derived type（派生型）

基本写法

program 程序名
implicit none
!派生型的宣言
type :: 型名
  构成要素的宣言
end type
!派生型的变量的宣言
type(型名) :: 派生型的变量
type(型名), dimesion(维度) :: 派生型的变量
!普通变量的宣言
......

处理
!单独代入值的操作
变量名%构成要素名 = 值
!全部代入的操作
变量名 = 型名(要素1的值, 要素2的值, 要素3的值, ...)
read *, 变量名%构成要素名
write *, 变量名%构成要素名

stop

end

自定义运算符号

声明时加上

interface operator (符号)
  function 函数名(自变量1, 自变量2, ...)
    函数的表达式
  end function
end interface

模块化

在主程序前写一个模块，里面包含若干派生型和副程序，并在主程序第二行use 模块名使其生效

module 模块名
  type 派生型名
    构成要素的宣言
  end type 派生型名
contains
  function ...
    函数的表达式
  end function
  subroutine ...
    子程序处理内容
  end subroutine
end module
program 程序名
  use 模块名
  implicit none
  type(派生型名) :: 变量名
  其他宣言
  主程序处理内容
end
其他子程序与函数

用例

根据字母排序name-tel列

module s
  implicit none
  type :: ad
    character(10) :: name
    character(6) :: tel
  end type

  contains

  subroutine rd(a)
    implicit none
    type (ad), intent(inout) :: a

      read *, a%name, a%tel
      return

  end subroutine 

  subroutine wr(a)
      implicit none 
      type (ad), intent(inout) :: a

        print '(1x,a10,1x,a6)', a%name, a%tel
        return

  end subroutine

  subroutine sort(a,n)
    implicit none
    type (ad), dimension(*), intent(inout) :: a
    type (ad) :: w
    integer, intent(inout) :: n
    integer :: i , ter

    do ter=n-1,1,-1
      do i=1, ter
        if (a(i)%name>a(i+1)%name) then
          w=a(i)
          a(i)=a(i+1)
          a(i+1)=w
        end if
      end do
    end do
    return

  end subroutine

end module

program abc
  use s
  implicit none
  type(ad), dimension(10) :: a
  integer :: i,n

  print *, 'n='
  read(*,*) n 
  do i=1,n
    call rd(a(i))
  end do
  call sort(a,n)
  do i=1,n
    call wr(a(i))
  end do

  print *, 'press any key to continue'
  read *,
  
  stop
    
end
 n=
3
Jackson,0101245
Anna,0045147
Ben,4874125
 Anna       004514
 Ben        487412
 Jackson    010124
 press any key to continue

时间差计算

module t
  implicit none
  type :: hms
    integer :: h,m,s
  end type hms

  contains

  function d(a,b)
    implicit none
    type (hms) :: d
    type (hms) ,intent(inout) :: a,b
    integer :: as,bs,cs

      as=a%h*3600+a%m*60+a%s
      bs=b%h*3600+b%m*60+b%s
      cs=bs-as
      d%h=cs/3600
      d%m=mod (cs,3600)/60
      d%s=mod (cs,60)
      return

  end function

  subroutine rd(m,a)
    implicit none
    character(*), intent(in) :: m
    type (hms), intent(inout) :: a

      write(*,*) m
      read(*,*) a%h, a%m, a%s
      return

  end subroutine

  subroutine wr(m,a)
    implicit none
    character(*), intent(in) :: m
    type (hms), intent(inout) :: a

      write(*,*) m
      write(*,*) a%h, 'hr'
      write(*,*) a%m, 'min'
      write(*,*) a%s, 'sec'
      return

  end subroutine

end module

program dt
  use t
  implicit none
  type (hms) :: a,b,c
  
  call rd('a=',a)
  call rd('b=',b)
  c=d(a, b)
  call wr('b-a=',c)

  print *, 'press any key to continue'
  read *,
  
  stop
    
end
 a=
14,66,56
 b=
22,45,14
 b-a=
           7 hr
          38 min
          18 sec
 press any key to continue

自定义四则符号使之在主程序中可以直接作用于分数

module f
  implicit none
  type::de
    integer::u,d
  end type
end module
program abc
  use f
  implicit none
  type(de)::a,b,c,d,e,g
  interface operator(+)
    function pl(a,b)
      use f
      implicit none
      type(de)::pl
      type(de),intent(in)::a,b
    end function
  end interface
  interface operator(-)
    function mn(a,b)
      use f
      implicit none
      type(de)::mn
      type(de),intent(in)::a,b
    end function
  end interface
  interface operator(*)
    function ml(a,b)
      use f
      implicit none
      type(de)::ml
      type(de),intent(in)::a,b
    end function
  end interface
  interface operator(/)
    function dv(a,b)
      use f
      implicit none
      type(de)::dv
      type(de),intent(in)::a,b
    end function
  end interface
  call rd('a=',a)
  call rd('b=',b)
  c=a+b
  d=a-b
  e=a*b
  g=a/b
  call wr('a+b',c)
  call wr('a-b',d)
  call wr('a*b',e)
  call wr('a/b',g)
  print*,'press any key to continue'
  read*,
  stop
  contains
  subroutine rd(w,a)
    use f
    implicit none
    character(*),intent(in)::w
    type(de),intent(inout)::a
    print*,w
    read*,a%u,a%d
    return
  end subroutine
  subroutine wr(w,a)
    use f
    implicit none
    character(*),intent(in)::w
    type(de),intent(inout)::a
    print*,w,a%u,'/',a%d
    return
  end subroutine
end
function pl(a,b)
  use f
  implicit none
  type(de)::pl
  type(de),intent(in)::a,b
  type(de)::rz
  interface
    function yf(a)
      use f
      implicit none
      type(de)::yf
      type(de),intent(in)::a
    end function
  end interface
  rz%u=a%u*b%d+a%d*b%u
  rz%d=a%d*b%d
  pl=yf(rz)
  return
end function
function mn(a,b)
  use f
  implicit none
  type(de)::mn
  type(de),intent(in)::a,b
  type(de)::rz
  interface
    function yf(a)
      use f
      implicit none
      type(de)::yf
      type(de),intent(in)::a
    end function
  end interface
  rz%u=a%u*b%d-a%d*b%u
  rz%d=a%d*b%d
  mn=yf(rz)
  return
end function
function ml(a,b)
  use f
  implicit none
  type(de)::ml
  type(de),intent(in)::a,b
  type(de)::rz
  interface
    function yf(a)
      use f
      implicit none
      type(de)::yf
      type(de),intent(in)::a
    end function
  end interface
  rz%u=a%u*b%u
  rz%d=a%d*b%d
  ml=yf(rz)
  return
end function
function dv(a,b)
  use f
  implicit none
  type(de)::dv
  type(de),intent(in)::a,b
  type(de)::rz
  interface
    function yf(a)
      use f
      implicit none
      type(de)::yf
      type(de),intent(in)::a
    end function
  end interface
  rz%u=a%u*b%d
  rz%d=a%d*b%u
  dv=yf(rz)
  return
end function
function yf(a)
  use f
  implicit none
  type(de)::yf
  type(de),intent(in)::a
  integer::i,m,n
  interface
    function gcd(m,n)
      implicit none
      integer::gcd
      integer,intent(in)::m,n
    end function
  end interface
  m=a%u
  n=a%d
  i=gcd(m,n)
  m=m/i
  n=n/i
  yf%u=m
  yf%d=n
  return
end function
function gcd(m,n)
  implicit none
  integer::gcd
  integer,intent(in)::m,n
  integer::a,b,r
  a=m
  b=n
  r=mod(a,b)
  do while(r/=0)
    a=b
    b=r
    r=mod(a,b)
  end do
  gcd=b
  return
end function
 a=
454531,545
 b=
1451451,6565
 a+b   519930486 /    -3577925
 a-b -2102012076 /     3577925
 a*b  1695489103 /    -3577925
 a/b  -436990427 /   263680265
 press any key to continue

添加新评论

电子邮件地址不会被公开，评论内容可能需要管理员审核后显示。