24小时热门版块排行榜    

查看: 1297  |  回复: 4

xmch2011

铁虫 (小有名气)

[求助] 求fortran95编写的数值程序

想学学用fortran95写的数值程序,那位同学有没有这样的程序,学习一下,谢谢!
回复此楼
数学,力学,物理
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

wll778824

银虫 (小有名气)

【答案】应助回帖

★ ★ ★ ★ ★
感谢参与,应助指数 +1
小雨萌萌: 金币+5, 帮发放金币咯~ 2012-04-05 16:34:13
给你一个有限体积算法求解Burgers  方程的fortran程序,源代码用固定格式写的
        !Solve Burgers equation u_t+(u^2/2)_x=0 using Finite Volume Method
        !The time is discretized by using RK3





        module constant
        implicit double precision(a-h,o-z)
        parameter pi=3.1415926,dt=0.001,nw=2000
        parameter n=20,h=2.0*pi/dble(n),san=0.0
        end module

        program FVM
        use constant
        implicit double precision(a-h,o-z)
        common u0(-1:n+2),u1(-1:n+2),u2(-1:n+2)
        common/u/ u(-1:n+2),uminus(0:n),uadd(0:n) !uminus=u^-,uadd=u^+
        common/flux/ flux(0:n)
        common/ua/ ua1(n),ua2(n),state(n)

        common u3(-1:n+2)


        do j=1,n
        u0(j)=1.0/3.0+2.0/(3.0*h)
     &*(cos((dble(j-1))*h+san)-cos(dble(j)*h+san))
        enddo
        u0(0)=u0(n)
        u0(-1)=u0(n-1)
        u0(n+1)=u0(1)
        u0(n+2)=u0(2)




        u=u0
        call RECONS

        do ntime=1,nw



        call AVERAGE
       

        u1=0
        u0(0)=0
        u0(n+1)=0
        u(0)=0
        u(n+1)=0
        u1=u0+dt*u
        u=u1
        u(0)=u(n)
        u(-1)=u(n-1)
        u(n+1)=u(1)
        u(n+2)=u(2)
         
       
        call RECONS
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        call AVERAGE
        u2=0
        u0(0)=0
        u0(n+1)=0
        u1(0)=0
        u1(n+1)=0
        u(0)=0
        u(n+1)=0
        u2=0.75*u0+0.25*u1+0.25*dt*u
        u=u2
        u(0)=u(n)
        u(-1)=u(n-1)
        u(n+1)=u(1)
        u(n+2)=u(2)
         
       
        call RECONS
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        call AVERAGE
        u3=0
        u0(0)=0
        u0(n+1)=0
        u2(0)=0
        u2(n+1)=0
        u(0)=0
        u(n+1)=0
       

        u3=(u0+2.0*u2+2.0*dt*u)/3.0
        u=u3
        u(0)=u(n)
        u(-1)=u(n-1)
        u(n+1)=u(1)
        u(n+2)=u(2)

        u0=u
         
       
        call RECONS
        write(*,*)ntime


       









        if(ntime==1400)then
        open(11,file='1.4uadd.dat')

        do i=0,n
        write(11,'(2f15.6)')san+dble(i)*h,uadd(i)
        enddo

        open(12,file='1.4uminus.dat')

        do i=0,n
        write(12,'(2f15.6)')san+dble(i)*h,uminus(i)

        enddo
        elseif(ntime==1500)then
        open(13,file='1.5uadd.dat')

        do i=0,n
        write(13,'(2f15.6)')san+dble(i)*h,uadd(i)
        enddo

        open(14,file='1.5uminus.dat')

        do i=0,n
        write(14,'(2f15.6)')san+dble(i)*h,uminus(i)

        enddo

        elseif(ntime==2000)then
        open(15,file='2uadd.dat')

        do i=0,n
        write(15,'(2f15.6)')san+dble(i)*h,uadd(i)
        enddo

        open(16,file='2uminus.dat')

        do i=0,n
        write(16,'(2f15.6)')san+dble(i)*h,uminus(i)

        enddo

        elseif(ntime==1000)then
        open(17,file='1uadd.dat')

        do i=0,n
        write(17,'(2f15.6)')san+dble(i)*h,uadd(i)
        enddo

        open(18,file='1uminus.dat')

        do i=0,n
        write(18,'(2f15.6)')san+dble(i)*h,uminus(i)

        enddo
        endif

        enddo
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


        end

以上为主程序,以下为子程序
2楼2012-04-02 12:12:10
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

wll778824

银虫 (小有名气)

【答案】应助回帖

★ ★ ★
小雨萌萌: 金币+3, 3Q! 2012-04-05 16:33:56
subroutine AVERAGE
        use constant
        implicit double precision(a-h,o-z)
        common/u/ u(-1:n+2),uminus(0:n),uadd(0:n)
        common/flux/ flux(0:n)
        flux=0


        do i=0,n
        flux(i)=0.5*(0.5*uminus(i)*uminus(i)
     &+0.5*uadd(i)*uadd(i)-0.6*(uadd(i)-uminus(i)))
        enddo

        do j=1,n
        u(j)=(flux(j-1)-flux(j))/h
        enddo

        end
