!***************************************************** !* RESOLUTION OF A TRIANGLE * !* ------------------------------------------------- * !* Given three side or angle elements of a triangle * !* out of six, this program will determine the mis- * !* sing elements and calculate the surface. The not * !* given elements must be put to zero. * !* ------------------------------------------------- * !* Ref.: "Mathématiques en Turbo-Pascal By M. Ducamp * !* and A. Reverchon (vol 2), Eyrolles, Paris, 1988" * !* [BIBLI 05]. * !* ------------------------------------------------- * !* SAMPLE RUN: * !* * !* RESOLUTION OF A TRIANGLE * !* * !* A = 18 * !* B = 0 * !* C = 0 * !* * !* Angle unit: PI = 180 * !* * !* TA (angle opposite to side A) = 0 * !* TB (angle opposite to side B) = 110 * !* TC (angle opposite to side C) = 52.2 * !* * !* * !* A = 18.0000000000000 * !* B = 55.3311291183785 * !* C = 46.5260338924988 * !* * !* TA = 17.8000000000000 * !* TB = 110.0000000000000 * !* TC = 52.2000000000000 * !* * !* Surface: 393.481559106180 * !* * !* F90 version by J-P Moreau. * !* (www.jpmoreau.fr) * !***************************************************** Program Triangle parameter(PI=3.14159265359) real*8 a,b,c,ta,tb,tc,one_pi integer two character*4 ch print *,'' print *,' RESOLUTION OF A TRIANGLE' print *,'' print *,' Give three side or angle elements out of six. The other elements' print *,' must be given as zero. The program will determine the missing' print *,' elements and display results.' print *,'' write(*,100,advance='no'); read *, a write(*,101,advance='no'); read *, b write(*,102,advance='no'); read *, c print *,'' write(*,105,advance='no'); read *, one_pi print *,'' write(*,110,advance='no'); read *, ta write(*,111,advance='no'); read *, tb write(*,112,advance='no'); read *, tc ta=ta*PI/one_pi; tb=tb*PI/one_pi; tc=tc*PI/one_pi print *,'' two=0 call DisplayTriangle(a,b,c,ta,tb,tc,one_pi,two) if (two.eq.1) then print *, ' There is a second triangle solution:' read *,ch print *,'' call DisplayTriangle(a,b,c,ta,tb,tc,one_pi,two) end if stop 100 format(' Side A = ') 101 format(' Side B = ') 102 format(' Side C = ') 105 format(' Angle unit: PI = ') 110 format(' TA (angle opposite to side A) = ') 111 format(' TB (angle opposite to side B) = ') 112 format(' TC (angle opposite to side C) = ') END real*8 Function SQR(x) real*8 x SQR=x*x end Subroutine Exchange(i,j,angle,indx,side) real*8 angle(3),side(3) integer indx(3) real*8 r n=indx (i); indx (i)=indx (j); indx (j)=n r=angle(i); angle(i)=angle(j); angle(j)=r r=side (i); side (i)=side (j); side (j)=r return end Subroutine CalculateAngle(i,angle,side) parameter(PI=3.14159265359) real*8 angle(3), side(3) real*8 r, SQR j=1+MOD(i,3); k=1+MOD(j,3) r=(SQR(side(j))+SQR(side(k))-SQR(side(i)))/2.d0/side(j)/side(k) angle(i)=PI/2.d0-DATAN(r/DSQRT(1.d0-r*r)) end; integer Function Triangle1(a,b,c,ta,tb,tc,s,two) parameter(PI=3.14159265359) real*8 a,b,c,ta,tb,tc,s integer two real*8 side(3), angle(3) integer indx(3) real*8 r !------------ prepare indx tables ------------- side(1)=a; angle(1)=ta side(2)=b; angle(2)=tb side(3)=c; angle(3)=tc do i=1, 3 indx(i)=i end do !------------ verify consistency of data ------- Triangle1=0; nbside=0; nbangle=0 !angles must be in 0,PI and sides > 0 do i=1, 3 if (angle(i)<0.or.angle(i)>PI.or.side(i)<0) then return end if end do do i=1, 3 if (side(i)>0) nbside=nbside+1 end do do i=1, 3 if (angle(i)>0) nbangle=nbangle+1 end do if (nbside.eq.0.or.nbside+nbangle.ne.3.or.angle(1)+angle(2)+angle(3)>PI) then return end if !end verify consistency of data Select Case(nbside) !-------------------- 1 side given ----------- case(1) do i=1, 3 if (angle(i).eq.0) then !calculate missing angle angle(i)=PI-angle(1)-angle(2)-angle(3) end if end do if (side(2)>0) call Exchange(1,2,angle,indx,side) !put given side if (side(3)>0) call Exchange(1,3,angle,indx,side) !in position 1 side(2)=side(1)*dsin(angle(2))/dsin(angle(1)) side(3)=side(1)*dsin(angle(3))/dsin(angle(1)) !-------------------- 2 sides given ---------- case(2) if (side(3)>0) then !put unknown side in position 3 if (side(1)>0) then call Exchange(2,3,angle,indx,side) else call Exchange(1,3,angle,indx,side) end if end if if (angle(3)>0) then !a, b, tc given side(3)=DSQRT(a*a+b*b-2.d0*a*b*dcos(angle(3))) do i=1, 2 call CalculateAngle(i,angle,side) end do else !a, b, ta given if (angle(1).eq.0) call Exchange(1,2,angle,indx,side) r=side(2)*dsin(angle(1)) if (r>side(1)) return r=DSQRT(side(1)*side(1)-r*r) if (angle(1) >= PI/2.and.side(1) <= side(2)) return if (angle(1) < PI/2.and.side(1) < side(2)) then if (two.eq.1) then side(3)=side(2)*dcos(angle(1)) - r else side(3)=side(2)*dcos(angle(1)) + r two=1 end if else side(3)=side(2)*dcos(angle(1)) + r end if do i=2, 3 call CalculateAngle(i,angle,side) end do end if !-------------------- 3 sides given ---------- case(3) if (c<=DABS(a-b).or.c>=a+b) return do i=1, 3 call CalculateAngle(i,angle,side) end do End Select !----------------------- desindex --------------- a=side(indx(1)); ta=angle(indx(1)) b=side(indx(2)); tb=angle(indx(2)) c=side(indx(3)); tc=angle(indx(3)) !---------------------- calculate surface ------- r=(a+b+c)/2 s=DSQRT(r*(r-a)*(r-b)*(r-c)) Triangle1=1 !success return End !Function Triangle1 Subroutine DisplayTriangle(a,b,c,ta,tb,tc,one_pi,two) parameter(PI=3.14159265359) real*8 a,b,c,ta,tb,tc,one_pi real*8 xa,xb,xc,xta,xtb,xtc,s integer ii,two,Triangle1 xa=a; xb=b; xc=c xta=ta; xtb=tb; xtc=tc ii=Triangle1(xa,xb,xc,xta,xtb,xtc,s,two) if (ii.eq.1) then print *,' A = ', xa print *,' B = ', xb print *,' C = ', xc print *,'' print *,' TA = ', xta*(one_pi/PI) print *,' TB = ', xtb*(one_pi/PI) print *,' TC = ', xtc*(one_pi/PI) print *,'' print *,' Surface: ', s else print *,' Wrong data or no solution found.' end if print *,'' return End !end of file triangle.f90