Fortran语言编程小结

1.单双精度

Program ex01

implicit none

real(kind=4) :: a

real(kind=8) :: b

a=3.66666666666666666666666_4 ! 确定这个数字是使用单精度

b=3.66666666666666666666666_8 ! 确定这个数字是使用双精度write(*,*) a,b

End program ex01

2.判断kind值

program ex02

Implicit none ! 判断可以记录9个位数的整数kind值

integer, parameter :: long_int = selected_int_kind( 9 ) ! 判断可以记录3个位数的整数kind值integer, parameter :: short_int = selected_int_kind( 3 )

! 判断可以有3个有效位数, 指数可以记录到3的浮点数kind值integer, parameter :: long_real = selected_real_kind( 10, 50 )

! 判断可以有10个有效位数, 指数可以记录到50的浮点数kind值integer, parameter :: short_real= selected_real_kind( 3, 3 )

integer(kind=long_int) :: a = 123456

integer(kind=short_int) :: b = 123

real(kind=long_real) :: c = +1.23456789D45

real(kind=short_real) :: d =+1230

write(*, "(I3,1X,I10)" ) long_int, a

write(*, "(I3,1X,I10)" ) short_int, b

write(*, "(I3,1X,E10.5)" ) long_real, c

write(*, "(I3,1X,E10.5)" ) short_real, d

END

3.TYPE

program ex0434

implicit none

Type :: person ! 开始建立person这个类型

character(len=30) :: name ! 人名

integer :: age ! 年龄

integer :: height ! 身高

INTEGER :: weight ! 体重

character(len=80) :: address ! 地址

End type person

type(person) :: a ! 声明一个person类型的变量

write(*,*) "NAME:"

read(*,*) a%name

write(*,*) "AGE:"

read(*,*) a%age

write(*,*) "HEIGHT:"

read(*,*) a%height

write(*,*) "WEIGHT:"

read(*,*) a%weight

write(*,*) "ADDRESS:"

read(*,*) a%address

write(*,100) a%name,a%age,a%height,a%weight

100 format("Name:",A10/,"Age:",I3/,"Height:",I3/,"Weight:",I3/,&

"Addres:",A80)

End

4.REAL 与INTEGER

Program ex0431

implicit none

integer :: a=1

integer :: b=2

real :: c

c=a/b ! c=1/2=0, 虽然c是浮点数,但因为a,b是整数,计算a/b时会用整数去计算. write(*,"(F5.2)") c

End

5.DATA 变量表/初值表/，变量表/初值表/，…

PROGRAM ex0430

IMPLICIT NONE

INTEGER A

REAL B

COMPLEX C

CHARACTER(20) STR

DA TA A,B,C,STR /1, 2.0, (1.0,2.0), 'FORTRAN 77'/

WRITE(*,*) A,B,,C,STR

END

6.复数实虚部

Program ex0430

complex :: c = (1,2)

write(*,100)real(c),'+',aimag(c),'i'

100 format(f5.1,a1,f5.1,a1)

End

7.逻辑输出

Program ex0416

logical a,b

a=.true.

b=.false.

write(*,100) a,b

100 format(L5,L4)

End

8.Program ex0415

character(len=20) string

character(len=5) substring

string = "Have a nice day."

substring = "nice"

write(*,*) ichar('A') ! 输出字符A的ASCII码

write(*,*) char(65) ! 输出ASCII码65所代表的字符,也就是A write(*,*) len(string) ! 输出字符串string声明时的长度

write(*,*) len_trim(string) ! 输出字符串string内容的长度

write(*,*) index(string, substring) ! nice在Have a nice day的第8个位置End

9.Program ex0414

character(len= 6) first

character(len=10) second

character(len=20) add

first="Happy "

second="Birthday"

add = first//second ! 经由两个连续的除号可以连接两个字符串

write(*,100) add

100 FORMAT('生日快乐',/,A)

End

10.带精度计算

