应《网络安全法》要求，自2017年10月1日起，未进行实名认证将不得使用互联网跟帖服务。为保障您的帐号能够正常使用，请尽快对帐号进行手机号验证，感谢您的理解与支持！

24小时热门版块排行榜    

小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Fortran » 【交流】Fortran语言答疑专帖
北京石油化工学院2026年研究生招生接收调剂公告
1588/16返回列表首页上一页67891011下一页末页
查看: 11516  |  回复: 157
只看楼主 @他人 存档 新回复提醒 (忽略) 收藏    在APP中查看
本帖产生 1 个 程序强帖 ，点击这里进行查看

maomao1210

金虫 (正式写手)
!1. Solving linear equations by QR decomposition/Gram-Schmidt and
        !                               QR decomposition/back-substitution.
        !2. Calculating the determinant of a matrix.
        
        program LIN_EQ
                implicit none

                         integer, parameter :: dbl=SELECTED_REAL_KIND(14), n=3, m=2
                         real(KIND=dbl) :: A(n,m), Q(n,m), R(m,m), QR(n,m), A_old(n,m), &
                                                         & b(n), x(m), DET
                         integer :: i

                A(1,1)=1 ; A(1,2)=1
                A(2,1)=0 ; A(2,2)=1
                A(3,1)=1 ; A(3,2)=1

                b(1)=6 ; b(2)=4 ; b(3)=6

                A_old = A

                CALL QR_GS(A, n, m, Q, R)
!emuch                CALL QR_BACK(Q, R, n, m, b, x)
                                CALL QR_BACK(Q, R, b, x)
!emuch                CALL QR_DETERMINANT(R, m, DET)
                CALL QR_DETERMINANT(R,  DET)
                call matout("A is", A, n, m)
                call matout("b is", b, n, 1)
                call matout("Q is", Q, n, m)
                call matout("R is", R, m, m)
                QR = MATMUL(Q,R)
                call matout("Q*R is", QR, n, m)
                call matout("x is", x, m, 1)

                if (n/=m) then
                   print '("The determinant of the matrix R is", f10.6)', DET
                   else
                          print '("The determinant of the matrix A is", f10.6)', DET
                endif

        

      
         contains  !emuch

        !Subroutine for QR decomposition by a modified Gram-Schmidt method
        subroutine QR_GS(A, n, m, Q, R)
        Implicit none

        integer, parameter :: dbl=SELECTED_REAL_KIND(14)
        integer :: n, m, i, j, k, l, i1
        real(KIND=dbl) :: A(n,m), Q(n,m), R(m,m)

        do i = 1, m
           R(i,i)=SQRT(DOT_PRODUCT(A(1:n,i),A(1:n,i)))
           do j = 1, n
                  Q(j,i) = A(j,i)/R(i,i)
           enddo
           do j = i+1, m
                  R(i,j)=DOT_PRODUCT(Q(1:n,i), A(1:n,j))
                  do k = 1, n
                         A(k,j) = A(k,j)-Q(k,i)*R(i,j)
                  enddo
           enddo
        enddo   

        end subroutine QR_GS

        
        !Subroutine for solving linear equations Ax=b => QRx=b by QR back-substitution.

!emuch        subroutine QR_BACK(Q, R, n, m, b, x)
                subroutine QR_BACK(Q, R, b, x)
        implicit none

        integer, parameter :: dbl=SELECTED_REAL_KIND(14)
        real(KIND=dbl) :: Q(n,m), R(m,m), x(m), b(n), Q_T(m,n), b_ny(m)
        !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        
        !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        integer :: i, k

        Q_T = TRANSPOSE(Q)
        b_ny = MATMUL(Q_T, b)

        x = 0.0
               

        do i = m, 1, -1
           do k = i+1, m
                  x(i) = x(i) - R(i,k)*x(k)
           enddo
           x(i) = (x(i) + b_ny(i))/R(i,i)
        enddo

        end subroutine QR_BACK

        !Subroutine for calculating the determinant of a matrix by QR decomposition.

