[閒聊] FORTRAN的模組，既然外流了，那就乾脆一點
今天給哲晉看作業時
赫然發現我整個材料包都給他了
好吧
分享一下
不過不要全部復至貼上喔
還是要自己改一下
不然聽說教授也是會抓抄襲的說
以下
module chen_yen_an
contains
!!算標準差，n是資料數，a是數據(用陣列放入)
function sta(n,a)
integer,intent(in) :: n
real,dimension(n) :: a
real :: avg,sta,xx
avg=sum(a)/real(n)
xx=0
do i=1,n
xx=xx+abs((a(i)-avg))**2.
enddo
sta=sqrt(xx/real(n))
endfunction
!!回歸線和相關線數(相關係數好像有錯，哪位高手幫忙抓一下吧!!)
!!n是資料數，x,y用陣列輸入，m是斜率b是截距，r是有錯的相關系數
subroutine d2(n,x,y,m,b,r)
integer,intent(in) :: n
real,intent(out) :: m,b,r
real,dimension(n),intent(in) :: x,y
real,dimension(n) :: xx,xy,xryr
real :: xavg,yavg
xy=x*y
xx=x**2.
yavg=sum(y)/real(n)
xavg=sum(x)/real(n)
do i=1,n
xryr=(x(n)-xavg)*(y(n)-yavg)
enddo
m=(sum(xy)-sum(x)*yavg)/(sum(xx)-sum(x)*xavg)
b=yavg-m*xavg
r=sum(xryr)/real(n)/(sta(n,x)*sta(n,y))
endsubroutine
!!數字排大小n是資料筆數，a是資料用陣列輸入
subroutine big_to_small(n,a)
integer,intent(in) :: n
real,dimension(n) :: a
real :: x
do i=1,n-1
do j=1,n-1
if (a(j)<a(j+1)) then
x=a(j)
a(j)=a(j+1)
a(j+1)=x
endif
enddo
enddo
endsubroutine
!!按字母順序排n是資料數，g是最多幾個字，a是字元(用陣列輸入)，b會告訴你順序
subroutine l_a_to_z(n,g,a,b)
integer,intent(in) :: n,g
character(g),dimension(n),intent(in) :: a
integer,intent(out) :: b(n)
integer :: i,j,temp2
character(g) :: temp3
character(g),dimension(n) :: temp
b=(/(i,i=1,n)/)
do i=1,n
temp(i)=a(i)
enddo
do i=1,n-1
do j=i+1,n
if (LLT(temp(j),temp(i)))then
temp3=temp(i)
temp(i)=temp(j)
temp(j)=temp3
temp2=b(i)
b(i)=b(j)
b(j)=temp2
endif
enddo
enddo
endsubroutine
!!字元換大寫
subroutine ucase(a)
implicit none
character(len=*) :: a
integer :: i,length
length=len(a)
do i=1,length
if(LGE(a(i:i),"a").and.LLE(a(i:i),"z"))then
a(i:i)=achar(iachar(a(i:i))-32)
endif
enddo
endsubroutine
!!大因小倍
subroutine lcm_gcd(a,b,lcm,gcd)
integer,intent(in) :: a,b
integer,intent(out) :: lcm,gcd
integer :: aa,bb,c
aa=abs(a)
bb=abs(b)
if(aa<bb)then
c=aa
aa=bb
bb=c
endif
do
c=mod(aa,bb)
if(c==0) exit
aa=bb
bb=c
enddo
gcd=bb
lcm=(a*b)/gcd
endsubroutine
!!階乘
function factorial(n)
integer,intent(in) :: n
integer :: factorial,i
factorial=1
if (n==0)then
factorial=1
else
do i=1,n
factorial=factorial*i
enddo
endif
endfunction
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!f must be defined!!!!!!!!!!
!!!!!!!!以下是積分了阿~~~!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!記得要有F(x)喔~~~!!!!!!!!!!
!!!!!!!!ab是上下限，n式逼近的程度!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!梯形法
function areatr(a,b,n)
real :: areatr
real,intent(in) :: a,b
integer,intent(in) :: n
real :: x,dx,sum1,sum2
integer :: i
sum1=0
dx=(b-a)/real(n)
do i=1,n-1
x=a+i*dx
sum1=sum1+f(x)
enddo
sum2=(f(a)+f(b))/2.+sum1
areatr=dx*sum2
endfunction
!!蒙地卡羅(不知道最大和最小值)
function areamo(a,b,nall)
real :: rx,ry,v,ma,mi,areamo,a,b,c
integer :: nall,nin,d
call random_seed
ma=0
mi=0
do c=a,b,1./real(nall)
if (f(c)>0) then
if (f(c)>ma) then
ma=f(c)
endif
else
if (f(c)<mi) then
mi=f(c)
endif
endif
enddo
nin=0
do d=1,nall
call random_number(rx)
call random_number(ry)
rx=rx*(b-a)+a
ry=ry*(ma-mi)+mi
if (0.<f(rx).and.ry<f(rx)) then
nin=nin+1
else if (f(rx)<0..and.ry<f(rx)) then
nin=nin-1
endif
enddo
v=(ma-mi)*(b-a)*real(nin)/real(nall)
areamo=v
endfunction
!!蒙地卡羅(知道最大值是MA和MB)
function areamo2(a,b,nall,ma,mi)
real :: rx,ry,v,ma,mi,areamo2
integer :: nall,nin,d
call random_seed
nin=0
do d=1,nall
call random_number(rx)
call random_number(ry)
rx=rx*(b-a)+a
ry=ry*(ma-mi)+mi
if (0.<f(rx).and.ry<f(rx)) then
nin=nin+1
else if (f(rx)<0..and.ry<f(rx)) then
nin=nin-1
endif
enddo
v=(ma-mi)*(b-a)*real(nin)/real(nall)
areamo2=v
endfunction
!!!!!!!!!!!!!!!
function f(x) !
real :: f,x !
f=x !
endfunction !
!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!拍3.1415926............
function pi()
real :: pi
pi=atan(1.)*4.
endfunction
!!1~m整數中排出N個亂數
function p_mn(m,n)
integer,intent(in) :: m,n
integer :: number(n),p_mn(n)
real :: rand
logical :: index(m)
index=.false.
call random_seed
do i=1,n
10 call random_number (rand)
number(i)=1+int(m*rand)
if (index(number(i))) goto 10
p_mn(i)=number(i)
index(number(i))=.true.
enddo
endfunction
!!亂數
function rand()
real :: rand
call random_number (rand)
endfunction
end module
以上
我最後還是放上來了
發現有錯要說
祝大家考試順利
加油摟~
--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 61.231.97.225
推
12/30 20:56, , 1F
12/30 20:56, 1F
推
12/30 21:44, , 2F
12/30 21:44, 2F
推
12/30 22:39, , 3F
12/30 22:39, 3F
推
12/30 23:02, , 4F
12/30 23:02, 4F
推
12/30 23:23, , 5F
12/30 23:23, 5F
推
12/30 23:35, , 6F
12/30 23:35, 6F
推
12/30 23:59, , 7F
12/30 23:59, 7F
推
01/01 13:02, , 8F
01/01 13:02, 8F
推
01/01 21:45, , 9F
01/01 21:45, 9F
推
01/01 23:11, , 10F
01/01 23:11, 10F
推
01/02 10:23, , 11F
01/02 10:23, 11F
推
01/06 00:14, , 12F
01/06 00:14, 12F