Program ex0408

real(kind=8) :: a,b

a=1

b=0.1

write(*,*) a,"+",b,"=",a+b

End

11.逻辑if语句

Program ex0504

implicit none

integer rain, windspeed

logical r,w

write(*,*) "Rain:"

read(*,*) rain

write(*,*) "Wind:"

read(*,*) windspeed

r = (rain>=500) ! 如果rain>=150, r=.true, 不然r=.false.

w = (windspeed>=10) ! 如果windspeed>=10, w=.true, 不然w=.false. if ( r .or. w ) then ! 只要r或w有一个值是true就成立

write(*,*) "停止上班上课"

else

write(*,*) "照常上班上课"

End if

End

12.Select Case用法

Program ex0512

implicit none

integer :: score

character grade

write(*,*) "Score:"

read(*,*) score

select case(score)

case(90:100)

grade='A'

case(80:89)

grade='B'

case default

grade='?'

End select

write(*,"('Grade:',A1)") grade

End

13.IF GOTO语句

PROGRAM ex0514

IMPLICIT NONE

REAL height

REAL weight

WRITE(*,*) "height:"

READ(*,*) height

WRITE(*,*) "weight:"

READ(*,*) weight

IF ( weight > height-100 ) GOTO 200

100 WRITE(*,*) "Under control."

GOTO 300

200 WRITE(*,*) "Too fat!"

300 STOP

END

14.DO WHILE 循环

Program ex0604

implicit none

integer, parameter :: limit=10

integer counter

integer :: ans = 0

counter = 2

do while( counter <= limit )

ans = ans + counter

counter = counter + 2

end do

write(*,*) ans

END

15.CYCLE,EXIT 语句

Program ex0609

implicit none

integer :: i,j

loop1: do i=1,3

loop2: do j=1,3

if ( i==3 ) exit loop1 ! 跳离loop1循环

if ( j==2 ) cycle loop2 ! 重做loop2循环

write(*, "('(',i2,',',i2,')')" ) i, j

end do loop2

end do loop1

End

16.大小写字符

Program ex0612

implicit none

integer i

integer strlen

character(len=20) :: string

write(*,*) "String:"

read(*,*) string

strlen = LEN_TRIM(string)

do i = 1, strlen

string(i:i) = char( ichar(string(i:i)) +32 )

end do

write(*,"('encoded:',A20)") string

End

17.循环计算

Program ex0614

implicit none

real a,b,ans

character :: key = 'y' ！为了至少循环一次do while( key=='y' .or. key=='Y' )

read(*,*) a

read(*,"(A1)") key

read(*,*) b

select case(key)

case('+')

ans = a+b

case('-')

ans = a-b

case('*')

ans = a*b

case('/')

ans = a/b

case default

write(*,"('Unknown operator ',A1)") key

stop

end select

write(*,"(F6.2,A1,F6.2,'=',F6.2)") a,key,b,ans

write(*,*) "(Y/y) to do again. (Other) to exit."

read(*,"(A1)") key

end do

End

18.矩阵相加

pogram ex

implicit none

integer, parameter :: row = 2

integer, parameter :: col = 2

integer :: matrixA(row,col)

integer :: matrixB(row,col)

integer :: matrixC(row,col)

integer r

integer c

write(*,*) "Matrix A"

do r=1, row

do c=1, col

write(*,"('A(',I1,',',I1,')=')") r,c

read(*,*) matrixA(r,c)

end do

end do

write(*,*) "Matrix B"

do r=1, row

do c=1, col

write(*,"('B(',I1,',',I1,')=')") r,c

read(*,*) matrixB(r,c)

end do

end do

write(*,*) "Matrix A+B="

do r=1, row

do c=1, col

matrixC(r,c) = matrixB(r,c)+matrixA(r,c)

write(*,"('(',I1,',',I1,')=',I3)") r,c,matrixC(r,c)

end do

end do

end pogram ex