3楼2012-04-02 12:12:44
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

wll778824

银虫 (小有名气)

【答案】应助回帖

★ ★ ★
小雨萌萌: 金币+3, 3Q! 2012-04-05 16:33:44
subroutine RECONS
        use constant
        implicit double precision(a-h,o-z)
        common/u/ u(-1:n+2),uminus(0:n),uadd(0:n)
        common/flux/ flux(0:n)
        uminus=0
        uadd=0
        do j=0,n
        uminus(j)=-1.0/6.0*u(j-1)+5.0/6.0*u(j)+1.0/3.0*u(j+1)
        enddo


        do j=0,n
        uadd(j)=1.0/3.0*u(j)+5.0/6.0*u(j+1)-1.0/6.0*u(j+2)
        enddo
         

        end
4楼2012-04-02 12:13:01
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

xmch2011

铁虫 (小有名气)

★ ★ ★ ★ ★ ★ ★ ★ ★ ★
小雨萌萌: 金币-10, 谢人家也不把悬赏的金币发一下呀?帮你发放金币! 2012-04-05 16:33:33
引用回帖:
4楼: Originally posted by wll778824 at 2012-04-02 12:13:01:
subroutine RECONS
        use constant
        implicit double precision(a-h,o-z)
        common/u/ u(-1:n+2),uminus(0:n),uadd(0:n)
        common/flux/ flux(0:n)
        uminus=0
        uadd=0
        do j=0,n
        uminus(j)=-1.0/6.0*u(j-1) ...

谢谢你啊,学习一下
数学,力学,物理
5楼2012-04-03 11:35:00
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 xmch2011 的主题更新
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[基金申请] 投票:  有多少人是今天查系统知道结果的? +17 爱看书的可乐 2026-08-26 19/950 2026-08-31 21:19 by xiangy672
[基金申请] 基金未中,这种答复是模板吗? +6 zhaosm1982 2026-08-27 7/350 2026-08-31 21:18 by qdxxmc
[基金申请] 面上意见出来了 +12 黄鸟于飞Chao 2026-08-29 23/1150 2026-08-31 18:57 by 黄鸟于飞Chao
[基金申请] 能否申诉? +7 echo8914667 2026-08-30 8/400 2026-08-31 17:00 by yihongxu
[基金申请] 中青基了要发朋友圈吗? +7 349506619 2026-08-28 7/350 2026-08-31 13:39 by 冼亮淀粉酶
[基金申请] 29号明天会评吗 +4 笨笨唐 2026-08-28 4/200 2026-08-31 09:30 by huixian257
[基金申请] 基金不中,共勉 +12 eulota 2026-08-26 12/600 2026-08-31 08:42 by ZJTJZ
[基金申请] 为什么到现在没收到通知? +5 tannykie 2026-08-29 5/250 2026-08-30 21:05 by purplejack
[基金申请] 有没有仍没收到信息的 +7 德尚中行 2026-08-27 8/400 2026-08-30 20:52 by purplejack
[基金申请] 麻烦专家们看看评委们的意见(F口面上) +6 gdd2018 2026-08-28 11/550 2026-08-30 08:58 by 超级无敌华子
[基金申请] 我就是申请一个面上项目而已,这评审意见是按照杰青的条件评的吧? +6 gouxfjh 2026-08-28 11/550 2026-08-30 07:57 by gouxfjh
[基金申请] 国自然面上复盘~欢迎讨论 (金币+15) +15 晴天加油 2026-08-26 16/800 2026-08-29 18:28 by symmetry
[基金申请] 系统查不到 +11 董八千 2026-08-26 11/550 2026-08-28 18:06 by Leogzhya
[基金申请] 看板上这么多中的,有点像50人群里49个人都是骗子的那种感觉…… +5 a089 2026-08-26 6/300 2026-08-27 14:05 by jonewore
[基金申请] 我不理解! +15 Edward_pc 2026-08-26 23/1150 2026-08-26 20:34 by zzuzxg
[基金申请] 出来了 +9 trojank 2026-08-26 9/450 2026-08-26 14:25 by 宝贝虫子
[基金申请] 项目信息和经费信息在系统里都可以看到了 +6 wittyboy 2026-08-26 14/700 2026-08-26 10:55 by wittyboy
[基金申请] 今天务委会开完了,明天出结果吗 +19 angus9576 2026-08-25 23/1150 2026-08-26 10:03 by zp519
[基金申请] 牛来!米来!面来! +8 beefly 2026-08-26 8/400 2026-08-26 08:37 by xuzhipiao
[基金申请] 某些机构,以效率低为荣,以效率低作为存在感 +9 yuleib84 2026-08-25 10/500 2026-08-25 17:14 by alexon
信息提示
请填处理意见