!emuch        subroutine QR_DETERMINANT(R, m, DET)
            subroutine QR_DETERMINANT(R, DET)
        implicit none

         integer, parameter :: dbl=SELECTED_REAL_KIND(14)
         real(KIND=dbl) ::  R(m,m), DET
         integer ::  i

        DET = 1

        do i = 1, m
        DET = DET*R(i,i)
        enddo

        end subroutine QR_DETERMINANT
end program LIN_EQ
赞一下 回复此楼
71楼2010-01-01 13:17:58
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

maomao1210

金虫 (正式写手)
★ ★ ★ ★ ★ ★
nono2009(金币+6,VIP+0):专家辛苦了！新年快乐！ 1-1 14:36
没什么大事情，就是变量类型没有声明，我给你加了contains ,把end program拿后面去了。去掉了原来的一些声明。

你自己也可以自己把变量类型声明上就可以了。其实你声明了，只不过是数组后声明的，你挪前面就可以了。 自己好好看看吧。我加了注释了。
赞一下(22人) 回复此楼
72楼2010-01-01 13:20:44
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

lnba

新虫 (初入文坛)

想问一下整数变量的问题

★
小木虫(金币+0.5):给个红包，谢谢回帖交流
fortran里面的整型变量最大只能定义为integer*4，也就是2^31吗？有没有可能定义更大的整型变量？我用integer*8它总是报错...
赞一下(1人) 回复此楼
73楼2010-01-14 07:26:36
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

maomao1210

金虫 (正式写手)
★
余泽成(金币+1,VIP+0):辛苦了！ 1-14 18:01
引用回帖:
Originally posted by lnba at 2010-1-14 07:26:
fortran里面的整型变量最大只能定义为integer*4，也就是2^31吗？有没有可能定义更大的整型变量？我用integer*8它总是报错...

我测试了一下，是可以的，我不知道你的为啥报错，估计是别的地方导致的错误吧？
赞一下(10人) 回复此楼
74楼2010-01-14 16:23:32
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

lnba

新虫 (初入文坛)
★
小木虫(金币+0.5):给个红包，谢谢回帖交流
引用回帖:
Originally posted by maomao1210 at 2010-1-14 16:23:

我测试了一下，是可以的，我不知道你的为啥报错，估计是别的地方导致的错误吧？

应该不是别的地方，下面是错误信息。
Error: This is not a valid data type.   [8]  integer*8 j
我要是用integer*4 j 就没有问题.....
赞一下(1人) 回复此楼
75楼2010-01-15 21:54:12
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

maomao1210

金虫 (正式写手)
引用回帖:
Originally posted by lnba at 2010-1-15 21:54:


应该不是别的地方，下面是错误信息。
Error: This is not a valid data type.   [8]  integer*8 j
我要是用integer*4 j 就没有问题.....

如果方便的话，能否把程序贴出来？
赞一下 回复此楼
76楼2010-01-16 09:03:41
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

jhuiuc

至尊木虫 (正式写手)
★
小木虫(金币+0.5):给个红包，谢谢回帖交流
期待专家解答
http://muchong.com/bbs/viewthread.php?tid=1800067&fpage=1
赞一下(1人) 回复此楼
77楼2010-01-16 16:32:59
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

hqlk2010

★
小木虫(金币+0.5):给个红包，谢谢回帖交流
楼主,可以推荐几本Fortran初学者可以用的书籍吗?
赞一下(1人) 回复此楼
78楼2010-01-18 17:41:08
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

1357246

铁杆木虫 (职业作家)

壮士
★
小木虫(金币+0.5):给个红包，谢谢回帖交流
jjdg:删除新产生的文件，就只用原代码重新弄一次 2010-04-04 14:14
你好

我用Fortran做计算，第一次算出来的结果用origin绘的图对

可是我算第二次的时候程序出错，我重启后好了，可是算出的结果就不对了，换电脑，结果还是不对，