[ write(*,"(I3,I3,/,I3,I3)") ((mc(i,j), i=1,2),j=1,2)]

19.program ex

implicit none

integer, parameter :: row = 2

integer, parameter :: col = 2

integer :: a(2,2)=(/ 1,2,3,4 /)

! a(1,1)=1, a(2,1)=2, a(1,2)=3, a(2,2)=4

integer :: b(4)=(/ 5,6,7,8 /)

integer :: c(2)

write(*,*) a,2)

write(*,*) a(:,1)

c = a(:,1) ! c(1)=a(1,1), c(2)=a(2,1)

write(*,*) c ! c(1), c(2)

c = a(2,:) ! c(1)=a(2,1), c(2)=a(2,2)

write(*,*) c ! c(1), c(2)

write(*,*) c(2:1:-1) ! c(2), c(1)

c = b(1:4:2) ! c(1)=b(1), c(2)=b(3)

write(*,*) c ! c(1), c(2)

End

20.FORALL语句

Program ex

Implicit none

integer :: I,J

integer, parameter :: size = 5

integer :: a(size,size)

forall ( I=1:size, J=1:size, I>J ) a(I,J)=1 ! 上半部分forall ( I=1:size, J=1:size, I==J ) a(I,J)=2 ! 对角线forall ( I=1:size, J=1:size, I

End

21.Allocatable

Program EX

Implicit none

integer :: size, error=0

integer, parameter :: one_mb=1024*1024 ! 1MB

character, allocatable :: a(:)

Do

size=size+one_mb !

allocate( a(size), stat=error )

if ( error/=0 ) exit

write(*,"('Allocate ',I10, ' bytes')") size

write(*,"(F10.2,' MB used')") real(size)/real(one_mb)

deallocate( a )

End do

End

22.Function 函数

Program ex

implicit none

real :: a=10

real :: b=20

real :: add

write(*,"(f6.2)") add(a,b)

End

Function add(a,b)

implicit none

real :: a,b

real :: add

add = a*b

End

23.SAVE语句

Program ex

Implicit none

call sub()

call sub()

call sub()

End program

Subroutine sub()

Implicit none

Integer :: count = 1

Save count ! 指定save变量永远活着，不会忘记它的内容

Write(*,*) count

count = count+1

End [运行结果：1 2 3 ]

24.生成随机数

program ex

implicit none

interface ! 定义函数的接口

function random10(lbound, ubound)

implicit none

real :: lbound, ubound

real :: random10(10)

end function

end interface

real :: a(10)

CALL RANDOM_SEED() ! 系统根据日期和时间随机地提供种子

a = random10(1.0, 10.0)

write(*,"(10F6.2)") a

end

function random10(lbound, ubound)

implicit none

real :: lbound, ubound

real :: len

real :: random10(10)

real t

integer i

len = ubound - lbound ! 计算范围大小

do i=1,10

call random_number(t) ! t会是0～1之间的随机数

random10(i) = lbound + len * t ! 把t转换成lbound～ubound间的随机数end do

End

25.MODULE语句

Module global

implicit none

integer a,b

common a,b

End module

Program ex0834

use global

implicit none

a=1

b=2

call sub()

End program

Subroutine sub()

use global

implicit none

write(*,*) a,b

return

End subroutine

26.写文件到text

program ex0902

implicit none

character(len=20) :: string

open(unit=10, file="test.txt")

write(10,"(A20)") "I LOVE YOU." ! 写到文件中rewind(10)

read(10,"(A20)") string ! 从文件中读出来

write(*,"(A20)") string ! 写到屏幕上

end

27.随机成绩

program gendata

implicit none

integer students

integer i

real r(3)

write(*,"(4A5)") "座位","语文","数学","英语" call random_seed()

write(*,*) "How many students?"

read(*,*) students

do i=1,students

call random_number(r)

write(*,"(6I5)") i,int(r*50+50)

end do

end program