Fortran Coder

标题: 关于三角形若干算法的作业 [打印本页]
作者: xiaomelody    时间: 2015-1-8 17:07
标题: 关于三角形若干算法的作业
各位大神，晚上就要交作业了，求各位帮帮忙，帮我看看，到底哪里出错了不对劲。三条直线相交，分别为一下

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
作者: li913    时间: 2015-1-10 10:18
算法没问题，可以改进。
[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 



   
作者: xiaomelody    时间: 2015-1-10 22:45
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



欢迎光临 Fortran Coder (http://bbs.fcode.cn/) Powered by Discuz! X3.2