怎么解释这种情况呢？
多谢解答
赞一下(2人) 回复此楼
✟耶稣爱你我也爱你✟【林前13:4-8】爱是恒久忍耐，又有恩慈。爱是不嫉妒。爱是不自夸。不张狂。不作害羞的事。不求自己的益处。不轻易发怒。不...
79楼2010-04-03 12:44:11
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

maomao1210

金虫 (正式写手)
★ ★
jjdg:我觉得会不会还是用了临时文件来存中间变量的问题 2010-04-04 14:14
wangen994(金币+2):请跟帖领取一月到三月份工资http://emuch.net/bbs/viewthread.php?tid=1647754&fpage=1 2010-04-05 09:25
引用回帖:
Originally posted by 1357246 at 2010-04-03 12:44:11:
你好

我用Fortran做计算，第一次算出来的结果用origin绘的图对

可是我算第二次的时候程序出错，我重启后好了，可是算出的结果就不对了，换电脑，结果还是不对，

怎么解释这种情况呢？
多谢解答

呵呵，这个问题还没遇见过，容我想想，如果能把代码贴出来的话，会更好一些。呵呵。
赞一下(2人) 回复此楼
80楼2010-04-04 11:01:35
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 maomao1210 的主题更新
1588/16返回列表首页上一页67891011下一页末页
普通表情 龙 兔 虎 猫 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 0703化学 +9 goldtt 2026-04-02 11/550 2026-04-06 10:35 by 无际的草原
[考研] 材料与化工专硕306分找合适调剂 +6 沧海轻舟e 2026-04-06 6/300 2026-04-06 10:02 by lqwchd
[考研] 生物与医药273求调剂 +7 荔题南墙 2026-04-05 7/350 2026-04-06 09:26 by 286640313
[考研] 301求调剂 +6 细胞相关蛋白 2026-04-02 10/500 2026-04-06 08:34 by jp9609
[考研] 294求调剂 +4 Grey_Ey 2026-04-01 5/250 2026-04-05 23:05 by Grey_Ey
[考研] （调剂）一志愿报考哈尔滨工业大学0857资源与环境专业378分考生 +7 狠狠加油 2026-04-05 7/350 2026-04-05 22:31 by dongzh2009
[考研] 086000生物与医药298调剂求助 +9 元元青青 2026-03-31 12/600 2026-04-05 21:03 by 学员8dgXkO
[考研] 材料调剂 +15 一样YWY 2026-04-01 15/750 2026-04-04 22:23 by hemengdong
[考研] 282电子信息0854专硕调剂 +4 202451007219 2026-04-02 6/300 2026-04-04 21:55 by laoshidan
[考研] 材料调剂 +12 一样YWY 2026-04-02 13/650 2026-04-04 20:49 by 蓝云思雨
[考研] 277工科求调剂 +7 1915668 2026-04-04 7/350 2026-04-04 17:21 by 啊俊！
[考研] 一志愿双非085502，267分，过四级求调剂 +3 再忙也要吃饭啊 2026-04-03 3/150 2026-04-04 05:03 by gswylq
[考研] 材料科学与工程考研 +10 拯救皮特托先生 2026-04-02 10/500 2026-04-03 23:57 by userper
[考研] 本科985，专业0812分336求调剂 +4 莫莫很行 2026-04-03 4/200 2026-04-03 21:31 by zhq0425
[考研] 266求调剂 +18 阳阳哇塞 2026-04-01 18/900 2026-04-03 18:38 by zllcz
[考研] 求调剂 +3 usbdndj 2026-04-03 3/150 2026-04-03 14:10 by dxiaoxin
[考研] 320求调剂 +3 农业工程与信息� 2026-04-03 3/150 2026-04-03 11:40 by 土木硕士招生
[考研] 366求调剂一志愿东北大学 +8 运气来得若有似� 2026-04-02 8/400 2026-04-02 21:39 by dongzh2009
[考研] 生物学327，求调剂 +5 书上的梅子 2026-04-01 6/300 2026-04-02 06:47 by ilovexiaobin
[考研] 284求调剂 +12 小熊～～ 2026-03-31 12/600 2026-04-01 20:23 by 花??
信息提示
关闭
请填处理意见
关闭