cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c LE HANGGLIDING c Version 0.1 (2020-10-08) c Version 0.11 (2020-11-11) c Pere Casellas c Laboratori d'envol c http://www.laboratoridenvol.com c FORTRAN fort77/gfortran (GNU/Linux) c GNU General Public License 3.0 (http://www.gnu.org) cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c 1. VARIABLES NAMES cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c 2. VARIABLES DECLARATION cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc real*8 xkf,xwf real*8 hgty,hgna,hgna2,hgcle,hglel,hgled,hgcke real*8 hgtke,hgtan,hgake,hgaan,hgsac real*8 hgrke,hgkel,hgan,hgcb,hgdt,hgdv,hgbi real*8 hg_span,hg_ar,hg_area,hg_ke real*8 hgbd1,hgbd2 real*8 tesail(0:100,10) real*8 xle23(0:200),yle23(0:200),zle23(0:200),stepx,stepy real*8 xle23d(0:200),yle23d(0:200),zle23d(0:200),dis23(0:200) real*8 xle12d(0:200),yle12d(0:200),zle12d(0:200) real*8 xle(0:500),yle(0:500),zle(0:500) real*8 k1defl,k2defl real*8 x(0:200),y(0:200),z(0:200) real*8 xp(0:200),yp(0:200),zp(0:200) real*8 exbatten(0:50,0:50),inbatten(0:50,0:50) real*8 sa_a(200),sa_b(200),sa_c(200),sa_d(200),sa_tot real*8 so_lef,so_kef,so_ler real*8 xru(2),xrv(2),xsu(2),xsv(2),xtu,xtv real*8 x0,y0,z0,point(3),angle(3) real*8 dx,dy,dz,d1,d2,d3,dacu,dacuf,dis,llarg real*8 b1x,b1y,b2x,b2y,b3x,b3y,b4x,b4y real*8 alpha,beta,gamm1,gamm2,delta,tetha,radi real*8 tetha1,tetha2,teta,tet,a1,a2,defle,u(500),v(500) real*8 epsil real*8 washb(0:50,0:50),sprob(0:50,0:50) real*8 defle_(10,50),defle_delta,defle_parabola real*8 bo_nose,bo_nosesh,bo_wire(10,10) integer bowsprit,ibo_wires real*8 sail_li(100,10) integer sail_lines integer i,np,nple,nptesail,sailktyp integer tesailty integer exbattens,inbattens,nwash,nspro integer jcontrol,kcontrol integer defle_n1,defle_n2 integer ptd(500,500) integer case_deflection real*8 hgled1,hgled2,hgledz,signe character*50 wname,bname,lehgv,lehgd,lehgpc,lehguser,xtext real*8 pi pi=4.0d0*datan(1.0d0) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c 3. INIT ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc lehgd="2020-10-08" ! Date lehgpc='"Baldiri"' ! Code name lehguser="GENERAL" open(unit=20,file='glider.dxf') open(unit=22,file='data.txt') open(unit=23,file='lehg-out.txt') open(unit=30,file='wires.txt') open(unit=25,file='glider-3d.dxf') call dxfinit(20) call dxfinit(25) cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c 4. DATA READING cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Reading data.txt rewind (22) rewind (23) rewind (30) c 4.1 Basic data do i=1,7 read (22,*) end do read (22,*) lehgv read (22,*) read (22,*) bname read (22,*) read (22,*) wname read (22,*) read (22,*) xkf read (22,*) read (22,*) xwf write (*,*) write (*,*) "LABORATORI D'ENVOL HANG GLIDING ",lehgv write (*,*) "Hang gliders design program" write (*,*) write (*,*) "> Basic data read" c 4.2 Basic geometry do i=1,4 read (22,*) end do read (22,*) hgty ! hg type read (22,*) read (22,*) hgna ! nose angle read (22,*) read (22,*) hgcle ! point crossbar in le read (22,*) read (22,*) hglel ! leading edge length read (22,*) read (22,*) hgled1,hgled2,hgledz ! leading edge deflections read (22,*) read (22,*) hgcke ! point crossbar in keel read (22,*) read (22,*) hgtke, hgtan ! point triangle in keel, and angle read (22,*) read (22,*) hgake, hgaan ! point antenna in keel, and angle read (22,*) read (22,*) hgsac ! max sail chord read (22,*) read (22,*) hgrke ! point rear cable in keel read (22,*) read (22,*) hgkel ! keel length read (22,*) read (22,*) hgan ! antenna length read (22,*) read (22,*) hgcb ! control bar length read (22,*) read (22,*) hgdt ! downtune length read (22,*) read (22,*) hgdv ! vertical part of downtube (offset) read (22,*) read (22,*) hgbi ! basic billow angle read (22,*) read (22,*) so_lef, so_kef, so_ler ! sail offsets write (*,*) "> Basic geometry read" c 4.3 Sail trailing edge definition do i=1,4 read (22,*) end do read (22,*) tesailty ! trailing edge sail type if (tesailty.eq.1) then ! Type 1, read coordinates read (22,*) nptesail do i=1,nptesail read(22,*) tesail(i,1),tesail(i,2),tesail(i,3) end do end if write (*,*) "> Sail trailing edge read" c 4.4 Read sail in keel do i=1,3 read (22,*) end do read (22,*) sailktyp write (*,*) "> Sail in keel data read" c 4.5 Read battens do i=1,4 read (22,*) end do read (22,*) exbattens ! number of estrados battens do i=1,exbattens read (22,*) exbatten(i,1),exbatten(i,2),exbatten(i,3), + exbatten(i,4),exbatten(i,5) end do read (22,*) read (22,*) inbattens ! number of estrados battens do i=1,inbattens read (22,*) inbatten(i,1),inbatten(i,2),inbatten(i,3), + inbatten(i,4),inbatten(i,5) end do write (*,*) "> Battens read" c 4.6 Read washout bars do i=1,3 read (22,*) end do read (22,*) nwash do i=1,nwash read (22,*) washb(i,1),washb(i,2),washb(i,3),washb(i,4) end do write (*,*) "> Washout bars read" c 4.6 Read sprog bars do i=1,3 read (22,*) end do read (22,*) nspro do i=1,nspro read (22,*) sprob(i,1),sprob(i,2),sprob(i,3),sprob(i,4) end do write (*,*) "> Sprogs data read" c 4.6 Read le deflectors do i=1,3 read (22,*) end do read (22,*) defle_n1 if (defle_n1.eq.1) then ! read deflectors read (22,*) defle_n2 do i=1,defle_n2 read (22,*) defle_(i,1),defle_(i,2),defle_(i,3),defle_(i,4), + defle_(i,5),defle_(i,6) end do end if write (*,*) "> Deflectors data read" c 4.7 Read bowsprit hang gliders data do i=1,3 read (22,*) end do read (22,*) bowsprit if (bowsprit.eq.1) then read (22,*) bo_nose, bo_nosesh read (22,*) ibo_wires do i=1,ibo_wires read (22,*) j,bo_wire(i,1) end do end if write (*,*) "> Bowsprit read" c 4.7 Read sail lines do i=1,3 read (22,*) end do read (22,*) sail_lines if (sail_lines.gt.0) then do i=1,sail_lines read (22,*) sail_li(i,1),sail_li(i,2),sail_li(i,3), + sail_li(i,4),sail_li(i,5),sail_li(i,6) end do end if write (*,*) "> Optionall sail lines read" c 4.8 Read parts to draw do i=1,3 read (22,*) end do do i=1,16 read (22,*) ptd(i,1),ptd(i,2) end do write (*,*) "> Parts to draw read" write (*,*) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c 5. CALCULUS ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc hgna2=hgna*pi/360. ! half nose angle in rad hgled=hgled2 c Basic reference points x(1)=0. y(1)=0. z(1)=0. x(2)=hgcle*dsin(hgna2) y(2)=hgcle*dcos(hgna2) z(2)=0. x(3)=hglel*dsin(hgna2) y(3)=hglel*dcos(hgna2) z(3)=0. c Point 3' without reformating xp(3)=x(3)-hgled*dcos(hgna2) yp(3)=y(3)+hgled*dsin(hgna2) zp(3)=0. x(4)=0. y(4)=hgcke z(4)=0. x(5)=0. y(5)=hgtke z(5)=0. x(6)=0. y(6)=hgake z(6)=0. x(7)=0. y(7)=hgsac z(7)=0. x(8)=0. y(8)=hgrke z(8)=0. x(9)=0. y(9)=hgkel z(9)=0. ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Basic deflections calculus ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc case_deflection=2 ! general case if (case_deflection.eq.2) then signe=1. if (hgled1.lt.-0.001) then signe=-1. end if c Arc 1-2 alpha=signe*datan(2.*hgled1/hgcle) dis=dsqrt(hgled1*hgled1+(hgcle*hgcle/4.)) beta=hgna2+signe*alpha c write (*,*) "W ",alpha, beta c Prevent parallel lines r-s if (dabs(hgled1).lt.0.001) then beta=hgna2*1.00001 end if c recta r (M1-O) xru(1)=x(1)+0.5*dis*dsin(beta) xrv(1)=y(1)+0.5*dis*dcos(beta) xru(2)=xru(1)-signe*100.*dcos(beta) xrv(2)=xrv(1)+signe*100.*dsin(beta) c recta s (N1-O) xsu(1)=x(1)+dis*dsin(beta) xsv(1)=y(1)+dis*dcos(beta) xsu(2)=xsu(1)-signe*100.*dcos(hgna2) xsv(2)=xsv(1)+signe*100.*dsin(hgna2) call xrxs(xru,xrv,xsu,xsv,xtu,xtv) radi=dsqrt((xsu(1)-xtu)**2.+(xsv(1)-xtv)**2.) tetha=datan((radi-signe*hgled1)/(0.5*hgcle)) delta=(0.5*pi)-tetha tetha1=0.5*pi+datan(xtu/xtv) tetha2=datan((xtv-y(2))/(x(2)-xtu)) c Case hgled1 negative if (hgled1.lt.-0.001) then tetha1=pi+tetha-0.5*pi+hgna2 tetha2=tetha1+2.*delta delta=-delta end if c Adjust some parameters if (dabs(hgled1).lt.0.001) then delta=0.0d0 end if c Deflection in 2-3 by delta angle a2=dsqrt((x(3)-x(2))**2.+(y(3)-y(2))**2.) defle_delta=a2*dsin(delta) c Calule arc 1-2 tet=(tetha1-tetha2)/99. do i=1,100 teta=tetha1-tet*dfloat(i-1) xle12d(i)=xtu+radi*dcos(teta) yle12d(i)=xtv-radi*dsin(teta) end do c Adjust some parameters if (dabs(hgled1).lt.0.001) then xle12d(100)=x(2) yle12d(100)=y(2) end if c Dibuixa 1-2 (PROVISIONAL) do i=1,99 c call line(xle12d(i),yle12d(i),xle12d(i+1),yle12d(i+1),2) end do c Parabola 2-3 (case deflection 2) defle_parabola=hgled2-defle_delta k2defl=2. k1defl=defle_parabola/((hglel-hgcle)**k2defl) c Leading edge 2-3 in 100 points do i=1,100 xle23(i)=x(2)+(x(3)-x(2))*dfloat(i-1)/dfloat(99) yle23(i)=y(2)+(y(3)-y(2))*dfloat(i-1)/dfloat(99) end do c Local parabolic deflection (u,v) in point i do i=1,100 u(i)=(a2/99.)*dfloat(i-1) v(i)=k1defl*(u(i)**k2defl) end do c Redefine (xle23,yle23) using local deflection do i=1,100 xle23(i)=-x(2)+xle23(i)-v(i)*dcos(hgna2) yle23(i)=-y(2)+yle23(i)+v(i)*dsin(hgna2) end do c do i=1,99 c call line(x(2)+xle23(i),y(2)+yle23(i), c + x(2)+xle23(i+1),y(2)+yle23(i+1),3) c end do c Additional rotation delta in point 2 do i=1,100 xle23d(i)=x(2)+xle23(i)*dcos(delta)-yle23(i)*dsin(delta) yle23d(i)=y(2)+xle23(i)*dsin(delta)+yle23(i)*dcos(delta) end do c Linia groga do i=1,99 c call line(xle23d(i),yle23d(i),xle23d(i+1),yle23d(i+1),2) end do c Define leading edge (xle,yle) nple=199 do i=1,nple if (i.le.100) then xle(i)=xle12d(i) yle(i)=yle12d(i) zle(i)=0.0d0 end if if (i.gt.100) then xle(i)=xle23d(i-99) yle(i)=yle23d(i-99) zle(i)=0.0d0 end if end do end if ! case_deflection=2 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Deflected leading edge type 1 (parabolic deflection) c Not used. Use more general case 2. c Generalized parabolic type deflection along le: v=k1·u^K2 c Deflection only in section 2-3 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc if (case_deflection.eq.1) then c Parabola 2-3' (case deflection 1) stepx=(x(3)-x(2))/101. stepy=(y(3)-y(2))/101. do i=0,100+1 ! 100 points is enought xle23(i)=x(2)+stepx*dfloat(i) yle23(i)=y(2)+stepy*dfloat(i) zle23(i)=0. end do c Local deflection v=k1·u^K2 in XY plane k2defl=2. k1defl=hgled/((hglel-hgcle)**k2defl) do i=0,100+1 dis23(i)=(xle23(i)-x(2))/dsin(hgna2) xle23d(i)=xle23(i)-(k1defl*(dis23(i))**k2defl)*dcos(hgna2) yle23d(i)=yle23(i)+(k1defl*(dis23(i))**k2defl)*dsin(hgna2) end do ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Reformating leading egde in one vector 103 points c Update the subroutine for more complex 3D leading edge ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc xle(1)=0. yle(1)=0. zle(1)=0. do i=0,101 xle(i+2)=xle23d(i) yle(i+2)=yle23d(i) zle(i+2)=zle23d(i) end do c Number of leading edge points nple=103 c Total length dacu=0.0d0 do j=1,nple-1 dacu=dacu+dsqrt((xle(j)-xle(j+1))**2.+(yle(j)-yle(j+1))**2.+ + (zle(j)-zle(j+1))**2.) end do c "Cut" deflected leading edge to conserve hglel angle(3)=datan((yle(nple)-yle(nple-1))/ + (xle(nple)-xle(nple-1))) xle(nple)=xle(nple)-(dacu-hglel)*dcos(angle(3)) yle(nple)=yle(nple)-(dacu-hglel)*dsin(angle(3)) c Reformat 3' point xp(3)=xle(nple) yp(3)=yle(nple) xle23d(101)=xp(3) yle23d(101)=yp(3) end if ! case_deflection=1 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Some redefinitions in basic points ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Define point 2' dis=hgcle call dale(xle,yle,zle,nple,dis,point,angle) xp(2)=point(1) yp(2)=point(2) c Redefine point 2 c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! c VERIFY c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (dabs(hgled1).gt.0.001) then ! only if arc 1-2 x(2)=point(1) y(2)=point(2) end if c call line(xle(nple),yle(nple),xle(nple),yle(nple)+20.,1) c Define point 3' and "cut" leading edge dis=hglel call dale(xle,yle,zle,nple,dis,point,angle) xp(3)=point(1) yp(3)=point(2) xle(nple)=xp(3) yle(nple)=yp(3) c call line(xle(nple),yle(nple),xle(nple),yle(nple)+20.,3) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Sail area calculus (projected) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Calcule sail area as sum of trapeziums based on te points definition c For each point in trailing edge sa_tot=0. do j=1,nple do i=1,nptesail+1 if (i.eq.1) then tesail(0,2)=0. tesail(0,3)=hgsac end if if (i.eq.nptesail+1) then tesail(nptesail+1,2)=xp(3) tesail(nptesail+1,3)=yp(3) end if c Detect point in le in prolongation of sail te point if (tesail(i,2).ge.xle(j).and.tesail(i,2).le.xle(j+1)) then xru(1)=xle(j) xrv(1)=yle(j) xru(2)=xle(j+1) xrv(2)=yle(j+1) xsu(1)=tesail(i,2) xsv(1)=tesail(i,3) xsu(2)=xsu(1) xsv(2)=xsv(1)-100. call xrxs(xru,xrv,xsu,xsv,xtu,xtv) tesail(i,4)=xtu tesail(i,5)=xtv c call line(tesail(i,2),tesail(i,3),tesail(i,4),tesail(i,5),2) end if end do ! i end do ! j c Sum of trapeziums areas do i=1,nptesail+1 sa_a(i)=tesail(i,2)-tesail(i-1,2) sa_b(i)=tesail(i-1,3)-tesail(i-1,5) sa_c(i)=tesail(i,3)-tesail(i,5) sa_d(i)=sa_a(i)*(sa_b(i)+sa_c(i))/2. sa_tot=sa_tot+sa_d(i) end do ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Main parameters ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc hg_na=hgna ! nose angle in degrees hg_span=xp(3)/50. ! span in meters hg_area=sa_tot*2./10000. ! area in m2 hg_ar=hg_span*hg_span/hg_area ! aspect ratio hg_ke=hgsac/100. ! max chord in meters ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Battens coordinates (extrados) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c do i=1,exbattens c Rear batten exbatten(i,2) exbatten(i,3) do i=1,exbattens c Intersection in deflected le exbatten(i,6) exbatten(i,7) c Line r xru(1)=exbatten(i,2) xrv(1)=exbatten(i,3) xru(2)=xru(1)-100.*dsin((exbatten(i,4))*pi/180.) xrv(2)=xrv(1)-100.*dcos((exbatten(i,4))*pi/180.) c Line s (select in deflected leading edge) do j=1,nple-1 xsu(1)=xle(j) xsv(1)=yle(j) xsu(2)=xle(j+1) xsv(2)=yle(j+1) call xrxs(xru,xrv,xsu,xsv,xtu,xtv) c Detect segment if (xtu.ge.xle(j).and.xtu.le.xle(j+1)) then exbatten(i,6)=xtu exbatten(i,7)=xtv end if end do ! j c Batten % dx=(exbatten(i,2)-exbatten(i,6))*exbatten(i,5)/100. dy=(exbatten(i,3)-exbatten(i,7))*exbatten(i,5)/100. exbatten(i,8)=exbatten(i,2)-dx exbatten(i,9)=exbatten(i,3)-dy end do ! i ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Battens coordinates (intrados) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c do i=1,inbattens c Rear batten exbatten(i,2) exbatten(i,3) do i=1,inbattens c Intersection in deflected le exbatten(i,6) exbatten(i,7) c Line r xru(1)=inbatten(i,2) xrv(1)=inbatten(i,3) xru(2)=xru(1)-100.*dsin((inbatten(i,4))*pi/180.) xrv(2)=xrv(1)-100.*dcos((inbatten(i,4))*pi/180.) c Line s (select in deflected leading edge) do j=1,nple-1 xsu(1)=xle(j) xsv(1)=yle(j) xsu(2)=xle(j+1) xsv(2)=yle(j+1) call xrxs(xru,xrv,xsu,xsv,xtu,xtv) c Detect segment if (xtu.ge.xle(j).and.xtu.le.xle(j+1)) then inbatten(i,6)=xtu inbatten(i,7)=xtv end if end do ! j c Batten % dx=(inbatten(i,2)-inbatten(i,6))*inbatten(i,5)/100. dy=(inbatten(i,3)-inbatten(i,7))*inbatten(i,5)/100. inbatten(i,8)=inbatten(i,2)-dx inbatten(i,9)=inbatten(i,3)-dy end do ! i ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Washout bars calculus ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Read along deflected leading edge do i=1,nwash call dale(xle,yle,zle,nple,hglel-washb(i,1),point,angle) washb(i,5)=point(1) washb(i,6)=point(2) alpha=angle(3) c Washout bar coordinates beta=alpha+washb(i,3)*pi/180.-pi/2. washb(i,7)=washb(i,5)-washb(i,2)*dsin(beta) washb(i,8)=washb(i,6)+washb(i,2)*dcos(beta) end do ! i ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Deflectors calculus ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc if (defle_n1.eq.1) then do i=1,defle_n2 call dale(xle,yle,zle,nple,defle_(i,2),point,angle) defle_(i,7)=point(1) defle_(i,8)=point(2) call dale(xle,yle,zle,nple,defle_(i,3),point,angle) defle_(i,9)=point(1) defle_(i,10)=point(2) llarg=defle_(i,4)*dcos(defle_(i,5)*pi/180.-pi/2.) defle_(i,11)=point(1)+llarg*dsin(angle(3)) defle_(i,12)=point(2)-llarg*dcos(angle(3)) defle_(i,15)=-defle_(i,4)*dsin(defle_(i,5)*pi/180.-pi/2.) call dale(xle,yle,zle,nple,defle_(i,6),point,angle) defle_(i,13)=point(1) defle_(i,14)=point(2) end do end if ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Deflectors calculus ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc if (bowsprit.eq.1) then do i=1,ibo_wires dis=bo_wire(i,1) call dale(xle,yle,zle,nple,dis,point,angle) bo_wire(i,2)=angle(3) ! local angle bo_wire(i,3)=point(1) ! x-coordinate bo_wire(i,4)=point(2) ! x-coordinate bo_wire(i,5)=point(3) end do end if ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c 6. 2D DRAWING ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Drawing box b1x=-620. b1y=-135. b2x=-b1x b2y=b1y b3x=b1x b3y=776. b4x=b2x b4y=b3y call line(b1x,b1y,b2x,b2y,9) call line(b1x,b1y,b3x,b3y,9) call line(b4x,b4y,b2x,b2y,9) call line(b3x,b3y,b4x,b4y,9) c Draw straight leadig edge reference line if (ptd(16,1).eq.1) then call line(x(1),y(1),x(3),y(3),ptd(16,2)) call line(-x(1),y(1),-x(3),y(3),ptd(16,2)) end if c Deflected leading edge if (ptd(2,1).eq.1) then do i=1,nple-1 call line(xle(i),yle(i),xle(i+1),yle(i+1),ptd(2,2)) call line(-xle(i),yle(i),-xle(i+1),yle(i+1),ptd(2,2)) end do end if c Draw keel if (ptd(1,1).eq.1) then call line(x(1),y(1),x(9),y(9),ptd(1,2)) end if c Draw crossbar if (ptd(3,1).eq.1) then if (bowsprit.ne.1) then call line(x(2),y(2),x(4),y(4),ptd(3,2)) call line(-x(2),y(2),-x(4),y(4),ptd(3,2)) end if end if c Trailing edge sail if (ptd(15,1).eq.1) then do i=0,nptesail if (i.eq.0) then tesail(i,2)=0. tesail(i,3)=hgsac tesail(i,4)=0. end if if (i.eq.nptesail) then tesail(nptesail+1,2)=xle(nple) tesail(nptesail+1,3)=yle(nple) tesail(nptesail+1,4)=0. end if call line(tesail(i,2),tesail(i,3),tesail(i+1,2), + tesail(i+1,3),ptd(15,2)) call line(-tesail(i,2),tesail(i,3),-tesail(i+1,2), + tesail(i+1,3),ptd(15,2)) end do end if c Draw extrados battens if (ptd(8,1).eq.1) then if (exbattens.gt.0) then do i=1,exbattens call line(exbatten(i,2),exbatten(i,3),exbatten(i,8), + exbatten(i,9),ptd(8,2)) call line(-exbatten(i,2),exbatten(i,3),-exbatten(i,8), + exbatten(i,9),ptd(8,2)) end do end if end if c Draw intrados battens if (ptd(8,1).eq.1) then if (inbattens.gt.0) then do i=1,inbattens call line(inbatten(i,2),inbatten(i,3),inbatten(i,8), + inbatten(i,9),ptd(9,2)) call line(-inbatten(i,2),inbatten(i,3),-inbatten(i,8), + inbatten(i,9),ptd(9,2)) end do end if end if c Draw washout tips if (ptd(7,1).eq.1) then do i=1,nwash call line(washb(i,5),washb(i,6),washb(i,7),washb(i,8),ptd(7,2)) call line(-washb(i,5),washb(i,6),-washb(i,7),washb(i,8),ptd(7,2)) end do end if c Draw deflectors if (ptd(10,1).eq.1) then if (defle_n1.eq.1) then do i=1,defle_n2 call line(defle_(i,9),defle_(i,10),defle_(i,11),defle_(i,12), + ptd(10,2)) call line(defle_(i,7),defle_(i,8),defle_(i,11),defle_(i,12), + ptd(11,2)) call line(defle_(i,13),defle_(i,14),defle_(i,11),defle_(i,12), + ptd(11,2)) call line(-defle_(i,9),defle_(i,10),-defle_(i,11),defle_(i,12), + ptd(10,2)) call line(-defle_(i,7),defle_(i,8),-defle_(i,11),defle_(i,12), + ptd(11,2)) call line(-defle_(i,13),defle_(i,14),-defle_(i,11), + defle_(i,12),ptd(11,2)) end do end if end if c Draw bowsprit if (ptd(4,1).eq.1) then if (bowsprit.eq.1) then call line(x(1),y(1),x(1),-bo_nose,ptd(4,2)) c Draw main bowsprit cables do i=1,ibo_wires call line(x(1),bo_nosesh-bo_nose,bo_wire(i,3),bo_wire(i,4), + ptd(14,2)) call line(-x(1),bo_nosesh-bo_nose,-bo_wire(i,3),bo_wire(i,4), + ptd(14,2)) end do end if end if c Draw some marks dis=5.0d0 c Point triangle call line(-dis,hgtke,dis,hgtke,1) c Point antenna call line(-dis,hgake,dis,hgake,4) c Point cable rear call line(-dis,hgrke,dis,hgrke,3) c Drawing sail lines if (sail_lines.gt.0) then do i=1,sail_lines call line(sail_li(i,2),sail_li(i,3),sail_li(i,4),sail_li(i,5), + int(sail_li(i,6))) call line(-sail_li(i,2),sail_li(i,3),-sail_li(i,4),sail_li(i,5), + int(sail_li(i,6))) end do end if c Print text notes in DXF x0=-x(3)*0.7 y0=0.0d0 write (xtext,'(A5,A4)') "LEHG-",lehgv call txt(x0,y0+14.*0,8.0d0,0.0d0,xtext,7) call txt(x0,y0+14.*1,8.0d0,0.0d0,bname,7) call txt(x0,y0+14.*2.,8.0d0,0.0d0,wname,7) write (xtext,'(A5,1x,F5.1,1x,A3)') "Angle",hgna,"deg" call txt(x0,y0+14.*3.,8.0d0,0.0d0,xtext,7) write (xtext,'(A5,F5.2,1x,A1)') "Span ",hg_span,"m" call txt(x0,y0+14.*4.,8.0d0,0.0d0,xtext,7) write (xtext,'(A5,F5.2,1x,A1)') "AR ",hg_ar,"" call txt(x0,y0+14.*5.,8.0d0,0.0d0,xtext,7) write (xtext,'(A5,F5.2,1x,A2)') "Area ",hg_area,"m2" call txt(x0,y0+14.*6.,8.0d0,0.0d0,xtext,7) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c 7. 3D DRAWING ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c 8. WRITE lep-out.txt ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc write (23,*) write (23,*) "LABORATORI D'ENVOL HANG GLIDING ",lehgv write (23,*) "Hang gliders design program" write (23,*) write (23,'(1x,A5,2x,A50)') "Brand",bname write (23,'(1x,A5,2x,A50)') "Model",wname write (23,'(1x,A5,1x,F5.1,1x,A3)') "Angle",hgna,"deg" write (23,'(1x,A5,2x,F6.3,2x,A2)') "Span ",hg_span,"m " write (23,'(1x,A5,2x,F6.3,2x,A2)') "AR ",hg_ar,"m " write (23,'(1x,A5,2x,F6.3,2x,A2)') "Area ",hg_area, "m2" write (23,*) write (23,'(1x,A13,2x,F6.3,2x,A2)') "Leading edge ", + hglel/100., "m" write (23,'(1x,A13,2x,F6.3,2x,A2)') "Keel length ", + hgkel/100., "m" write (23,*) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c 9. END OF MAIN PROGRAM ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc call dxfend(20) call dxfend(25) close (20) close (22) close (23) close (25) close (30) write (*,'(1x,A5,2x,A50)') "Brand",bname write (*,'(1x,A5,2x,A50)') "Model",wname write (*,'(1x,A5,1x,F5.1,1x,A3)') "Angle",hgna,"deg" write (*,'(1x,A5,2x,F6.3,2x,A2)') "Span ",hg_span,"m " write (*,'(1x,A5,2x,F6.3,2x,A2)') "AR ",hg_ar,"m " write (*,'(1x,A5,2x,F6.3,2x,A2)') "Area ",hg_area, "m2" write (*,*) write (*,*) "OK, hang glider calculated !" write (*,*) write (*,*) "Please open the following files:" write (*,*) write (*,*) " glider.dxf" * write (*,*) " glider-3d.dxf" write (*,*) " lehg-out.txt" * write (*,*) " wires.txt" write (*,*) end ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c X. GRAPHICAL SUBROUTINES ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c SUBROUTINE LINE 2D ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc SUBROUTINE line(p1x,p1y,p2x,p2y,linecolor) c line P1-P2 real*8 p1x,p1y,p2x,p2y write(20,'(A,/,I1,/,A)') "LINE",8,"default" write(20,'(I1,/,A)') 6,"CONTINUOUS" write(20,'(I2,/,F14.4,/,I2,/,F14.4)') 10,p1x,20,-p1y write(20,'(I2,/,F14.4,/,I2,/,F14.4)') 11,p2x,21,-p2y write(20,'(I2,/,I2,/,I2,/,I3,/,I2)') 39,0,62,linecolor,0 return end ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c SUBROUTINE TEXT ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc SUBROUTINE txt(p1x,p1y,htext,atext,xtext,txtcolor) c line P1-P2 real*8 atext,htext,p1x,p1y character*50 xtext integer txtcolor write(20,'(A,/,I1,/,A)') "TEXT",5,"10A38" write(20,'(I1,/,I1)') 8, 0 write(20,'(I1,/,A)') 6,"CONTINUOUS" write(20,'(I2,/,I3)') 62, txtcolor write(20,'(I2,/,F12.2,/,I2,/,F12.2)') 10,p1x,20,-p1y write(20,'(I2,/,F12.2)') 30,0.0 write(20,'(I2,/,F12.2)') 40, htext write(20,'(I2,/,A50)') 1, xtext write(20,'(I2,/,F12.2,/I1)') 50, atext,0 return end ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c SUBROUTINE ITEXT ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc SUBROUTINE itxt(p1x,p1y,htext,atext,itext,txtcolor) c line P1-P2 real*8 atext,htext,p1x,p1y integer itext, txtcolor write(20,'(A,/,I1,/,A)') "TEXT",5,"10A38" write(20,'(I1,/,I1)') 8, 0 write(20,'(I1,/,A)') 6,"CONTINUOUS" write(20,'(I2,/,I3)') 62, txtcolor write(20,'(I2,/,F12.2,/,I2,/,F12.2)') 10,p1x,20,-p1y write(20,'(I2,/,F12.2)') 30,0.0 write(20,'(I2,/,F12.2)') 40, htext write(20,'(I2,/,I12)') 1, itext write(20,'(I2,/,F12.2,/I1)') 50, atext,0 return end ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c DXF init ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc SUBROUTINE dxfinit(nunit) write(nunit,'(I1,/,A,/,I1)') 0,"SECTION",2 write(nunit,'(A)') "HEADER" write(nunit,'(I1,/,A)') 9,"$EXTMAX" write(nunit,'(I2,/,F12.3,/,I2,/,F12.3)') 10,-670.,20,-3630. write(nunit,'(I1,/,A)') 9,"$EXTMIN" write(nunit,'(I2,/,F12.3,/,I2,/,F12.3)') 10,7000.,20,120. write(nunit,'(I1,/,A,/,I1)') 0,"ENDSEC",0 write(nunit,'(A,/,I1)') "SECTION",2 write(nunit,'(A,/,I1)') "ENTITIES",0 return end ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c DXF end ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc SUBROUTINE dxfend(nunit) write(nunit,'(A,/,I1,/,A)') "ENDSEC",0,"EOF" return end ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c SUBROUTINE POINT 2D ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc SUBROUTINE point(x1,y1,pointcolor) c line P1-P2 character*50 lyname(50) real*8 x1,y1 integer pointcolor,typepoint integer typm1(50),typm4(50) real*8 typm2(50),typm3(50),typm5(50),typm6(50) common /markstypes/ typm1,typm2,typm3,typm4,typm5,typm6 lyname(4)="A" lyname(5)="points" typepoint=typm4(1) c write (*,*) typepoint,lyname(4) c Euclidean point if (typepoint.eq.1) then write(20,'(A,/,I1,/,A)') "POINT",8,"points" write(20,'(I1,/,A)') 6,"CONTINUOUS" write(20,'(I2,/,F12.2,/,I2,/,F12.2)') 10,x1,20,-y1 write(20,'(I2,/,I2,/,I2,/,I3,/,I2)') 39,0,62,pointcolor,0 end if c Point defined as circle diameter 0.4 mm if (typepoint.eq.2) then write(20,'(A,/,I1,/,A)') "CIRCLE",8,"mcircles" write(20,'(I1,/,A)') 6,"CONTINUOUS" write(20,'(I2,/,F12.2,/,I2,/,F12.2)') 10,x1,20,-y1 write(20,'(I2,/,F12.3,/,I2,/,I3,/,I2)') 40,0.1*typm5(1),62, + pointcolor,0 end if return end cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE r and s lines 2D intersection c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc SUBROUTINE xrxs(xru,xrv,xsu,xsv,xtu,xtv) real*8 xru(2),xrv(2),xsu(2),xsv(2) real*8 xtu,xtv,xmr,xbr,xms,xbs xmr=(xrv(2)-xrv(1))/(xru(2)-xru(1)) xbr=xrv(1)-xmr*xru(1) c if (dabs((xru(2)-xru(1))).le.0.0001) then c xmr=(xrv(2)-xrv(1))/0.000001 c end if xms=(xsv(2)-xsv(1))/(xsu(2)-xsu(1)) xbs=xsv(1)-xms*xsu(1) c if (dabs((xsu(2)-xsu(1))).le.0.0001) then c xms=(xsv(2)-xsv(1))/0.000001 c end if xtu=(xbs-xbr)/(xmr-xms) xtv=xmr*xtu+xbr c Case xsu(1)=xsu(2) if (dabs((xsu(2)-xsu(1))).le.0.0001d0) then xtu=xsu(1) xtv=xmr*xsu(1)+xbr end if c Case xru(1)=xru(2) if (dabs((xru(2)-xru(1))).le.0.0001d0) then xtu=xru(1) xtv=xms*xru(1)+xbs end if c write (*,*) "Z ", xru(1),xrv(1),xmr,xms,xtu,xtv return end ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c SUBROUTINE dale c Distance and angles along leading edge c Returns absolute point coordinates (x,y,z) and angles ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc SUBROUTINE dale(xle,yle,zle,nple,dis,point,angle) real*8 xle(0:200),yle(0:200),zle(0:200) real*8 dis,d1,d2,d3,dacu,dacuf real*8 point(3),angle(3) integer nple,jcontrol,kcontrol c Read along deflected leading edge kcontrol=1 dacu=0.0d0 do j=1,nple-1 dacu=dacu+dsqrt((xle(j)-xle(j+1))**2.+(yle(j)-yle(j+1))**2.+ + (zle(j)-zle(j+1))**2.) c Detect segment if (kcontrol.eq.1) then if (dacu.ge.dis) then jcontrol=j kcontrol=0 dacuf=dacu end if end if end do ! j c Distances d1+d2+d3=dacuf d1=0.0d0 do j=1,jcontrol-1 d1=d1+dsqrt((xle(j)-xle(j+1))**2.+(yle(j)-yle(j+1))**2.+ + (zle(j)-zle(j+1))**2.) end do d2=dis-d1 d3=dacuf-dis c Interpolate in segment angle(3)=datan((yle(jcontrol+1)-yle(jcontrol))/ + (xle(jcontrol+1)-xle(jcontrol))) point(1)=xle(jcontrol)+d2*dcos(angle(3)) point(2)=yle(jcontrol)+d2*dsin(angle(3)) return end