real*8 x1,y1,x2,y2 real*8 d1,d2,d3,d4 real*8 alfa,beta,gama real*8 pi real*8 r_12,d12 real*8 d1a,d2a,d3a,d4a real*8 H,R real*8 xa,ya,xb,yb,xc,yc,x2a,y2a real*8 r_1a,r_ab,r_bc,r_c2,r_12a,d12a real*8 omega,lambda real*8 difx,dify character*180 linha1,linha2,linha3,linha4, + linha5,linha6,linha7,linha8 pi=4.d0*datan(1.d0) open (100,file='2pocos.dat') c Profundidade dos pocos (m) H=456.123d0 c R = raio medio terrestre (m) R=6378140.d0 c Coordenadas dos fios de prumo nos dois pocos P1 e P2, conhecidas por observacao a superficie x1=25558.257d0 y1=65769.466d0 x2=26585.111d0 y2=66117.494d0 linha1='Coordenadas dos fios de prumo nos dois pocos P1 e P2, conh +ecidas por observacao a superficie:' write (100,111) linha1 111 format (a180) write (100,*) write (100,*) ' x1=',x1 write (100,*) ' y1=',y1 write (100,*) write (100,*) ' x2=',x2 write (100,*) ' y2=',y2 write (100,*) c Rumo e distancia P1P2 R_12=datan((x2-x1)/(y2-y1)) if ((x2-x1).gt.0.d0.and.(y2-y1).gt.0.d0) R_12=R_12 if ((y2-y1).lt.0.d0) R_12=R_12+pi if ((x2-x1).lt.0.d0.and.(y2-y1).gt.0.d0) R_12=R_12+2.d0*pi linha2='Rumo da direccao P1 P2:' write (100,111) linha2 write (100,*) write (100,*) ' R12 =',R_12*180.d0/pi write (100,*) d12=dsqrt((x2-x1)**2+(y2-y1)**2) c Distancias observadas na poligonal subterranea d1=347.092d0 d2=395.622d0 d3=312.972d0 d4=351.828d0 c Angulos observados na poligonal subterranea alfa=163.8497d0*pi/180.d0 beta=96.7161d0*pi/180.d0 gama=153.7702d0*pi/180.d0 c Distancias reduzidas a superficie d1a=d1+d1*H/R d2a=d2+d2*H/R d3a=d3+d3*H/R d4a=d4+d4*H/R c Calculo da poligonal subterranea, arbitrando um valor para o rumo para a frente no ponto inicial (P1) write (*,'(a\)') ' Rumo de saida ficticio (em graus):' read (*,*) R_1a R_1a=R1_a*pi/180.d0 c R_1a=0.d0 c R_1a=pi/2.d0 c R_1a=pi/4.d0 c R_1a=3.d0 linha3='Rumo ficticio para a frente no ponto P1 no interior da min +a (nao e possivel determinar uma orientacao de saida):' write (100,111) linha3 write (100,*) write (100,*) 'R_1a =',R_1a*180.d0/pi write (100,*) linha4='Coordenadas ficticias dos restantes pontos da poligonal:' write (100,111) linha4 write (100,*) xa=x1+d1a*dsin(R_1a) ya=y1+d1a*dcos(R_1a) write (100,*) ' xa=',xa write (100,*) ' ya=',ya write (100,*) c R1_1a=datan((xa-x1)/(ya-y1)) c c if ((xa-x1).gt.0.d0.and.(ya-y1).gt.0.d0) R1_1a=R1_1a c if ((ya-y1).lt.0.d0) R1_1a=R1_1a+pi c if ((xa-x1).lt.0.d0.and.(ya-y1).gt.0.d0) R1_1a=R1_1a+2.d0*pi c c d12=dsqrt((x2-x1)**2+(y2-y1)**2) R_ab=R_1a-pi+alfa if (R_ab.lt.0.d0) then R_ab=R_ab+2.d0*pi end if if (R_ab.gt.2.d0*pi) then R_ab=R_ab-2.d0*pi end if write (100,*) 'R_ab=',R_ab*180.d0/pi write (100,*) xb=xa+d2a*dsin(R_ab) yb=ya+d2a*dcos(R_ab) write (100,*) ' xb=',xb write (100,*) ' yb=',yb write (100,*) R_bc=R_ab-pi+beta if (R_bc.lt.0.d0) then R_bc=R_bc+2.d0*pi end if if (R_bc.gt.2.d0*pi) then R_bc=R_bc-2.d0*pi end if write (100,*) 'R_bc=',R_bc*180.d0/pi write (100,*) xc=xb+d3a*dsin(R_bc) yc=yb+d3a*dcos(R_bc) write (100,*) ' xc=',xc write (100,*) ' yc=',yc write (100,*) R_c2=R_bc-pi-gama if (R_c2.lt.0.d0) then R_c2=R_c2+2.d0*pi end if if (R_c2.gt.2.d0*pi) then R_c2=R_c2-2.d0*pi end if write (100,*) 'R_c2=',R_c2*180.d0/pi write (100,*) x2a=xc+d4a*dsin(R_c2) y2a=yc+d4a*dcos(R_c2) write (100,*) ' x2a=',x2a write (100,*) ' y2a=',y2a write (100,*) c Rumo e distancia P1P2a R_12a=datan((x2a-x1)/(y2a-y1)) if ((x2a-x1).gt.0.d0.and.(y2a-y1).gt.0.d0) R_12a=R_12a if ((y2a-y1).lt.0.d0) R_12a=R_12a+pi if ((x2a-x1).lt.0.d0.and.(y2a-y1).gt.0.d0) R_12a=R_12a+2.d0*pi linha5='Rumo ficticio R12:' write (100,111) linha5 write (100,*) write (100,*) 'R12 ficticio =',R_12a*180.d0/pi write (100,*) d12a=dsqrt((x2a-x1)**2+(y2a-y1)**2) c Rotacao e escala do referencial subterraneo omega=R_12a-R_12 if (omega.lt.0.d0) omega=omega+2.d0*pi linha6='Rotacao dos 2 referenciais:' write (100,111) linha6 write (100,*) write (100,*) omega*180.d0/pi write (100,*) c Escala dos dois referenciais lambda=d12a/d12 c Novo calculo da poligonal subterranea R_1a=R_1a-omega if (R_1a.lt.0.d0) then R_1a=R_1a+2.d0*pi end if if (R_1a.gt.2.d0*pi) then R_1a=R_1a-2.d0*pi end if linha7='Rumo para a frente no ponto P1 no interior da mina:' write (100,111) linha7 write (100,*) write (100,*) R_1a*180.d0/pi write (100,*) linha8='Coordenadas dos restantes pontos da poligonal:' write (100,111) linha8 write (100,*) xa=x1+d1a*dsin(R_1a) ya=y1+d1a*dcos(R_1a) write (100,*) ' xa=',xa write (100,*) ' ya=',ya write (100,*) R_ab=R_1a-pi+alfa if (R_ab.lt.0.d0) then R_ab=R_ab+2.d0*pi end if if (R_ab.gt.2.d0*pi) then R_ab=R_ab-2.d0*pi end if xb=xa+d2a*dsin(R_ab) yb=ya+d2a*dcos(R_ab) write (100,*) ' xb=',xb write (100,*) ' yb=',yb write (100,*) R_bc=R_ab-pi+beta if (R_bc.lt.0.d0) then R_bc=R_bc+2.d0*pi end if if (R_bc.gt.2.d0*pi) then R_bc=R_bc-2.d0*pi end if xc=xb+d3a*dsin(R_bc) yc=yb+d3a*dcos(R_bc) write (100,*) ' xc=',xc write (100,*) ' yc=',yc write (100,*) R_c2=R_bc-pi-gama if (R_c2.lt.0.d0) then R_c2=R_c2+2.d0*pi end if if (R_c2.gt.2.d0*pi) then R_c2=R_c2-2.d0*pi end if x2a=xc+d4a*dsin(R_c2) y2a=yc+d4a*dcos(R_c2) write (100,*) ' x2=',x2a write (100,*) ' y2=',y2a write (100,*) difx=x2-x2a dify=y2-y2a write (100,*) ' difx2=',difx write (100,*) ' dify2=',dify write (100,*) end