下载文档原格式
第14章固有过程固然，我们已经能够做到运用FORTRAN 95来描述任何的计算任务，因为FORTRAN 95所提供的数据类型，固有运算，派生类型，自定义运算，以及构造函数与子例行程序的方法，都足以使得我们应付任何的计算问题。
不过FORTRAN 95标准还提供了大量的科学计算的常规计算与函数，都可以作为固有过程直接使用，而不需要我们自己来编写源码。
这就好像对于一个汽车装配师，除了给他提供螺栓，轴承之类的标准零件，还给他提供更高层次的标准配件，例如各种型号的发动机，电机之类。
因此熟练掌握固有过程，将给我们带来如虎添翼的感觉。
FORTRAN 95把固有过程作为标准来提出，就意味着任何的FORTRAN 95的编译器实现版本，都必须能够提供它们：115个固有过程，其中包括109个固有函数和6个固有子例行程序。
当然不排除很多的编译器还提供额外的固有过程。
正是由于固有过程是属于FORTRAN 95的标准内容，因此和固有运算，例如+，一样，总是“随叫随到”，无论在哪个程序单位内部，只要使用某个固有过程的名称，就等于调用了该固有过程。
不过，如果它的名称被用户定义的函数或子例行程序所“侵占”，那么在下面的情况下，被调用的将是用户自定义的函数或子例行程序而不是固有过程：●该自定义函数或子例行程序的界面是显式的；●该自定义函数或子例行程序出现在EXTERNAL语句当中；●该自定义函数属于语句函数。
当然上述的名称被侵权的有效范围只是该自定义函数或子例行程序的作用域。
相应的，固有过程也就只能在下面的情形下夺回被侵占的名称：●不存在使用该名称的语句函数；●它的名称出现在INTRINSIC语句当中；●相应的用户定义的过程的界面是隐式的。
例如在一个模块或一个内部过程里面，由于它的界面是显式的，那么固有过程的名称就能够被侵占，除非固有过程的名称出现在一个有效的INTRINSIC语句当中。
下面我们主要讨论固有过程的按照功能的分类，以及每个种类的固有过程所能够完成的计算任务。
第四章1.program main implicit none write(*,*) "Have a good time." write(*,*) "That's not bad." write(*,*) '"Mary" isn''t my name.' end program2.program main real, parameter :: PI=3 implicit none.14159 real radius write(*,*) "请输入半径长" read(*,*) radius write(*,"(' 面积='f8. 3)") radius*radius*PI end program3.program main implicit none real grades write(*,*) "请输入成绩" read(*,*) grades write(*,"(' 调整后成绩为'f8.3)") SQRT(grades)*10.0 end program4.integer a,b real ra,rb a=2 b=3 ra=2.0 rb=3.0 write(*,*) b/a ! 输出1, 因为使用整数计算, 小数部分会无条件舍去write(*,*) rb/ra ! 输出1.55.p rogram main implicit none type distance real meter, inch, cm end type type(distance) :: d write(*,*) "请输入长度:" read(*,*) d%meter d%cm = d%meter*100 d%inch = d%cm/2.54 write(*,"(f8.3'米='f8.3'厘米='f8.3'英寸')") d%meter, d%cm, d%inch end program第五章1.program main implicit none integer money real tax write(*,*) "请输入月收入" read(*,*) money if ( money<1000 ) then tax = 0.03 else if ( money<5000) then tax = 0.1 else tax = 0.15 end if write(*,"(' 税金为'I8)") nint(money*tax) end program2.program main implicit none integer day character(len=20) :: tv write(*,*) "请输入星期几" read(*,*) day select case(day) case(1,4) tv = "新闻" case(2,5) tv = "电视剧" case(3,6) tv = "卡通" case(7) tv = "电影" case default write(*,*) "错误的输入" stop end select write(*,*) tv end program3.program main implicit none integer age, money real tax write(*,*) "请输入年龄" read(*,*) age write(*,*) "请输入月收入" read(*,*) money if ( age<50 ) then if ( money<1000 ) then tax = 0.03 else if ( money<5000 )then tax = 0.10 else tax = 0.15 end if else if ( money<1000 ) then tax = 0.5 else if ( money<5000 )then tax = 0.7 else tax = 0.10 end if end if write(*,"(' 税金为'I8)") nint(money*tax) end program4.program main implicit none integer year, days logical mod_4, mod_100, mod_400 write(*,*) "请输入年份" read(*,*) year mod_4 = ( MOD(year,4) == 0 ) mod_100 = ( MOD(year,100) == 0 ) mod_400 = ( MOD(year,400) == 0 ) if ( (mod_4 .NEQV. mod_100) .or. mod_400 ) then days = 366 else days = 365 end if write(*,"('这一年有'I3'天')") days stop end program第六章1.program main implicit none integer i do i=1,5 write(*,*) "Fortran" end do stop end program2.program main implicit none integer i,sum sum = 0 do i=1,99,2 sum = sum+i end do write(*,*) sum stop end program3.program main implicit none integer, parameter :: answer = 45 integer, parameter :: max = 5 integer weight, i do i=1,max write(*,*) "请输入体重" read(*,*) weight if ( weight==answer ) exit end do if ( i<=max ) then write(*,*) "猜对了" else write(*,*) "猜错了" end if stop end program4.program main implicit none integer, parameter :: max=10 integer i real item real ans ans = 1.0 item = 1.0 do i=2,max item = item/real(i) ans = ans+itemend do write(*,*) ans stop end program5.program main implicit none integer, parameter :: length = 79 character(len=length) :: input, output integer i,j write(*,*) "请输入一个字串" read(*,"(A79)") input j=1 do i=1, len_trim(input) if ( input(i:i) /= ' ' ) then output(j:j)=input(i:i) j=j+1 end if end do write(*,"(A79)") output stop end program第七章1.program main implicit none integer, parameter :: max = 10 integer i integer :: a(max) = (/ (2*i, i=1,10) /) integer :: t ! sum()是fortran库函数write(*,*) real(sum(a))/real(max) stop end program2.integer a(5,5) ! 5*5=25 integer b(2,3,4) ! 2*3*4=24 integer c(3,4,5,6) ! 3*4*5*6=360 integer d(-5:5) ! 11 integer e(-3:3, -3:3) ! 7*7=493.program main implicit none integer, parameter :: max=10 integer f(max) integer i f(1)=0 f(2)=1 do i=3,max f(i)=f(i-1)+f(i-2) end do write(*,"(10I4)") f stop end program4.program main implicit none integer, parameter :: size=10 integer :: a(size) = (/ 5,3,6,4,8,7,1,9,2,10 /) integer :: i,j integer :: t do i=1, size-1 do j=i+1, size if ( a(i) < a(j) ) then ! a(i)跟a(j)交换t=a(i) a(i)=a(j) a(j)=t end if end do end do write(*,"(10I4)") a stop end5.a(2,2) ! 1+(2-1)+(2-1)*(5) = 7 a(3,3) ! 1+(3-1)+(3-1)*(5) = 13第八章1.program main implicit none real radius, area write(*,*) "请输入半径长" read(*,*) radius call CircleArea(radius, area) write(*,"(' 面积= 'F8.3)") area stop end program subroutine CircleArea(radius, area) implicit none real, parameter :: PI=3.14159 real radius, area area = radius*radius*PI return end subroutine2.program main implicit none real radius real, external :: CircleArea write(*,*) "请输入半径长" read(*,*) radius write(*,"(' 面积= 'F8.3)") CircleArea(radius) stop end program real function CircleArea(radius) implicit none real, parameter :: PI=3.14159 real radius CircleArea = radius*radius*PI return end function3.program main implicit none call bar(3) call bar(10) stop end program subroutine bar(length) implicit none integer, intent(in) :: length integer i character(len=79) :: string string=" " do i=1,length string(i:i)='*' end do write(*,"(A79)") string return end subroutine4.p rogram main implicit none integer, external :: add write(*,*) add(100) end program recursive integer function add(n) result(sum) implicit none integer, intent(in) :: n if ( n<0 ) then sum=0 return else if ( n<=1 ) then sum=n return end if sum = n + add(n-1) return end function5.program main implicit none integer, external :: gcd write(*,*) gcd(18,12) end program integer function gcd(A,B) implicit none integer A,B,BIG,SMALL,TEMP BIG=max(A,B) SMALL=min(A,B) do while( SMALL /= 1 ) TEMP=mod(BIG,SMALL) if ( TEMP==0 ) exit BIG=SMALL SMALL=TEMP end do gcd=SMALL return end function6.program main use TextGraphLib implicit none integer, parameter :: maxx=60, maxy=20 real, parameter :: StartX=0.0, EndX=3.14159*2.0 real, parameter :: xinc = (EndX-StartX)/(maxx-1) real x integer i,px,py call SetScreen(60,20) call SetCurrentChar('*') x=StartX do px=1,maxx py = (maxy/2)*sin(x)+maxy/2+1 callPutChar(px,py) x=x+xinc end docall UpdateScreen() stop end program第九章1.program main implicit none character(len=79) :: filename character(len=79) :: buffer integer, parameter :: fileid = 10 integer count integer :: status = 0 logical alive write(*,*) "Filename:" read (*,"(A79)") filename inquire( file=filename, exist=alive) if ( alive ) then open(unit=fileid, file=filename, & access="sequential", status="old") count = 0 do while(.true.) read(unit=fileid, fmt="(A79)", iostat=status ) buffer if ( status/=0 ) exit ! 没有资料就跳出循环write(*,"(A79)") buffer count = count+1 if ( count==24 ) then pause count = 0 end if end do else write(*,*) TRIM(filename)," doesn't exist." end if stop end2.p rogram main implicit none character(len=79) :: filename character(len=79) :: buffer integer, parameter :: fileid = 10 integer i integer :: status = 0 logical alive write(*,*) "Filename:" read (*,"(A79)") filename inquire( file=filename, exist=alive) if ( alive ) then open(unit=fileid, file=filename, & access="sequential", status="old") do while(.true.) read(unit=fileid, fmt="(A79)", iostat=status ) buffer if ( status/=0 ) exit ! 没有资料就跳出循环do i=1, len_trim(buffer) buffer(i:i) = char( ichar(buffer(i:i))-3 ) end do write(*,"(A70)") buffer end do else write(*,*) TRIM(filename)," doesn't exist." end if stop end3.program main implicit none type student integer chinese, english, math, science, social, total end type type(student) :: s, total integer, parameter :: students=20, subjects=5 integer i open(10,file="grades.bin",access="direct",recl=1) write(*,"(7A10)") "座号","中文","英文","数学","自然","社会","总分" total = student(0,0,0,0,0,0) do i=1, students read(10,rec=(i-1)*subjects+1) s%chinese read(10,rec=(i-1)*subjects+2) s%english read(10,rec=(i-1)*subjects+3) s%math read(10,rec=(i-1)*subjects+4) s%science read(10,rec=(i-1)*subjects+5) s%social s%total = s%chinese+s%english+s%math+s%science+s%social total%chinese = total%chinese+s%chinese total%english = total%english+s%english total%math = total%math+s%math total%science = total%science+s%science total%social = total%social+s%social total%total = total%total+s%total write(*,"(7I10)") i, s end do write(*,"(A10,6F10.3)") "平均", & real(total%chinese)/real(students),& real(total%english)/real(students),& real(total%math)/real(students),& real(total%science)/real(students),& real(total%social)/real(students),& real(total%total)/real(students) stop end4.program main implicit none character(len=79) :: filename character(len=79) :: buffer integer, parameter :: fileid = 10 integer i integer :: status = 0 logical alive write(*,*) "Filename:" read (*,"(A79)") filename inquire( file=filename, exist=alive) if ( alive ) then open(unit=fileid, file=filename, & access="sequential", status="old") do while(.true.) read(unit=fileid, fmt="(A79)", iostat=status ) buffer if ( status/=0 ) exit ! 没有数据就跳出循环do i=1, len_trim(buffer) buffer(i:i) = char( ichar(buffer(i:i))-(mod(i-1,3)+1) ) end do write(*,"(A70)") buffer end do else write(*,*) TRIM(filename)," doesn't exist." end if stop end5.module typedef type student integer :: num integer :: Chinese, English, Math, Natural, Social integer :: total integer :: rank end type end module program main use typedef implicit none integer, parameter :: fileid=10 integer, parameter :: students=20 character(len=80) :: tempstr type(student) :: s(students) ! 储存学生成绩type(student) ::total ! 计算平均分数用integer i, num, error open(fileid, file="grades.txt",status="old", iostat=error) if ( error/=0 ) then write(*,*) "Open grades.txt fail." stop end if read(fileid, "(A80)") tempstr ! 读入第一行文字total=student(0,0,0,0,0,0,0,0) ! 用循环读入每位学生的成绩do i=1,students read(fileid,*) s(i)%num, s(i)%Chinese, s(i)%English, & s(i)%Math, s(i)%Natural, s(i)%Social ! 计算总分s(i)%Total = s(i)%Chinese + s(i)%English + & s(i)%Math + s(i)%Natural + s(i)%Social ! 累加上各科的分数, 计算各科平均时使用total%Chinese = total%Chinese + s(i)%Chinese total%English = total%English + s(i)%English total%Math = total%Math + s(i)%Math total%Natural = total%Natural + s(i)%Natural total%Social = total%Social + s(i)%Social total%Total = total%Total + s(i)%Total end do call sort(s,students) ! 重新输出每位学生成绩write(*,"(8A7)") "座号","中文","英文","数学","自然","社会","总分","名次" do i=1,students write(*,"(8I7)") s(i) end do ! 计算并输出平圴分数write(*,"(A7,6F7.1)") "平均", & real(total%Chinese)/real(students),& real(total%English)/real(students),& real(total%Math) /real(students),& real(total%Natural)/real(students),& real(total%Social) /real(students),& real(total%Total) /real(students) stop end program subroutine sort(s,n) use typedef implicit none integer n type(student) :: s(n), t integer i,j do i=1,n-1 do j=i+1,n if ( s(i)%total < s(j)%total ) then t = s(i) s(i)=s(j) s(j) = t end if end do end do forall(i=1:n) s(i)%rank = i end forall end subroutine第十章1.integer(kind=4) :: a ! 4 bytes real(kind=4) :: b ! 4 bytes real(kind=8) :: c ! 8 bytes character(len=10) :: str ! 10 bytes integer(kind=4), pointer :: pa ! 4 bytes real(kind=4), pointer :: pb ! 4 bytes real(kind=8), pointer :: pc ! 4 bytes character(len=10), pointer :: pstr ! 4 bytes type student integer Chinese, English, Math end type type(student) :: s ! 12 bytes type(student), pointer :: ps ! 4 bytes2.integer, target :: a = 1 integer, target :: b = 2 integer, target :: c = 3 integer, pointer :: p p=>a write(*,*) p ! 1 p=>b write(*,*) p ! 2 p=>c p=5 write(*,*) c ! 53.module linklist type student integer :: num integer :: Chinese, English, Math, Science, Social end type type datalink type(student) :: item type(datalink), pointer :: next end type contains function SearchList(num, head) implicit none integer :: num type(datalink), pointer :: head, p type(datalink), pointer :: SearchList p=>head nullify(SearchList) do while( associated(p) ) if ( p%item%num==num ) then SearchList => p return end if p=>p%next end do return end function end module linklist program ex1016 use linklist implicit none character(len=20) :: filename character(len=80) :: tempstr type(datalink), pointer :: head type(datalink), pointer :: p type(student), allocatable :: s(:) integer i,error,size write(*,*) "filename:" read(*,*) filename open(10, file=filename, status="old", iostat=error) if ( error/=0 ) then write(*,*) "Open file fail!" stop end if allocate(head) nullify(head%next) p=>head size=0 read(10, "(A80)") tempstr ! 读入第一行字符串, 不需要处理它! 读入每一位学生的成绩do while(.true.) read(10,fmt=*, iostat=error) p%item if ( error/=0 ) exit size=size+1 allocate(p%next, stat=error) ! 新增下一个数据if ( error/=0 ) then write(*,*) "Out of memory!" stop end if p=>p%next ! 移动到链表的下一个数据nullify(p%next) end do write(*,"('总共有',I3,'位学生')") size allocate( s(size) ) p=>head do i=1,size s(i)=p%item p=>p%next end do do while(.true.)write(*,*) "要查询几号同学的成绩?" read (*,*) i if ( i<1 .or. i>size ) exit ! 输入不合理的座号write(*,"(5(A6,I3))") "中文",s(i)%Chinese,& "英文",s(i)%English,& "数学",s(i)%Math,& "自然",s(i)%Science,& "社会",s(i)%Social end do write(*,"('座号',I3,'不存在, 程序结束.')") i stop end program4.module typedef implicit none type :: datalink integer :: i type(datalink), pointer :: next end type datalink end module typedef program ex1012 use typedef implicit none type(datalink) , pointer :: p, head, next integer :: i,n,err write(*,*) 'Input N:' read(*,*) n allocate( head ) head%i=1 nullify(head%next) p=>head do i=2,n allocate( p%next, stat=err ) if ( err /= 0 ) then write(*,*) 'Out of memory!' stop end if p=>p%next p%i=i end do nullify(p%next) p=>head do while(associated(p)) write(*, "(i5)" ) p%i p=>p%next end do ! 释放链表的存储空间p=>head do while(associated(p)) next => p%next deallocate(p) p=>next end do stop end program第十一章1.module utility implicit none interface area module procedure CircleArea module procedure RectArea end interface contains real function CircleArea(r) real, parameter :: PI=3.14159 real r CircleArea = r*r*PI return end function real function RectArea(a,b) real a,b RectArea = a*b return end function end module program main use UTILITY implicit none write(*,*) area(1.0) write(*,*) area(2.0,3.0) stop end program2.module time_utility implicit none type :: time integer :: hour,minute,second end type time interface operator(+) module procedure add_time_time end interface contains function add_time_time( a, b ) implicit none type(time) :: add_time_time type(time), intent(in) :: a,b integer :: seconds,minutes,carry seconds=a%second+b%second carry=seconds/60 minutes=a%minute+b%minute+carry carry=minutes/60 add_time_time%second=mod(seconds,60) add_time_time%minute=mod(minutes,60) add_time_time%hour=a%hour+b%hour+carry return end function add_time_time subroutine input( a ) implicit none type(time), intent(out) :: a write(*,*) " Input hours:" read (*,*) a%hour write(*,*) " Input minutes:" read (*,*) a%minute write(*,*) " Input seconds:" read (*,*) a%second return end subroutine input subroutine output( a ) implicit none type(time), intent(in) :: a write(*, "(I3,' hours',I3,' minutes',I3,' seconds')" ) a%hour,a%minute,a%second return end subroutine output end module time_utility program main use time_utility implicit none type(time) :: a,b,c call input(a) call input(b) c=a+b call output(c) stop end program main3.module rational_utility implicit none private public :: rational, & operator(+), operator(-), operator(*),& operator(/), assignment(=),operator(>),& operator(<), operator(==), operator(/=),& output, input type :: rational integer :: num, denom end type rational interface operator(+) module procedure rat__rat_plus_rat end interface interface operator(-) module procedure rat__rat_minus_rat end interface interface operator(*) module procedure rat__rat_times_rat end interface interface operator(/) module procedurerat__rat_div_rat end interface interface assignment(=) module procedure rat_eq_rat module procedure int_eq_rat module procedure real_eq_rat end interface interface operator(>) module procedure rat_gt_rat end interface interface operator(<) module procedure rat_lt_rat end interface interface operator(==) module procedure rat_compare_rat end interface interface operator(/=) module procedure rat_ne_rat end interface contains function rat_gt_rat(a,b) implicit none logical :: rat_gt_rat type(rational), intent(in) :: a,b real :: fa,fb fa=real(a%num)/real(a%denom) fb=real(b%num)/real(b%denom) if ( fa > fb ) then rat_gt_rat=.true. else rat_gt_rat=.false. end if return end function rat_gt_rat function rat_lt_rat(a,b) implicit none logical :: rat_lt_rat type(rational), intent(in) :: a,b real :: fa,fb fa=real(a%num)/real(a%denom) fb=real(b%num)/real(b%denom) if ( fb > fa ) then rat_lt_rat=.true. else rat_lt_rat=.false. end if return end function rat_lt_rat function rat_compare_rat(a,b) implicit none logical :: rat_compare_rat type(rational), intent(in) :: a,b type(rational) :: c c=a-b if ( c%num == 0 ) then rat_compare_rat=.true. else rat_compare_rat=.false. end if return end function rat_compare_rat function rat_ne_rat(a,b) implicit none logical :: rat_ne_rat type(rational), intent(in) :: a,b type(rational) :: c c=a-b if ( c%num==0 ) then rat_ne_rat=.false. else rat_ne_rat=.true. end if return end function rat_ne_rat subroutine rat_eq_rat( rat1, rat2 ) implicit none type(rational), intent(out):: rat1 type(rational), intent(in) :: rat2 rat1%num = rat2%num rat1%denom = rat2%denom return end subroutine rat_eq_rat subroutine int_eq_rat( int, rat ) implicit none integer, intent(out):: int type(rational), intent(in) :: rat int = rat%num / rat%denom return end subroutine int_eq_rat subroutine real_eq_rat( float, rat ) implicit none real, intent(out) :: float type(rational), intent(in) :: rat float = real(rat%num) / real(rat%denom) return end subroutine real_eq_rat function reduse( a ) implicit none type(rational), intent(in) :: a integer :: b type(rational) :: reduse b=gcv_interface(a%num,a%denom) reduse%num = a%num/b reduse%denom = a%denom/b return end function reduse function gcv_interface(a,b) implicit none integer, intent(in) :: a,b integer :: gcv_interface if ( min(a,b) .eq. 0 ) then gcv_interface=1 return end if if (a==b) then gcv_interface=a return else if ( a>b ) then gcv_interface=gcv(a,b) else if ( a<b ) then gcv_interface=gcv(b,a) end if return end function gcv_interface recursive function gcv(a,b) result(ans) implicit none integer, intent(in) :: a,b integer :: m integer :: ans m=mod(a,b) select case(m) case(0) ans=b return case(1) ans=1 return case default ans=gcv(b,m) end select return end function gcv function rat__rat_plus_rat( rat1, rat2 ) implicit none type(rational) :: rat__rat_plus_rat type(rational), intent(in) :: rat1,rat2 type(rational) :: act act%denom= rat1%denom * rat2%denom act%num = rat1%num*rat2%denom + rat2%num*rat1%denom rat__rat_plus_rat = reduse(act) return end function rat__rat_plus_rat function rat__rat_minus_rat( rat1, rat2 ) implicit none type(rational) :: rat__rat_minus_rat type(rational), intent(in) :: rat1, rat2 type(rational) :: temp temp%denom = rat1%denom*rat2%denom temp%num =rat1%num*rat2%denom -rat2%num*rat1%denom rat__rat_minus_rat = reduse( temp ) return end function rat__rat_minus_rat function rat__rat_times_rat( rat1, rat2 ) implicit none type(rational) :: rat__rat_times_rat type(rational), intent(in) :: rat1, rat2 type(rational) :: temp temp%denom = rat1%denom* rat2%denom temp%num = rat1%num * rat2%num rat__rat_times_rat = reduse(temp) return end function rat__rat_times_rat function rat__rat_div_rat( rat1, rat2 ) implicit none type(rational) :: rat__rat_div_rat type(rational), intent(in) :: rat1, rat2 type(rational) :: temp temp%denom = rat1%denom* rat2%num temp%num = rat1%num * rat2%denom rat__rat_div_rat = reduse(temp) return end function rat__rat_div_rat subroutine input(a) implicit none type(rational), intent(out) :: a write(*,*) "分子:" read(*,*) a%num write(*,*) "分母:" read(*,*) a%denom return end subroutine input subroutine output(a) implicit none type(rational), intent(in) :: a if ( a%denom/=1 ) then write(*, "(' (',I3,'/',I3,')' )" ) a%num,a%denom else write(*, "(I3)" ) a%num end if return end subroutine output end module rational_utility program main use rational_utility implicit none type(rational) :: a,b,c call input(a) call input(b) c=a+b write(*,*) "a+b=" call output(c) c=a-b write(*,*) "a-b=" call output(c) c=a*b write(*,*) "a*b=" call output(c) c=a/b write(*,*) "a/b=" call output(c) if (a>b) write(*,*) "a>b" if (a<b) write(*,*) "a<b" if (a==b) write(*,*) "a==b" if (a/=b) write(*,*) "a/=b" stop end program main4.module vector_utility implicit none type vector real x,y end type interface operator(+) module procedure vector_add_vector end interface interface operator(-) module procedure vector_sub_vector end interface interface operator(*) module procedure real_mul_vector module procedure vector_mul_real module procedure vector_dot_vector end interface interface operator(.dot.) module procedure vector_dot_vector end interface contains type(vector) function vector_add_vector(a,b) type(vector), intent(in) :: a,b vector_add_vector = vector(a%x+b%x, a%y+b%y) end function type(vector) function vector_sub_vector(a,b) type(vector), intent(in) :: a,b vector_sub_vector = vector(a%x-b%x, a%y-b%y) end function type(vector) function real_mul_vector(a,b) real, intent(in) :: a type(vector), intent(in) :: b real_mul_vector = vector( a*b%x, a*b%y ) end functiontype(vector) function vector_mul_real(a,b) type(vector), intent(in) :: a real, intent(in) :: b vector_mul_real = real_mul_vector(b,a) end function real function vector_dot_vector(a,b) type(vector), intent(in) :: a,b vector_dot_vector = a%x*b%x + a%y*b%y end function subroutine output(vec) type(vector) :: vec write(*,"('('F6.2','F6.2')')") vec end subroutine end module program main use vector_utility implicit none type(vector) a,b,c a=vector(1.0, 2.0) b=vector(2.0, 1.0) c=a+b call output(c) c=a-b call output(c) write(*,*) a*b end program main。
Fortran95简介-全文版Fortran95簡介－全文版By陳鯨太FORTRAN的演進FORTRAN的起源，要追溯到1954年IBM公司的一項計畫。
由JOHN BACKUS 領導的一個小組，嘗試著在IBM 704電腦上面發展一套程式，它可以把使用接近數學語言的文字，翻譯成機械語言。
這個計畫在剛開始並不被大家看好，但他們在1957年交出了成果，也就是第一套FORTRAN編譯器，FORTRAN語言也就因此誕生了。
FORTRAN語言的執行效率普遍的令各界滿意，它證明了這項計畫的可行性，也成為第一個被廣泛使用的高階語言。
FORTRAN的名字來自於英文的FORMULA TRANSLATOR這兩個字，而這兩個字恰是數學公式翻譯器的意思。
舊版的FORTRAN77是在1978年由美國國家標準局(ANSI)所正式公布的，之後改版有1992年提出的FORTRAN90以及1997年的FORTRAN95，本文是為了FORTRAN 95所撰寫。
編譯器簡介1、VISUAL FORTRANVISUAL FORTRAN一開始是起源於MICROSOFT的FORTRAN POWERSTATION 4.0，這套工具後來賣給DIGITAL公司來繼續發展，下一個版本稱為DIGITAL VISUAL FORTRAN 5.0，DIGITAL後來被COMPAQ合併，所以接下來的6.0及6.5版就稱為COMPAQ VISUAL FORTRAN。
而COMPAQ目前又跟HP合併，也許下一個版本會稱為HP VISUAL FORTRAN。
VISUAL FORTRAN被整合在一個叫作MICROSOFT VISUAL STUDIO的圖形介面開發環境中，VISUAL STUDIO提供一個統一的使用介面，這個介面包括文書編輯功能，PROJECT的管理、除錯工具等等，所以在使用上其實跟上學期的VISUAL C++滿類似的，同學們上課用過VISUAL C++，對VISUAL FORTRAN應該不會陌生。
第五章第一题program wd51implicit nonereal :: areal :: bwrite(*,*) "请输入一位上班族的月收入a="read(*,*) aif (a<=1000) thenb=a*0.03else if(a>=1000 .and. a<=5000) thenb=a*0.1elseb=a*0.15end ifwrite(*,*)"这位上班族所应缴纳的税金b=",bstopend第二题program wd52implicit noneinteger :: weekwrite(*,*)"请输入星期来查询当天晚上的节目week=" read(*,*) weekif(week==1 .or. week==4) thenwrite(*,*) "新闻"else if(week==2 .or. week==5) thenwrite(*,*) "电视剧"else if(week==3 .or. week==6) thenwrite(*,*) "卡通片"elsewrite(*,*) "电影"end ifend第三题program wd53implicit noneinteger age,moneyreal taxwrite(*,*) "请输入一位上班族的年龄="read (*,*) agewrite(*,*) "输入他的年收入="read (*,*) moneyif (age<50) thenif(money<=1000) thentax=money*0.03else if(money>1000 .and. money<5000) thentax=money*0.1elsetax=money*0.15end ifelse if (age>=50) thenif(money<=1000) thentax=money*0.05else if(money>1000 .and. money<5000) thentax=money*0.07elsetax=money*0.1end ifend ifwrite(*,*) "这位上班族所缴纳的税金是=",tax stopend第四题program wd54implicit noneinteger year,daylogical :: a,b,cwrite(*,*) "请输入一个公元年份="read (*,*) yeara=(MOD(year,4)==0)b=(MOD(year,100)==0)c=(MOD(year,400)==0)if((a.NEQV.b) .or. c) thenday=366elseday=365end ifwrite(*,*)"一年当中有",day,"天" stopend。
第17章Visual Fortran擴充功能FORTRAN 95程式設計這一章會介紹Visual Fortran在FORTRAN標準外所擴充的功能，主要分成兩大部分；第一部分會介紹Visual Fortran的擴充函式，第二部分會介紹Visual Fortran的繪圖功能。
17-1 Visual Fortran擴充函式Visual Fortran中提供了很多讓FORTRAN跟作業系統溝通的函式，這些函式都包裝在MODULE DFPORT中。
呼叫這些函式前，請先確認程式碼中有使用USE DFPORT這一行指令。
integer(4) function IARGC()傳回執行時所傳入的參數個數subroutine GETARG(n, buffer)用命令列執行程式時，可以在後面加上一些參數來執行程式，使用GETARG可以取出這些參數的內容。
integer n決定要取出哪個參數character*(*)buffer傳回參數內容FORTRAN程式編譯好後，執行程式時可以在命令列後面加上一些額外的參數。
假如有一個執行檔為a.exe，執行時若輸入a –o –f，在a之後的字串都會被當成參數。
這時候執行 a –o -f時，呼叫函數IARGC會得到2，因為總共傳入了兩個參數。
呼叫函式GETARGC(1,buffer)時，字串buffer=”-o”，也就是第1個參數的值。
subroutine GETLOG(buffer)查詢目前登錄電腦的使用者名稱。
character*(*)buffer傳回使用者名稱integer(4) function HOSTNAM(buffer)查詢電腦的名稱，查詢動作成功完成時函數傳回值為0。
buffer字串長度不夠使用時，傳回值為-1。
character*(*)buffer傳回電腦的名稱程式執行時，工作目錄是指當開啟檔案時，沒有特別指定目錄位置時會使用的目錄。
通常這個目錄就是執行檔的所在位置，在程式進行中可以查詢或改變這個目錄的位置。
FORTRAN95程序设计实验指导第一节 Compaq Visual FORTRAN 6.5快速入门1.1 安装Compaq Visual FORTRAN 6.51.1.1 系统要求安装Compaq Visual FORTRAN 6.5（以下简称为CVF）需要具备以下软硬件条件：●80586或以上处理器，运行Windows 98//NT/2000或以上操作系统。
●具有光盘驱动器。
●64MB或以上内存。
●足够的硬盘空间。
安装程序根据安装选项提示所需的硬盘空间。
专业版的典型安装需要约300MB硬盘空间。
●SVGA显示器。
●鼠标。
1.1.2 安装步骤下面以Windows 2000操作系统为例，对于其他Windows 操作系统，安装过程与此类似。
首先，将含CVF的光盘插入光盘驱动器，在资源管理器中运行Setup程序，屏幕显示Compaq VisualFORTRAN Setup窗口；单击【istall Visual Fortran】按钮；当出现询问是否查看README.TXT文件的对话框时单击【否】按钮；安装程序自动搜索已有组件，单击【Continue】(继续)按钮，并按提示输入用户名、公司名、产品系列号后，安装程序会显示安装选项对话框(图1.1)；如果要改变安装CVF 的文件夹,单击【Change Folder...】(改变文件夹)按钮，选择或输入所需的文件夹名；如果输入的文件夹不存在，安装程序会自动生成该文件夹，并生成几个下级文件夹以存放相应的各类文件。
图1.1还显示了各安装选项的简短说明和安装时所需的硬盘空间。
选择下列四个安装选项之一继续安装：Typical(典型)Custom(定制)Run from CD-ROM(从光盘运行)Typical(典型)安装选项将安装最常用的部分，约需298MB硬盘空间。
Custom(定制)安装选项将允许用户选择安装自己需要的组件(约需350MB空间)。
Run From CD-ROM(从光盘运行)安装选项约需29MB硬盘空间。
Fortran95基本语法字符：Fortran不区分大小写Fortran 格式：自由格式和固定格式。
Fortran程序代码扩展名为：*.For 或*.F的文件就是指固定格式；以*.F90为扩展名的文件，就是自由格式。
à固定格式：规定了程序代码每一行中每个字段的意义。
第7~72个字符，是可以用来编写程序的字段。
每一行的前5个字符只能是空格或数字，数字用来作为“行代码”。
每一行的第6个字符只能是空格或“0”以外的字符。
à自由格式：叹号（！）后面的文本都是注释。
每行可以编写13 2个字符。
行号放在每行程序的最前面。
一行程序代码的最后如果是符号&，代表下一行程序会和这一行连接；如果一行程序代码的开头是符号&，代表它会和上一行程序连接。
Fortran的数据类型à整型（Integer）à浮点数(Real) à复数(Complex) à字符(Character)à逻辑判断(Logical)—True or FalseRemark: Visual Fortran安装好后，默认的安装目录C:\Program Files\Microsoft Visual Studio\DV98\bin下有一个Bitviewer程序可以用来表看各种数据格式实际在内存中的二进制数据。
Fortran的数学表达式（）（括号）、**（乘幂）、*（乘法）or /（除法）、+（加法）or –（减法）à优先级(高à低).输入（Write）输出（Print）命令Fortran程序通常以Program描述来开头，Program后面还要接一个自定义的程序名称（这个名称可以完全自定义，不需要和文件名有任何关系）。
Fortran程序最后还要有End描述，表示程序代码写到这一行结束。
Write（*，*）命令：括号中的两个星号都有各自的意义，第一个星号代表输出的位置使用默认值，也就是屏幕，第二个星号则代表不特别设置输出格式。
FORTRAN 95 语法基础目录：一、应用程序的创建与运行/FORTRAN 95所用的字符/ 变量类型及其声明，常量声明/表达式与运算符二、输入与输出：表控、有格式三、选择语句与结构：IF语句、CASE结构四、DO循环结构五、数组：数组的声明，数组的引用，数组的算术运算，数组的输入、输出，给数组赋初值，动态数组，WHERE、FORALL语句六、子程序：语句函数，内部子程序，调用子程序时的虚实结合：形参为数组、非定界数组、子程序名、星号，递归子程序，外部子程序，纯子程序，逐元子程序七、派生数据类型与结构体八、指针与动态链表九、文件：存取方式，基本操作语句，各类文件的读写操作十、接口、模块十一、公用区、存储关联、数据块子程序十二、绘图：坐标系、设置图形颜色、创建图形程序/ 常用过程：设置线型、绘一像素点、设置当前位置、绘直线、绘弧线、绘矩形、绘多边形、绘制扇形（圆、椭圆）/ 文字信息的显示附/录：标准函数与标准子例行程序一、基础部份1-1 FORTRAN 95 应用程序的创建与运行创建或运行FORTRAN 95程序必须在Microsoft Developer Studio平台上进行。
尽管程序文本及相关文件的编辑可以在任一文本编辑器上进行，然后再拷到Studio的文档窗口中。
但最好还是一开始就进入Studio环境。
创建FORTRAN 95 程序的步骤大致如下：1）启动Microsoft Developer Studio可以通过不同方式运行dfdev.exe程序以启动Microsoft Developer Studio[开始] \ Compaq Visual Fortran 6 \ Developer Studio \ dfdev.exe：或……\CVF66 \\MSDEV98\dfdev.exeMicrosoft Developer Studio的界面如下图所示：文档窗口工作空间窗口输出窗口2）建立工作空间（WorkSpace）工作空间（WorkSpace）对应着windows资源管理器的一个文件夹。
Fortran95简介－全文版By陈鲸太FORTRAN的演进FORTRAN的起源，要追溯到1954年IBM公司的一项计划。
由JOHN BACKUS 领导的一个小组，尝试着在IBM 704计算机上面发展一套程序，它可以把使用接近数学语言的文字，翻译成机械语言。
这个计划在刚开始并不被大家看好，但他们在1957年交出了成果，也就是第一套FORTRAN编译器，FORTRAN语言也就因此诞生了。
FORTRAN语言的执行效率普遍的令各界满意，它证明了这项计划的可行性，也成为第一个被广泛使用的高级语言。
FORTRAN的名字来自于英文的FORMULA TRANSLATOR这两个字，而这两个字恰是数学公式翻译器的意思。
旧版的FORTRAN77是在1978年由美国国家标准局(ANSI)所正式公布的，之后改版有1992年提出的FORTRAN90以及1997年的FORTRAN95，本文是为了FORTRAN 95所撰写。
编译器简介1、VISUAL FORTRANVISUAL FORTRAN一开始是起源于MICROSOFT的FORTRANPOWERSTATION 4.0，这套工具后来卖给DIGITAL公司来继续发展，下一个版本称为DIGITAL VISUAL FORTRAN 5.0，DIGITAL后来被COMPAQ合并，所以接下来的6.0及6.5版就称为COMPAQ VISUAL FORTRAN。
而COMPAQ目前又跟HP合并，也许下一个版本会称为HP VISUALFORTRAN。
VISUAL FORTRAN被整合在一个叫作MICROSOFT VISUAL STUDIO的图形接口开发环境中，VISUAL STUDIO提供一个统一的使用接口，这个接口包括文书编辑功能，PROJECT的管理、除错工具等等，所以在使用上其实跟上学期的VISUAL C++满类似的，同学们上课用过VISUAL C++，对VISUAL FORTRAN应该不会陌生。
《FORTRAN 95程序设计》学习笔记66RPG gg★目录★《FORTRAN 95程序设计》学习笔记 (1)基础知识(基础、字符串、FORMAT、隐式、TYPE) (1)流程与控制(if、select、do) (4)数组(声明、隐式循环、整体操作、可变数组) (5)函数与子程序(子程序、函数、全局变量) (6)MODULE与面向对象(重载操作符、虚函数) (9)文件相关(OPEN、WRITE、READ) (10)指针（指向变量、数组、函数） (11)Visual Fortran 编译器（DLL，VB调用） (12)数值算法与IMSL（数值算法插件） (14)常用库函数（数学、数组、零碎、子程序） (15)基础知识(基础、字符串、FORMAT、隐式、TYPE)★【小玩意】二进制观察器：装在M.. Visual Studio\DF98\bin，有一个Bitviewer，可以观察变量储存方式★【语法】续行：行结尾或行开头使用& 符号；注释：使用! 符号★【语法】数学表达式：+ ；- ；* ；/ ；( ；) ；**乘幂★【语法】程序结束：STOP (Ruby的exit)★【语法】输出：write(*,*)，完整写法：write(unit=*,fmt=*)⏹建议：少用print，尽量用write★【语法】声明⏹整型：integer(kind=4) a ；其中kind是使用的bytes数，4 or 2◆其他写法：integer*4 a; integer(4) a⏹浮点：real(kind=4) a ；有效数位6位（12345678存为1.234567E7），如果是kind8则为15位有效数字◆此外：1E10：单精10^10，1D10：双精10^10⏹复数：complex :: a=(2,3)◆实部：real(a) ；虚部：imag(a)⏹布尔型：Logical，.true. 和.false.★【语法与函数】字符串：character(20) string⏹注意理解，fortran的弱智字符串就是一个长度不能变的一维的东西，极其猥琐，和Java、Ruby不能相提并论的⏹string(13:13) = “a” ：对第13个字节的读、存⏹string(2:3) = “go”⏹string(6) = “我的妈呀”：从第6个位置开始设置为“我的妈呀”⏹ a = string_a // string_b：用“//”连接两个字符串⏹【常用函数】char(num)，ichar(char)：ASCII码的转换相关功能⏹【常用函数】len(string)，len_trim(string)：长度，去掉尾部空格后的长度⏹【常用函数】index(string,key)：找key在string首出现的位置⏹【常用函数】trim(string)：返回去掉尾部空格的字符串(用途不大)⏹【函数】repeat(char,int)：返回一个重复int次的char串⏹character(len=20) string 普通声明；character(len=*) string 接收的时候可自动长度★【规范格式】FORMAT格式化⏹ e.g.◆write (*,100) A◆100 format(I4) ←这里是100号标识调用的格式⏹参数控制符(前面加数字为重复次数，如4I6或<a>I6。
FORTRAN95程序设计实验FORTRAN95程序设计实验本文档涉及附件。
本文所涉及的法律名词及注释。
⒈简介本文档旨在提供一个完整的FORTRAN95程序设计实验的指南。
它包括实验的背景、目的、实验步骤、程序代码和测试结果等内容。
⒉实验背景在本节中，将介绍该实验的背景信息。
这可能包括与程序设计相关的概念、算法、问题陈述等。
⒊实验目的在本节中，将明确说明该实验的目的。
这可以包括学习特定的FORTRAN95编程技术、理解特定算法的实现、解决特定问题等。
⒋实验步骤本节将详细说明完成该实验所需的步骤。
每个步骤都应该清晰明了，并包括必要的代码片段和解释。
⑴实验准备在本段中，将列出完成该实验所需的软件和硬件准备，例如安装FORTRAN95编译器、准备输入文件、设置运行环境等。
⑵实验步骤1：任务1在本段中，将详细介绍实验中的第一个任务。
这可以包括问题描述、算法设计、需要编写的FORTRAN95代码等。
⑶实验步骤2：任务2在本段中，将详细介绍实验中的第二个任务。
同样，包括问题描述、算法设计、FORTRAN95代码等。
⒌程序代码在本节中，将提供实验中使用的完整FORTRAN95程序代码。
代码应该经过清晰的注释，以便读者理解。
⒍测试结果本节将展示每个任务的测试结果。
这可能包括输入和输出示例，以及对结果的说明和分析。
⒎总结在本节中，将对整个实验进行总结。
包括实验过程中遇到的困难、得到的经验教训、对FORTRAN95编程的理解等。
⒏附件该文档包含以下附件：实验说明书、FORTRAN95代码文件、输入文件、输出文件等。
⒐法律名词及注释在本节中，将列出在文档中使用到的法律名词，并提供相应的注释。
这有助于读者更好地理解涉及法律方面的内容。
《Fortran95语言程序设计》课程教学大纲课程英文名称：Fortran95 Programming Design课程编号：0332232002课程计划学时：32学分：2课程简介：FORTRAN语言程序设计是材料物理专业的开设的专业基础课， FORTRAN语言在科学计算领域有着十分广泛的应用。
通过本课程的学习，应使学生掌握FORTRAN95的基本概念，语法规则和利用FORTRAN95进行程序设计的方法。
使学生在后继课的学习中，能够利用FORTRAN95上机编程，解决相应的实际问题，并能在今后的学习和工作中，结合自己的专业知识，开发相应的计算机应用程序。
一、课程教学内容及教学基本要求第一章 Fortran语言程序设计概述本章重点：算法、程序基本结构难点：语言元素本章学时:2学时教学形式:讲授与上机实践相结合教具:计算机，投影仪第一节 Fortran语言程序设计概述本节要求了解：程序设计的过程、基本方法、程序设计语言的分类、Fortran语言的发展、Fortran77、Fortran95程序设计的构成及其兼容性，(考核概率20%)理解：算法的概念，掌握：算法的描述、程序基本结构与书写规则(考核概率100%)1 程序设计的过程算法的描述（重点，难点）2 程序设计的基本方法3 程序设计语言4 Fortran语言的发展5 Fortran95程序基本结构与书写规则（重点）6 Fortran95程序设计的兼容性第二节Fortran95开发环境（第一次上机实验课讲述）本节要求了解：在可视化编程的条件下Fortran 语言所具备的一些新的特点和功能，掌握：可视化编程所需的基础知识和一般步骤(考核概率100%)1 熟悉Fortran95 环境进入系统2 建立项目文件3 建立源程序文件4 输入源程序的内容5 编译、连接、运行作业：认真复习本章内容，预习第二章内容。
第二章数据类型及其运算本章重点：Fortran语言的基本数据类型及其常量表示方法难点：算术表达式的写法本章学时:1学时教学形式:讲授与上机实践相结合教具:计算机，投影仪第一节数据类型及其运算本节要求了解：各种类型常量、变量的定义、算术表达式的写法，(考核概率100%)掌握：Fortran语言的基本数据类型及其常量表示方法(考核概率50%)1 常量2 变量及其定义3符号常量及其定义4 Fortran表达式（重点）作业：认真复习本章内容。
