Fortran Coder

查看: 4867|回复: 2
打印 上一主题 下一主题

[空间几何] 关于三角形若干算法的作业

[复制链接]

9

帖子

5

主题

0

精华

入门

F 币
51 元
贡献
29 点
跳转到指定楼层
楼主
发表于 2015-1-8 17:07:41 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
各位大神,晚上就要交作业了,求各位帮帮忙,帮我看看,到底哪里出错了不对劲。三条直线相交,分别为一下

r1:: a1*x + b1*y + c1 = 0
r2:: a2*x + b2*y + c2 = 0
  r3:: a3*x + b3*y + c3 = 0



设T是三角形其顶点A =(XA,YA),B =(XB,YB),C =(XC,YC)
分别相交于 A(R1, R2),B(R1,R3),C(R2,R3)。
   S是三角形的面积


              / a1 b1 c1 \               / a1 b1 \               / a1 b1 \                 /        \  
M123 = | a2 b2 c2 |    M12 = | a2 b2 |     M13 = |       |         M23 = | a2 b2 |
              \ a3 b3 c3 /                 \       /                 \ a3 b3 /                 \ a3 b3 /
   计算以下

   (1)三角形顶点的坐标,A,B,C
   (2)三角形内角的角度AA,BB,CC,以度,分,秒六十进制
   (3)面积S
   (4)F1 =(DET(M123))** 2
   (5)F2=2* DET(M12)* DET(M13)* DET(M23)
   (6)F= F1/ ABS(F2)




[Fortran] 纯文本查看 复制代码
PROGRAM sistemas
IMPLICIT NONE
REAL a1,b1,c1,a2,b2,c2,a3,b3,c3,m12,m13,m23,xa,ya,xb,yb,xc,yc!,F1,F2,F
!lectura de los coeficientes del fichero'datos'(que ya debe existir)

OPEN (11,FILE='dato5.txt')
READ (11,*) a1,b1,c1,a2,b2,c2,a3,b3,c3
!solucion del sistema

m12= a1*b2 - a2*b1   ! determinante de la matriz m12
IF (m12 == 0) STOP ' el sistema no tiene solucion unica'
xa = (-c1*b2 + c2*b1) / m12
ya = (-c2*a1 + c1*a2) / m12 

m13= a1*b3 - a3*b1   ! determinante de la matriz m13
IF (m13 == 0) STOP ' el sistema no tiene solucion unica'
xb = (-c1*b3 + c3*b1) / m13
yb = (-c3*a1 + c1*a3) / m13

m23= a2*b3 - a3*b2   ! determinante de la matriz m23
IF (m23 == 0) STOP ' el sistema no tiene solucion unica'
xc = (-c2*b3 + c3*b2) / m23                                  
yc = (-c3*a2 + c2*a3) / m23 

!m123=a1*b2*c3+a2*b3*c1+a3*b1*c2-a3*b2*c1-a1*b3*c2-a2*b1*c3
!IF (m123==0) STOP
!F1=m123**2
!F2=2*m12*m13*m23
!F = F1 / ABS(F2)



! Escritura de resultados en el fichero 'result' (lo crea el programa)

OPEN (12, FILE='result')
WRITE (12,9000) xa,ya,xb,yb,xc,yc
9000 FORMAT (3X,F12.4)

 
end program sistemas 


!module area_triangulo
!contains
 ! subroutine areas(a,b,c,s) !a,b,c son tres lados del triangulo
  !implicit none
  !real,intent(in):: a,b,c
  !real,intent(out):: s
  !real:: p
  !a=sqrt((xb-xa)**2+(yb-ya)**2)
  !b=sqrt((xc-xa)**2+(yc-ya)**2)
  !c=sqrt((xc-xb)**2+(yc-yb)**2)
  !p = ( a + b + c ) / 2.0
  !s = sqrt( p * (p-a) * (p-b) * (p-c) )
  
  !end subroutine areas
 






   

dato5.txt

103 Bytes, 下载次数: 4

分享到:  微信微信
收藏收藏 点赞点赞 点踩点踩

834

帖子

2

主题

0

精华

大宗师

F 币
3922 元
贡献
2332 点
沙发
发表于 2015-1-10 10:18:20 | 只看该作者
算法没问题,可以改进。
[Fortran] 纯文本查看 复制代码
PROGRAM sistemas
IMPLICIT NONE
REAL a1,b1,c1,a2,b2,c2,a3,b3,c3,m12,m13,m23,xa,ya,xb,yb,xc,yc!,F1,F2,F
integer i

OPEN (11,FILE='dato5.txt')
OPEN (12, FILE='result.txt')
do
READ (11,*,iostat=i) a1,b1,c1,a2,b2,c2,a3,b3,c3
if(i/=0) exit
m12= a1*b2 - a2*b1   ! determinante de la matriz m12
IF (m12 == 0) STOP ' el sistema no tiene solucion unica'
xa = (-c1*b2 + c2*b1) / m12
ya = (-c2*a1 + c1*a2) / m12 

m13= a1*b3 - a3*b1   ! determinante de la matriz m13
IF (m13 == 0) STOP ' el sistema no tiene solucion unica'
xb = (-c1*b3 + c3*b1) / m13
yb = (-c3*a1 + c1*a3) / m13

m23= a2*b3 - a3*b2   ! determinante de la matriz m23
IF (m23 == 0) STOP ' el sistema no tiene solucion unica'
xc = (-c2*b3 + c3*b2) / m23                                  
yc = (-c3*a2 + c2*a3) / m23 

WRITE (12,9000) xa,ya,xb,yb,xc,yc
9000 FORMAT (6(3X,F12.4))
write(*,*) a1*xa+b1*ya+c1,a2*xa+b2*ya+c2
write(*,*) a1*xb+b1*yb+c1,a3*xb+b3*yb+c3
write(*,*) a3*xc+b3*yc+c3,a2*xc+b2*yc+c2
end do
pause
end program sistemas 

   

评分

参与人数 1F 币 +9 贡献 +9 收起 理由
楚香饭 + 9 + 9 很给力!

查看全部评分

9

帖子

5

主题

0

精华

入门

F 币
51 元
贡献
29 点
板凳
 楼主| 发表于 2015-1-10 22:45:19 | 只看该作者
li913 发表于 2015-1-10 10:18
算法没问题,可以改进。[mw_shl_code=fortran,true]PROGRAM sistemas
IMPLICIT NONE
REAL a1,b1,c1,a2,b2,c ...

大神,还能帮我看看另外个帖子吗?FORTRAN IMSL的语法,链接http://bbs.fcode.cn/thread-462-1-1.html
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

捐赠本站|Archiver|关于我们 About Us|小黑屋|Fcode ( 京ICP备18005632-2号 )

GMT+8, 2024-11-1 07:20

Powered by Tencent X3.4

© 2013-2024 Tencent

快速回复 返回顶部 返回列表