Fortran语言程序设计01 函数与子例行程序

目录

函数例子：计算n个城市，d天的最高气温，最低气温，平均气温

子例行程序改写上一个例子

子例行程序排序冒泡算法

综合问题：有些时候，气温统计丢失了，记录中用-999代替，如何计算？

 递归子程序

语句函数

---

函数例子：计算n个城市，d天的最高气温，最低气温，平均气温

program example1 for chapter7
    implicit None
    external calavg,calmax,calmin
    integer,parameter::n=3,d=3
    real calavg,calmax,calmin 
    real temp(n,d),tavg(n),tmax(n),tmin(n)
    integer i,j 
    do i=1,n
        read(*,*),temp(i,:)
    end do 
 
    do i=1,n
        tavg(i) = calavg(temp(i,:),d)
        tmax(i) = calmax(temp(i,:),d)
        tmin(i) = calmin(temp(i,:),d)
    end do 
 
    write(*,*)'average is ',tavg
    write(*,*)'maxium is ',tmax 
    write(*,*)'minium is ',tmin 
 
    read(*,*)
end program 
 
function calmax(a,m)
    implicit none 
    integer m,i 
    real a(m)
    real calmax
 
    calmax = a(1)
    do i = 2,m 
        if (calmax.LT.a(i))then
            calmax = a(i)
        end if 
    end do 
 
end function calmax 
 
function calmin(a,m)
    implicit none 
    integer m,i 
    real a(m)
    real calmin 
    calmin = a(1)
    do i=2,m
        if(calmin.GT.a(i))then 
            calmin = a(i)
        end if 
    end do 
end function calmin 
 
function calavg(a,m)
    implicit none 
    integer m,i 
    real::a(m)
    real calavg
    real sum
    sum = 0
    do i = 1,m
        sum = sum + a(i)/m 
    end do 
    calavg = sum 
 
end function calavg 
 

子例行程序改写上一个例子

program example2 
    implicit none 
    external calavg,calmax,calmin 
    integer,parameter::n=3,d=3
    real temp(n,d),tavg(n),tmax(n),tmin(n)
 
    integer i,j 
    do i=1,n 
        read(*,*)temp(i,:)
    end do 
 
    do i=1,n 
        call calavg(temp(i,:),d,tavg(i))
        call calmax(temp(i,:),d,tmax(i))
        call calmin(temp(i,:),d,tmin(i))
 
    end do 
 
    write(*,*)"ave",tavg
    write(*,*)"max",tmax 
    write(*,*)"min",tmin 
 
    read(*,*)
 
 
end program 
 
subroutine calavg(a,d,x)
    implicit none 
    integer d,i 
    real a(d),sum,x
    sum = 0.
    do i=1,d
        sum = sum + a(i)
    end do 
    x = sum/d 
end subroutine calavg 
 
subroutine calmax(a,d,x)
    implicit none 
    integer d,i,j
    real a(d),x
    x = a(1)
    do i=2,d
            if(x.LT.a(i))then 
                x = a(i)
            end if 
    end do 
 
end subroutine calmax 
 
subroutine calmin(a,d,x)
    implicit none 
    integer d,i,j
    real a(d),x 
    x = a(1)
    do i=2,d
            if(x.GT.a(i))then
                x = a(i)         
            end if 
    end do 
 
end subroutine calmin 
 

子例行程序排序冒泡算法（引入）

program example1
    implicit none 
    external sort 
    integer,parameter::N = 10 
    real,dimension(N)::ain=(/0,9,6,3,5,8,2,1,4,7/),aout
    write(*,*),ain
    call sort(ain,aout)
    write(*,*)"after",aout
 
    read(*,*)
 
end program
 
subroutine sort(ain,aout)
    implicit none 
    integer,parameter::N=10
    real ain(N),aout(N)
    real tmp 
    integer i,j 
 
    do i = 1,N-1
        do j = i+1,N 
            if (ain(i).GE.ain(j))then 
                tmp = ain(i)
                ain(i) = ain(j)
                ain(j) = tmp 
            end if 
        end do 
    end do 
 
    do i = 1,N 
        aout(i) = ain(i)
    end do 
 
end subroutine sort 

综合问题：有些时候，气温统计丢失了，记录中用-999代替，如何计算？

program example2 
    implicit none 
    external calavg,calmax,calmin 
    integer,parameter::n=1,d=5
    real temp(n,d),tavg(n),tmax(n),tmin(n)
 
    integer i,j 
    do i=1,n 
        read(*,*)temp(i,:)
    end do 
 
    do i=1,n 
        call calavg(temp(i,:),d,tavg(i))
        call calmax(temp(i,:),d,tmax(i))
        call calmin(temp(i,:),d,tmin(i))
 
    end do 
 
    write(*,*)"ave",tavg
    write(*,*)"max",tmax 
    write(*,*)"min",tmin 
 
    read(*,*)
 
 
end program 
 
subroutine calavg(a,d,x)
    implicit none 
    external correct
    integer d,i,m
    real a(d),aout(d),sum,x
    sum = 0.
    call correct(a,d,m,aout)
    do i=1,m
        sum = sum + aout(i)
    end do 
    x = sum/m
end subroutine calavg 
 
subroutine calmax(a,d,x)
    implicit none 
    external correct
    integer d,i,j,m
    real a(d),aout(d),x
    call correct(a,d,m,aout)
    x = aout(1)
    !write(*,*),aout
    do i=2,m
            if(x.LT.aout(i))then 
                x = aout(i)
            end if 
    end do 
 
end subroutine calmax 
 
subroutine calmin(a,d,x)
    implicit none 
    external correct
    integer d,i,j,m
    real a(d),aout(d),x 
    call correct(a,d,m,aout)
    x = aout(1)
    write(*,*)m,"min!!"
    do i=2,m
        if(x.GT.aout(i))then
            x = aout(i)         
        end if 
    end do 
 
end subroutine calmin 
 
subroutine correct(a,d,m,aout)
    implicit none 
    integer d,i,p,k
    real a(d),aout(d)
    integer m 
    p = 1
    m = d
    do k=1,d
        aout(k) = a(k)
    end do 
 
    do while(p.LT.m)
        do while(-999.NE.aout(p))
            p = p + 1
            if(p.GE.m)then
                exit
            end if 
            
        end do 
 
        if(p.GE.m)then
            exit
        end if 
 
        do i=p,m 
            aout(i) = aout(i+1)
        end do 
 
        m = m - 1
    end do 
 
    if(aout(d).EQ.-999)then
        m = m-1
    end if 
    write(*,*),m,"!!*"
    write(*,*),aout,"!!**"
end subroutine correct 

 

 递归子程序

用递归子例行程序做阶乘运算

program example12
    implicit none
    integer f,n
    write(*,*)'input n'
    read*,n 
    call fact(f,n)
    write(*,*)'factorial=',f 
    read(*,*)
end program 
 
recursive subroutine fact(f,i)
    implicit none 
    integer f,i 
    if(i.EQ.1)then 
        f = 1
    else
        call fact(f,i-1)
        f = f * i 
    end if  
end subroutine fact   
 
 

语句函数（支持整数）

program example8
    integer f,x
    real g 
    f(x) = 3*(0.1*x)**2+6*x + 5
    g(x) = 3*(0.1*x)**2+6*x + 5
    write(*,*),f(6),g(6)
 
    read(*,*)
end program 

 

program example8
    F(i,j,k) = 3.1415926 /180. * (i+j/60.+k/3600.)
    write(*,*),F(60,20,30)
 
    read(*,*)
end program