c***************************************************************
c      LE PARAGLIDING v 3.27e "Jardins"
c      Pere Casellas 2010-2026
c      Laboratori d'envol
c      http://www.laboratoridenvol.com
c      pere AT laboratoridenvol DOT com
c      Version experimental 0.1: 2005-02-13
c      Version 0.8: 2010-01-02 "gnuLAB2"
c      Version 0.9: 2010-02-14
c      Version 1.0: 2010-03-07
c      Version 1.02: 2010-04-17 "Annency"
c      Version 1.1: 2010-04-25 "South Africa"
c      Version 1.11: 2010-12-26 "Montseny"
c      Version 1.2: 2011-01-14 "Adrenaline"
c      Version 1.25: 2011-03-20 "Romano"
c      Version 1.4: 2011-04-25 "V-Ribs"
c      Verssion 1.5: 2011-12-08 "HyperLite"
c      Version 2.0: 2012-01-08 "BHL"
c      Version 2.1: 2012-05-27 "BatLite"
c      Version 2.2: 2013-05-05 "Altair"
c      Version 2.21: 2013-07-17 "Fluid Wings"
c      Version 2.23: 2013-08-13 "BHL-2"
c      Version 2.31: 2013-12-31 "BASE"
c      Version 2.35: 2014-04-21 "BASE"
c      Version 2.37: 2015-04-25 "Omsk"
c      Versiom 2.41: 2015-09-20 "Omsk"
c      Version 2.45: 2016-03-12 "Utah"
c      Version 2.50: 2016-05-09 "Utah"
c      Version 2.51: 2016-06-05
c      Version 2.52: 2016-08-18
c      Version 2.52++: 2016-08-27
c      Version 2.60: 2016-12-12 "Les Escaules"
c      Version 2.70: 2018-02-04 "Baldiri"
c      Version 2.73: 2018-05-12 "Baldiri"
c      Version 2.77; 2018-08-28 "Baldiri" 
c      Version 2.80; 2018-10-12 "Baldiri"
c      Version 2.81: 2018-12-24
c      Version 2.85: 2019-01-01
c      Version 2.88: 2019-01-07
c      Version 2.90: 2019-01-13 
c      Version 2.95: 2019-01-20   
c      Version 2.96: 2019-05-07
c      Version 2.99: 2019-06-24
c      Version 3.00: 2020-01-12 "Pirineus"
c      Version 3.02: 2020-01-26 "Pirineus"
c      Version 3.03: 2020-04-13 "Pirineus"
c      Version 3.10: 2020-05-02 "Pirineus"
c      Version 3.11: 2020-09-06 "Pirineus"
c      Version 3.12: 2020-12-15 "Pirineus"
c      Version 3.14: 2020-12-25 "Pirineus"
c      Version 3.15: 2021-01-17 "Canigó"
c      Version 3.16: 2021-08-29 "Z"
c      Version 3.16+: 2021-11-27 "Z"
c      Version 3.17: 2021-12-12 "Z"   
c      Version 3.17+: 2022-01-03 "Z"
c      version 3.18: 2022-02-06 "Vinebre"
c      version 3.19: 2022-05-22 "Vinebre"
c      version 3.20U: 2022-09-01 "Vinebre"
c      version 3.20V: 2022-09-18 "Vinebre"
c      version 3.21T: 2023-01-05 "Gorraptes"
c      version 3.23: 2023-12-11 "Gorraptes"   
c      version 3.23+: 2024-01-07 "Gorraptes" 
c      version 3.24: 2024-07-12 "Ebre"
c      version 3.24a: 2024-09-06 "Ebre"
c      version 3.24a: 2024-12-11 "Pic de Midi de Bigorre"
c      version 3.25 2025-01-10 "Jardins"
c      version 3.27e 2025-12-11 "Jardins"
c      version 3.27+ 2026-01-28 "Jardins"
c      FORTRAN fort77/gfortran (GNU/Linux)
c      GNU General Public License 3.0 (http://www.gnu.org)
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c       program leparagliding
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      1. VARIABLE NAMES
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      ncells: number of cells
c      nribst: total ribs
c      nribss: in semi-wing
c      rib(i,j): rib i parameter j
c            j=1 rib number
c            j=2 x_rib
c            j=3 y_LE
c            j=4 y_TE
c            j=5 chord
c            j=6 x'
c            j=7 z_rib
c            j=8 alpha washin
c            j=9 beta
c            j=10 rotation point
c            j=11 vent in
c            j=12 vent out
c            j=14 open=1 closed=0
c            j=15 anchors number
c            j=16 A %
c            j=17 B %
c            j=18 C %
c            J=19 D %
c            j=20 E %
c            j=21 F % brake
c            j=22 cell wide (i to i+1)
c            j=23 extrados length
c            j=24 intrados wide
c            j=25 intrados length
c            j=26 inlet length
c            j=30 panel length to the left of rib i - extrados
c            j=31 rib i length - extrados
c            j=32 panel length to the right of rib i - extrados
c            j=33 panel length to the left of rib i - intrados
c            j=33 rib i length - intrados
c            j=35 panel length to the right of rib i - intrados
c            j=36,37,38,39 mark amplification coeficients
c      alpha: airfoil washin angle
c      alpham: max washin
c      beta: airfoil vertical angle
c      calag: calage
c      cple: center of pressure
c      hcp: height pilote - center of pressure
c      assiette:angle between horizontal line and chord
c      finesse: glide ratio
c      aoa: angle of attack AoA
c      nomair(i): airfoil archive
c      np(i,1): airfoil points number
c      u(i,j,20) v(i,j,20): airfoils coordinates
c        K = 1 = original coordinates
c            2 = 100*coordinates
c            3 = scaled coordinates
c            4 = washin coordinates
c            5 = espace coordinates
c            6 = singular points
c                j=1 A anchor point 3D
c                j=2 B anchor point 3D
c                j=3 C anchor point 3D
c                j=4 D anchor point 3D
c                j=5 E anchor point 3D
c                j=6 F anchor point - brake 3D
c                j=7 B intake in point 3D
c                j=8 B intake out point 3D
c            7 = overwide local left
c            8 = overwide local right
c            9 = coordinates overwide left
c            10 = coordinates overwide right
c            11 = coordinates left sewing border
c            12 = coordinates right sewing border
c            14 = panel extreme points left
c            15 = panel extreme points right
c            16 = airfoil borders
c            18 = anchor space coordinates
c            19 = anchor absolute coordinates
c      x(i,j) y(i,j) z(i,j): absolute airfoil coordinates
c      xx(1,j) yy(1,j) zz(1,j): central airfoil (or i=0)
c      hol(100,20,20) airfoil holes properties
c      xl(i,j) xr(i,j) panels length
c      skin(k,j) skin tension
c      xupp, xupple, xuppte, xlow, xlowle, xlowte, xrib sewing allowances
c      mc(ii,j,k) suspension matrix
c           ii = line plan
c           j = path number
c           k = matrix column
c               1 ramifications number of the path
c               2 1 (ramification level 1)
c               3 order in the level 1
c               4 2 (ramification level 2)
c               5 order in the level 2
c               6 3 (ramification level 3)
c               7 order in the level 3
c               8 4 (ramification level 4)
c               9 order in the level 4
c               10 anchor line (1=A,2=B,3=C,4=c,5=D,6=freno)
c               11 anchor rib number
c      cam(ii) paths in plan ii
c      slp suspension line plans
c      corda(i,k) ramification properties of line i
c           k = 1 line plan
c           k = 2 line level (1=riser)
c           k = 3 liner order (in the same level, and left to right)
c           k = 4 action points associated
c           k = 5 path ramifications
c           k = 6 final anchor row 1=A 2=B ...
c           k = 7 anchor rib number
c      x1line(corda(i,1),corda(i,2),corda(i,3)) line i initial x-coordinate
c      y1line(corda(i,1),corda(i,2),corda(i,3)) line i initial y-coordinate
c      z1line(corda(i,1),corda(i,2),corda(i,3)) line i initial z-coordinate
c      x2line(corda(i,1),corda(i,2),corda(i,3)) line i final x-coordinate
c      y2line(corda(i,1),corda(i,2),corda(i,3)) line i final y-coordinate
c      z2line(corda(i,1),corda(i,2),corda(i,3)) line i final z-coordinate
c      x3line(corda(i,1),corda(i,2),corda(i,3)) line i action point x-coordinate
c      y3line(corda(i,1),corda(i,2),corda(i,3)) line i action point y-coordinate
c      z3line(corda(i,1),corda(i,2),corda(i,3)) line i action point z-coordinate
c      xline(i) line i length
c      raml(i,j) ramfication lengths
c
c      hvr(i,j) H and V ribs definiton
c      j=1 H-strap
c      j=2 V-rib partial
c      j=3 V-rib full
c      j=4 VH rib (3 cells)
c
c      V-ribs absolute coordinates
c      rx1(),ry1(),rz1()
c      rx2(),ry2(),rz2()
c      rx3(),ry3(),rz3()
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      2. VARIABLES TYPE DECLARATION
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c       Local coordinates
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       real*8 x0,y0,x1,y1,z1,x2,y2,z2,x3,y3,z3
       real*8 xinc,yinc,zinc
       real*8 xpunt(0:1000),ypunt(0:1000) ! generic vector
       real*8 xloc(0:3000),yloc(0:3000),zloc(0:3000)
       real*8 xglo(0:3000),yglo(0:3000),zglo(0:3000)

       real*8 Apla,Bpla,Cpla,l_line,m_line,n_line
       real*8 l2_line,m2_line,n2_line

       real*8 p1x,p1y,p1z,p2x,p2y,p2z,p3x,p3y,p3z,p4x,p4y,p4z
       real*8 distance,param1,param2,param3 ! general parameters

c       real*8 amte,amter,amtel,amle,amler,amlel
       real*8 amle,amler

       real*8 tetha1,tetha2,tetha3,tetha4,angle
c       real*8 angle1
       real*8 angle2

       real*8 xx0,yy0,x00,xxa,yyb

       real*8 o1x,o1y,o2x,o2y,o3x,o3y,o4x,o4y

       real*8 xn,xm,xa,xb,xn1,xm1,xn2,xm2,xn3,xm3,xk

       real*8 xu,xv
c       real*8 xlu1,xlv1,xlu2,xlv2

       real*8 a,b,aa,bb,a1,b1,c1

       real*8 alptri,atri,btri,rtri,satri,h1tri,h2tri,h3tri

       real*8 agor,bgor,cgor,cggor,step1

       character*50 gname

       character*50 wname2


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Global coordinates
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       character*50 wname,bname,nomair(100),nomairext(100),lyname(50)
       character*50 nomair2(100),nomair3(100),nomair4(100)
       character*50 xtext,lepv,lepd,lepc
       character*2 atp

       character*50 xstring, string1, string2, string3

       character*1 ln1,ln2
       character*2 ln3
       character*4 ln4(500)


       real*8 xmk,xmark,xcir,xdes,xdesx,xdesy,xprev,xpost
       real*8 xdes1,xdes2,xcir1,xcir2

       real*8 xcos

       integer ncells,nribst,evenodd

       real*8 xkf,xwf
       real*8 ribdif, htens, xndif

c      Coordenades airfoil en gir Z
       real*8 unew(500),vnew(500),wnew(500)
       real*8 pos, rot_z

       real*8 rib(0:100,500)

       real*8 alpha,tetha,alpham,alphac,alphat,alpha1,alpha2,alpr,alpl
       real*8 alple,alp
       real*8 phii(0:100),alpha_ii,assiette_ii,chii(0:100)
       real*8 x_apap(0:100),y_apap(0:100),z_apap(0:100)

       real*8 u(0:100,500,99),v(0:100,500,99),w(0:100,500,99) ! airfoil 3D
       real*8 uf(0:100,500,50),vf(0:100,500,50)   ! flat panels development
       real*8 ufe(0:100,500,50),vfe(0:100,500,50) ! panels extrados
       real*8 ufv(0:100,500,99),vfv(0:100,500,99) ! panels vents
       real*8 ufi(0:100,500,50),vfi(0:100,500,50) ! panels intrados
       real*8 ufa(0:100,500,50),vfa(0:100,500,50) ! auxiliar a
       real*8 ufb(0:100,500,50),vfb(0:100,500,50) ! auxiliar b
       real*8 ufc(0:100,500,50),vfc(0:100,500,50) ! auxiliar b
       real*8 uft(0:100,500,50),vft(0:100,500,50) ! auxiliar t
       real*8 ufr(0:100,500,50),vfr(0:100,500,50) ! auxiliar r
       real*8 u_aux(0:100,500,10),v_aux(0:100,500,10),
     + w_aux(0:100,500,10) ! auxiliar general

       real*8 xrsep,yrsep,psep,psey
       real*8 asep,bsep,sepx,sepy,sepxx,sepyy

       real*8 cs1x,cs1y,cs2x,cs2y

       real*8 usalvat(0:100,500,50),vsalvat(0:100,500,50)

       real*8 ru(0:100,500,99),rv(0:100,500,99),rw(0:100,500,99)

       real*8 x(0:100,500),y(0:100,500),z(0:100,500)

       real*8 rx(0:100,500),ry(0:100,500),rz(0:100,500)

       real*8 hx2(0:100,50,10), hy2(0:100,50,10), hz2(0:100,50,10)
       real*8 hx3(0:100,50,10), hy3(0:100,50,10), hz3(0:100,50,10)

       real*8 rx1(0:100,50,10), ry1(0:100,50,10), rz1(0:100,50,10)
       real*8 rx2(0:100,50,10), ry2(0:100,50,10), rz2(0:100,50,10)
       real*8 rx3(0:100,50,10), ry3(0:100,50,10), rz3(0:100,50,10)

       real*8 sx1(0:100,50,10), sy1(0:100,50,10), sz1(0:100,50,10)
       real*8 sx2(0:100,50,10), sy2(0:100,50,10), sz2(0:100,50,10)
       real*8 sx3(0:100,50,10), sy3(0:100,50,10), sz3(0:100,50,10)
       real*8 sx4(0:100,50,10), sy4(0:100,50,10), sz4(0:100,50,10)

       integer np(0:100,9)
       real*8 xx(1,500),yy(1,500),zz(1,500)

       real*8 px0,py0,ptheta
       real*8 pa,pb,pc,pd,pe,pf
       real*8 pa1l,pa2l,phl,pa1r,pa2r,phr
       real*8 pb1t,pb2t,pht,phu,pw1

       real*8 pl1x(0:100,500),pl1y(0:100,500),pl2x(0:100,500),
     + pl2y(0:100,500)
       real*8 pr1x(0:100,500),pr1y(0:100,500),pr2x(0:100,500),
     + pr2y(0:100,500)

       real*8 hol(0:100,200,20),skin(10,10)

       real*8 xsob(10),ysob(10)

       real*8 xupp, xupple, xuppte, xlow, xlowle, xlowte, xrib, xvrib
       real*8 xlowsaved

       real*8 brake(0:100,10)

       integer mc(10,100,50), cam(10), corda(500,50)

       integer cordam, cordat, t

       real*8 xcorda(500,5), ycorda(500,5), zcorda(500,5), raml(10,5)

       real*8 x1line(10,5,100),y1line(10,5,100),z1line(10,5,100)
       
       real*8 x2line(10,5,100),y2line(10,5,100),z2line(10,5,100)

       real*8 phi1(10,5,100),phi2(10,5,100),phi0(10,5,100)

       real*8 calag,cple,hcp,hcpp,assiette,afinesse,aoa,finesse,planeig
       real*8 assiette2003
       real*8 calage,cpress,clengr,clengl,clengk,clengb

       real*8 zcontrol, csusl, control

       real*8 acit,xci,yci,aci,cdgx,cdgy,cdg,xpoi,xdis

       real*8 dist,dist1,cdl,cdm,cdn

       real*8 xkar,ykar,zkar

       real*8 farea,parea,fparea,fspan,pspan,faratio,paratio

       real*8 comp1(10),comp2(10), xline(500),  xline2(500)

       real*8 hvr(0:200,50)

       real*8 ucnt(0:500,10,20), vcnt(0:500,10,20)

       real*8 ucnt1(0:100,10,500), vcnt1(0:100,10,500)
       real*8 ucnt2(0:100,10,500), vcnt2(0:100,10,500)
       real*8 ucnt3(0:100,10,500), vcnt3(0:100,10,500)
       real*8 ucnt4(0:100,10,500), vcnt4(0:100,10,500)

       integer jcon(0:200,10,500)
       integer jcon2(0:200,10,500),jcon4(0:200,10,500)
       integer jcon9(0:200,10,500),jcon11(0:200,10,500)

c      Sections 15 and 16 (colors)
       integer npce, npc1e(100), npc2e(100), npc3e(100,100)
       integer npci, npc1i(100), npc2i(100), npc3i(100,100)
       real*8 xpc1e(100,100), xpc2e(100,100) 
       real*8 xpc1i(100,100), xpc2i(100,100)

       integer npace, npac1e(100), npac2e(100), npac3e(100,100)
       integer npaci, npac1i(100), npac2i(100), npac3i(100,100)
       real*8 xpac1e(100,100), xpac2e(100,100) 
       real*8 xpac1i(100,100), xpac2i(100,100)
       real*8 xpac3e(100,100), xpac4e(100,100) 
       real*8 xpac3i(100,100), xpac4i(100,100)

       real*8 xle(100,100), xleinc(100,100)
       real*8 xpc3e(100,100), ypc3e(100,100)
       real*8 xli(100,100), xliinc(100,100)
       real*8 xpc3i(100,100), ypc3i(100,100)

       real*8 xarp(10), yarp(10)

       real*8 hdist(100), hangle(100)

       real*8 xtri(50),ytri(50)

       real*8 csus(10,10), cdis(10,10)

       real*8 aload(100,10), xload(500), xlide(500), xlifi(500)
       real*8 lvcx(500,500), lvcy(500,500),rvcx(500,500),rvcy(500,500)

       real*8 anccont(0:100,10),ancconti(0:100,10)

       real*8 bd(10,10)

       real*8 xpt1,ypt1,zpt1,xpt2,ypt2,zpt2,xpt3,ypt3,zpt3
       real*8 xpt4,ypt4,zpt4,xpt6,ypt6,zpt6

       integer slpi(10), slp

       real*8 xlin1(5000),ylin1(5000)
       real*8 xlin3(5000),ylin3(5000)

       real*8 xru(3),xrv(3),xsu(3),xsv(3)

       real*8 xtu2(100),xtv2(100),xtu4(100),xtv4(100)
       real*8 xtu9(100),xtv9(100),xtu11(100),xtv11(100)

       real*8 xlte11(100),xl911(100),xlle9(100)
       real*8 xrte11(100),xr911(100),xrle9(100)
       real*8 xc24(100)

c       real*8 px9i(300),py9i(300)
       real*8 px9o(500),py9o(500)

       real*8 xanchor(100,6),yanchor(100,6)
       real*8 xanchoril(100,6),yanchoril(100,6)
       real*8 xanchorir(100,6),yanchorir(100,6)

       real*8 xprb(0:100,6,0:10),yprb(0:100,6,0:10)
       real*8 jconi(6),jconf(6),xkprb(6)
       real*8 jcve(100),jcvi(100)
       real*8 xirl(0:500),xirr(0:500),jirl(0:500),jirr(0:500)
       real*8 distee(0:500),anglee(0:500),siu(0:500),siv(0:500)
       real*8 alprom,xdu,xdv,xpo1,xpo2,ypo1,ypo2

c       real*8 xlll,xrrr,yrrr,ylll
       real*8 xgir
       real*8 xpos,ypos,xpx2,xpy2,xr,xs,xrm,xsm
       real*8 xequis,yequis, xth1, xth2
       real*8 xlabel, zlabel, clli, varrow

       integer typepoint,typetab,typevent,typejonc
       integer typm1(50),typm4(50)
       integer iccolor(50),ele3d(50),ele3dc(50),iccolor34(50)
       real*8 typm2(50),typm3(50),typm5(50),typm6(50)
       real*8 xrad

c      Section 21

       integer ngo(100,3)
       real*8 xextra(0:100,10),xintra(0:100,10)
       real*8 xjonc(0:100,500,10),sjo(0:100,10)
       real*8 xjonc2(0:100,500,10),sjo2(0:100,10)

       integer k21blocs,k21blocf(20,10)
       integer ngoo(20,100,3)
       real*8 sjoo(20,100,10)
       real*8 xextraa(20,0:100,10),xintraa(20,0:100,10)
       real*8 x21(20,100,20)
       real*8 joncf(0:100,20,100,10)

c      Section 22
       real*8 xmy(0:100,10)

c      Section 27
       real*8 alc1, alc2

c      Section 28

       real*8 p28(10), a128, a228, lini28(100,10), lfin28(100,10)
       real*8 alpha28(100),calagnew(100)
       real*8 cnewtps(100),cnewcms(100),cnewtpt(100),cnewcmt(100)
       integer n128, n228

c      Section 29

       integer k29d,k29dd,ncuts(200),ini29(200),fin29(200)

       real*8  cutamp(10),cut29(0:10,200)
       real*8 s,sm,haut

       integer iupp(10,10,200),ilow(10,10,200)
       integer xiupp(10,10,200),xilow(10,10,200)
       real*8 kiupp(10,200),kilow(10,200)
       integer uppcuts(200),upptype(200),lowcuts(200),lowtype(200)
       real*8 hautok(0:100,500), zinf(0:100,10,10)
       integer pp29(10,10) ! Print parameters

c      Subroutines used in section 29: planeby123,pointp

       real*8 punt0(3),punt1(3),punt2(3),punt3(3),punt4(3),unitv(3)
       real*8 aplane,bplane,cplane,dplane,xt,dp0

       real*8 csi(0:100,60) ! Brute force in 8.5.5/drwvent
     
c      Section 31
       integer ksk,ng,ngi,ngskt,nribini,nribfin,npoints,ntype31
       integer skinpoints(0:100),ngroup31(0:100),ntypei31(0:100)

c       real*8 xxx,yyy,hhh,a128,a1281,a228,a2282
       real*8 xxx,yyy,hhh,a1281,a2282
       real*8 skinew(101,10), skinnew(0:100,101,10)
       real*8 xsobnew(0:100,101),ysobnew(0:100,101)
       real*8 xmida1,xmida2,xmida3,xmida4
       real*8 xpoint(101),ypoint(101),xvalue,yvalue
       real*8 xx1,xx2,yy1,yy2,zz1,zz2
       real*8 atext,htext

c      Section 32
       real*8 panel_x_coe,panel_x_min,panel_y_coe,rib_x_coe,rib_y_coe
       real*8 rib_1_coe

c      Section 33
       integer k33d, k33t, nrisers
       real*8  x33(0:10)

c      Section 34
       integer k34d, k34n, jltype(0:50)
       real*8 tyline(0:50,20),rvalue,lentype(0:50),lentypewl(0:50)

       character*30 tylinea(0:50,20)
       
c      Section 35
       integer k35d, k35dl, k35lm
       real*8  x35ro,x35mu,x35v,x35alpha,x35cl,x35cd,x35cm
       real*8  x35slines,x35dlcoef,x35spilot,x35dpcoef
       real*8  x35wingmass,x35pilotmass,x35linesmass
       real*8  x35ycp,x35zcp,x35ypp,x35vh,x35vv,x35qlmass
       real*8  x35wl,x35wd,x35twl,x35twd,x35wlp,x35wdp
       real*8  x35linesd,x35pilotd
       real*8  x35oswald,x35lambda,x35xi,x35inducedd

       real*8  x35gamma,x35theta,x35zero,x35zeroprev
       real*8  x35_a,x35_b,x35_c,x35_d,x35_e,x35_f,x35_i,x35_j
       real*8  x35_up,x35_down,x35_left,x35_right

       real*8  x35cle,x35cde,x35finesse,x35_k1,x35_k2,x35_k
       real*8  x35_k1fi,x35_k2fi
       real*8  x35gammai,x35vi,x35gammafi

       real*8  x35py,x35dly,x35dlz

       real*8 x35dragextra,x35_k1d,x35_k2d,x35liftextra
       real*8 x35grav,x35pmc,x35totald
       real*8 x35pmcx,x35pmcy,x35pmcz ! pilot mass center
       real*8 x35qlmcx,x35qlmcy,x35qlmcz ! ql mass center
       real*8 x35totmcx,x35totmcy,x35totmcz ! total mass center
       real*8 x35distwcp,x35kd

       real*8 x35m1contr,x35m2contr,x35m3contr,x35m4contr,x35m5contr  ! convergence control
       real*8 x355_a,x355_b,x355_c,x355_d
       real*8 x35linesdf
       real*8 x35var(100) ! auxiliar real variables

c      Internal section 4.6
       real*8 chordsum, chord_pcdg, chordy
       real*8 wcdgx3d,wcdgy3d,wcdgz3d

c      Internal section 14.9
       real*8 xlimo(0:100,0:50) ! Lines more properties
       real*8 xlimog(0:50) ! General properties

c      Section 37
       character*30 a37date
       real*8 c3001(20) ! Miniribs values
       integer i3001(20)

c      xwimp

       character*50 folder, makedirectory
       real*8 xdihedral(0:100)

c      Section 4.20 control parameters
       real*8 amplemig,amplerix,ampleriy,amplepix

c      Especial vents
       real*8 lvalp,lv1u,lv1v,lv2u,lv2v,lv3u,lv3v,lv4u,lv4v

c      Geometryc subroutines

c      l,m,n director cosinus       
       real*8 lcosd(3),mcosd(3),ncosd(3)

c      Parameter panels impression

       real*8 ysautt,ysaut

c      Side linghts in panels, use for equidistant marks

       real*8 llarl(0:100,3,100),llarr(0:100,3,100)
       real*8 xinil,xinir
       real*8 xfinl(0:100,3,100),xfinr(0:100,3,100)
       integer iq

       integer ich ! i control header
       character*72 lepuser 

c      Subroutine remapcont
       integer npini,npfin,npobj
       real*8 ucont(0:100,500),vcont(0:100,500)

c      Subroutine elliquad
       real*8 pgx(100),pgy(100) ! generic points
    

c      Auuxiliar values
       real*8 xlen,ylen
       real*8 xyextra,xyintra,xyshift

       real*8 seppix(0:100)

c      Subroutine drwvent
       real*8 xpoly(500),ypoly(500),zpoly(500)
       real*8 x_poly,y_poly,z_poly,x_poly1,y_poly1,z_poly1,
     + x_poly2,y_poly2,z_poly2,xpolylen
       real*8 xlenl,xlenr,xlenlr,xlenrr

c      Subroutine drwvent
       real*8 distrel,distrel1,distrel2

c      Subroutine tessella
       real*8 tesse3d(3,0:100,500,99)

c      Subroutine interpseg (polyline interpolation)
       real*8 useg(1000),vseg(1000)
       real*8 lsegment,lsegmentc,ltotal,linter,ldif
       real*8 upoint(100),vpoint(100)

c      Absolute variables used in sections
       real*8 sectx(100,100)
       integer secti(100,100)
       character*50 secta(100,100)

       integer n_words
       integer, parameter   :: nlen=1000
       character (len=nlen) :: entireline
       character (len=100)  :: words(nlen)        

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      COMMON BLOKS
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       common /markstypes/ typm1,typm2,typm3,typm4,typm5,typm6

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Parameters
       real*8 pi
       pi=4.0d0*datan(1.0d0)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Run numbers control
       irun=0
 1     continue
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


c      Substitution of BOX(1,3) BOX(1,5) by BOX(-1,3) BOX(-1,5)
c      Set n1draw=1 xyextra=2.0 yxintra=1.0 to return previous version

       n1draw=0 ! parameter to control classic plans. If set to 0 no print.
       xyextra=0.0d0   ! Control BOX Y-position extrados
       xyintra=-1.0d0
       xyshift=500.0d0 ! Control Y-position extrados
       iflag_assiette=0 ! Assiette flag

c      integer color
c      common typepoint

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Basic LEparagliding data version
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       lepv="3.28"              ! Version
       lepd="2026-03-28"        ! Date
       lepc='"Jardins"'         ! Code name
       lepuser="GENERAL"  
       ich=0                    ! 0=general version, 1=special version

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      3. INIT
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write (*,*) "LABORATORI D'ENVOL PARAGLIDING"
       write (*,*) "Paragliders and parachutes design program"
       write (*,*)
       write (*,'(A14,1x,A6,1x,A7,1x,A50)') " LEparagliding",lepv,
     + "version",lepc
       write (*,'(1x,A10)') lepd
c      Customized header
       if (ich.eq.1) then
       write (*,*) 
       write (*,*) "**************************************************"
       write (*,*) "Special version for:"
       write (*,'(1x,A72)') lepuser
       write (*,*) "**************************************************"
       else
       end if
       write (*,*)
       write (*,*) "Pere Casellas"
       write (*,*) "pere@laboratoridenvol.com"
       write (*,*) "GNU General Public License 3.0 http://www.gnu.org"
       write (*,*)

       open(unit=20,file='leparagliding.dxf')
       open(unit=22,file='leparagliding.txt')
       open(unit=23,file='lep-out.txt')
       open(unit=30,file='lines.txt')
       open(unit=25,file='lep-3d.dxf')     

       call dxfinit(20)

       call dxfinit(25)

c       call mtriangle(0.0d0,200.0d0,10.0d0,0.0d0,1)
c       call mtriangle(20.0d0,200.0d0,10.0d0,pi/2.0d0,2)
c       call mtriangle(40.0d0,200.0d0,10.0d0,pi/3.0d0,3)
c       call mtriangle(60.0d0,200.0d0,10.0d0,pi,4)


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      4. DATA READING
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 1 Geometry (basic data and geometry)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


c      Lectura de dades del fitxer

       rewind (22)
       rewind (23)
       rewind (30)

c      Read basic data
       do i=1,9
       read (22,*)
       end do

       read (22,*) bname
       read (22,*)
       read (22,*) wname
       read (22,*)
       read (22,*) xkf
       read (22,*)
       read (22,*) xwf
       read (22,*)
       read (22,*) ncells
       read (22,*)
       read (22,*) nribst
       read (22,*)
       read (22,*) alpham, kbbb         ! case 0,1

c      Read case "2"
       if (kbbb.eq.2) then
       backspace(22)
       read (22,*) alpham, kbbb, alphac ! case 2
       alphat=alpham-alphac
       end if

       read (22,*)
       read (22,*) atp, kaaa
       read (22,*)
       read (22,*)

c      Read ribs geometry
       nribss=int(ncells/2.)+1

c      Ribs geometry rib,x,LE,TE,chord,x',z,beta,RP 

c      Count words in first row of geometry matrix
       read (22,'(A)',end=9) entireline
9      continue
       backspace(22)

c      Count words
       words = ""
       read (entireline,*,iostat=ierr) words
       n_words = count(words /= "")

c      Read matrix of geometry
       do i=1,nribss

       if (n_words.eq.11) then ! case lep >= 3.16
       read (22,*) rib(i,1), rib(i,2), rib(i,3), rib(i,4), rib(i,6), 
     + rib(i,7), rib(i,9), rib(i,10), rib(i,51), rib(i,250), rib(i,251)
       end if

       if (n_words.eq.9) then ! case lep < 3.16
       read (22,*) rib(i,1), rib(i,2), rib(i,3), rib(i,4), rib(i,6), 
     + rib(i,7), rib(i,9), rib(i,10), rib(i,51)
       rib(i,250)=0.0d0
       rib(i,251)=0.0d0
       end if

c      Anticipates tan(0.0) if beta=0.
       if (rib(i,10).eq.0.) then
       rib(i,10)=0.01
       end if

c      Anticipates xp=0 in central airfoil
       if (rib(1,6).eq.0.) then
       rib(i,6)=0.01
       end if

c      central cell width control
       cencell=rib(1,2)

c      Scale geometry to absolute
       rib(i,2)=rib(i,2)*xwf
       rib(i,3)=rib(i,3)*xwf
       rib(i,4)=rib(i,4)*xwf
       rib(i,6)=rib(i,6)*xwf
       rib(i,7)=rib(i,7)*xwf

c      Chord
       rib(i,5)=rib(i,4)-rib(i,3)

c      Washin calculus

c      Case 0
       
       if (kbbb.eq.0) then
       rib(i,8)=rib(i,51)
       end if

c      Case 1
       if (kbbb.eq.1) then
       ribdif=rib(1,5)-rib(i,5)
       ribdim=rib(1,5)-rib(nribss,5)
       rib(i,8)=alpham*ribdif/ribdim
       end if

c      Case 2
       if (kbbb.eq.2) then
       ribdif=rib(1,5)-rib(i,5)
       ribdim=rib(1,5)-rib(nribss,5)
       rib(i,8)=(alphat*ribdif/ribdim)+alphac
       end if

       end do

c      Add virtual rib nribss+1 (used in V-ribs Type-5)

       if (nribss.ge.2) then
       do j=1,10
       rib(nribss+1,j)=rib(nribss-1,j)
       end do
       rib(nribss+1,6)=rib(nribss,6)+(rib(nribss,6)-rib(nribss-1,6))
       rib(nribss+1,7)=rib(nribss,7)+(rib(nribss,7)-rib(nribss-1,7))
       rib(nribss+1,51)=rib(nribss-1,51)
       rib(nribss+1,250)=rib(nribss-1,250)
       rib(nribss+1,251)=rib(nribss-1,251)
       end if

       write (*,*) "01-Planform read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 2 Airfoils
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Airfoil data: name, intakes location, open cells, disp
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*)
       do i=1,nribss
       read (22,*) rib(i,1),nomair(i),rib(i,11),rib(i,12),rib(i,14)
     + ,rib(i,50),rib(i,55),rib(i,56)
       end do

       nomair(nribss+1)=nomair(nribss-1) ! Additional virtual rib
       rib(nribss+1,11)=rib(nribss-1,11)
       rib(nribss+1,12)=rib(nribss-1,12)
       rib(nribss+1,14)=rib(nribss-1,14)
       rib(nribss+1,50)=rib(nribss-1,50)
       rib(nribss+1,55)=rib(nribss-1,55)
       rib(nribss+1,56)=rib(nribss-1,56)

       write (*,*) "02-Airfoils read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 3 Anchor points
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Airfoil data: anchor points A,B,C,D,E,F location

       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*)
       do i=1,nribss
       read (22,*) rib(i,1),rib(i,15),rib(i,16),rib(i,17),rib(i,18),
     + rib(i,19),rib(i,20),rib(i,21)
       end do

       do j=15,21 ! Additional virtual rib
       rib(nribss+1,j)=rib(nribss-1,j)
       end do

c      Load rib 0 data
       do k=1,300  ! Be sure all rib parameters are assigned (!)
       rib(0,k)=rib(1,k)
       end do
       rib(0,2)=-rib(1,2)
       rib(0,6)=-rib(1,6)
       
       write (*,*) "03-Anchors position read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 4 holes
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) ndis

       do m=1,ndis
       
       read (22,*) nrib1
       read (22,*) nrib2
       read (22,*) nhols

       ir=nrib1

       do l=1,nhols

       hol(ir,l,1)=float(nhols)

       read(22,*) hol(ir,l,9),hol(ir,l,2),hol(ir,l,3),hol(ir,l,4),
     + hol(ir,l,5),hol(ir,l,6),hol(ir,l,7),hol(ir,l,8)

       end do
       
       do ii=nrib1,nrib2

       do l=1,nhols

       hol(ii,l,1)=hol(ir,l,1)
       hol(ii,l,2)=hol(ir,l,2)
       hol(ii,l,3)=hol(ir,l,3)
       hol(ii,l,4)=hol(ir,l,4)
       hol(ii,l,5)=hol(ir,l,5)
       hol(ii,l,6)=hol(ir,l,6)
       hol(ii,l,7)=hol(ir,l,7)
       hol(ii,l,8)=hol(ir,l,8)
       hol(ii,l,9)=hol(ir,l,9)

       if (hol(ii,l,9).eq.11) then ! parameters for unloaded
       ii11=ii
       nhols11=nhols
       end if

       end do

       end do

       end do

       write (*,*) "04-Airfoil holes read"

       ir=1
       
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 5 skin tension data
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc  

       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*)

       do k=1,6
       read (22,*) skin(k,1),skin(k,2),skin(k,3),skin(k,4)
       end do
       read (22,*) htens
       htensi=htens
       read (22,*) ndif, xndif

       write (*,*) "05-Skin tension read"
 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 6 sewing allowances
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) xupp, xupple, xuppte
       read (22,*) xlow, xlowle, xlowte
       read (22,*) xrib
       read (22,*) xvrib

       write (*,*) "06-Sewing allowances read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 7 marks
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) xmark, xcir, xdes

       write (*,*) "07-Marks read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 8 calage estimation parameters
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) finesse
       read (22,*)
       read (22,*) cpress
       read (22,*)
       read (22,*) calage
       read (22,*)
       read (22,*) clengr
       read (22,*)
       read (22,*) clengl
       clengl=clengl*xwf
       read (22,*)
       read (22,*) clengk

       write (*,*) "08-Calage read"

       planeig=finesse

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 9 suspension lines description
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)

c      Read pondered media type zcontrol
       read (22,*) zcontrol

c      Read plans number
       read (22,*) slp

c      Detect if lines properties were added
c      WARNING only case levels le 4 considered !!!!
c      Case 5 levels still not developed
       read (22,*) i
c      Count number of columns and see if lines properties were added
       read (22,'(A)',end=11) entireline
11     continue
       backspace(22)
       backspace(22)
       words = ""
       read (entireline,*,iostat=ierr) words
       n_words = count(words /= "")
c      Define icase_lines
       if (n_words.eq.11) then
       icase_lines=0 ! set automatic properties
       end if
       if (n_words.gt.11) then
       icase_lines=1 ! use table properties
       end if

c       Write (*,*) "icase ", icase_lines

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case icase_lines=0 (type not added)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (icase_lines.eq.0) then

c      Read all plans
       do ii=1,int(slp) ! Brakes not included

c      Read paths in plane ii
       read (22,*) cam(ii)

c      Read path i
       do i=1,cam(ii)

c      Read levels number
       read (22,*) mc(ii,i,1)
       backspace(22)

c      Read normally levels 1 to 4
       if (mc(ii,i,1).le.4) then
       read (22,*) mc(ii,i,1), mc(ii,i,2), mc(ii,i,3), mc(ii,i,4), 
     + mc(ii,i,5),mc(ii,i,6), mc(ii,i,7), mc(ii,i,8), mc(ii,i,9),
     + mc(ii,i,14), mc(ii,i,15)
       mc(ii,i,10)=0.
       mc(ii,i,11)=0.
       end if

c      Read additional level number 5 (WARNING still not used)
       if (mc(ii,i,1).eq.5) then
       read (22,*) mc(ii,i,1), mc(ii,i,2), mc(ii,i,3), mc(ii,i,4), 
     + mc(ii,i,5),mc(ii,i,6), mc(ii,i,7), mc(ii,i,8), mc(ii,i,9),
     + mc(ii,i,10), mc(ii,i,11), mc(ii,i,14), mc(ii,i,15)
       end if

c      Set default lines type (1,2,3,4)
       j=mc(ii,i,1) ! levels number
       do k=1,j
       mc(ii,i,30+k)=k
       end do

       end do ! i paths

       end do ! ii plans

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case icase_lines=1 (type specified)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (icase_lines.eq.1) then

c      Read all plans
       do ii=1,int(slp) ! Brakes not included

c      Read paths in plane ii
       read (22,*) cam(ii)

c      Read path i
       do i=1,cam(ii)

c      Read levels number
       read (22,*) mc(ii,i,1)
       backspace(22)

c      Read levels 1 to 4 - and lines type

c      Two levels
       if (mc(ii,i,1).eq.2) then
c      Read up to 2 levels
       if (mc(ii,i,1).le.4) then
       read (22,*) mc(ii,i,1), mc(ii,i,2), mc(ii,i,3), mc(ii,i,4), 
     + mc(ii,i,5),mc(ii,i,6), mc(ii,i,7), mc(ii,i,8), mc(ii,i,9),
     + mc(ii,i,14), mc(ii,i,15), gname, mc(ii,i,31), mc(ii,i,32)
       mc(ii,i,10)=0.
       mc(ii,i,11)=0.
       mc(ii,i,33)=0.
       mc(ii,i,34)=0.
       end if
c      Read additional level number 5 (WARNING still not used)
       if (mc(ii,i,1).eq.5) then
       read (22,*) mc(ii,i,1), mc(ii,i,2), mc(ii,i,3), mc(ii,i,4), 
     + mc(ii,i,5),mc(ii,i,6), mc(ii,i,7), mc(ii,i,8), mc(ii,i,9),
     + mc(ii,i,10), mc(ii,i,11), mc(ii,i,14), mc(ii,i,15),
     + gname, mc(ii,i,31), mc(ii,i,32)
       end if
       end if ! 2 levels

c      Three levels
       if (mc(ii,i,1).eq.3) then
c      Read up to 3 levels
       if (mc(ii,i,1).le.4) then
       read (22,*) mc(ii,i,1), mc(ii,i,2), mc(ii,i,3), mc(ii,i,4), 
     + mc(ii,i,5),mc(ii,i,6), mc(ii,i,7), mc(ii,i,8), mc(ii,i,9),
     + mc(ii,i,14), mc(ii,i,15), gname, mc(ii,i,31), mc(ii,i,32),
     + mc(ii,i,33)
       mc(ii,i,10)=0.
       mc(ii,i,11)=0.
       mc(ii,i,34)=0.

c       write (*,*) ii,i,mc(ii,i,31),mc(ii,i,32),mc(ii,i,33)

       end if
c      Read additional level number 5 (WARNING still not used)
       if (mc(ii,i,1).eq.5) then
       read (22,*) mc(ii,i,1), mc(ii,i,2), mc(ii,i,3), mc(ii,i,4), 
     + mc(ii,i,5),mc(ii,i,6), mc(ii,i,7), mc(ii,i,8), mc(ii,i,9),
     + mc(ii,i,10), mc(ii,i,11), mc(ii,i,14), mc(ii,i,15),
     + gname, mc(ii,i,31), mc(ii,i,32), mc(ii,1,33)
       end if
       end if ! 3 levels

c      Four levels
       if (mc(ii,i,1).eq.4) then
c      Read up to 4 levels
       if (mc(ii,i,1).le.4) then
       read (22,*) mc(ii,i,1), mc(ii,i,2), mc(ii,i,3), mc(ii,i,4), 
     + mc(ii,i,5),mc(ii,i,6), mc(ii,i,7), mc(ii,i,8), mc(ii,i,9),
     + mc(ii,i,14), mc(ii,i,15), gname, mc(ii,i,31), mc(ii,i,32),
     + mc(ii,i,33), mc(ii,i,34)
       mc(ii,i,10)=0.
       mc(ii,i,11)=0.
c       write (*,*) ii,i,mc(ii,i,31),mc(ii,i,32),mc(ii,i,33),mc(ii,i,34)

       end if
c      Read additional level number 5 (WARNING still not used)
       if (mc(ii,i,1).eq.5) then
       read (22,*) mc(ii,i,1), mc(ii,i,2), mc(ii,i,3), mc(ii,i,4), 
     + mc(ii,i,5),mc(ii,i,6), mc(ii,i,7), mc(ii,i,8), mc(ii,i,9),
     + mc(ii,i,10), mc(ii,i,11), mc(ii,i,14), mc(ii,i,15),
     + gname, mc(ii,i,31), mc(ii,i,32),mc(ii,i,33), mc(ii,i,34)
       end if
       end if ! 4 levels

       end do ! i paths

       end do ! ii plans

       end if

       write (*,*) "09-Lines read"

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 10 brakes
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       ii=slp+1

       read (22,*)
       read (22,*)
       read (22,*)

c      Rean main brake length

       read (22,*) clengb

       clengb=clengb*xwf

c      Read paths
       read (22,*) cam(ii)

c      Detect if brake lines properties were added
c      Count number of columns and see if lines properties were added
       read (22,'(A)',end=12) entireline
12     continue
       backspace(22)
       words = ""
       read (entireline,*,iostat=ierr) words
       n_words = count(words /= "")
c      Define icase_lines
       if (n_words.eq.11) then
       icase_brakes=0 ! set automatic properties
       end if
       if (n_words.gt.11) then
       icase_brakes=1 ! use table properties
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case icase_brakes=0 (type not added)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (icase_brakes.eq.0) then
c      Read path i
       do i=1,cam(ii)
       read (22,*) mc(ii,i,1), mc(ii,i,2), mc(ii,i,3), mc(ii,i,4), 
     + mc(ii,i,5),mc(ii,i,6), mc(ii,i,7), mc(ii,i,8), mc(ii,i,9),
     + mc(ii,i,14), brake(i,3)
c      Set default lines type (1,2,3,4)
       j=mc(ii,i,1) ! levels number
       do k=1,j
       mc(ii,i,30+k)=k
       end do
c      Fractional anchors option
       brake(i,1)=dfloat(int(brake(i,3)))
       brake(i,2)=brake(i,3)-brake(i,1)
       mc(ii,i,15)=int(brake(i,3))
       end do ! i paths
       end if ! icase_brakes=0

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case icase_brakes=1 (type added)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (icase_brakes.eq.1) then
c      Read path i
       do i=1,cam(ii)

c      Read levels number
       read (22,*) mc(ii,i,1)
       backspace(22)

c      Case two levels
       if (mc(ii,i,1).eq.2) then
       read (22,*) mc(ii,i,1), mc(ii,i,2), mc(ii,i,3), mc(ii,i,4), 
     + mc(ii,i,5),mc(ii,i,6), mc(ii,i,7), mc(ii,i,8), mc(ii,i,9),
     + mc(ii,i,14), brake(i,3), gname, mc(ii,i,31),mc(ii,i,32)
       end if

c      Case three levels
       if (mc(ii,i,1).eq.3) then
       read (22,*) mc(ii,i,1), mc(ii,i,2), mc(ii,i,3), mc(ii,i,4), 
     + mc(ii,i,5),mc(ii,i,6), mc(ii,i,7), mc(ii,i,8), mc(ii,i,9),
     + mc(ii,i,14), brake(i,3), gname, mc(ii,i,31),mc(ii,i,32),
     + mc(ii,i,33)
       end if

c      Case four levels
       if (mc(ii,i,1).eq.4) then
       read (22,*) mc(ii,i,1), mc(ii,i,2), mc(ii,i,3), mc(ii,i,4), 
     + mc(ii,i,5),mc(ii,i,6), mc(ii,i,7), mc(ii,i,8), mc(ii,i,9),
     + mc(ii,i,14), brake(i,3), gname, mc(ii,i,31),mc(ii,i,32),
     + mc(ii,i,33),mc(ii,i,34)
c       write (*,*) ii,i,mc(ii,i,31),mc(ii,i,32),mc(ii,i,33),mc(ii,i,34)

       end if

c      Fractional anchors option
       brake(i,1)=dfloat(int(brake(i,3)))
       brake(i,2)=brake(i,3)-brake(i,1)
       mc(ii,i,15)=int(brake(i,3))
       end do ! i paths
       end if ! icase_brakes=1

c      Read Brake distribution
       read (22,*)
       read (22,*) bd(1,1), bd(2,1), bd(3,1), bd(4,1), bd(5,1)
       read (22,*) bd(1,2), bd(2,2), bd(3,2), bd(4,2), bd(5,2)
       bd(1,2)=bd(1,2)*xwf
       bd(2,2)=bd(2,2)*xwf 
       bd(3,2)=bd(3,2)*xwf 
       bd(4,2)=bd(4,2)*xwf 
       bd(5,2)=bd(5,2)*xwf

       write (*,*) "10-Brakes read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 11 ramification lengths
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)

       read (22,*) raml(3,1), raml(3,3)
       read (22,*) raml(4,1), raml(4,3), raml(4,4)
       read (22,*) raml(5,1), raml(5,3)
       read (22,*) raml(6,1), raml(6,3), raml(6,4)

       raml(3,1)=raml(3,1)*xwf 
       raml(3,3)=raml(3,3)*xwf
       raml(4,1)=raml(4,1)*xwf
       raml(4,3)=raml(4,3)*xwf  
       raml(4,4)=raml(4,4)*xwf
       raml(5,1)=raml(5,1)*xwf
       raml(5,3)=raml(5,3)*xwf
       raml(6,1)=raml(6,1)*xwf
       raml(6,3)=raml(6,3)*xwf
       raml(6,4)=raml(6,4)*xwf

       write (*,*) "11-Ramifications read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 12 H V and HV ribs
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)

       read (22,*) nhvr
       read (22,*) xrsep, yrsep

       xrsep=xrsep*xkf
       yrsep=yrsep*xkf

       if (nhvr.ne.0) then
       
       do i=1,nhvr
       read (22,*) hvr(i,1),hvr(i,2),hvr(i,3),hvr(i,4),hvr(i,5),hvr(i,6)
     + ,hvr(i,7),hvr(i,8),hvr(i,9),hvr(i,10)

c      Case 3 special, use f- and r+ in % of chord, instead of absolute cm
c      Yuri request 2016-08-25
c      Set column 7 and 8 in %, and column number 9 to "1"
       if (hvr(i,2).eq.3.and.hvr(i,9).eq.1) then
       hvr(i,7)=(hvr(i,7)/100)*(rib(int(hvr(i,3)),5))

       if (hvr(i,5).eq.1.and.hvr(i,6).eq.0) then
       hvr(i,8)=(hvr(i,8)/100)*(rib(int(hvr(i,3))-1,5))
       end if
       if (hvr(i,5).eq.0.and.hvr(i,6).eq.1) then
       hvr(i,8)=(hvr(i,8)/100)*(rib(int(hvr(i,3))+1,5))
       end if
       if (hvr(i,5).eq.1.and.hvr(i,6).eq.1) then
       hvr(i,8)=(hvr(i,8)/100)*(rib(int(hvr(i,3)),5))
       end if

       end if !  case Type 3

       hvr(i,15)=0.0 ! Set increment left
       hvr(i,16)=0.0 ! Set increment right

       end do

c      Re-read file
       do i=1,nhvr
       backspace(22)
       end do

c      Allow read type 6 in lep >= 2.49
c      Feature will be deleted when updated data file format
       do i=1,nhvr
       if (hvr(i,2).eq.6.or.hvr(i,2).eq.16) then
       read (22,*) hvr(i,1),hvr(i,2),hvr(i,3),hvr(i,4),hvr(i,5),hvr(i,6)
     + ,hvr(i,7),hvr(i,8),hvr(i,9),hvr(i,10),hvr(i,11),hvr(i,12)
       else
       read (22,*) hvr(i,1),hvr(i,2),hvr(i,3),hvr(i,4),hvr(i,5),hvr(i,6)
     + ,hvr(i,7),hvr(i,8),hvr(i,9),hvr(i,10)
       hvr(i,15)=0.0 ! Set increment left
       hvr(i,16)=0.0 ! Set increment right
       end if
       end do
       
c      Inicialitzar valors a 0
       do i=1,nhvr
       hvr(i,15)=0.0d0
       hvr(i,16)=0.0d0
       hvr(i,17)=0.0d0
       hvr(i,18)=0.0d0
       hvr(i,19)=0.0d0
       hvr(i,20)=0.0d0
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Adjust some absolute values in cm by xwf
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       do i=1,nhvr

       if (hvr(i,2).eq.1) then
       hvr(i,7)=hvr(i,7)*1
       end if

       if (hvr(i,2).eq.2) then
       hvr(i,7)=hvr(i,7)*xwf
       hvr(i,8)=hvr(i,8)*xwf
       end if

       if (hvr(i,2).eq.3.and.hvr(i,9).ne.1.) then
       hvr(i,7)=hvr(i,7)*xwf
       hvr(i,8)=hvr(i,8)*xwf
       end if

       if (hvr(i,2).eq.4) then
       hvr(i,7)=hvr(i,7)*xwf
       hvr(i,8)=hvr(i,8)*xwf
       end if

       if (hvr(i,2).eq.5) then
       hvr(i,10)=hvr(i,10)*xwf
       end if

       if (hvr(i,2).eq.6) then
       hvr(i,6)=hvr(i,6)*xwf
       hvr(i,7)=hvr(i,7)*xwf
       hvr(i,11)=hvr(i,11)*xwf
       hvr(i,12)=hvr(i,12)*xwf
       end if

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat new Types in %
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       do i=1,nhvr

c      Reformat Type 11 in % to Type 1 in cm
       if (hvr(i,2).eq.11) then
       hvr(i,17)=hvr(i,7)
       hvr(i,7)=(hvr(i,17)/100)*(rib(int(hvr(i,3)),5))
       hvr(i,20)=(hvr(i,17)/100)*(rib(int(hvr(i,5)),5))-hvr(i,7)
       hvr(i,2)=1
       end if

c      Reformat Type 12 in % to Type 2 in cm
       if (hvr(i,2).eq.12) then
       hvr(i,17)=hvr(i,7)
       hvr(i,18)=hvr(i,8)
       hvr(i,7)=(hvr(i,17)/100)*(rib(int(hvr(i,3)),5))
       hvr(i,8)=(hvr(i,18)/100)*(rib(int(hvr(i,3)),5))
c      Proportional value at left 
       hvr(i,15)=(hvr(i,18)/100)*(rib(int(hvr(i,3))-1,5))-hvr(i,8)
c      Proportional value at right
       hvr(i,17)=(hvr(i,18)/100)*(rib(int(hvr(i,3))+1,5))-hvr(i,8)
       hvr(i,2)=2

c       write (*,*) "1>",hvr(i,1),hvr(i,15),hvr(i,8),hvr(i,17)

       end if

c      Reformat Type 13 in % to Type 3 in cm
       if (hvr(i,2).eq.13) then
       hvr(i,17)=hvr(i,7)
       hvr(i,18)=hvr(i,8)
       hvr(i,7)=(hvr(i,17)/100)*(rib(int(hvr(i,3)),5))
       hvr(i,8)=(hvr(i,18)/100)*(rib(int(hvr(i,3)),5))
c      Proportional value at left 
       hvr(i,15)=(hvr(i,18)/100)*(rib(int(hvr(i,3))-1,5))-hvr(i,8)
c      Proportional value at right
       hvr(i,16)=(hvr(i,18)/100)*(rib(int(hvr(i,3))+1,5))-hvr(i,8)
       hvr(i,2)=3
       end if

c      Reformat Type 14 in % to Type 4 in cm
       if (hvr(i,2).eq.14) then
       hvr(i,17)=hvr(i,7)
       hvr(i,18)=hvr(i,8)
       hvr(i,7)=(hvr(i,7)/100)*(rib(int(hvr(i,3)),5))
       hvr(i,8)=(hvr(i,8)/100)*(rib(int(hvr(i,3)),5))
c      Proportional value at left 
       hvr(i,15)=(hvr(i,17)/100)*(rib(int(hvr(i,3))-1,5))-hvr(i,7)
c      Proportional value at right
       hvr(i,16)=(hvr(i,17)/100)*(rib(int(hvr(i,3))+2,5))-hvr(i,7)
       hvr(i,2)=4
       end if

c      Reformat Type 15 in % to Type 5 in cm
       if (hvr(i,2).eq.15) then
       hvr(i,10)=(hvr(i,10)/100)*(rib(int(hvr(i,3)),5))
       hvr(i,2)=5
       end if

c      Reformat Type 16 in % to Type 6 in cm
       if (hvr(i,2).eq.16) then
       hvr(i,6)=(hvr(i,6)/100)*(rib(int(hvr(i,3)),5))
       hvr(i,7)=(hvr(i,7)/100)*(rib(int(hvr(i,3)),5))
       hvr(i,11)=(hvr(i,11)/100)*(rib(int(hvr(i,8)),5))
       hvr(i,12)=(hvr(i,12)/100)*(rib(int(hvr(i,8)),5))
       hvr(i,2)=6
       end if

c      NOTA: valors hvr(i,11) i hvr(i,12) són per a donar continuitat 
c      creant amples ajustat per dreta-esquerra segons corda rib

       end do

       end if

       write (*,*) "12-H V VH ribs read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 15 extrados colors
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) npce

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case classic
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (npce.ge.1) then
c      k=total ribs with colors marks
       do k=1,npce
       read (22,*) npc1e(k), npc2e(k)
c      l=mark number in k rib
       do l=1,npc2e(k)
       read (22,*) npc3e(k,l), xpc1e(k,l), xpc2e(k,l)
       end do
       end do  
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case -2 read cuts by panel (Pawel Lipski method) 2024-09-06
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (npce.eq.-2) then
       read (22,*) npace
c      k=total panels with colors marks
       do k=1,npace
       read (22,*) npac1e(k), npac2e(k)
c      l=cut number in panel k
       do l=1,npac2e(k)
       read (22,*) npac3e(k,l), xpac1e(k,l), xpac2e(k,l),
     + xpac3e(k,l), xpac4e(k,l)
       end do
       end do  
       end if

       write (*,*) "15-Extrados colors read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 16 intrados colors
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) npci

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case classic
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (npci.ge.1) then
c      k=total ribs with colors marks
       do k=1,npci
       read (22,*) npc1i(k), npc2i(k)
c      l=mark number in k rib
       do l=1,npc2i(k)
       read (22,*) npc3i(k,l), xpc1i(k,l), xpc2i(k,l)
       end do
       end do
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case -2 read cuts by panel (Pawel Lipski method) 2024-09-06
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (npci.eq.-2) then
       read (22,*) npaci
c      k=total panels with colors marks
       do k=1,npaci
       read (22,*) npac1i(k), npac2i(k)
c      l=cut number in panel k
       do l=1,npac2i(k)
       read (22,*) npac3i(k,l), xpac1i(k,l), xpac2i(k,l),
     + xpac3i(k,l), xpac4i(k,l)
       end do
       end do  
       end if

       write (*,*) "16-Intrados colors read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 17 Aditional rib points
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)

       read (22,*) narp

       if (narp.eq.0) then
c      Do noting
       end if

       if (narp.ne.0) then
       do i=1,narp
       read (22,*) xarp(i), yarp(i)
       end do
       end if

       write (*,*) "17-Aditional rib points read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 18 Elastic lines corrections
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)

       read (22,*) csusl

       read (22,*) cdis(2,1), cdis(2,2)
       read (22,*) cdis(3,1), cdis(3,2), cdis(3,3)
       read (22,*) cdis(4,1), cdis(4,2), cdis(4,3), cdis(4,4)
       read (22,*) cdis(5,1), cdis(5,2), cdis(5,3),cdis(5,4),cdis(5,5)

       do i=1,5

       read (22,*) csus(i,1), csus(i,2), csus(i,3), csus(i,4)

       end do

       write (*,*) "18-Elastic lines corrections read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SECTIONS 4.19,4.20 added since version >= 2.70
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 19 DXF layer names
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)

       read (22,*) k19d

       do i=1,k19d
       read(22,*) gname,lyname(i)
       end do

       write (*,*) "19-DXF layer names read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 20 marks types
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)

       read (22,*) k20d

       do i=1,k20d
       read(22,*) gname,typm1(i),typm2(i),typm3(i),
     + typm4(i),typm5(i),typm6(i)
       end do

       write (*,*) "20-DXF mark types read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 21 joncs definition
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k21d

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Do nothing if rods scheme 0
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (k21d.eq.0) then
       k21blocs=0
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read data for nose rods scheme 1
c      Only one bloc using rods type 1
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (k21d.eq.1) then

       m=1 ! Only one bloc
       read (22,*) ng21 ! max groups in section 21

       do ng=1,ng21 ! read in group
       read (22,*) ngoo(m,ng,1),ngoo(m,ng,2),ngoo(m,ng,3)
       read (22,*) xextraa(m,ng,1),xextraa(m,ng,2),xextraa(m,ng,3),
     + xextraa(m,ng,4)
       read (22,*) xintraa(m,ng,1),xintraa(m,ng,2),xintraa(m,ng,3),
     + xintraa(m,ng,4)
       read (22,*) sjoo(m,ng,1),sjoo(m,ng,2),sjoo(m,ng,3),sjoo(m,ng,4)
       end do
       
c      Define jonc group rib(i,166) - NOT USED ??????
       do i=1,nribss
       rib(i,166)=0.
       end do
       do ng=1,ng21
       do i=1,nribss
       if (i.ge.ngo(ng,2).and.i.le.ngo(ng,3)) then
       rib(i,166)=float(ng)
       end if
c       write(*,*) "NG=",i,ng,rib(i,166)
       end do ! ribs
       end do ! groups

       k21blocs=1 ! set number of blocs 1
       k21blocf(1,1)=1 ! set bloc 1
       k21blocf(1,2)=1 ! set jonc type 1
       k21blocf(1,3)=ng21 ! set jonc type 1

       end if ! Type 1

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read data for nose rods scheme 2
c      In scheme 2 we have various blocs
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (k21d.eq.2) then

       read (22,*) k21blocs ! number of blocs

c      Read each type
       do m=1,k21blocs

       read (22,*) k21blocf(m,1), k21blocf(m,2)

c      Case classic joncs in the nose
       if (k21blocf(m,2).eq.1) then

       read (22,*) k21blocf(m,3) ! Number of groups in bloc m
       do ng=1,k21blocf(m,3) ! read in group
       read (22,*) ngoo(m,ng,1),ngoo(m,ng,2),ngoo(m,ng,3)
       read (22,*) xextraa(m,ng,1),xextraa(m,ng,2),xextraa(m,ng,3),
     + xextraa(m,ng,4)
       read (22,*) xintraa(m,ng,1),xintraa(m,ng,2),xintraa(m,ng,3),
     + xintraa(m,ng,4)
       read (22,*) sjoo(m,ng,1),sjoo(m,ng,2),sjoo(m,ng,3),sjoo(m,ng,4)
       end do

       end if

c      Case arc joncs
       if (k21blocf(m,2).eq.2) then

       read (22,*) k21blocf(m,3) ! Number of groups in bloc m
       do ng=1,k21blocf(m,3) ! read in group
       read (22,*) ngoo(m,ng,1),ngoo(m,ng,2),ngoo(m,ng,3)
       read (22,*) x21(m,ng,1),x21(m,ng,2),x21(m,ng,3),x21(m,ng,4),
     + x21(m,ng,5)
       read (22,*) sjoo(m,ng,1),sjoo(m,ng,2),sjoo(m,ng,3),sjoo(m,ng,4)
       end do ! ng group

       end if


c      Case shark nose rods
       if (k21blocf(m,2).eq.3) then

       read (22,*) k21blocf(m,3) ! Number of groups in bloc m
       do ng=1,k21blocf(m,3) ! read in group
       read (22,*) ngoo(m,ng,1),ngoo(m,ng,2),ngoo(m,ng,3)
       read (22,*) xextraa(m,ng,1),xextraa(m,ng,2),xextraa(m,ng,3),
     + xextraa(m,ng,4)
       read (22,*) xextraa(m,ng,5),xextraa(m,ng,6),xextraa(m,ng,7),
     + xextraa(m,ng,8)
       read (22,*) xintraa(m,ng,5),xintraa(m,ng,6),xintraa(m,ng,7),
     + xintraa(m,ng,8)
       read (22,*) xintraa(m,ng,1),xintraa(m,ng,2),xintraa(m,ng,3),
     + xintraa(m,ng,4)
       read (22,*) sjoo(m,ng,1),sjoo(m,ng,2),sjoo(m,ng,3),sjoo(m,ng,4)
       end do

       end if


       end do ! bloc m
   
       end if ! Type 2

       write (*,*) "21-Joncs definition read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 22 nose mylars definition
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k22d

c      Do nothing!
       if (k22d.eq.0) then
       end if

c      Read data for nose mylars type 1
       if (k22d.eq.1) then

       read (22,*) ng22 ! max groups in section 21

       do ng=1,ng22 ! read in group
       read (22,*) ngo(ng,1),ngo(ng,2),ngo(ng,3)
       read (22,*) xmy(ng,1),xmy(ng,2),xmy(ng,3),xmy(ng,4),
     + xmy(ng,5),xmy(ng,6)
       end do
       
       end if ! Type 1

c      Define mylar group rib(i,168)
       do i=1,nribss
       rib(i,168)=0.
       end do
       do ng=1,ng22
       do i=1,nribss
       if (i.ge.ngo(ng,2).and.i.le.ngo(ng,3)) then
       rib(i,168)=float(ng)
       end if
       end do
       end do

       write (*,*) "22-Nose mylars definition read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 23 tab reinforcements definition
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k23d
       if (k23d.eq.0) then

c      Define default parameters

       else

c      Read custom parameters

       end if

       write (*,*) "23-Tab reinforcements definition read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 24 general 2D DXF options
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k24d
       if (k24d.eq.0) then

c      Define default parameters
       iccolor(1)=1    ! red
       iccolor(2)=30   ! orange
       iccolor(3)=3    ! green
       iccolor(4)=4    ! cyan
       iccolor(5)=6    ! magenta
       iccolor(6)=5    ! blue

       else

c      Read custom parameters
       read (22,*) gname, iccolor(1)
       read (22,*) gname, iccolor(2)
       read (22,*) gname, iccolor(3)
       read (22,*) gname, iccolor(4)
       read (22,*) gname, iccolor(5)
       read (22,*) gname, iccolor(6)

       end if

       write (*,*) "24-General 2D DXF options read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 25 general 3D DXF options
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k25d
       if (k25d.eq.0) then

c      Define default parameters
       iccolor(11)=8    ! red
       iccolor(12)=8  ! orange
       iccolor(13)=8    ! green
       iccolor(14)=8    ! cyan
       iccolor(15)=8    ! magenta
       iccolor(16)=30    ! blue
       ele3d(11)=0
       ele3dc(11)=5	!blue extrados
       ele3d(12)=0
       ele3dc(12)=1	!red vents
       ele3d(13)=0
       ele3dc(13)=3	!green intrados

       else

c      Read custom parameters
       read (22,*) gname, iccolor(11)
       read (22,*) gname, iccolor(12)
       read (22,*) gname, iccolor(13)
       read (22,*) gname, iccolor(14)
       read (22,*) gname, iccolor(15)
       read (22,*) gname, iccolor(16)
       read (22,*) gname, ele3d(11), ele3dc(11)
       read (22,*) gname, ele3d(12), ele3dc(12)
       read (22,*) gname, ele3d(13), ele3dc(13)

       end if

       write (*,*) "25-General 3D DXF options read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 26 Glue vents
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k26d

       if (k26d.eq.0) then
       else
       end if

       if (k26d.eq.1) then
       do i=1,nribss

       read (22,*) j, rib(i,165)
      
       if (rib(i,165).eq.4.or.rib(i,165).eq.-4) then
       backspace(22)
       read (22,*) j, rib(i,165),csi(i,19),csi(i,20)
       if (i.eq.1) then
       csi(i,20)=csi(i,19) ! Set coherent central cell
       end if
       end if

       if (rib(i,165).eq.5.or.rib(i,165).eq.-5) then
       backspace(22)
       read (22,*) j, rib(i,165),csi(i,19),csi(i,20),csi(i,18)
       if (i.eq.1) then
       csi(i,20)=csi(i,19) ! Set coherent central cell
       end if
       end if

       if (rib(i,165).eq.6.or.rib(i,165).eq.-6) then
       backspace(22)
       read (22,*) j, rib(i,165),csi(i,19),csi(i,20)
       end if

       end do ! i
       end if

       rib(0,165)=rib(1,165)

       write (*,*) "26-Glue vents read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 27 Special wingtip
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k27d

       if (k27d.eq.0) then
       else
       end if

c      Angle wingtip
       if (k27d.eq.1) then
       read (22,*) gname, alc1
       alc1=alc1*pi/180.
       read (22,*) gname, alc2
       alc2=alc2*pi/180.
       rib(nribss,3)=rib(nribss-1,3)+
     + (rib(nribss,2)-rib(nribss-1,2))*tan(alc1)
       rib(nribss,4)=rib(nribss-1,4)+
     + (rib(nribss,2)-rib(nribss-1,2))*tan(alc2)
       rib(nribss,5)=rib(nribss,4)-rib(nribss,3)
       end if

c      Parabolic wingtip
       if (k27d.eq.2) then
       read (22,*) gname, sectx(27,3)  ! Distance
       read (22,*) gname, sectx(27,4)  ! Angle
       alc1=alc1*pi/180.
       end if

       write (*,*) "27-Special wingtip read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 28 Parameters for calage variation
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k28d
       if (k28d.eq.0) then ! set default values

       
       else
 
       if (k28d.eq.1) then
       read (22,*) nriser28
       read (22,*) p28(1), p28(2), p28(3), p28(4), p28(5), p28(6)
       read (22,*) a128, n128, a228, n228
       end if
       
       end if

       write (*,*) "28-Parameters for calage variation read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 29 3D-SHAPING
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k29d ! Data control
  
c      Do nothing
       if (k29d.eq.0) then
c      Set default values for no cuts
       k29dd=1
       ng29=1
       ini29(1)=1
       fin29(1)=nribss
       uppcuts(1)=0
       upptype(1)=1
       lowcuts(1)=0
       lowtype(1)=1
       do i=1,nribss
       rib(i,169)=0.
       end do
c      Set default print parameters
       do i=1,5
       pp29(i,1)=0
       pp29(i,2)=0
       pp29(i,3)=1
       pp29(i,4)=1
       pp29(i,5)=0
       end do
       end if

c       k29dd=0

c      3D-type type 1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (k29d.eq.1) then

c      Initialize defaults
c      Define 3d group rib(i,169)
       do i=1,nribss
       rib(i,169)=0.
       end do

       read (22,*) k29dd  ! 3D-type (not used)

       read (22,*) gname,ng29

       do ng=1,ng29  ! Iterate in each group

       read (22,*) gname, k, ini29(ng), fin29(ng)
       read (22,*) gname, uppcuts(ng), upptype(ng)

       do i=ini29(ng),fin29(ng)
       rib(i,169)=k
       end do

       if (uppcuts(ng).eq.0) then
       end if
     
       if (uppcuts(ng).eq.1) then
       read (22,*) iupp(1,1,ng),iupp(1,2,ng),iupp(1,3,ng),kiupp(1,ng)
       end if

       if (uppcuts(ng).eq.2) then
       read (22,*) iupp(1,1,ng),iupp(1,2,ng),iupp(1,3,ng),kiupp(1,ng)
       read (22,*) iupp(2,1,ng),iupp(2,2,ng),iupp(2,3,ng),kiupp(2,ng)
       end if

       read (22,*) gname, lowcuts(ng), lowtype(ng)

       if (lowcuts(ng).eq.0) then
       end if
     
       if (lowcuts(ng).eq.1) then
       read (22,*) ilow(1,1,ng),ilow(1,2,ng),ilow(1,3,ng),kilow(1,ng)
       end if

       end do ! In each group

       end if ! 3D active type 1

c      3D-type type 2
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (k29d.eq.2) then

c      Read data

c      Initialize defaults
c      Define 3d group rib(i,169)
       do i=1,nribss
       rib(i,169)=0.
       end do

       read (22,*) k29dd  ! 3D-type (not used)

       read (22,*) gname,ng29

       do ng=1,ng29  ! Iterate in each group

       read (22,*) gname, k, ini29(ng), fin29(ng)
       read (22,*) gname, uppcuts(ng), upptype(ng)

       do i=ini29(ng),fin29(ng)
       rib(i,169)=k
       end do

       if (uppcuts(ng).eq.0) then
       end if
     
       if (uppcuts(ng).eq.1) then
       read (22,*) iupp(1,1,ng),xiupp(1,2,ng),xiupp(1,3,ng),kiupp(1,ng)
       end if

       if (uppcuts(ng).eq.2) then
       read (22,*) iupp(1,1,ng),xiupp(1,2,ng),xiupp(1,3,ng),kiupp(1,ng)
       read (22,*) iupp(2,1,ng),xiupp(2,2,ng),xiupp(2,3,ng),kiupp(2,ng)
       end if

       read (22,*) gname, lowcuts(ng), lowtype(ng)

       if (lowcuts(ng).eq.0) then
       end if
     
       if (lowcuts(ng).eq.1) then
       read (22,*) ilow(1,1,ng),xilow(1,2,ng),xilow(1,3,ng),kilow(1,ng)
       end if

       end do ! In each group

c      Compute discrete points ir airfoils section

     
c      Return to type 1
       k29d=1

       end if ! 3D active type 2

c      Read print parameters
       if (k29d.ne.0) then
       read (22,*)
       read (22,*) gname,pp29(1,1),pp29(1,2),pp29(1,3),pp29(1,4)
       read (22,*) gname,pp29(2,1),pp29(2,2),pp29(2,3),pp29(2,4)
       read (22,*) gname,pp29(3,1),pp29(3,2),pp29(3,3),pp29(3,4)
       read (22,*) gname,pp29(4,1),pp29(4,2),pp29(4,3),pp29(4,4)
       read (22,*) gname,pp29(5,1),pp29(5,2),pp29(5,3),pp29(5,4)
       end if

c      Print panels using 3D subroutines
       if (k29d.eq.0) then
       k29d=1
       end if

c      Compute discrete points
       rib(0,169)=rib(1,169)

       write (*,*) "29-3D-Shaping read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 30 AIRFOIL THICKNESS MODIFICATION
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k30d
       if (k30d.eq.0) then

       do i=1,nribss
       rib(i,160)=1.0 ! Standard thickness
       end do

       else

       if (k30d.eq.1) then

       do i=1,nribss

       read (22,*) i9, rib(i,160)

       end do

       end if

       end if

       write (*,*) "30-Airfoil modification read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 31 new skin tension
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k31d

       if (k31d.eq.0) then

       else

       if (k31d.eq.1) then

       read (22,*) ngskt ! max groups

       do ng=1,ngskt ! read in group
    
       read (22,*)
       read (22,*) ngi, nribini, nribfin, npoints, ntype31

       do i=nribini,nribfin
       skinpoints(i)=npoints
       ngroup31(i)=ngi
       ntypei31(i)=ntype31
       end do

       do k=1,npoints ! read points
       read (22,*) ksk, skinew(k,1),skinew(k,2),
     + skinew(k,3),skinew(k,4)

       do i=nribini,nribfin ! assign in each rib group
       skinnew(i,k,1)=skinew(k,1)
       skinnew(i,k,2)=skinew(k,2)
       skinnew(i,k,3)=skinew(k,3)
       skinnew(i,k,4)=skinew(k,4)
       end do

       end do ! read all points in group

       end do

       end if

c      Set 0 rib
       skinpoints(0)=skinpoints(1)
       ngroup31(0)=ngroup31(1)
       ntypei31(0)=ntypei31(1)
       do k=1,npoints
       skinnew(0,k,1)=skinnew(1,k,1)
       skinnew(0,k,2)=skinnew(1,k,2)
       skinnew(0,k,3)=skinnew(1,k,3)
       skinnew(0,k,4)=skinnew(1,k,4)
       end do

       end if

       write (*,*) "31-New skin tension read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 32 parameters for part separation
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k32d

       if (k32d.eq.0) then

       panel_x_coe=1.0
       panel_x_min=1.0
       panel_y_coe=1.0
       rib_x_coe=1.0
       rib_y_coe=1.0
       rib_1_coe=1.0

       else

       if (k32d.eq.1) then
       read (22,*) gname, panel_x_coe
       read (22,*) gname, panel_x_min
       read (22,*) gname, panel_y_coe
       read (22,*) gname, rib_x_coe
       read (22,*) gname, rib_y_coe
       read (22,*) gname, rib_1_coe
       read (22,*) gname, gname
       read (22,*) gname, gname
       read (22,*) gname, gname
       read (22,*) gname, gname
       end if

       end if

       write (*,*) "32-Parameters for part separation read"


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 33 Detailed risers
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k33d

       nrisers=int(slp) ! Defined in section 9

c      Case risers same length
c      Use lengths defined in section 8
       if (k33d.eq.0) then

       x33(1)=clengr
       x33(2)=clengr
       x33(3)=clengr
       x33(4)=clengr
       x33(5)=clengr

       else

       read (22,*) k33t

c      Case normal risers
       if (k33t.eq.1) then
       do i=1,nrisers
       read (22,*) gname, x33(i)
       end do
       end if

c      Case vario seat two points
       if (k33t.eq.2) then
       end if

c      Case vario seat three points
       if (k33t.eq.3) then
       end if

c      Case vario seat four points
       if (k33t.eq.4) then
       end if

       end if

       write (*,*) "33-Parameters for detailed risers read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 34 Lines characteristics table
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k34d

c      Set default values
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (k34d.eq.0) then
c      Set default table
       k34n=6
       tylinea(1,1)="r"
       tyline(1,2)=25.
       tyline(1,3)=2.
       tylinea(1,4)="Riser"
       tyline(1,5)=1000.
       tylinea(1,6)="polyester"
       tyline(1,7)=20.
       tylinea(1,8)="s"
       tyline(1,9)=12.
       tyline(1,10)=7

       tylinea(2,1)="c"
       tyline(2,2)=1.90
       tyline(2,3)=2.
       tylinea(2,4)="Line275"
       tyline(2,5)=275.
       tylinea(2,6)="s_dyneem"
       tyline(2,7)=2.26
       tylinea(2,8)="s"
       tyline(2,9)=12.
       tyline(2,10)=1

       tylinea(3,1)="c"
       tyline(3,2)=1.40
       tyline(3,3)=2.
       tylinea(3,4)="Line160"
       tyline(3,5)=160.
       tylinea(3,6)="s_dyneem"
       tyline(3,7)=1.34
       tylinea(3,8)="s"
       tyline(3,9)=10.
       tyline(3,10)=30

       tylinea(4,1)="c"
       tyline(4,2)=1.15
       tyline(4,3)=2.
       tylinea(4,4)="Line120"
       tyline(4,5)=120.
       tylinea(4,6)="s_dyneem"
       tyline(4,7)=1.00
       tylinea(4,8)="s"
       tyline(4,9)=10.
       tyline(4,10)=5

       tylinea(5,1)="c"
       tyline(5,2)=0.80
       tyline(5,3)=2.
       tylinea(5,4)="Line100U"
       tyline(5,5)=100.
       tylinea(5,6)="u_dyneem"
       tyline(5,7)=0.43
       tylinea(5,8)="p"
       tyline(5,9)=8.
       tyline(5,10)=2

       tylinea(6,1)="c"
       tyline(6,2)=2.00
       tyline(6,3)=2.
       tylinea(6,4)="Line200B"
       tyline(6,5)=160.
       tylinea(6,6)="s_dyneem"
       tyline(6,7)=0.2
       tylinea(6,8)="s"
       tyline(6,9)=12.
       tyline(6,10)=6

       do i=1,6
       jltype(i)=i ! set type number
       end do

       end if ! default values table

c      Read characteristics table
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (k34d.eq.1) then
       read (22,*) k34n

       do i=1,k34n ! Read all lines types

       read (22,*) jltype(i), tylinea(i,1)
       backspace(22)

c      Read line case r
       if (tylinea(i,1).eq."r") then
       read (22,*) j,tylinea(i,1),tyline(i,2),tyline(i,3),tylinea(i,4),
     + tyline(i,5),gname,tylinea(i,6),tyline(i,7),gname,
     + tylinea(i,8),tyline(i,9),gname,tyline(i,10)
       end if

c      Read line case c
       if (tylinea(i,1).eq."c") then
       read (22,*) j,tylinea(i,1),tyline(i,2),tylinea(i,4),
     + tyline(i,5),gname,tylinea(i,6),tyline(i,7),gname,
     + tylinea(i,8),tyline(i,9),gname,tyline(i,10)
       end if

       end do

       end if ! Case read custom table

       write (*,*) "34-Parameters for lines characteristics table read"


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 35 Solve equilibrium equations
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k35d

c      Case don't solve equilibrium
       if (k35d.eq.0) then
       end if

c      Case solve equilibrium
       if (k35d.eq.1) then
       read (22,*) gname, x35grav
       read (22,*) gname, x35ro
       read (22,*) gname, x35mu
       read (22,*) gname, x35v
       read (22,*) gname, x35alpha
       read (22,*) gname, x35cl
       read (22,*) gname, x35cle
       read (22,*) gname, x35cd
       read (22,*) gname, x35cde
       read (22,*) gname, x35cm
       read (22,*) gname, x35spilot
       read (22,*) gname, x35dpcoef
       read (22,*) gname, x35wingmass
       read (22,*) gname, x35pilotmass
       read (22,*) gname, x35pmc
       read (22,*) gname, x35qlmass
       read (22,*) gname, x35ycp
       read (22,*) gname, x35zcp
       end if

       x35alpha=x35alpha*pi/180. ! convert to radians

       write (*,*) "35-Parameters for solve equilibrium read"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 36 Create files for XFLR5 analysis
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k36d

c      Case don't do xflr5 analysis
       if (k36d.eq.0) then
       end if

c      Case set parameters for .xwimp
       if (k36d.eq.1) then
       read (22,*) gname
       read (22,*) k36_a
       read (22,*) k36_b
       read (22,*) k36_c
       read (22,*) k36_d
       read (22,*) gname
       read (22,*) k36_e
       end if

       write (*,*) "36-Parameters for xflr5 analysis read"


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read 37 Read some special parameters
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Set default values
       nsegments=12 ! Section 8.5.0.2 Call tessellation
       chord_pcdg=36. ! Center of mass of a typical wing section (is 4.6)
       i37c=0 ! Set lines colors by plans
       i37solve=1 ! solve equilibrium equations by Casellas method (1) or De Villiers (2) or combined (3)
       i37fparea=2 ! Solve Lift, drag, Speed for Flat area (1) projected (2)
       i37output=0 ! 0=simplified output, 1=detailed output
c      End default values

       read (22,*)
       read (22,*)
       read (22,*)
       read (22,*) k37d

c      Case no special parameters, set defaults
       if (k37d.eq.0) then
       end if

c      Case read special parameters
       if (k37d.eq.1) then
       read (22,*) k37n ! Number of lines to read

       do i=1,k37n

       read (22,*) icode
       backspace (22)

c      Code 1291, set nsegments for stl surfaces
       if (icode.eq.1291) then
       read (22,*) icode, nsegments
       end if

c      Code 1146, set cdg of a typical wing section
       if (icode.eq.1146) then
       read (22,*) icode, chord_pcdg
       end if

c      Code 1341, set CAD colors for each lyne type
       if (icode.eq.1341) then
       read (22,*) icode,i37c
       end if

c      Code 1351, change solve method for equilibrium equations
       if (icode.eq.1351) then
       read (22,*) icode,i37solve
       end if

c      Code 1352, solve for flat (1) or projected (2) areas
       if (icode.eq.1352) then
       read (22,*) icode,i37fparea
       end if

c      Code 1353, normal (0) or detailed output (1)
       if (icode.eq.1353) then
       read (22,*) icode,i37output
       end if

c      Code 2000, print edition date
       iflag2000=0
       if (icode.eq.2000) then
       read (22,*) icode,a37date
       iflag2000=1
       end if

c      Code 2003, force assiette angle defined by the user
c      Used in phii and chii calculus section 10.1
       if (icode.eq.2003) then
       read (22,*) icode,assiette2003 ! set in degrees, positive below, negative below horizon
       iflag_assiette=1
       end if

c      Code 3001, set minirib transitions
       i3001(2)=0
       if (icode.eq.3001) then
       read (22,*) i3001(1),i3001(2)
       backspace(22)
       if (i3001(2).eq.0) then ! do nothing
       end if
       if (i3001(2).eq.1) then ! read linear
       read (22,*) i3001(1),i3001(2),c3001(3),c3001(4),i3001(5),c3001(6)
       end if
       if (i3001(2).eq.2) then ! read parabolic
       read (22,*) i3001(1),i3001(2),c3001(3),c3001(4),i3001(5),c3001(6)
     + ,c3001(7)
       end if
       if (i3001(3).eq.3) then ! read cosinuidal
       read (22,*) i3001(1),i3001(2),c3001(3),c3001(4),i3001(5),c3001(6)
       end if
       end if

       end do ! read all lines


       end if

       write (*,*) "37-Some special parameters read"


c      END OF READ SECTION


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      4.2 Write xwimp geometry file for XFLR5
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (k36d.eq.1) then

c      Make xflr5 folder
       folder = 'xflr5'
       makedirectory = 'mkdir -p ' // trim('../') // "/" // trim(folder)
       call system(makedirectory)

c      open xwimp file
       l=0
       k=len(wname)
       do i=1,k
       if (wname(i:i).ne.' ') then
       l=l+1
       end if
       end do
       write (wname2, '(A,A)') wname(1:l),".xwimp"
       open(unit=34,file='../xflr5/'//wname2)

c      Set airfoil names

c      Thicknees suffix nomair3
       if (k30d.eq.1) then
       do i=1,nribss
       write (nomair3(i),'(F5.0)') rib(i,160)*1000
       l=0
       k=len(nomair3(i))
       do j=1,k
       if (nomair3(i)(j:j).ne.' ') then
       l=l+1
       end if
       end do

c      Add zeros al left of suffix name
       if (l.eq.4) then
       write (nomair3(i)(1:4),'(A,A)') "0",nomair3(i)(2:4)
       end if
       if (l.eq.3) then
       write (nomair3(i)(1:4),'(A,A)') "00",nomair3(i)(3:4)
       end if
       if (l.eq.2) then
       write (nomair3(i)(1:4),'(A,A)') "000",nomair3(i)(4:4)
       end if
       end do
       end if
       
c      Airfoil names nomair2, including thicknees suffix
       do i=1,nribss
       l=0
       k=len(nomair(i))
       do j=1,k
       if (nomair(i)(j:j).ne.' ') then
       l=l+1
       end if
       end do
       write (nomair2(i), '(A,A,A)') nomair(i)(1:l-4),"-",
     + nomair3(i)(1:4)
       end do

c      Add .dat extension to names
       do i=1,nribss
       l=0
       k=len(nomair2(i))
       do j=1,k
       if (nomair2(i)(j:j).ne.' ') then
       l=l+1
       end if
       end do
       write (nomair4(i), '(A,A)') nomair2(i)(1:l),".dat"
       end do

       write (34,*) wname

c      Write main xwimp matrix

c      Case paraglider odd number of cells (senar)
c      Add additional line
       if (rib(1,2).gt.0.1d0) then
       i=1
       write (34,'(F9.5,x,F9.5,x,F9.5,x,F9.5,x,F9.5,x,I3,x,I3,x,I2,x,I2,
     + x,A30,x,A30)')
     + 0.0d0, rib(i,5)/100., rib(i,3)/100.,
     + 0.0d0, rib(i,8),
     +  k36_a,k36_b,k36_c,k36_d,nomair2(i),nomair2(i)
       end if ! case odd

c      Case paraglider even number of cells (parell)
       do i=1,nribss-1
       xdihedral(i)=(180./pi)*
     + datan((rib(i+1,7)-rib(i,7))/(rib(i+1,6)-rib(i,6)))
       write (34,'(F9.5,x,F9.5,x,F9.5,x,F9.5,x,F9.5,x,I3,x,I3,x,I2,x,I2,
     + x,A30,x,A30)')
     + rib(i,2)/100., rib(i,5)/100., rib(i,3)/100.,
     + -xdihedral(i), rib(i,8),
     + k36_a,k36_b,k36_c,k36_d,nomair2(i),nomair2(i)
       end do
       i=nribss
       write (34,'(F9.5,x,F9.5,x,F9.5,x,F9.5,x,F9.5,x,I3,x,I3,x,I2,x,I2,
     + x,A30,x,A30)')
     + rib(i,2)/100., rib(i,5)/100., rib(i,3)/100.,
     + -xdihedral(i-1), rib(i,8),
     +  k36_a,k36_b,k36_c,k36_d,nomair2(i),nomair2(i)

       close(34)

c      Write airfoils .dat files

       do i=1,nribss
 
       open (24, file=nomair(i))
       rewind (24)

       read (24,*) 
       read (24,*) np(i,1) ! total points
       read (24,*) np(i,2) ! extrados points
       read (24,*) np(i,3) ! intake points
       read (24,*) np(i,4) ! intrados points

       open (35, file='../xflr5/'//nomair4(i))
       write (35, *) nomair2(i)
       do j=1,np(i,1)
       read (24,*) u(i,j,1),v(i,j,1)
       write (35,'(F11.8,3x,F11.8)') u(i,j,1),v(i,j,1)*rib(i,160)
       end do
       close (35)

       close (24)

       end do

       end if ! End creation of xflr5 files


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      4.3 Write some warnings and errors found in data
c      Do not cover all errors, but some of habitual
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Number of ribs and cells case even odd 
c      Ribs even > cells -1
c      Ribs odd > cells

       if (ncells.ne.nribst-1) then
       write (*,*) "ERROR: number of cells will be number of ribs -1"
       end if

       
c     COMPLETE


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       write (*,*) "All data read! Calculus start..."
       write (*,*)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc



cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      4.3 Make stl/ folder and open some optional files
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (pp29(5,1).eq.1) then ! case stl and scad

c      Make stl folder
       folder = 'stl'
       makedirectory = 'mkdir -p ' // trim('../') // "/" // trim(folder)
       call system(makedirectory)


       if (pp29(4,1).eq.1) then ! Open external DXF
       open(unit=26,file='lep-3d-surfaces.dxf') 
       call dxfinit(26)
       end if

       if (pp29(5,1).eq.1) then ! Open external stls
       open(unit=27,file='../stl/lep-3d-surfaces.scad') 
       open(unit=28,file='../stl/lep-3d-surfaces.stl') 
       open(unit=29,file='../stl/Upper-surface.stl')
       open(unit=32,file='../stl/Vents-surface.stl')
       open(unit=31,file='../stl/Lower-surface.stl')
       end if

       end if ! case stl and scad

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      4.4 Alguns parŕmetres de mides
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       xmida1=12.0d0*xkf/1.5d0  ! Mida de lletra 1
       xmida2=10.0d0*xkf/1.5d0  ! Mida de lletra 2  
       xmida3=6.0d0*xkf/1.5d0   ! Mida de lletra 3 petita
       xmida4=3.0d0*xkf/1.5d0   ! Mida de lletra 4 molt petita 

       xmida3=xmida3 ! primer us
       xmida4=xmida4   

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      PARAMETERS TO BE DEFINED IN DATA FILE
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Revise all overrides
c      Try to normalize to cm as soon as possible      
       typepoint=typm4(1)
       typevent=typm4(4)
       typetab=typm4(5)
       typejonc=typm4(6)

       if (typm4(1).eq.1) then
       xdes=typm6(1)/10.0d0 !override classic xdes
       end if

       if (typm4(1).eq.2) then
       xrad=typm5(1)
       xdes=typm6(1)/10.0d0 !override classic xdes
       end if

c      Compte amb aquesta definició!
       if (typm4(5).le.3) then
       typm5(5)=typm5(5)/10.0d0 !override classic 1 cm
       typm6(5)=typm6(5)/10.0d0 !override classic xdes 1.2 mm
       end if

       xdes1=typm3(1)/10.0d0
       xdes2=typm6(1)/10.0d0
       xcir1=typm2(1)/10.0d0
       xcir2=typm5(1)/10.0d0

c       write (*,*) "xdes=",xdes

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      4.5 Center of gravity calculus (2D)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Planform

       acit=rib(1,2)*rib(1,5)
       cdgx=0.5*rib(1,2)*acit
       cdgy=0.5*(rib(1,3)+rib(1,4))*acit

       do i=1,nribss-1

       aci=0.5*(rib(i,5)+rib(i+1,5))*(rib(i+1,2)-rib(i,2))
       xci=0.5*(rib(i,2)+rib(i+1,2))
       yci=0.25*(rib(i,3)+rib(i,4)+rib(i+1,3)+rib(i+1,4))

       cdgx=cdgx+xci*aci
       cdgy=cdgy+yci*aci

       acit=acit+aci

       end do

       cdgx=cdgx/acit
       cdgy=cdgy/acit

       cdg=100.*((cdgy-rib(1,3))/rib(1,5))

       if (atp.eq."ds".or.atp.eq."ss") then
       write (*,'(A,F5.2,A)') " Area = ", acit*2./10000., " m2"
       else
       write (*,'(A,F5.2,A,F7.1,A)') " Area = ", acit*2./10000., " m2 ",
     + 10.7639*acit*2./10000.," ft2"
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      4.6 Center of gravity calculus (3D)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Simplified method. Use only chord lines.
c      Do a weighted arithmetic mean of mass centers
c      Predefine the gravity center of a typical chord line.

c       if (k37d.eq.0) then ! set default value
c       chord_pcdg=36. ! Center of mass of a typical wing section
c       end if

c      Detect if true cells number is even
       neven=0
       if (rib(1,2).lt.0.2d0) then ! case true even cells number
       neven=1
       end if

c      Case odd
       if (neven.eq.0) then
c      Sum of all chords
       chordsum=0.0d0
       do i=1,nribss
       chordsum=chordsum+2.*rib(i,5)
       end do
c      wcdgx3d
       wcdgx3d=0.0d0
c      wcdgy3d
       wcdgy3d=0.0d0
       do i=1,nribss
       chordy=(rib(i,3)*(100.-chord_pcdg)+rib(i,4)*chord_pcdg)/100.
       wcdgy3d=wcdgy3d+chordy*rib(i,5)*2.
       end do
       wcdgy3d=wcdgy3d/chordsum
c      wcdgz3d
       wcdgz3d=0.0d0
       do i=1,nribss
       wcdgz3d=wcdgz3d+rib(i,7)*rib(i,5)*2.
       end do
       wcdgz3d=wcdgz3d/chordsum
       end if
       
c      Case even
       if (neven.eq.1) then
c      Sum of all chords
       chordsum=0.0d0
       do i=2,nribss
       chordsum=chordsum+2.*rib(i,5)
       end do
       chordsum=chordsum+rib(1,5)
c      wcdgx3d
       wcdgx3d=0.0d0
c      wcdgy3d
       wcdgy3d=0.0d0
       do i=2,nribss
       chordy=(rib(i,3)*(100.-chord_pcdg)+rib(i,4)*chord_pcdg)/100.
       wcdgy3d=wcdgy3d+chordy*rib(i,5)*2.
       end do
       chordy=(rib(1,3)*(100.-chord_pcdg)+rib(1,4)*chord_pcdg)/100.
       wcdgy3d=(wcdgy3d+chordy*rib(1,5))/chordsum
c      wcdgz3d
       wcdgz3d=0.0d0
       do i=2,nribss
       wcdgz3d=wcdgz3d+rib(i,7)*rib(i,5)*2.
       end do
       wcdgz3d=(wcdgz3d+rib(1,7)*rib(1,5))/chordsum
       end if ! case even

c       write (*,*) "Case ",neven
c       write (*,*) "wcdgx3d ",wcdgx3d 
c       write (*,*) "wcdgy3d ",wcdgy3d 
c       write (*,*) "wcdgz3d ",wcdgz3d 


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      4.7 Adjust some parameters
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Ample panells extrados a efectes de separació
       amplemig=0.0d0
       npaes=int(nribss/2)
       do i=2,npaes
       amplemig=amplemig+rib(i,2)-rib(i-1,2)
       end do
       amplemig=amplemig/float(npaes-1)

c      Escala descensos de ribs no suspentats
c      WARNING revisar concepte (!)
       do i=1,nribss

       rib(i,50)=rib(i,50)*xwf

       end do

c      Parts separation parameters (SECTION 32)
c      Default parameters
       amplerix=1.0*rib_x_coe
       ampleriy=1.0*rib_y_coe
       amplepix=1.1*panel_x_coe

c      Rib separation parameters
       seprix=350.*xwf*amplerix
       sepriy=90.*xwf*ampleriy
       sepri1_y=(1.-rib_1_coe)*50.*xwf

c      Panels separation
c      seppix(i)=60.*xwf
c      seppix(i)=(amplemig*1.7+(0.20d0*xupp))*amplepix

c      Define separation between panels proportional to its width

       call eo(ncells,evenodd)

c       if (evenodd.eq.1) then
       seppix(0)=-30.0d0
       do i=1,nribss
       seppix(i)=(seppix(i-1)+xwf*(rib(i,2)-rib(i-1,2))*amplepix+
     + 0.2d0*xupp+10.0d0*panel_x_min)
       end do
c       end if

       if (evenodd.eq.3) then
       seppix(0)=-30.0d0
       do i=1,nribss-1
       seppix(i)=(seppix(i-1)+xwf*(rib(i+1,2)-rib(i,2))*amplepix+
     + 0.2d0*xupp+10.0d0*panel_x_min)
       end do
       end if
      
c      Compute some ribs additional parameters
c      Lengths from LE to anchor points A,B,...E

      do i=0,nribss

      rib(i,66)=(rib(i,16)*rib(i,5)/100.)
      rib(i,67)=(rib(i,17)*rib(i,5)/100.)
      rib(i,68)=(rib(i,18)*rib(i,5)/100.)
      rib(i,69)=(rib(i,19)*rib(i,5)/100.)
      rib(i,70)=(rib(i,20)*rib(i,5)/100.)

      end do

c     y separation for panels parts

      ysautt=(rib(1,5)+rib(nribss-2,5))*0.5d0*xwf*0.2d0*panel_y_coe

c     Some parameters for internal marks (subroutine xmarsi)
      xini=0.0d0
      xfin=0.0d0

c     Adjust beta rotation in rib 0
      rib(0,9)=-rib(1,9)
c     Adjust rot_z rotation in rib 0
      rib(0,250)=-rib(1,250)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     4.8 DXF layers  (project)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      5. GRAPHIC DESIGN
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      5.1 Planform
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Box (1,1)

c      5.1.1 Ribs
       do i=1,nribss
       call line(rib(i,2),rib(i,3),rib(i,2),rib(i,4),5)
       call line(-rib(i,2),rib(i,3),-rib(i,2),rib(i,4),5)

       call itxt(rib(i,2)-110.*(typm3(9)/10.),rib(i,3)-15,
     + typm3(9),0.0d0,i,7)
       call itxt(-rib(i,2)-110.*(typm3(9)/10.),rib(i,3)-15,
     + typm3(9),0.0d0,i,7)

       end do

c      5.1.2 Draw rotated ribs ("Z" versions")
       do i=1,nribss
c      Using auxiliar points 1,2,3
       x3=rib(i,2)
       y3=rib(i,3)+(rib(i,4)-rib(i,3))*rib(i,251)/100.0
       x1=x3+(y3-rib(i,3))*dsin(rib(i,250)*pi/180.0)
       y1=y3-(y3-rib(i,3))*dcos(rib(i,250)*pi/180.0)
       x2=x3-(rib(i,4)-y3)*dsin(rib(i,250)*pi/180.0)
       y2=y3+(rib(i,4)-y3)*dcos(rib(i,250)*pi/180.0)

       if (dabs(rib(i,250)).gt.0.01d0) then ! 0.000 in IF
       call line(x1,y1,x2,y2,2)
       call line(-x1,y1,-x2,y2,2)
       end if

       end do

c      5.1.3 Leading edge        
       call line(-rib(1,2),rib(1,3),rib(1,2),rib(1,3),1)
       do i=1,nribss-1
       call line(rib(i,2),rib(i,3),rib(i+1,2),rib(i+1,3),1)
       call line(-rib(i,2),rib(i,3),-rib(i+1,2),rib(i+1,3),1)
       end do
 
c      5.1.4 Trailing edge  
       call line(-rib(1,2),rib(1,4),rib(1,2),rib(1,4),3)
       do i=1,nribss-1
       call line(rib(i,2),rib(i,4),rib(i+1,2),rib(i+1,4),3)
       call line(-rib(i,2),rib(i,4),-rib(i+1,2),rib(i+1,4),3)
       end do

c      Vents

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      DRAW vents in CASES in 1-1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (k26d.eq.1) then

       do i=1,nribss

c      Vents: Line 1-2 in, Line 3-4 out
       pgx(1)=rib(i-1,2)
       pgy(1)=rib(i-1,3)+rib(i-1,5)*rib(i,11)/100.
       pgx(2)=rib(i,2)
       pgy(2)=rib(i,3)+rib(i,5)*rib(i,11)/100.
       pgx(3)=rib(i,2)
       pgy(3)=rib(i,3)+rib(i,5)*rib(i,12)/100.
       pgx(4)=rib(i-1,2)
       pgy(4)=rib(i-1,3)+rib(i-1,5)*rib(i,12)/100.

c      Draw especial vents CASE 0
       if (rib(i,165).eq.0.) then
       call line(pgx(3),pgy(3),pgx(4),pgy(4),6)
       call line(-pgx(3),pgy(3),-pgx(4),pgy(4),6)
       call line(pgx(1),pgy(1),pgx(2),pgy(2),6)
       call line(-pgx(1),pgy(1),-pgx(2),pgy(2),6)
       end if

c      Draw especial vents CASE 1
       if (rib(i,165).eq.1) then
       call line(pgx(3),pgy(3),pgx(4),pgy(4),6)
       call line(-pgx(3),pgy(3),-pgx(4),pgy(4),6)
       end if

c      Draw especial vents CASE 4
       if (rib(i,165).eq.4.) then
c      Line 5-6
       param1=csi(i,19)
       param2=csi(i,20)
       pgy(5)=pgy(1)+((pgy(4)-pgy(1)))*(1.-(param1/100.))
       pgy(6)=pgy(2)+((pgy(3)-pgy(2)))*(1.-(param2/100.))
       call line(pgx(1),pgy(5),pgx(2),pgy(6),6)
       call line(-pgx(1),pgy(5),-pgx(2),pgy(6),6)
c      Line 3-4
       call line(pgx(3),pgy(3),pgx(4),pgy(4),6)
       call line(-pgx(3),pgy(3),-pgx(4),pgy(4),6)
       end if

c      Draw especial vents CASE 5
       if (rib(i,165).eq.5.) then
c      Arc 5-6
       param1=csi(i,19)
       param2=csi(i,20)
c      Fletxa as % of vent
       param3=csi(i,18)*(pgy(4)-pgy(1)+pgy(3)-pgy(2))/200.
       pgy(5)=pgy(1)+((pgy(4)-pgy(1)))*(1.-(param1/100.))
       pgy(6)=pgy(2)+((pgy(3)-pgy(2)))*(1.-(param2/100.))
c      Arc 5-6
       call arcfle(pgx(1),pgy(5),pgx(2),pgy(6),param3,1,6)
       call arcfle(-pgx(1),pgy(5),-pgx(2),pgy(6),param3,1,6)
c      Line 3-4
       call line(pgx(3),pgy(3),pgx(4),pgy(4),6)
       call line(-pgx(3),pgy(3),-pgx(4),pgy(4),6)
       end if

c      Draw especial vents CASE 6
       if (rib(i,165).eq.6) then
       call line(pgx(3),pgy(3),pgx(4),pgy(4),6)
       call line(-pgx(3),pgy(3),-pgx(4),pgy(4),6)
       param1=csi(i,19)
       param2=csi(i,20)
       call elliquad(pgx,pgy,param1,param2)
       call elliquad(-pgx,pgy,param1,param2)
       end if

c      Draw especial vents CASE -1
       if (rib(i,165).eq.-1.) then
       call line(pgx(1),pgy(1),pgx(2),pgy(2),6)
       call line(-pgx(1),pgy(1),-pgx(2),pgy(2),6)
       end if

c      Draw especial vents CASE -2
       if (rib(i,165).eq.-2.) then
       call line(pgx(1),pgy(1),pgx(2),pgy(2),6)
       call line(-pgx(1),pgy(1),-pgx(2),pgy(2),6)
       call line(pgx(4),pgy(4),pgx(2),pgy(2),6)
       call line(-pgx(4),pgy(4),-pgx(2),pgy(2),6)
       end if

c      Draw especial vents CASE -3
       if (rib(i,165).eq.-3.) then
       call line(pgx(1),pgy(1),pgx(2),pgy(2),6)
       call line(-pgx(1),pgy(1),-pgx(2),pgy(2),6)
       call line(pgx(1),pgy(1),pgx(3),pgy(3),6)
       call line(-pgx(1),pgy(1),-pgx(3),pgy(3),6)
       end if

c      Draw especial vents CASE -4
       if (rib(i,165).eq.-4.) then
c      Line 5-6
       param1=csi(i,19)
       param2=csi(i,20)
       pgy(5)=pgy(1)+((pgy(4)-pgy(1)))*(1.-(param1/100.))
       pgy(6)=pgy(2)+((pgy(3)-pgy(2)))*(1.-(param2/100.))
       call line(pgx(1),pgy(5),pgx(2),pgy(6),6)
       call line(-pgx(1),pgy(5),-pgx(2),pgy(6),6)
c      Line 1-2
       call line(pgx(1),pgy(1),pgx(2),pgy(2),6)
       call line(-pgx(1),pgy(1),-pgx(2),pgy(2),6)
       end if

c      Draw especial vents CASE -5
       if (rib(i,165).eq.-5.) then
c      Arc 5-6
       param1=csi(i,19)
       param2=csi(i,20)
c      Fletxa as % of vent
       param3=csi(i,18)*(pgy(4)-pgy(1)+pgy(3)-pgy(2))/200.
       pgy(5)=pgy(1)+((pgy(4)-pgy(1)))*(1.-(param1/100.))
       pgy(6)=pgy(2)+((pgy(3)-pgy(2)))*(1.-(param2/100.))
c      Arc 5-6
       call arcfle(pgx(1),pgy(5),pgx(2),pgy(6),param3,-1,6)
       call arcfle(-pgx(1),pgy(5),-pgx(2),pgy(6),param3,-1,6)
c      Line 1-2
       call line(pgx(1),pgy(1),pgx(2),pgy(2),6)
       call line(-pgx(1),pgy(1),-pgx(2),pgy(2),6)
       end if

c      Draw especial vents CASE -6
       if (rib(i,165).eq.-6) then
       call line(pgx(1),pgy(1),pgx(2),pgy(2),6)
       call line(-pgx(1),pgy(1),-pgx(2),pgy(2),6)
       param1=csi(i,19)
       param2=csi(i,20)
       call elliquad(pgx,pgy,param1,param2)
       call elliquad(-pgx,pgy,param1,param2)
       end if

        end do

        end if ! k26d=1

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      5.1.6 Draw vents classic in 1-1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (k26d.eq.0) then

c      Intake in

       if (cencell.ge.0.01.and.rib(1,14).eq.1)  then  
       call line(-rib(1,2),rib(1,3)+rib(1,5)*rib(1,11)/100.,rib(1,2),
     + rib(1,3)+rib(1,5)*rib(1,11)/100.,6)
       end if

       do i=2,nribss
       if(rib(i,14).eq.1) then
       call line(rib(i-1,2),rib(i-1,3)+rib(i-1,5)*rib(1,11)/100.,
     + rib(i,2),rib(i,3)+rib(i,5)*rib(1,11)/100.,6)
       call line(-rib(i-1,2),rib(i-1,3)+rib(i-1,5)*rib(1,11)/100.,
     + -rib(i,2),rib(i,3)+rib(i,5)*rib(1,11)/100.,6)
       end if

       if(rib(i,14).eq.0) then
       call line(rib(i-1,2),rib(i-1,3)+rib(i-1,5)*rib(1,11)/100.,
     + rib(i,2),rib(i,3)+rib(i,5)*rib(1,11)/100.,9)
       call line(-rib(i-1,2),rib(i-1,3)+rib(i-1,5)*rib(1,11)/100.,
     + -rib(i,2),rib(i,3)+rib(i,5)*rib(1,11)/100.,9)
       end if          

       end do

c      Central cell
       i=1
       if(rib(i,14).eq.0) then
       call line(-rib(i,2),rib(i,3)+rib(i,5)*rib(1,11)/100.,
     + rib(i,2),rib(i,3)+rib(i,5)*rib(1,11)/100.,9)
       end if      
        
c      Intake out

       if (cencell.ge.0.01.and.rib(1,14).eq.1)  then  
       call line(-rib(1,2),rib(1,3)+rib(1,5)*rib(1,12)/100.,rib(1,2),
     + rib(1,3)+rib(1,5)*rib(1,12)/100.,6)
       end if

       do i=2,nribss
       if(rib(i,14).eq.1) then
       call line(rib(i-1,2),rib(i-1,3)+rib(i-1,5)*rib(1,12)/100.,
     + rib(i,2),rib(i,3)+rib(i,5)*rib(1,12)/100.,6)
       call line(-rib(i-1,2),rib(i-1,3)+rib(i-1,5)*rib(1,12)/100.,
     + -rib(i,2),rib(i,3)+rib(i,5)*rib(1,12)/100.,6)
       end if
       end do

       end if ! k26d=0


c      5.1.7 Anchor points

       xpoi=3. ! segment

       do i=1,nribss

       do k=1,int(rib(i,15))

       call line(rib(i,2)-xpoi,rib(i,3)+rib(i,5)*rib(i,15+k)/100.,
     + rib(i,2)+xpoi,rib(i,3)+rib(i,5)*rib(i,15+k)/100.,1)

       call line(xpoi-rib(i,2),rib(i,3)+rib(i,5)*rib(i,15+k)/100.,
     + -rib(i,2)-xpoi,rib(i,3)+rib(i,5)*rib(i,15+k)/100.,1)
       
       end do
       end do

c      5.1.8 Brakes in 2D included fractionary points

       do k=1,cam(ii)     ! cam in brake lines

       i=int(brake(k,3))  ! rib

       if (rib(i,21).ne.0.) then

       xr=rib(i,2)
       xs=rib(i,3)+rib(i,5)*rib(i,21)/100.

       brake(k,1)=float(int(brake(k,3)))
       brake(k,2)=brake(k,3)-brake(k,1)

       if (i.lt.nribss.and.brake(k,2).ne.0.) then
       xrm=rib(i+1,2)
       xsm=rib(i+1,3)+rib(i+1,5)*rib(i+0,21)/100.0d0 ! i+0 ok
       xr=xr+brake(k,2)*(xrm-xr)
       xs=xs+brake(k,2)*(xsm-xs)
       end if

       call ellipse(xr,xs,1.5d0*xcir,1.5d0*xcir,0.0d0,1)
       call ellipse(-xr,xs,1.5d0*xcir,1.5d0*xcir,0.0d0,1)

       end if

       end do

c      5.1.8+ Restitute virtual anchor for 3D if rib i+1 not defined
c      Not strictly necessary
       do k=1,cam(ii)
       i=int(brake(k,3)) 
       if (i.lt.nribss.and.rib(i+1,21).eq.0.and.brake(k,2).ne.0) then
       rib(i+1,21)=100.  ! only 100% case, or specify value
       end if   
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      5.1.9 Extrados colors
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Case 1
       if (npce.ge.1) then
       xpoi=2. ! segment
       do k=1,npce
       i=npc1e(k)
       do l=1,npc2e(k)
       ydist=100.-xpc1e(k,l)
       call line(rib(i,2)-xpoi,rib(i,3)+rib(i,5)*ydist/100.,
     + rib(i,2)+xpoi,rib(i,3)+rib(i,5)*ydist/100.,4)
       end do
       end do
       end if

c      Case -2
       if (npce.eq.-2) then
       do k=1,npace ! for each panel
       il=npac1e(k)-1
       ir=npac1e(k)
       do l=1,npac2e(k) ! for each cut
       ydistl=100.-xpac1e(k,l)
       ydistr=100.-xpac2e(k,l)
       if (il.ne.0) then
       call line(rib(il,2),rib(il,3)+rib(il,5)*ydistl/100.,
     + rib(ir,2),rib(ir,3)+rib(ir,5)*ydistr/100.,4)
       end if
       if (il.eq.0) then ! solve central panel
       call line(rib(il,2)*0.0,rib(il,3)+rib(il,5)*ydistl/100.,
     + rib(ir,2),rib(ir,3)+rib(ir,5)*ydistr/100.,4)
       end if
       end do
       end do
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      5.1.10 Intrados colors
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (atp.ne."ss") then

c      Case 1
       if (npci.ge.1) then
       xpoi=2. ! segment
       do k=1,npci
       i=npc1i(k)
       do l=1,npc2i(k)
       ydist=100.-xpc1i(k,l)
       call line(-rib(i,2)-xpoi,rib(i,3)+rib(i,5)*ydist/100.,
     + -rib(i,2)+xpoi,rib(i,3)+rib(i,5)*ydist/100.,30)
       end do
       end do
       end if

c      Case -2
       if (npci.eq.-2) then
       do k=1,npaci ! for each panel
       il=npac1i(k)-1
       ir=npac1i(k)
       do l=1,npac2i(k) ! for each cut
       ydistl=100.-xpac1i(k,l)
       ydistr=100.-xpac2i(k,l)
       if (il.ne.0) then
       call line(-rib(il,2),rib(il,3)+rib(il,5)*ydistl/100.,
     + -rib(ir,2),rib(ir,3)+rib(ir,5)*ydistr/100.,30)
       end if
       if (il.eq.0) then ! solve central panel
       call line(-rib(il,2)*0.0,rib(il,3)+rib(il,5)*ydistl/100.,
     + -rib(ir,2),rib(ir,3)+rib(ir,5)*ydistr/100.,30)
       end if
       end do
       end do
       end if

       end if

c      5.1.11 Miniribs and unloaded middle ribs

       rib(0,2)=-rib(1,2)
       rib(0,3)=rib(1,3)
       rib(0,4)=rib(1,4)

       do i=1,nribss

c      Draw only if minirib present
       if (rib(i,56).gt.1) then

       xru(1)=0.5*(rib(i,2)+rib(i-1,2))
       xrv(1)=0.5*(rib(i,3)+rib(i-1,3))
       xru(2)=0.5*(rib(i,2)+rib(i-1,2))
       xrv(2)=0.5*(rib(i,4)+rib(i-1,4))
       xrv(1)=xrv(2)-0.5*(rib(i,5)+rib(i-1,5))*rib(i,56)/100.

       call line(xru(1),xrv(1),xru(2),xrv(2),8)
       call line(-xru(1),xrv(1),-xru(2),xrv(2),8)
       
       end if

       end do

c      5.1.12 Draw special wingtips 

c      Draw wintip type 2 (parabolic)
c      Generic parabola y=xk*x**xn
       if (k27d.eq.2) then
       x0=rib(nribss,5)*sectx(27,3)*0.01
       dist=x0
       y0=0.0d0
       x1=x0+rib(nribss,3)-rib(nribss-1,3)
       y1=rib(nribss,2)-rib(nribss-1,2)
       if (sectx(27,4).eq.0.0) then
       xn=y1*x1/((x1-x0)*y1)
       else
       xn=x1*dtan(sectx(27,4)*pi/180.)/y1
       end if
       xk=y1/(x1**xn)
c      Compute parabola in 60 points
       do k=1,60
       xinc=x1/dfloat(59)
       xpunt(k)=xinc*dfloat(k-1)
       ypunt(k)=xk*xpunt(k)**xn
       end do
c      Set parabola in place and draw
       n=60
       x0=rib(nribss,2)
       y0=-(dist+rib(nribss,3))
       angle=90.
       do k=1,60
       xloc(k)=xpunt(k)
       yloc(k)=ypunt(k)
       end do
       call loc2glo2D(n,xloc,yloc,xglo,yglo,x0,y0,angle)
       do k=1,59
       call line(xglo(k),-yglo(k),xglo(k+1),-yglo(k+1),30)
       call line(-xglo(k),-yglo(k),-xglo(k+1),-yglo(k+1),30)
       end do
c      Define complete base line
       do k=1,60
       
       end do
       end if


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      5.2 Canopy design - vault
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Box (1,1)

       x0=0.
       y0=380.*xkf

       call line(-rib(1,6),y0+rib(1,7),rib(1,6),y0+rib(1,7),5)
       do i=1,nribss-1
       call line(rib(i,6),y0+rib(i,7),rib(i+1,6),y0+rib(i+1,7),5)
       call line(-rib(i,6),y0+rib(i,7),-rib(i+1,6),y0+rib(i+1,7),5)
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      5.3 Boxes
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Matrix 6x4

       do asep=0.,7.,1.
       do bsep=0.,3.,1.

       x1=-630.*xkf+asep*1260.*xkf
       x2=630.*xkf+asep*1260.*xkf
       y1=-50.*xkf+bsep*890.95*xkf
       y2=840.95*xkf+bsep*890.95*xkf

       call line(x1,y1,x2,y1,9)
       call line(x1,y1,x1,y2,9)
       call line(x2,y1,x2,y2,9)
       call line(x1,y2,x2,y2,9)
       
       end do
       end do

c      Additional boxes for 3D-shaping

       if (n1draw.eq.1) then

       if (k29d.ne.0) then

       do asep=2.,4.,1.
       do bsep=-1.,-2.,-1.

       x1=-630.*xkf+asep*1260.*xkf
       x2=630.*xkf+asep*1260.*xkf
       y1=-50.*xkf+bsep*890.95*xkf
       y2=840.95*xkf+bsep*890.95*xkf

       if (asep.ne.3.) then
       call line(x1,y1,x2,y1,9)
       call line(x1,y1,x1,y2,9)
       call line(x2,y1,x2,y2,9)
       call line(x1,y2,x2,y2,9)
       end if
       
       end do
       end do

       end if
       end if ! n1draw

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6. AIRFOILS coordinates calculus
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Read airfoils
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=1,nribss

c      rewind 23
       open (24, file=nomair(i))
       rewind (24)

       k=len_trim(nomair(i))
       nomairext(i)=nomair(i)(k-2:k)

c       write (*,*) i,nomair(i),k,nomairext(i),"OK"

c      Case .txt airfoil

       if (nomairext(i).eq."txt") then

c      6.1 Read global points
       read (24,*) 
       read (24,*) np(i,1) ! total points
       read (24,*) np(i,2) ! extrados points
       read (24,*) np(i,3) ! intake points
       read (24,*) np(i,4) ! intrados points

       np(i,5)=np(i,2)+np(i,3)-1
       
c      Rib 0 points
       np(0,1)=np(1,1)
       np(0,2)=np(1,2)
       np(0,3)=np(1,3)
       np(0,4)=np(1,4)
       np(0,5)=np(1,5)

c      Rib nribss+1 points
       np(nribss+1,1)=np(nribss-1,1)
       np(nribss+1,2)=np(nribss-1,2)
       np(nribss+1,3)=np(nribss-1,3)
       np(nribss+1,4)=np(nribss-1,4)
       np(nribss+1,5)=np(nribss-1,5)

c      6.2 Read airfoil coordinates
       do j=1,np(i,1)
       read (24,*) u(i,j,1),v(i,j,1)
       v(i,j,1)=v(i,j,1)*rib(i,160)
       end do

       end if ! case .txt

c      Case .dat airfoil

       if (nomairext(i).eq."dat") then
c      Go to reformat airfoil (u,v) and np
       call datair(i,rib,np,u,v)

       end if

       end do ! i

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Detect cut points if defined by points (case 1)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Do nothing

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Detect cut points if defined by % along contour from TE (case 2)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (k29dd.eq.2) then

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Detect cut points if defined by % (case 3)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c       if (k29dd.eq.3) then

       do i=1,nribss
       ng=rib(i,169)
       do j=1,np(i,1)-1

c       write (*,*) xiupp(1,2,ng),u(i,j,1)
c       if (u(i,j,1).lt.xiupp(1,2,ng).and.u(i,j+1,1).ge.xiupp(1,2,ng)) then
       iupp(1,2,ng)=j
c       end if
c       if (u(i,j,1).gt.xiupp(1,3,ng).and.u(i,j+1,1).ge.xiupp(1,3,ng)) then
c       iupp(1,3,ng)=j
c       end if
c       if (u(i,j,1).gt.xiupp(2,2,ng).and.u(i,j+1,1).ge.xiupp(2,2,ng)) then
c       iupp(2,2,ng)=j
c       end if
c       if (u(i,j,1).gt.xiupp(2,3,ng).and.u(i,j+1,1).ge.xiupp(2,3,ng)) then
c       iupp(2,3,ng)=j
c       end if
c      Think intrados/extrdos cases

c       if (u(i,j,1).lt.xilow(1,2,ng).and.u(i,j+1,1).ge.xilow(1,2,ng)) then
c       ilow(1,2,ng)=j
c       end if
c       if (u(i,j,1).lt.xilow(1,3,ng).and.u(i,j+1,1).ge.xilow(1,3,ng)) then
c       ilow(1,3,ng)=j
c       end if

       end do
       end do

c       end if ! k29dd=3


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Airfoil coordinates modifications
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=1,nribss+1

       tetha=rib(i,8)*pi/180.0d0
       rot_z=rib(i,250)*pi/180.0d0
       pos=rib(i,5)*rib(i,251)/100.0d0

       do j=1,np(i,1)

c      6.3 Airfoil coordinates *100
       u(i,j,2)=100.*u(i,j,1)
       v(i,j,2)=100.*v(i,j,1)

c      6.4 Airfoil escaled and displaced coordinates
       u(i,j,3)=rib(i,5)*u(i,j,1)
       v(i,j,3)=rib(i,5)*v(i,j,1)-rib(i,50)

c      6.5 Airfoil washin coordinates, rotation in X-axis
       u(i,j,4)=(u(i,j,3)-(rib(i,10)/100.)*rib(i,5))*dcos(tetha)+
     + (v(i,j,3))*dsin(tetha)+(rib(i,10)/100.)*rib(i,5)
       v(i,j,4)=(-u(i,j,3)+(rib(i,10)/100.)*rib(i,5))*dsin(tetha)+
     + (v(i,j,3))*dcos(tetha)

c      6.5+ Airfoil rotation in Z by pos

       wnew(j)=-u(i,j,4)*dsin(rot_z)+pos*dsin(rot_z)
       unew(j)=u(i,j,4)*dcos(rot_z)+pos*(1-dcos(rot_z))
       vnew(j)=v(i,j,4)

       u(i,j,4)=unew(j)
       v(i,j,4)=vnew(j)
       w(i,j,4)=wnew(j)

c      6.6 Airfoil (u,v,w) espace coordinates
c       u(i,j,5)=u(i,j,4)
c       v(i,j,5)=v(i,j,4)*dcos(rib(i,9)*pi/180.)
c       w(i,j,5)=-v(i,j,4)*dsin(rib(i,9)*pi/180.)

c      6.6 Airfoils rotation in Y-axis
       w(i,j,5)=-w(i,j,4)*dcos(rib(i,9)*pi/180.)-
     + v(i,j,4)*dsin(rib(i,9)*pi/180.)
       u(i,j,5)=u(i,j,4)
       v(i,j,5)=-w(i,j,4)*dsin(rib(i,9)*pi/180.)+
     + v(i,j,4)*dcos(rib(i,9)*pi/180.)

c      6.7 Airfoil (x,y,z) absolute coordinates
       x(i,j)=rib(i,6)-w(i,j,5)
       y(i,j)=rib(i,3)+u(i,j,5)
       z(i,j)=rib(i,7)-v(i,j,5)

       u_aux(i,j,9)=y(i,j)
       v_aux(i,j,9)=z(i,j)
       w_aux(i,j,9)=x(i,j)

c      6.8 Tornar a posar la costella al seu lloc
       v(i,j,3)=v(i,j,3)+rib(i,50)

c      6.5,6.6,6.7 Call to subroutine xyzt
c       u_aux(i,j,1)=u(i,j,3)
c       v_aux(i,j,1)=v(i,j,3)-rib(i,50)
c       w_aux(i,j,1)=0.0d0
c       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
c       x(i,j)=w_aux(i,j,5)
c       y(i,j)=u_aux(i,j,5)
c       z(i,j)=v_aux(i,j,5)

c      6.8 Tornar a posar la costella al seu lloc
c      WARNING! Aixň no ho veig clar
c      Fer experiment per a verificar. És necessari?
c       v(i,j,3)=v(i,j,3)+rib(i,50)

c      Calcule nose point np(i,6) with coordinates (0,0)
       if(dabs(u(i,j,2)).lt.0.000001d0.and.dabs(v(i,j,2)).lt.
     + 0.000001d0) then
       np(i,6)=j
       np(0,6)=np(1,6)
       end if

       end do ! j

c      Additional point in airfoil plane (use in 10.1+)
       j=1
       u_aux(i,j,1)=(u(i,1,3)+u(i,np(i,6),3))*0.5d0
       v_aux(i,j,1)=50.0d0
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       x_apap(i)=w_aux(i,j,5)
       y_apap(i)=u_aux(i,j,5)
       z_apap(i)=v_aux(i,j,5)

       end do ! i

c      6.9 Airfoil 0 = 1' (symetrical to airfoil 1) BUT NON DISPLACED COORD

       do j=1,np(1,1)

       u(0,j,1)=u(1,j,1)
c      v(0,j,1)=u(1,j,1) ERROR
       v(0,j,1)=v(1,j,1)

c      Airfoil coordinates *100
       u(0,j,2)=u(1,j,2)
       v(0,j,2)=v(1,j,2)

c      Airfoil escaled coordinates
       u(0,j,3)=u(1,j,3)
       v(0,j,3)=v(1,j,3)

c      Airfoil washin coordinates
       u(0,j,4)=u(1,j,4)
       v(0,j,4)=v(1,j,4)

c      Airfoil (u,v,w) espace coordinates
       u(0,j,5)=-u(1,j,5)
       v(0,j,5)=v(1,j,5)
       w(0,j,5)=w(1,j,5)

c      Airfoil (x,y,z) absolute coordinates
       x(0,j)=-x(1,j)
       y(0,j)=y(1,j)
       z(0,j)=z(1,j)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Tornar a posar la costella al seu lloc
c      WARNING WARNIG
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c       v(0,j,3)=u(1,j,3)+rib(1,50)  ERROR
       v(0,j,3)=v(1,j,3)

       end do

c      6.10 Assignation 3D coordinates airfoil 0:

       i=1 ! WARNIING
       do j=1,np(1,1)
       xx(i,j)=-rib(i,6)+w(1,j,5)
       yy(i,j)=rib(i,3)+u(1,j,5)
       zz(i,j)=rib(i,7)-v(1,j,5)
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.10+ Compute TE-anchor lengths along airfoil contour
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=0,nribss

       do klz=1,rib(i,15) ! Iterate in A,B,C,D,E

       do j=np(i,1),2,-1

c      Detect segment j-1,j where anchor A,B,C,D,E is and interpolate
c      point u,v = rib(i,110+klz) rib(i,120+klz)

       if (u(i,j-1,3).le.rib(i,65+klz).and.u(i,j,3).gt.rib(i,65+klz).
     + and.u(i,j,3).ge.0) then

c      Interpolation v=xm * u + xb
       rib(i,110+klz)=rib(i,65+klz)
       xm=(v(i,j,3)-v(i,j-1,3))/(u(i,j,3)-u(i,j-1,3))
       xb=v(i,j-1,3)-xm*u(i,j-1,3)
       rib(i,120+klz)=xm*rib(i,110+klz)+xb

c      Compute distances along bottom surface

       rib(i,130+klz)=0.
       do jj=np(i,1),j+1,-1
       rib(i,130+klz)=rib(i,130+klz)+sqrt((u(i,jj,3)-u(i,jj-1,3))**2+
     + (v(i,jj,3)-v(i,jj-1,3))**2)
       end do
       rib(i,130+klz)=rib(i,130+klz)+sqrt((u(i,j,3)-rib(i,110+klz))**2+
     + (v(i,j,3)-rib(i,120+klz))**2)

c      Verificar amb CAD!!!

       end if

       end do ! j

c       write (*,*) i,klz,rib(i,131)

       end do ! klz

       end do ! rib i

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.11 Compute external cutt edges in airfoils (i,j,16)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      REVISAR LA PREOGRAMACIO. SIMPLIFICAR

       xcos=xrib/10. ! rib sewing allowance mm to cm

       do i=0,nribss
      
       do j=2,np(i,1)-1

c      Amplification factor
       xcosk=1.0

c      Fer mitja entre j-1 i j+1
       alpha1=(datan((v(i,j+1,3)-v(i,j,3))/((u(i,j+1,3)-u(i,j,3)))))
       alpha2=(datan((v(i,j,3)-v(i,j-1,3))/((u(i,j,3)-u(i,j-1,3)))))

       alpha=0.5*(alpha1+alpha2)

c      Alpha correction in sawtooht mono-surface airfoils
c      Dóna la volta a la vora superior

       if (alpha1.lt.0.and.alpha2.gt.0.and.j.ge.np(i,2)) then
c       alpha=alpha+pi
c       write (*,*) "correccio"
       end if     

       if (i.eq.1) then
c       write (*,*) "AQUI ",i,j,alpha1,alpha2,alpha
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Correcció xcosk a vores dent de serra
       if (atp.eq."ss".and.j.ge.np(i,2)+np(i,3)-1) then
       xcosk=1./(dsin(0.5*(pi+alpha1-alpha2))) 
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       u(i,j,16)=u(i,j,3)-xcos*xcosk*dsin(alpha)

       if(v(i,j,3).ge.0.) then
       v(i,j,16)=v(i,j,3)+xcos*xcosk*dcos(alpha)
       end if

       if(v(i,j,3).ge.0.and.j.ge.np(i,2)) then
       u(i,j,16)=u(i,j,3)+xcos*xcosk*dsin(alpha)
       v(i,j,16)=v(i,j,3)-xcos*xcosk*dcos(alpha)
       end if

       if(v(i,j,3).lt.0.) then
       u(i,j,16)=u(i,j,3)+xcos*xcosk*dsin(alpha)
       v(i,j,16)=v(i,j,3)-xcos*xcosk*dcos(alpha)
       end if

       if(u(i,j,3).eq.0) then
       u(i,j,16)=u(i,j,3)-xcos*xcosk
       v(i,j,16)=v(i,j,3)
       end if

       end do

       j=1

       alpha=(datan((v(i,j+1,3)-v(i,j,3))/((u(i,j+1,3)-u(i,j,3)))))

       u(i,j,16)=u(i,j,3)-xcos*xcosk*dsin(alpha)

       if(v(i,j,3).ge.0.) then
       v(i,j,16)=v(i,j,3)+xcos*xcosk*dcos(alpha)
       end if

       if(v(i,j,3).lt.0.) then
       u(i,j,16)=u(i,j,3)+xcos*xcosk*dsin(alpha)
       v(i,j,16)=v(i,j,3)-xcos*xcosk*dcos(alpha)

       end if

       j=np(i,1)

       alpha=(datan((v(i,j,3)-v(i,j-1,3))/((u(i,j,3)-u(i,j-1,3)))))

       u(i,j,16)=u(i,j,3)-xcos*xcosk*dsin(alpha)

       if(v(i,j,3).ge.0.) then
       v(i,j,16)=v(i,j,3)+xcos*xcosk*dcos(alpha)
       end if

       if(v(i,j,3).le.0.) then
       u(i,j,16)=u(i,j,3)+xcos*xcosk*dsin(alpha)
       v(i,j,16)=v(i,j,3)-xcos*xcosk*dcos(alpha)
       end if

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.11+ Airfoils thickness
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Aproximate calculus (not inperpolated)
c      Special airfoils not considered
c      Please improve

       do i=0,nribss

c      Extrados thickness
       do j=1,np(i,1)-1
       if (v(i,j+1,3).ge.v(i,j,3).and.u(i,j+1,3).lt.u(i,j,3)) then
       xth1=v(i,j+1,3)
       end if
c      Intrados thickness
       if (v(i,j+1,3).le.v(i,j,3).and.u(i,j+1,3).gt.u(i,j,3)) then
       xth2=v(i,j+1,3)
       end if
       end do
c      Airfoil thickness
       rib(i,148)=xth1-xth2
       rib(i,149)=100.*rib(i,148)/rib(i,5)

c      write (*,*) "Thicknees= ", i, rib(i,148), rib(i,149)

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.12 Airfoils drawing (complete)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Note: In section 8.5.0.0 we draw ovalized 2D airfoils
              
c      Box (1,2)
       
       sepxx=700.*xkf
       sepyy=100.*xkf
c      sepyy=100

       kx=0
       ky=0
       kyy=0

       do i=1,nribss

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*1.0*float(ky)


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Numering ribs
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       call itxt(sepx+19.-84.*(typm3(9)/7.),sepy,typm3(9),0.0d0,i,7)
       call itxt(sepx+19.-84.*(typm3(9)/7.),sepy+890.95*xkf,typm3(9),
     + 0.0d0,i,7)
       call itxt(sepx-16.-84.*(typm3(9)/7.)+2530.*xkf,sepy,typm3(9),
     + 0.0d0,i,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.12.0 Miniribs
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Upper surface minirib
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (rib(i,56).gt.1.and.rib(i,56).ne.100.and.atp.ne."ss") 
     + then

       rib(i,60)=0. ! Extrados minirib length

c      Detect point extrados
       do j=1,np(i,2)-1
       xminirib=rib(i-1,5)*rib(i,56)/100.       
       if (u(i-1,1,3)-u(i-1,j,3).lt.xminirib.and.u(i-1,1,3)-u(i-1,j+1,3)
     + .ge.xminirib) then
       jcontrole=j
       jcve(i)=j ! control vector extrados

       rib(i,107)=xminirib-(u(i-1,1,3)-u(i-1,j,3))
       xequise=u(i-1,j,3)-rib(i,107)
       yequise=v(i-1,j,3)-rib(i,107)*(v(i-1,j,3)-v(i-1,j+1,3))/
     + (u(i-1,j,3)-u(i-1,j+1,3))
       end if
       end do

c      Draw extrados minirib, Print and MC
       do j=1,jcontrole-1
       call line(sepx+u(i-1,j,3),-v(i-1,j,3)+sepy-sepriy*0.5,
     + sepx+u(i-1,j+1,3),-v(i-1,j+1,3)+sepy-sepriy*0.5,1)

       call line(sepx+u(i-1,j,16),-v(i-1,j,16)+sepy-sepriy*0.5,
     + sepx+u(i-1,j+1,16),-v(i-1,j+1,16)+sepy-sepriy*0.5,3)
       call line(2530.*xkf+sepx+u(i-1,j,16),-v(i-1,j,16)+sepy-sepriy*0.5
     + ,2530.*xkf+sepx+u(i-1,j+1,16),-v(i-1,j+1,16)+sepy-sepriy*0.5,1)

       call line(sepx+u(i-1,j,16),-v(i-1,j,16)+sepy-sepriy*0.5,
     + sepx+u(i-1,j,3),-v(i-1,j,3)+sepy-sepriy*0.5,5)

       rib(i,60)=rib(i,60)+sqrt((u(i-1,j,3)-u(i-1,j+1,3))**2.+
     + (v(i-1,j,3)-v(i-1,j+1,3))**2.)
       end do

       j=1
       call line(2530.*xkf+sepx+u(i-1,j,16),-v(i-1,j,16)+sepy-sepriy*0.5
     + ,2530.*xkf+sepx+u(i-1,j,3),-v(i-1,j,3)+sepy-sepriy*0.5,1)

c      Draw romano and itxt mark in minirib

       x1=2530.*xkf+sepx+u(i-1,j,3)
       y1=-v(i-1,j,3)+sepy-sepriy*0.5
c       call romano(i,x1-rib(i,60)*0.35,y1,0.0d0,1.0d0,7)
       x1=sepx+u(i-1,j,3)
       y1=-v(i-1,j,3)+sepy-sepriy*0.5
       call itxt(x1-rib(i,60)*0.35-30.,y1+1.,3.0d0,0.0d0,i,7)

c      Last segment
       j=jcontrole
       call line(sepx+u(i-1,j,3),-v(i-1,j,3)+sepy-sepriy*0.5,
     + sepx+xequise,-yequise+sepy-sepriy*0.5,1)
       alpha=datan(-(v(i-1,j,3)-v(i-1,j+1,3))/(u(i-1,j,3)-u(i-1,j+1,3)))
       xequisee=xequise+xrib*0.1*dsin(alpha)
       yequisee=yequise+xrib*0.1*dcos(alpha)

       call line(sepx+u(i-1,j,16),-v(i-1,j,16)+sepy-sepriy*0.5,
     + sepx+xequisee,-yequisee+sepy-sepriy*0.5,3)
       call line(2530.*xkf+sepx+u(i-1,j,16),-v(i-1,j,16)+sepy-sepriy*
     + 0.5,2530.*xkf+sepx+xequisee,-yequisee+sepy-sepriy*0.5,1)

       call line(sepx+xequisee,-yequisee+sepy-sepriy*0.5,
     + sepx+xequise,-yequise+sepy-sepriy*0.5,5)
       call line(2530.*xkf+sepx+xequisee,-yequisee+sepy-sepriy*0.5,
     + 2530.*xkf+sepx+xequise,-yequise+sepy-sepriy*0.5,1)

       rib(i,60)=rib(i,60)+sqrt((u(i-1,j,3)-xequisee)**2.+
     + (v(i-1,j,3)-yequisee)**2.)

       end if ! upper surface

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Bottom surface minirib
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (rib(i,56).gt.1.and.rib(i,56).ne.100.and.atp.ne."ss") 
     + then

       rib(i,61)=0. ! Intrados minirib length

c      Detect point intrados
       do j=np(i,1),np(i,2),-1
       xminirib=rib(i-1,5)*rib(i,56)/100.       
       if (u(i-1,1,3)-u(i-1,j,3).lt.xminirib.and.u(i-1,1,3)-u(i-1,j-1,3)
     + .ge.xminirib) then
       jcontroli=j
       jcvi(i)=j ! control vector intrados

       rib(i,107)=xminirib-(u(i-1,1,3)-u(i-1,j,3))
       xequisi=u(i-1,j,3)-rib(i,107)
       yequisi=v(i-1,j,3)-rib(i,107)*(v(i-1,j,3)-v(i-1,j-1,3))/
     + (u(i-1,j,3)-u(i-1,j-1,3))
       end if
       end do

c      Draw intrados minirib, Print and MC
       do J=np(i,1),jcontroli+1,-1
       call line(sepx+u(i-1,j,3),-v(i-1,j,3)+sepy-sepriy*0.5,
     + sepx+u(i-1,j-1,3),-v(i-1,j-1,3)+sepy-sepriy*0.5,1)

       call line(sepx+u(i-1,j,16),-v(i-1,j,16)+sepy-sepriy*0.5,
     + sepx+u(i-1,j-1,16),-v(i-1,j-1,16)+sepy-sepriy*0.5,3) 
       call line(2530.*xkf+sepx+u(i-1,j,16),-v(i-1,j,16)+sepy-sepriy*0.5
     + ,2530.*xkf+sepx+u(i-1,j-1,16),-v(i-1,j-1,16)+sepy-sepriy*0.5,1) 

       call line(sepx+u(i-1,j,16),-v(i-1,j,16)+sepy-sepriy*0.5,
     + sepx+u(i-1,j,3),-v(i-1,j,3)+sepy-sepriy*0.5,5)

       rib(i,61)=rib(i,61)+sqrt((u(i-1,j,3)-u(i-1,j-1,3))**2.+
     + (v(i-1,j,3)-v(i-1,j-1,3))**2.)

       end do

       j=np(i,1)
       call line(2530.*xkf+sepx+u(i-1,j,16),-v(i-1,j,16)+sepy-sepriy*0.5
     + ,2530.*xkf+sepx+u(i-1,j,3),-v(i-1,j,3)+sepy-sepriy*0.5,1)

c      Last segment
       j=jcontroli
       call line(sepx+u(i-1,j,3),-v(i-1,j,3)+sepy-sepriy*0.5,
     + sepx+xequisi,-yequisi+sepy-sepriy*0.5,1)
       alpha=datan((v(i-1,j,3)-v(i-1,j-1,3))/(u(i-1,j,3)-u(i-1,j-1,3)))
       xequisie=xequisi+xrib*0.1*dsin(alpha)
       yequisie=yequisi-xrib*0.1*dcos(alpha)

       call line(sepx+u(i-1,j,16),-v(i-1,j,16)+sepy-sepriy*0.5,
     + sepx+xequisie,-yequisie+sepy-sepriy*0.5,3)
       call line(2530.*xkf+sepx+u(i-1,j,16),-v(i-1,j,16)+sepy-sepriy*0.5
     + ,2530.*xkf+sepx+xequisie,-yequisie+sepy-sepriy*0.5,1)

       call line(sepx+xequisie,-yequisie+sepy-sepriy*0.5,
     + sepx+xequisi,-yequisi+sepy-sepriy*0.5,5)
       call line(2530.*xkf+sepx+xequisie,-yequisie+sepy-sepriy*0.5,
     + 2530.*xkf+sepx+xequisi,-yequisi+sepy-sepriy*0.5,1)

       rib(i,61)=rib(i,61)+sqrt((u(i-1,j,3)-xequisie)**2.+
     + (v(i-1,j,3)-yequisie)**2.)

c      Draw segment minirib
       call line(sepx+xequise,-yequise+sepy-sepriy*0.5,
     + sepx+xequisi,-yequisi+sepy-sepriy*0.5,1)
       call line(2530.*xkf+sepx+xequise,-yequise+sepy-sepriy*0.5,
     + 2530.*xkf+sepx+xequisi,-yequisi+sepy-sepriy*0.5,1)

c      Draw control romano point

       x1=2530.*xkf+sepx+0.5*(xequisi+xequise)
       y1=sepy-sepriy*0.5-0.5*(yequisi+yequise)
       call romano(i,x1+1.,y1+2.,0.0d0,typm6(9)*0.1,7)

       end if ! bottom surface

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.12.1 Airfoil extrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

        do j=1,np(i,2)-1

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Dibuixa airfoils basic contour
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       call line(sepx+u(i,j,3),-v(i,j,3)+sepy,sepx+u(i,j+1,3),
     + -v(i,j+1,3)+sepy,1)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Dibuixa airfoils washin basic contour al seu lloc
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       call line(sepx+u(i,j,4),-v(i,j,4)+sepy+xkf*890.95-rib(i,50),
     + sepx+u(i,j+1,4),-v(i,j+1,4)+sepy+xkf*890.95-rib(i,50),3)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Airfoils borders
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       call line(sepx+u(i,j,16),-v(i,j,16)+sepy,sepx+u(i,j+1,16),
     + -v(i,j+1,16)+sepy,3)

       call line(sepx+u(i,j,16),-v(i,j,16)+sepy,sepx+u(i,j,3),
     + -v(i,j,3)+sepy,5)

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.12.2 Air inlets
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case "pc"
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (atp.eq."pc") then

       j=np(i,2)
       k=np(i,2)+np(i,3)-1

c      Basic contour using straight line
       call line(sepx+u(i,j,3),-v(i,j,3)+sepy,sepx+u(i,k,3),
     + -v(i,k,3)+sepy,1)

c      Washin basic contour using straight line
       call line(sepx+u(i,j,4),-v(i,j,4)+sepy+xkf*890.85-rib(i,50),
     + sepx+u(i,k,4),-v(i,k,4)+sepy+xkf*890.85-rib(i,50),3)
 
c      Airfoil borders
       
       xdv=v(i,j,3)-v(i,k,3)
       xdu=u(i,k,3)-u(i,j,3)
       alpha=datan(xdv/xdu)
       if (xdv.eq.0) then
       alpha=0.
       end if

       u(i,j+2,16)=u(i,j,3)-xrib*0.1*dsin(alpha)
       v(i,j+2,16)=v(i,j,3)-xrib*0.1*dcos(alpha)
       u(i,k-2,16)=u(i,k,3)-xrib*0.1*dsin(alpha)
       v(i,k-2,16)=v(i,k,3)-xrib*0.1*dcos(alpha)

       if (rib(i,149).ne.0.) then
       call line(sepx+u(i,j+2,16),-v(i,j+2,16)+sepy,sepx+u(i,k-2,16),
     + -v(i,k-2,16)+sepy,3)
       end if

c      Two lines intersection

c      up nose
       
       xru(1)=u(i,j,16)
       xru(2)=u(i,j-1,16)
       xrv(1)=v(i,j,16)
       xrv(2)=v(i,j-1,16)
       xsu(1)=u(i,j+2,16)
       xsu(2)=u(i,k-2,16)
       xsv(1)=v(i,j+2,16)
       xsv(2)=v(i,k-2,16)

       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       u(i,j+1,16)=xtu
       v(i,j+1,16)=xtv

       if (rib(i,149).ne.0.) then
       call line(sepx+u(i,j+1,16),-v(i,j+1,16)+sepy,sepx+u(i,j,16),
     + -v(i,j,16)+sepy,3)
       call line(sepx+u(i,j+1,16),-v(i,j+1,16)+sepy,sepx+u(i,j+2,16),
     + -v(i,j+2,16)+sepy,3)
       end if

c      bottom nose
       
       xru(1)=u(i,k,16)
       xru(2)=u(i,k+1,16)
       xrv(1)=v(i,k,16)
       xrv(2)=v(i,k+1,16)
       xsu(1)=u(i,j+2,16)
       xsu(2)=u(i,k-2,16)
       xsv(1)=v(i,j+2,16)
       xsv(2)=v(i,k-2,16)
      
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       u(i,k-1,16)=xtu
       v(i,k-1,16)=xtv

c      Print segments if not zero thickness
       if (rib(i,149).ne.0.) then
       call line(sepx+u(i,k-1,16),-v(i,k-1,16)+sepy,sepx+u(i,k-2,16),
     + -v(i,k-2,16)+sepy,3)
       call line(sepx+u(i,k-1,16),-v(i,k-1,16)+sepy,sepx+u(i,k,16),
     + -v(i,k,16)+sepy,3)
       end if

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
C      Case "ds" or "ss"
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (atp.eq."ds".or.atp.eq."ss") then

       do j=np(i,2),np(i,2)+np(i,3)-2

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Dibuixa airfoils basic contour
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       call line(sepx+u(i,j,3),-v(i,j,3)+sepy,sepx+u(i,j+1,3),
     + -v(i,j+1,3)+sepy,1)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Dibuixa airfoils washin basic contour al seu lloc
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       call line(sepx+u(i,j,4),-v(i,j,4)+sepy+xkf*890.95-rib(i,50),
     + sepx+u(i,j+1,4),-v(i,j+1,4)+sepy+xkf*890.95-rib(i,50),3)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Airfoils borders
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       call line(sepx+u(i,j,16),-v(i,j,16)+sepy,sepx+u(i,j+1,16),
     + -v(i,j+1,16)+sepy,3)

       
       call line(sepx+u(i,j,16),-v(i,j,16)+sepy,sepx+u(i,j,3),
     + -v(i,j,3)+sepy,5)

       end do

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.12.3 Airfoil intrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c       do j=1,np(i,1)-1
        do j=np(i,2)+np(i,3)-1,np(i,1)-1

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Dibuixa airfoils basic contour
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       call line(sepx+u(i,j,3),-v(i,j,3)+sepy,sepx+u(i,j+1,3),
     + -v(i,j+1,3)+sepy,1)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Dibuixa airfoils washin basic contour al seu lloc
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       call line(sepx+u(i,j,4),-v(i,j,4)+sepy+xkf*890.85-rib(i,50),
     + sepx+u(i,j+1,4),-v(i,j+1,4)+sepy+xkf*890.85-rib(i,50),3)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Airfoils borders
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       call line(sepx+u(i,j,16),-v(i,j,16)+sepy,sepx+u(i,j+1,16),
     + -v(i,j+1,16)+sepy,3)

       
       call line(sepx+u(i,j,16),-v(i,j,16)+sepy,sepx+u(i,j,3),
     + -v(i,j,3)+sepy,5)

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.12.4 Dibuixa punts-segments singulars vores airfoils
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
       j=np(i,1)

       call line(sepx+u(i,j,16),-v(i,j,16)+sepy,sepx+u(i,j,3),
     + -v(i,j,3)+sepy,5)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.12.5 Draw holes
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do l=1,hol(i,1,1)

c      Dibuixa forat tipus 1 (alleugerament elliptics)
       if (hol(i,l,9).eq.1) then

       xx0=(hol(i,l,2))*rib(i,5)/100.0d0+sepx
       yy0=(-(hol(i,l,3))*rib(i,5)/100.0d0+sepy)
       xxa=(hol(i,l,4))*rib(i,5)/100.0d0
       yyb=((hol(i,l,5))*rib(i,5)/100.0d0)

       call ellipse(xx0,yy0,xxa,yyb,(hol(i,l,6)),3)
       end if ! Type 1

c      Dibuixa forat tipus 3 (triangles)

       if (hol(i,l,9).eq.3) then

       alptri=hol(i,l,6)*pi/180.
       atri=hol(i,l,4)*rib(i,5)/100.
       btri=hol(i,l,5)*rib(i,5)/100.
       rtri=hol(i,l,7)*rib(i,5)/100.
       
c      Marcador de costat negatiu
       satri=atri/sqrt(atri*atri)

       atri=abs(atri)

       cgor=0.5*pi-alptri
       ctri=dsqrt(atri*atri+btri*btri-2.*atri*btri*dcos(cgor))
       agor=dacos((ctri*ctri+btri*btri-atri*atri)/(2.*btri*ctri))
       bgor=dacos((ctri*ctri+atri*atri-btri*btri)/(2.*atri*ctri))
       aggor=pi-agor
       bggor=pi-bgor
       cggor=pi-cgor
       h1tri=rtri/dsin(0.5*cgor)
       h2tri=rtri/dsin(0.5*bgor)
       h3tri=rtri/dsin(0.5*agor)

       x1=hol(i,l,2)*rib(i,5)/100.
       y1=hol(i,l,3)*rib(i,5)/100.

       x2=x1+satri*atri*dcos(alptri)
       y2=y1+atri*dsin(alptri)

       x3=x1
       y3=y1+btri

       o1x=x1+satri*(h1tri*dcos(alptri+0.5*cgor))
       o1y=y1+h1tri*dsin(alptri+0.5*cgor)

       o2x=x2-satri*(h2tri*dcos(-alptri+0.5*bgor))
       o2y=y2+h2tri*dsin(-alptri+0.5*bgor)

       o3x=x3+satri*(h3tri*dsin(0.5*agor))
       o3y=y3-h3tri*dcos(0.5*agor)

c      Inicialitza comptatge punts triangle
       k=1

       step1=cggor/6.
       do tetha=0.,cggor+0.01,step1
       xtri(k)=o1x-satri*rtri*dcos(tetha)
       ytri(k)=o1y-rtri*dsin(tetha)
       k=k+1
       end do

       step2=bggor/6.
       do tetha=alptri,alptri+bggor+0.01,step2
       xtri(k)=o2x+satri*rtri*dsin(tetha)
       ytri(k)=o2y-rtri*dcos(tetha)
       k=k+1
       end do

       step3=aggor/6.
       do tetha=agor,pi+0.01,step3
       xtri(k)=o3x+satri*rtri*dcos(tetha)
       ytri(k)=o3y+rtri*dsin(tetha)
       k=k+1
       end do

       xtri(k)=xtri(1)
       ytri(k)=ytri(1)

c      Dibuixa triangles

       if (satri.eq.1.) then
       do k=1,21
       call line(sepx+xtri(k),-ytri(k)+sepy,
     + sepx+xtri(k+1),-ytri(k+1)+sepy,3)
       end do
       end if

       if (satri.eq.-1.) then
       do k=1,21
       call line(sepx+xtri(k),-ytri(k)+sepy,
     + sepx+xtri(k+1),-ytri(k+1)+sepy,3)
       end do
       end if

       end if ! Type 3


c      Draw holes type 4 (rectangles)
c      Request from Pawel Lipski
c      Added 2023-12-07

       if (hol(i,l,9).eq.4) then

       alptri=hol(i,l,6)*pi/180.
       atri=hol(i,l,4)*rib(i,5)/100.
       btri=hol(i,l,5)*rib(i,5)/100.
       rtri=hol(i,l,7)*rib(i,5)/100.
       
c      Flag negative value. -1 if atri negative, 1 atri if potitive
       satri=atri/sqrt(atri*atri)
       atri=abs(atri) ! makes positive by default

c      Rectangle corners
       x1=hol(i,l,2)*rib(i,5)/100.
       y1=hol(i,l,3)*rib(i,5)/100.

       x2=x1+satri*atri*dcos(alptri)
       y2=y1+atri*dsin(alptri)

       x3=x2-satri*btri*dsin(alptri)
       y3=y2+btri*dcos(alptri)

       x4=x1-satri*btri*dsin(alptri)
       y4=y1+btri*dcos(alptri)


c      Circle centers of rounded corners
       o1x=x1+satri*rtri*dcos(alptri)-satri*rtri*dsin(alptri)
       o1y=y1+rtri*dsin(alptri)+rtri*dcos(alptri)

       o2x=x2-satri*rtri*dcos(alptri)-satri*rtri*dsin(alptri)
       o2y=y2-rtri*dsin(alptri)+rtri*dcos(alptri)

       o3x=x3-satri*rtri*dcos(alptri)+satri*rtri*dsin(alptri)
       o3y=y3-rtri*dsin(alptri)-rtri*dcos(alptri)

       o4x=x4+satri*rtri*dcos(alptri)+satri*rtri*dsin(alptri)
       o4y=y4+rtri*dsin(alptri)-rtri*dcos(alptri)


c      Draw segments
       x12=x1+satri*rtri*dcos(alptri)
       y12=y1+rtri*dsin(alptri)
       x21=x2-satri*rtri*dcos(alptri)
       y21=y2-rtri*dsin(alptri)

       x23=x2-satri*rtri*dsin(alptri)
       y23=y2+rtri*dcos(alptri)
       x32=x3+satri*rtri*dsin(alptri)
       y32=y3-rtri*dcos(alptri)

       x34=x3-satri*rtri*dcos(alptri)
       y34=y3-rtri*dsin(alptri)
       x43=x4+satri*rtri*dcos(alptri)
       y43=y4+rtri*dsin(alptri)

       x41=x4+satri*rtri*dsin(alptri)
       y41=y4-rtri*dcos(alptri)
       x14=x1-satri*rtri*dsin(alptri)
       y14=y1+rtri*dcos(alptri)


c      Case satri=1
       if (satri.eq.1) then

        k=1
c       First arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o1x+rtri*dcos(tetha+pi+alptri)
        ytri(k)=o1y+rtri*dsin(tetha+pi+alptri)
        k=k+1
        end do

c       Second arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o2x+rtri*dcos(tetha+1.5*pi+alptri)
        ytri(k)=o2y+rtri*dsin(tetha+1.5*pi+alptri)
        k=k+1
        end do

c       Third arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o3x+rtri*dcos(tetha+alptri)
        ytri(k)=o3y+rtri*dsin(tetha+alptri)
        k=k+1
        end do

c       Fourth arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o4x+rtri*dcos(tetha+0.5*pi+alptri)
        ytri(k)=o4y+rtri*dsin(tetha+0.5*pi+alptri)
        k=k+1
        end do 
        xtri(k)=xtri(1)
        ytri(k)=ytri(1)

       end if ! satri=1


c      Case satri=-1
       if (satri.eq.-1.) then

        k=1
c       First arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o1x+rtri*dcos(-tetha-alptri)
        ytri(k)=o1y+rtri*dsin(-tetha-alptri)
        k=k+1
        end do

c       Second arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o2x+rtri*dcos(-tetha-0.5*pi-alptri)
        ytri(k)=o2y+rtri*dsin(-tetha-0.5*pi-alptri)
        k=k+1
        end do

c       Third arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o3x+rtri*dcos(-tetha+pi-alptri)
        ytri(k)=o3y+rtri*dsin(-tetha+pi-alptri)
        k=k+1
        end do

c       Fourth arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o4x+rtri*dcos(-tetha+0.5*pi-alptri)
        ytri(k)=o4y+rtri*dsin(-tetha+0.5*pi-alptri)
        k=k+1
        end do 
        xtri(k)=xtri(1)
        ytri(k)=ytri(1)

       end if ! satri=-1


c      Dibuixa arcs

       if (satri.eq.1.) then
       do k=1,28
       call line(sepx+xtri(k),-ytri(k)+sepy,
     + sepx+xtri(k+1),-ytri(k+1)+sepy,3)
       end do
       end if

       if (satri.eq.-1.) then
       do k=1,28
       call line(sepx+xtri(k),-ytri(k)+sepy,
     + sepx+xtri(k+1),-ytri(k+1)+sepy,3)
       end do
       end if

       end if ! Type 4




       end do  ! holes

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.12.6 Print joncs
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      SOLVE INTERFERENCE BETWEEN BLOCS!!!!

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.12.6.1 First) Iterate in blocs type 1
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      For each bloc do
       do m=1,k21blocs
c      For each group do
       do ng=1,k21blocf(m,3)

c      Detect rib belonging to group
       if (i.ge.ngoo(m,ng,2).and.i.le.ngoo(m,ng,3)) then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case bloc type 1
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (k21blocf(m,2).eq.1) then

c       write (*,*) "t1 ",k21blocf(m,1),k21blocf(m,2),i


c       if (rib(i,166).ne.0) then

       do jjk=1,4
       xextra(ng,jjk)=xextraa(m,ng,jjk)
       xintra(ng,jjk)=xintraa(m,ng,jjk)
       sjo(ng,jjk)=sjoo(m,ng,jjk)
       end do

       rib(i,166)=float(ng)

       call joncs(i,u,v,rib,xintra,xextra,xjonc,npo,atp,np)
       call pjoncs(i,xjonc,npo,sjo,sepx,sepy,rib,xkf)

       joncf(i,m,ng,2)=rib(i,167) ! Jonc lenght


c       end if

       end if ! bloc type 1

       end if ! detect rib

       end do ! group n

       end do ! bloc m

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.12.6.2 Second) Iterate in blocs type 2
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      For each bloc do
       do m=1,k21blocs
c      For each group do
       do ng=1,k21blocf(m,3)

c      Detect rib belonging to group
       if (i.ge.ngoo(m,ng,2).and.i.le.ngoo(m,ng,3)) then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case bloc rods type 2
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (k21blocf(m,2).eq.2) then

c       write (*,*) "t2 ",k21blocf(m,1),k21blocf(m,2),i

       do jjk=1,4
       sjo2(ng,jjk)=sjoo(m,ng,jjk)
       end do

       rib(i,166)=float(ng)
       nparc=41
       
       call joncs2(i,u,v,rib,x21,xjonc2,nparc,atp,np,m,ng)
       call pjoncs2(i,xjonc2,nparc,sjo2,sepx,sepy,rib,xkf)   

       joncf(i,m,ng,2)=rib(i,167) ! Jonc lenght

c      Print romano points BOX(1,7) -exp-
c       call romanop(i,1,sepx+xjonc2(i,1,1),sepy-xjonc2(i,1,2), ! BOX(1,7)
c     + sepx+xjonc2(i,nparc,1),sepy-xjonc2(i,nparc,2),0,0,0,xkf)

       end if


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case bloc rods type 3
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (k21blocf(m,2).eq.3) then

       do jjk=1,8
       xextra(ng,jjk)=xextraa(m,ng,jjk)
       xintra(ng,jjk)=xintraa(m,ng,jjk)
       sjo(ng,jjk)=sjoo(m,ng,jjk)
       end do

       rib(i,166)=float(ng)

       call joncst3(i,u,v,rib,xintra,xextra,xjonc,npo,atp,np)
       call pjoncs(i,xjonc,npo,sjo,sepx,sepy,rib,xkf)

       joncf(i,m,ng,2)=rib(i,167) ! Jonc lenght

       end if ! bloc type 3




       end if ! detect rib
   
       end do ! group n

       end do ! bloc m

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.12.7 Print mylars
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (rib(i,168).ne.0) then
       call mylars(i,u,v,sepx,sepy,rib,xmy,np,xkf,atp)
       end if

c      Change airfoil loction

       kx=int((float(i)/6.))
       ky=i-kx*6
       kyy=kyy+1

       end do  ! i airfoil

      
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.13 Airfoils drawing (para mesa de corte)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
              
c      Box (1,4)

       sepxx=700.*xkf
       sepyy=100.*xkf

       kx=0
       ky=0
       kyy=0

       do i=1,nribss

       sepx=2530.*xkf+sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky)

       call romano(i,sepx+0.89d0*rib(i,5),sepy-1.0d0,0.0d0,
     + typm6(9)*0.1,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.13.1 Airfoils borders
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Case "ds" or "ss"

       if (atp.eq."ds".or.atp.eq."ss") then

       do j=1,np(i,1)-1
       call line(sepx+u(i,j,16),-v(i,j,16)+sepy,sepx+u(i,j+1,16),
     + -v(i,j+1,16)+sepy,1)
       end do

       end if

c      Case "pc"

       jvi=np(i,2)           ! vent in
       jvo=np(i,2)+np(i,3)-1 ! vent out

       if (atp.eq."pc") then

c      Extrados

       do j=1,np(i,2)-1
       call line(sepx+u(i,j,16),-v(i,j,16)+sepy,sepx+u(i,j+1,16),
     + -v(i,j+1,16)+sepy,1)

       end do

c      Nose

c      Print segments if not zero thickness
       if (rib(i,149).ne.0.) then

       call line(sepx+u(i,jvi,16),-v(i,jvi,16)+sepy,sepx+u(i,jvo,16),
     + -v(i,jvo,16)+sepy,2)

c      Erase old code below:
c       call line(sepx+u(i,j+2,16),-v(i,j+2,16)+sepy,sepx+u(i,k-2,16),
c     + -v(i,k-2,16)+sepy,3)

c       call line(sepx+u(i,j+1,16),-v(i,j+1,16)+sepy,sepx+u(i,j,16),
c     + -v(i,j,16)+sepy,3)
c       call line(sepx+u(i,j+1,16),-v(i,j+1,16)+sepy,sepx+u(i,j+2,16),
c     + -v(i,j+2,16)+sepy,3)

c       call line(sepx+u(i,k-1,16),-v(i,k-1,16)+sepy,sepx+u(i,k-2,16),
c     + -v(i,k-2,16)+sepy,3)
c       call line(sepx+u(i,k-1,16),-v(i,k-1,16)+sepy,sepx+u(i,k,16),
c     + -v(i,k,16)+sepy,3)
       end if

c      Intrados

       do j=np(i,2)+np(i,3)-1,np(i,1)-1
       call line(sepx+u(i,j,16),-v(i,j,16)+sepy,sepx+u(i,j+1,16),
     + -v(i,j+1,16)+sepy,1)

       end do

       end if

     

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.13.2 Draw singular points-segments in airfoils border
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
       j=np(i,1)
       call line(sepx+u(i,j,16),-v(i,j,16)+sepy,sepx+u(i,j,3),
     + -v(i,j,3)+sepy,1)

       j=1
       call line(sepx+u(i,j,16),-v(i,j,16)+sepy,sepx+u(i,j,3),
     + -v(i,j,3)+sepy,1)

c See also: 9.3 Draw anchor points in airfoils

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      6.13.3 Draw elliptical holes (MC)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do l=1,hol(i,1,1)

c      Holes type 1 (ellipses)
       if (hol(i,l,9).eq.1) then

       xx0=hol(i,l,2)*rib(i,5)/100.+sepx
       yy0=(-hol(i,l,3)*rib(i,5)/100.+sepy)
       xxa=hol(i,l,4)*rib(i,5)/100.
       yyb=(hol(i,l,5)*rib(i,5)/100.)

       call ellipse(xx0,yy0,xxa,yyb,hol(i,l,6),1)

       end if ! Type 1

c      Dibuixa forat tipus 3 (triangles)

       if (hol(i,l,9).eq.3) then

       alptri=hol(i,l,6)*pi/180.
       atri=hol(i,l,4)*rib(i,5)/100.
       btri=hol(i,l,5)*rib(i,5)/100.
       rtri=hol(i,l,7)*rib(i,5)/100.
       
c      Marcador de costat negatiu
       satri=atri/sqrt(atri*atri)

       atri=abs(atri)

       cgor=0.5*pi-alptri
       ctri=dsqrt(atri*atri+btri*btri-2.*atri*btri*dcos(cgor))
       agor=dacos((ctri*ctri+btri*btri-atri*atri)/(2.*btri*ctri))
       bgor=dacos((ctri*ctri+atri*atri-btri*btri)/(2.*atri*ctri))
       aggor=pi-agor
       bggor=pi-bgor
       cggor=pi-cgor
       h1tri=rtri/dsin(0.5*cgor)
       h2tri=rtri/dsin(0.5*bgor)
       h3tri=rtri/dsin(0.5*agor)

       x1=hol(i,l,2)*rib(i,5)/100.
       y1=hol(i,l,3)*rib(i,5)/100.

       x2=x1+satri*atri*dcos(alptri)
       y2=y1+atri*dsin(alptri)

       x3=x1
       y3=y1+btri

       o1x=x1+satri*(h1tri*dcos(alptri+0.5*cgor))
       o1y=y1+h1tri*dsin(alptri+0.5*cgor)

       o2x=x2-satri*(h2tri*dcos(-alptri+0.5*bgor))
       o2y=y2+h2tri*dsin(-alptri+0.5*bgor)

       o3x=x3+satri*(h3tri*dsin(0.5*agor))
       o3y=y3-h3tri*dcos(0.5*agor)

c       write (*,*) atri,btri,ctri,agor,bgor,cgor

c      Inicialitza comptatge punts triangle
       k=1

       step1=cggor/6.
       do tetha=0.,cggor+0.01,step1
       xtri(k)=o1x-satri*rtri*dcos(tetha)
       ytri(k)=o1y-rtri*dsin(tetha)
       k=k+1
       end do

       step2=bggor/6.
       do tetha=alptri,alptri+bggor+0.01,step2
       xtri(k)=o2x+satri*rtri*dsin(tetha)
       ytri(k)=o2y-rtri*dcos(tetha)
       k=k+1
       end do

       step3=aggor/6.
       do tetha=agor,pi+0.01,step3
       xtri(k)=o3x+satri*rtri*dcos(tetha)
       ytri(k)=o3y+rtri*dsin(tetha)
       k=k+1
       end do

       xtri(k)=xtri(1)
       ytri(k)=ytri(1)

c      Dibuixa triangles

       if (satri.eq.1.) then
       do k=1,21
       call line(sepx+xtri(k),-ytri(k)+sepy,
     + sepx+xtri(k+1),-ytri(k+1)+sepy,1)
       end do
       end if

       if (satri.eq.-1.) then
       do k=1,21
       call line(sepx+xtri(k),-ytri(k)+sepy,
     + sepx+xtri(k+1),-ytri(k+1)+sepy,1)
       end do
       end if

       end if ! Type 3


c      Draw holes type 4 (rectangles)
c      Request from Pawel Lipski
c      Added 2023-12-07

       if (hol(i,l,9).eq.4) then

       alptri=hol(i,l,6)*pi/180.
       atri=hol(i,l,4)*rib(i,5)/100.
       btri=hol(i,l,5)*rib(i,5)/100.
       rtri=hol(i,l,7)*rib(i,5)/100.
       
c      Flag negative value. -1 if atri negative, 1 atri if potitive
       satri=atri/sqrt(atri*atri)
       atri=abs(atri) ! makes positive by default

c      Rectangle corners
       x1=hol(i,l,2)*rib(i,5)/100.
       y1=hol(i,l,3)*rib(i,5)/100.

       x2=x1+satri*atri*dcos(alptri)
       y2=y1+atri*dsin(alptri)

       x3=x2-satri*btri*dsin(alptri)
       y3=y2+btri*dcos(alptri)

       x4=x1-satri*btri*dsin(alptri)
       y4=y1+btri*dcos(alptri)


c      Circle centers of rounded corners
       o1x=x1+satri*rtri*dcos(alptri)-satri*rtri*dsin(alptri)
       o1y=y1+rtri*dsin(alptri)+rtri*dcos(alptri)

       o2x=x2-satri*rtri*dcos(alptri)-satri*rtri*dsin(alptri)
       o2y=y2-rtri*dsin(alptri)+rtri*dcos(alptri)

       o3x=x3-satri*rtri*dcos(alptri)+satri*rtri*dsin(alptri)
       o3y=y3-rtri*dsin(alptri)-rtri*dcos(alptri)

       o4x=x4+satri*rtri*dcos(alptri)+satri*rtri*dsin(alptri)
       o4y=y4+rtri*dsin(alptri)-rtri*dcos(alptri)


c      Draw segments
       x12=x1+satri*rtri*dcos(alptri)
       y12=y1+rtri*dsin(alptri)
       x21=x2-satri*rtri*dcos(alptri)
       y21=y2-rtri*dsin(alptri)

       x23=x2-satri*rtri*dsin(alptri)
       y23=y2+rtri*dcos(alptri)
       x32=x3+satri*rtri*dsin(alptri)
       y32=y3-rtri*dcos(alptri)

       x34=x3-satri*rtri*dcos(alptri)
       y34=y3-rtri*dsin(alptri)
       x43=x4+satri*rtri*dcos(alptri)
       y43=y4+rtri*dsin(alptri)

       x41=x4+satri*rtri*dsin(alptri)
       y41=y4-rtri*dcos(alptri)
       x14=x1-satri*rtri*dsin(alptri)
       y14=y1+rtri*dcos(alptri)


c      Case satri=1
       if (satri.eq.1) then

        k=1
c       First arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o1x+rtri*dcos(tetha+pi+alptri)
        ytri(k)=o1y+rtri*dsin(tetha+pi+alptri)
        k=k+1
        end do

c       Second arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o2x+rtri*dcos(tetha+1.5*pi+alptri)
        ytri(k)=o2y+rtri*dsin(tetha+1.5*pi+alptri)
        k=k+1
        end do

c       Third arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o3x+rtri*dcos(tetha+alptri)
        ytri(k)=o3y+rtri*dsin(tetha+alptri)
        k=k+1
        end do

c       Fourth arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o4x+rtri*dcos(tetha+0.5*pi+alptri)
        ytri(k)=o4y+rtri*dsin(tetha+0.5*pi+alptri)
        k=k+1
        end do 
        xtri(k)=xtri(1)
        ytri(k)=ytri(1)

       end if ! satri=1


c      Case satri=-1
       if (satri.eq.-1.) then

        k=1
c       First arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o1x+rtri*dcos(-tetha-alptri)
        ytri(k)=o1y+rtri*dsin(-tetha-alptri)
        k=k+1
        end do

c       Second arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o2x+rtri*dcos(-tetha-0.5*pi-alptri)
        ytri(k)=o2y+rtri*dsin(-tetha-0.5*pi-alptri)
        k=k+1
        end do

c       Third arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o3x+rtri*dcos(-tetha+pi-alptri)
        ytri(k)=o3y+rtri*dsin(-tetha+pi-alptri)
        k=k+1
        end do

c       Fourth arc
        do tetha=0.0,pi/2.,pi/12.
        xtri(k)=o4x+rtri*dcos(-tetha+0.5*pi-alptri)
        ytri(k)=o4y+rtri*dsin(-tetha+0.5*pi-alptri)
        k=k+1
        end do 
        xtri(k)=xtri(1)
        ytri(k)=ytri(1)

       end if ! satri=-1


c      Dibuixa arcs

       if (satri.eq.1.) then
       do k=1,28
       call line(sepx+xtri(k),-ytri(k)+sepy,
     + sepx+xtri(k+1),-ytri(k+1)+sepy,1)
       end do
       end if

       if (satri.eq.-1.) then
       do k=1,28
       call line(sepx+xtri(k),-ytri(k)+sepy,
     + sepx+xtri(k+1),-ytri(k+1)+sepy,1)
       end do
       end if

       end if ! Type 4



       end do  ! holes

       kx=int((float(i)/6.))
       ky=i-kx*6
       kyy=kyy+1

       end do  ! in ribs
      

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      5+ Drawing planform in 2D view x-y
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      5+.1 Planform

c      Box (3,1)

       x0=0.
       y0=2000.*xkf
       
c      Ribs

       do i=1,nribss

       do j=1,np(i,1)-1

       x1=x(i,j)+x0
       y1=y(i,j)+y0
       x2=x(i,j+1)+x0
       y2=y(i,j+1)+y0

       call line(x1,y1,x2,y2,1)
       call line(-x1,y1,-x2,y2,1)

       end do

       end do

c      Trailing edge

       do i=1,nribss-1

       call line(x(i,1)+x0,y(i,1)+y0,x(i+1,1)+x0,y(i+1,1)+y0,1)
       call line(-x(i,1)+x0,y(i,1)+y0,-x(i+1,1)+x0,y(i+1,1)+y0,1)

       end do

       call line(-x(1,1)+x0,y(1,1)+y0,x(1,1)+x0,y(1,1)+y0,1)

c      Leading edge

c      Calcula punt de LE
       do j=10,np(1,2)
       if (u(1,j,3).eq.0) then
       jzero=j
       end if
       end do

       j=jzero

       do i=1,nribss-1

       call line(x(i,j)+x0,y(i,j)+y0,x(i+1,j)+x0,y(i+1,j)+y0,1)
       call line(-x(i,j)+x0,y(i,j)+y0,-x(i+1,j)+x0,y(i+1,j)+y0,1)

       end do

       call line(-x(1,j)+x0,y(1,j)+y0,x(1,j)+x0,y(1,j)+y0,1)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Vents - Air intakes
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      
c      Classic vents
       if (k31d.eq.0) then

c      Vent in
       do i=1,nribss

       j=np(i,2)

c      Control if cell is closed

       if(int(rib(i,14)).eq.1) then
       call line(x(i-1,j)+x0,y(i-1,j)+y0,x(i,j)+x0,y(i,j)+y0,3)
       call line(-x(i-1,j)+x0,y(i-1,j)+y0,-x(i,j)+x0,y(i,j)+y0,3)
       end if
       if(int(rib(i,14)).eq.0) then
       call line(x(i-1,j)+x0,y(i-1,j)+y0,x(i,j)+x0,y(i,j)+y0,9)
       call line(-x(i-1,j)+x0,y(i-1,j)+y0,-x(i,j)+x0,y(i,j)+y0,9)
       end if

       end do

c      Vent out
       do i=1,nribss

       j=np(i,2)+np(i,3)-1

c      Control if cell is closed

       if(int(rib(i,14)).eq.1) then
       call line(x(i-1,j)+x0,y(i-1,j)+y0,x(i,j)+x0,y(i,j)+y0,3)
       call line(-x(i-1,j)+x0,y(i-1,j)+y0,-x(i,j)+x0,y(i,j)+y0,3)
       end if

       end do
       end if ! k31d=0

c      Case new vents
c      Estructura similar al cas 3D secció 21.2
       if (k31d.eq.1) then

       do i=1,nribss

       p1x=x(i-1,np(i,2))+x0
       p1y=y(i-1,np(i,2))+y0
       p2x=x(i,np(i,2))+x0
       p2y=y(i,np(i,2))+y0

       j=np(i,2)+np(i,3)-1

       p3x=x(i-1,j)+x0
       p3y=y(i-1,j)+y0
       p4x=x(i,j)+x0
       p4y=y(i,j)+y0

       if (rib(i,165).eq.0) then
       call line(p1x,p1y,p2x,p2y,3)
       call line(-p1x,p1y,-p2x,p2y,3)
       call line(p3x,p3y,p4x,p4y,3)
       call line(-p3x,p3y,-p4x,p4y,3)
       end if

       if (rib(i,165).eq.1) then
       call line(p3x,p3y,p4x,p4y,3)
       call line(-p3x,p3y,-p4x,p4y,3)
       end if

       if (rib(i,165).eq.-1) then
       call line(p1x,p1y,p2x,p2y,3)
       call line(-p1x,p1y,-p2x,p2y,3)
       end if

       if (rib(i,165).eq.-2) then
       call line(p1x,p1y,p2x,p2y,3)
       call line(-p1x,p1y,-p2x,p2y,3)
       call line(p3x,p3y,p2x,p2y,3)
       call line(-p3x,p3y,-p2x,p2y,3)
       end if

       if (rib(i,165).eq.-3) then
       call line(p1x,p1y,p2x,p2y,3)
       call line(-p1x,p1y,-p2x,p2y,3)
       call line(p1x,p1y,p4x,p4y,3)
       call line(-p1x,p1y,-p4x,p4y,3)
       end if

       end do

       end if ! k31d=1

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      5+.2 Drawing real*8 canopy in 2D view x-z
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Box (4,1)

       x0=0.
       y0=3000.*xkf

       do i=1,nribss

       do j=1,np(i,1)-1

       x1=x(i,j)+0.
       y1=z(i,j)+3000.*xkf
       x2=x(i,j+1)+0.
       y2=z(i,j+1)+3000.*xkf

       call line(x1,y1,x2,y2,7)
       call line(-x1,y1,-x2,y2,7)

       end do

       end do

c      Vent in

       do i=1,nribss

       j=np(i,2)

c      Control if cell is closed

       if(int(rib(i,14)).eq.1) then
       call line(x(i-1,j)+x0,z(i-1,j)+y0,x(i,j)+x0,z(i,j)+y0,3)
       call line(-x(i-1,j)+x0,z(i-1,j)+y0,-x(i,j)+x0,z(i,j)+y0,3)
       end if
       if(int(rib(i,14)).eq.0) then
       call line(x(i-1,j)+x0,z(i-1,j)+y0,x(i,j)+x0,z(i,j)+y0,9)
       call line(-x(i-1,j)+x0,z(i-1,j)+y0,-x(i,j)+x0,z(i,j)+y0,9)
       end if

       end do

c      Vent out
       do i=1,nribss

       j=np(i,2)+np(i,3)-1

c      Control if cell is closed

       if(int(rib(i,14)).eq.1) then
       call line(x(i-1,j)+x0,z(i-1,j)+y0,x(i,j)+x0,z(i,j)+y0,3)
       call line(-x(i-1,j)+x0,z(i-1,j)+y0,-x(i,j)+x0,z(i,j)+y0,3)
       end if

       end do

c      Drawing leading edge
c      Calculus point in LE
       do j=10,np(1,2)
       if (u(1,j,3).eq.0) then
       jzero=j
       end if
       end do

       j=jzero

       do i=1,nribss-1

       call line(x(i,j)+x0,z(i,j)+y0,x(i+1,j)+x0,z(i+1,j)+y0,5)
       call line(-x(i,j)+x0,z(i,j)+y0,-x(i+1,j)+x0,z(i+1,j)+y0,5)

       end do

       call line(-x(1,j)+x0,z(1,j)+y0,x(1,j)+x0,z(1,j)+y0,5)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      5+.3 Drawing real*8 canopy in 2D view y-z
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Box (4,2)

       x0=1260.*xkf
       y0=3000.*xkf

c      Airfoils y-z
       do i=1,nribss

       do j=1,np(i,1)-1
       call line(-y(i,j)+x0,z(i,j)+y0,-y(i,j+1)+x0,z(i,j+1)+y0,3)
       end do

c      Trailing edge
       j=np(i,1)
       call line(-y(i-1,j)+x0,z(i-1,j)+y0,-y(i,j)+x0,z(i,j)+y0,2)
c      Inlet in       
       j=np(i,2)
       if(rib(i,14).eq.1) then
       call line(-y(i-1,j)+x0,z(i-1,j)+y0,-y(i,j)+x0,z(i,j)+y0,1)
       end if
       if(rib(i,14).eq.0) then
       call line(-y(i-1,j)+x0,z(i-1,j)+y0,-y(i,j)+x0,z(i,j)+y0,9)
       end if

c      Inlet out     
c       if(rib(i-1,14).eq.1.and.rib(i,14).eq.1) then
       if(rib(i,14).eq.1) then
       j=np(i,2)+np(i,3)-1
       call line(-y(i-1,j)+x0,z(i-1,j)+y0,-y(i,j)+x0,z(i,j)+y0,1)
       end if

c      Long lines
       do j=2, np(i,2)-1,5
       call line(-y(i-1,j)+x0,z(i-1,j)+y0,-y(i,j)+x0,z(i,j)+y0,4)
       end do
       do j=np(i,2)+np(i,3)+1,np(i,1)-1,5
       call line(-y(i-1,j)+x0,z(i-1,j)+y0,-y(i,j)+x0,z(i,j)+y0,8)
       end do

       end do

c      Ultim perfil
c       i=nribss
c       do j=1,np(i,1)-1
c       call line(-y(i,j)+x0,z(i,j)+y0,-y(i,j+1)+x0,z(i,j+1)+y0,4)
c       end do



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      7. PANEL DEVELOPMENT
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      7.1 Panel 1'-1 extrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=1

       px0=0.
       py0=0.
       ptheta=0.

       do j=1,np(1,2)-1 ! extrados panels point j

c      Distances between points rib 0 and 1
       pa=dsqrt((x(i,j)-xx(i,j))**2.+(y(i,j)-yy(i,j))**2.+
     + (z(i,j)-zz(i,j))**2.)
       pb=dsqrt((x(i,j+1)-xx(i,j))**2.+(y(i,j+1)-yy(i,j))**2.+
     + (z(i,j+1)-zz(i,j))**2.)
       pc=dsqrt((x(i,j)-x(i,j+1))**2.+(y(i,j)-y(i,j+1))**2.+
     + (z(i,j)-z(i,j+1))**2.)
       pd=dsqrt((x(i,j)-xx(i,j+1))**2.+(y(i,j)-yy(i,j+1))**2.+
     + (z(i,j)-zz(i,j+1))**2.)
       pe=dsqrt((xx(i,j+1)-xx(i,j))**2.+(yy(i,j+1)-yy(i,j))**2.+
     + (zz(i,j+1)-zz(i,j))**2.)
       pf=dsqrt((x(i,j+1)-xx(i,j+1))**2.+(y(i,j+1)-yy(i,j+1))**2.+
     + (z(i,j+1)-zz(i,j+1))**2.)
       
       pa2r=(pa*pa-pb*pb+pc*pc)/(2.*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

       pb2t=(pb*pb-pe*pe+pf*pf)/(2.*pb)
       pb1t=pb-pb2t
       pht=dsqrt(pf*pf-pb2t*pb2t)
       
       pw1=datan(phr/pa1r)
       phu=pb1t*dtan(pw1)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0
       
       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

c      Iteration
       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))
      
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      REVISAR!!!!!
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       pl1x(0,j)=pl1x(i,j)
       pl1y(0,j)=pl1y(i,j)

       pr1x(0,j)=pr1x(i,j)
       pr1y(0,j)=pr1y(i,j)

       pl2x(0,j)=pl2x(i,j)
       pl2y(0,j)=pl2y(i,j)

       pr2x(0,j)=pr2x(i,j)
       pr2y(0,j)=pr2y(i,j)

c       write (*,*) "1: ", pl1y(0,j), pr1y(0,j)
c       write (*,*) "2: ", pl2y(0,j), pr2y(0,j)
c      Result OK y iguals!!!

       end do
       
c      Extrados

c      Box (1,3)

       i=1
       
       psep=1970.*xkf+seppix(i)*float(i-1)  ! WARNING
       psey=400.*xkf

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      7.2 Panel 1'-1 intrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      7.2.1 Intrados

c      Box (2,3)

       i=1

       px0=0.
       py0=0.
       ptheta=0.

       do j=np(1,2)+np(1,3)-1,np(1,1)-1 ! extrados panels, point j

c      Distances between points
       pa=dsqrt((x(i,j)-xx(i,j))**2.+(y(i,j)-yy(i,j))**2.+
     + (z(i,j)-zz(i,j))**2.)
       pb=dsqrt((x(i,j+1)-xx(i,j))**2.+(y(i,j+1)-yy(i,j))**2.+
     + (z(i,j+1)-zz(i,j))**2.)
       pc=dsqrt((x(i,j)-x(i,j+1))**2.+(y(i,j)-y(i,j+1))**2.+
     + (z(i,j)-z(i,j+1))**2.)
       pd=dsqrt((x(i,j)-xx(i,j+1))**2.+(y(i,j)-yy(i,j+1))**2.+
     + (z(i,j)-zz(i,j+1))**2.)
       pe=dsqrt((xx(i,j+1)-xx(i,j))**2.+(yy(i,j+1)-yy(i,j))**2.+
     + (zz(i,j+1)-zz(i,j))**2.)
       pf=dsqrt((x(i,j+1)-xx(i,j+1))**2.+(y(i,j+1)-yy(i,j+1))**2.+
     + (z(i,j+1)-zz(i,j+1))**2.)
       
c       write (*,*) i,pa,pb,pc,pd,pe,pf

       pa2r=(pa*pa-pb*pb+pc*pc)/(2.*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0

       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0


       pl1x(0,j)=pl1x(i,j)
       pl1y(0,j)=pl1y(i,j)

       pr1x(0,j)=pr1x(i,j)
       pr1y(0,j)=pr1y(i,j)

       pl2x(0,j)=pl2x(i,j)
       pl2y(0,j)=pl2y(i,j)

       pr2x(0,j)=pr2x(i,j)
       pr2y(0,j)=pr2y(i,j)

       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))
       
       end do
       
c      Intrados

       i=1
       
       psep=1970.*xkf+seppix(i)*float(i-1) ! WARNING
       psey=1291.*xkf
       ncontrol=1

c      Control if cell is closed
       if(int(rib(i,14)).eq.0.and.int(rib(i+1,14)).eq.0) then
       psey=400.*xkf
       ncontrol=0
       end if
       
c      7.2.2 Air intakes (vents) panels

       i=1

       px0=0.
       py0=0.
       ptheta=0.

       do j=np(1,2), np(1,2)+np(1,3)-2 ! vent panels, point j

c      Distances between points
       
       pa=dsqrt((x(i,j)-xx(i,j))**2.+(y(i,j)-yy(i,j))**2.+
     + (z(i,j)-zz(i,j))**2.)
       pb=dsqrt((x(i,j+1)-xx(i,j))**2.+(y(i,j+1)-yy(i,j))**2.+
     + (z(i,j+1)-zz(i,j))**2.)
       pc=dsqrt((x(i,j)-x(i,j+1))**2.+(y(i,j)-y(i,j+1))**2.+
     + (z(i,j)-z(i,j+1))**2.)
       pd=dsqrt((x(i,j)-xx(i,j+1))**2.+(y(i,j)-yy(i,j+1))**2.+
     + (z(i,j)-zz(i,j+1))**2.)
       pe=dsqrt((xx(i,j+1)-xx(i,j))**2.+(yy(i,j+1)-yy(i,j))**2.+
     + (zz(i,j+1)-zz(i,j))**2.)
       pf=dsqrt((x(i,j+1)-xx(i,j+1))**2.+(y(i,j+1)-yy(i,j+1))**2.+
     + (z(i,j+1)-zz(i,j+1))**2.)
       
       pa2r=(pa*pa-pb*pb+pc*pc)/(2.*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0

       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Assigna panell 0 zona vents
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       pl1x(0,j)=pl1x(i,j)
       pl1y(0,j)=pl1y(i,j)

       pr1x(0,j)=pr1x(i,j)
       pr1y(0,j)=pr1y(i,j)

       pl2x(0,j)=pl2x(i,j)
       pl2y(0,j)=pl2y(i,j)

       pr2x(0,j)=pr2x(i,j)
       pr2y(0,j)=pr2y(i,j)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       end do

c      Vents drawing

       if (n1draw.eq.1) then ! Draw central vent
       if (k26d.eq.0) then

c      Verify central cell width  
       if (cencell.ge.0.01)  then  

       i=1
       
       psep=1970.*xkf+seppix(i)*float(i-1) ! WARNING
       psey=1371.*xkf
       ncontrol=0

c      Control if cell is closed
       if(int(rib(1,14)).eq.0.and.int(rib(1+1,14)).eq.0) then
       ncontrol=1
       end if
c      Dibuixa boques
       ncontrol=1

       do j=np(1,2),np(1,2)+ncontrol*(np(1,3)-2)+(ncontrol-1)

       call line(psep+pl1x(i,j),psey-pl1y(i,j),psep+pr1x(i,j),
     + psey-pr1y(i,j),6)
       call line(psep+pl1x(i,j),psey-pl1y(i,j),psep+pr2x(i,j),
     + psey-pr2y(i,j),5)
       call line(psep+pl1x(i,j),psey-pl1y(i,j),psep+pl2x(i,j),
     + psey-pl2y(i,j),4)
       call line(psep+pr1x(i,j),psey-pr1y(i,j),psep+pr2x(i,j),
     + psey-pr2y(i,j),3)
       call line(psep+pr1x(i,j),psey-pr1y(i,j),psep+pl2x(i,j),
     + psey-pl2y(i,j),2)
       call line(psep+pl2x(i,j),psey-pl2y(i,j),psep+pr2x(i,j),
     + psey-pr2y(i,j),3)

       end do

       end if

       end if ! k26d=0
       end if ! n1draw

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      7.3 Panels 1 to nribss-1 extrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=1,nribss-1 ! panel i

       px0=0.
       py0=0.
       ptheta=0.

c      Extrados

       do j=1,np(i,2)-1,1 ! extrados panels point j

c      Distances between points
       pa=dsqrt((x(i+1,j)-x(i,j))**2.+(y(i+1,j)-y(i,j))**2.+
     + (z(i+1,j)-z(i,j))**2.)
       pb=dsqrt((x(i+1,j+1)-x(i,j))**2.+(y(i+1,j+1)-y(i,j))**2.+
     + (z(i+1,j+1)-z(i,j))**2.)
       pc=dsqrt((x(i+1,j+1)-x(i+1,j))**2.+(y(i+1,j+1)-y(i+1,j))**2.+
     + (z(i+1,j+1)-z(i+1,j))**2.)
       pd=dsqrt((x(i+1,j)-x(i,j+1))**2.+(y(i+1,j)-y(i,j+1))**2.+
     + (z(i+1,j)-z(i,j+1))**2.)
       pe=dsqrt((x(i,j+1)-x(i,j))**2.+(y(i,j+1)-y(i,j))**2.+
     + (z(i,j+1)-z(i,j))**2.)
       pf=dsqrt((x(i+1,j+1)-x(i,j+1))**2.+(y(i+1,j+1)-y(i,j+1))**2.+
     + (z(i+1,j+1)-z(i,j+1))**2.)
       
       pa2r=(pa*pa-pb*pb+pc*pc)/(2.*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

       pb2t=(pb*pb-pe*pe+pf*pf)/(2.*pb)
       pb1t=pb-pb2t
       pht=dsqrt(pf*pf-pb2t*pb2t)
       
       pw1=datan(phr/pa1r)
       phu=pb1t*dtan(pw1)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0
       
       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

c      Iteration
       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))
       
       end do
       
       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      7.4 Panels 1 to nribss-1 Intrados
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      7.4.1 Intrados

       do i=1,nribss-1 ! panel i

       px0=0.
       py0=0.
       ptheta=0.

       do j=np(i,2)+np(i,3)-1,np(i,1)-1 ! extrados panels, point j

c      Distances between points
       pa=dsqrt((x(i+1,j)-x(i,j))**2.+(y(i+1,j)-y(i,j))**2.+
     + (z(i+1,j)-z(i,j))**2.)
       pb=dsqrt((x(i+1,j+1)-x(i,j))**2.+(y(i+1,j+1)-y(i,j))**2.+
     + (z(i+1,j+1)-z(i,j))**2.)
       pc=dsqrt((x(i+1,j+1)-x(i+1,j))**2.+(y(i+1,j+1)-y(i+1,j))**2.+
     + (z(i+1,j+1)-z(i+1,j))**2.)
       pd=dsqrt((x(i+1,j)-x(i,j+1))**2.+(y(i+1,j)-y(i,j+1))**2.+
     + (z(i+1,j)-z(i,j+1))**2.)
       pe=dsqrt((x(i,j+1)-x(i,j))**2.+(y(i,j+1)-y(i,j))**2.+
     + (z(i,j+1)-z(i,j))**2.)
       pf=dsqrt((x(i+1,j+1)-x(i,j+1))**2.+(y(i+1,j+1)-y(i,j+1))**2.+
     + (z(i+1,j+1)-z(i,j+1))**2.)
       
       pa2r=(pa*pa-pb*pb+pc*pc)/(2.*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0

       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))
       
       end do
       
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc       
c     7.4.2 Air intakes (vents) panels calculus and drawing
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
c      Salva un vector per evitar interferencia vents-intrados
       do i=0,nribss
       npx=np(i,2)+np(i,3)-1
       pl1x(i,499)=pl1x(i,npx)
       pl1y(i,499)=pl1y(i,npx)
       pl2x(i,499)=pl2x(i,npx)
       pl2y(i,499)=pl2y(i,npx)
       pr1x(i,499)=pr1x(i,npx)
       pr1y(i,499)=pr1y(i,npx)
       pr2x(i,499)=pr2x(i,npx)
       pr2y(i,499)=pr2y(i,npx)
       end do


       do i=0,nribss-1 ! panel i

       px0=0.
       py0=0.
       ptheta=0.

       do j=np(i,2), np(i,2)+np(i,3)-1 ! vent panels, point j

c      Distances between points
       pa=dsqrt((x(i+1,j)-x(i,j))**2.+(y(i+1,j)-y(i,j))**2.+
     + (z(i+1,j)-z(i,j))**2.)
       pb=dsqrt((x(i+1,j+1)-x(i,j))**2.+(y(i+1,j+1)-y(i,j))**2.+
     + (z(i+1,j+1)-z(i,j))**2.)
       pc=dsqrt((x(i+1,j+1)-x(i+1,j))**2.+(y(i+1,j+1)-y(i+1,j))**2.+
     + (z(i+1,j+1)-z(i+1,j))**2.)
       pd=dsqrt((x(i+1,j)-x(i,j+1))**2.+(y(i+1,j)-y(i,j+1))**2.+
     + (z(i+1,j)-z(i,j+1))**2.)
       pe=dsqrt((x(i,j+1)-x(i,j))**2.+(y(i,j+1)-y(i,j))**2.+
     + (z(i,j+1)-z(i,j))**2.)
       pf=dsqrt((x(i+1,j+1)-x(i,j+1))**2.+(y(i+1,j+1)-y(i,j+1))**2.+
     + (z(i+1,j+1)-z(i,j+1))**2.)
       
c       write (*,*) i,pa,pb,pc,pd,pe,pf

       pa2r=(pa*pa-pb*pb+pc*pc)/(2.*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0

       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))

       end do
       
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      7.4.3 Vents drawing
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (n1draw.eq.1) then ! Override classic vents

       if (k26d.eq.0) then ! Draw classic vents

c      Saltar cella 0 si gruix nul
       iini=0
       if (cencell.lt.0.01) then
       iini=1
       end if

       do i=iini,nribss-1
       
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=1371.*xkf
       ncontrol=0

c      Control if cell is closed
       if(int(rib(i,14)).eq.0.and.int(rib(i+1,14)).eq.0) then
       ncontrol=1
       end if

       ncontrol=1       

       do j=np(i,2),np(i,2)+ncontrol*(np(i,3)-2)+(ncontrol-1)

       call line(psep+pl1x(i,j),psey-pl1y(i,j),psep+pr1x(i,j),
     + psey-pr1y(i,j),6)
       call line(psep+pl1x(i,j),psey-pl1y(i,j),psep+pr2x(i,j),
     + psey-pr2y(i,j),5)
       call line(psep+pl1x(i,j),psey-pl1y(i,j),psep+pl2x(i,j),
     + psey-pl2y(i,j),4)
       call line(psep+pr1x(i,j),psey-pr1y(i,j),psep+pr2x(i,j),
     + psey-pr2y(i,j),3)
       call line(psep+pr1x(i,j),psey-pr1y(i,j),psep+pl2x(i,j),
     + psey-pl2y(i,j),2)
       call line(psep+pl2x(i,j),psey-pl2y(i,j),psep+pr2x(i,j),
     + psey-pr2y(i,j),3)

       end do

       end do

       end if ! Vents classical

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      7.4.4 Vents drawing Adre
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (k26d.eq.0) then ! Draw classic vents

c      Saltar cella 0 si gruix nul
       iini=0
       if (cencell.lt.0.01) then
       iini=1
       end if

c      Count in ribs
       do i=iini,nribss-1
       
       psep=1970.*xkf+2520.*xkf+seppix(i)*1.0d0
       psey=1371.*xkf
       ncontrol=0

c      Control if cell is closed
       if(int(rib(i,14)).eq.0.and.int(rib(i+1,14)).eq.0) then
       ncontrol=1
       end if

       ncontrol=1       

c      Verify central cell width  
   
       do j=np(i,2),np(i,2)+ncontrol*(np(i,3)-2)+(ncontrol-1)

       call line(psep+pl1x(i,j),psey-pl1y(i,j),psep+pr1x(i,j),
     + psey-pr1y(i,j),6)
c       call line(psep+pl1x(i,j),psey-pl1y(i,j),psep+pr2x(i,j),
c     + psey-pr2y(i,j),5)
       call line(psep+pl1x(i,j),psey-pl1y(i,j),psep+pl2x(i,j),
     + psey-pl2y(i,j),4)
       call line(psep+pr1x(i,j),psey-pr1y(i,j),psep+pr2x(i,j),
     + psey-pr2y(i,j),3)
c       call line(psep+pr1x(i,j),psey-pr1y(i,j),psep+pl2x(i,j),
c     + psey-pl2y(i,j),2)
       call line(psep+pl2x(i,j),psey-pl2y(i,j),psep+pr2x(i,j),
     + psey-pr2y(i,j),3)

       end do

       end do

       end if ! Vents classical

       end if ! n1draw


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     8. SKIN TENSION
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.1 Calculs previs
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Vores de costura

       xcos=xupp/10. ! extrados

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Longituds i amples de celles
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      8.1.1 Extrados longitud cella extrema       
       i=nribss
       rib(nribss,23)=0.
       do j=1,np(nribss,2)-1
       rib(nribss,23)=rib(i,23)+sqrt((pr2x(i-1,j)-pr1x(i-1,j))**2+
     + (pr2y(i-1,j)-pr1y(i-1,j))**2)
       end do

c      8.1.2 Intrados longitud cella extrema       
       i=nribss
       rib(nribss,25)=0.
       do j=np(i,2)+np(i,3)-1,np(i,1)-1
       rib(i,25)=rib(i,25)+sqrt((pr2x(i-1,j)-pr1x(i-1,j))**2+
     + (pr2y(i-1,j)-pr1y(i-1,j))**2)
       end do

c      8.1.2+ Inlet longitud cella extrema       
       i=nribss
       rib(nribss,26)=0.
       do j=np(i,2),np(i,2)+np(i,3)-2
       rib(i,26)=rib(i,26)+sqrt((pr2x(i-1,j)-pr1x(i-1,j))**2+
     + (pr2y(i-1,j)-pr1y(i-1,j))**2)
       end do

c      Resta de celles
       do i=0,nribss-1

       rib(i,23)=0.
       rib(i,25)=0.
       rib(i,26)=0.

c      8.1.3 Longitud extrados
       do j=1,np(i,2)-1
       rib(i,23)=rib(i,23)+sqrt((pl2x(i,j)-pl1x(i,j))**2+
     + (pl2y(i,j)-pl1y(i,j))**2)
       end do

c      8.1.4 Longitud intrados
       do j=np(i,2)+np(i,3)-1,np(i,1)-1
       rib(i,25)=rib(i,25)+sqrt((pl2x(i,j)-pl1x(i,j))**2+
     + (pl2y(i,j)-pl1y(i,j))**2)
       end do

c      8.1.5 Longitud inlet
       do j=np(i,2),np(i,2)+np(i,3)-2
       rib(i,26)=rib(i,26)+sqrt((pl2x(i,j)-pl1x(i,j))**2+
     + (pl2y(i,j)-pl1y(i,j))**2)
       end do

c      8.1.6 Punts de calcul amples de celles

c      Calcula punts je ji per definir ample celles, calcula ample

       je=int(np(i,2)/2)
       rib(i,22)=dsqrt((pr1x(i,je)-pl1x(i,je))**2.+(pr1y(i,je)
     + -pl1y(i,je))**2.)

       ji=int((np(i,2)+np(i,3)-1+np(i,1))/2)
       rib(i,24)=dsqrt((pr1x(i,ji)-pl1x(i,ji))**2.+(pr1y(i,ji)
     + -pl1y(i,ji))**2.)

c      Print linia esquerra
c       do j=1,np(i,2)-1
c       call line(pl1x(i,j),-pl1y(i,j),pl2x(i,j),-pl2y(i,j),1)
c       end do

       end do

c      Ample celles extremes       
       i=nribss
       je=int(np(i,2)/2)
       rib(i,22)=dsqrt((pr1x(i-1,je)-pl1x(i-1,je))**2.+(pr1y(i-1,je)
     + -pl1y(i-1,je))**2.)

       ji=int((np(i,2)+np(i,3)-1+np(i,1))/2)
       rib(i,24)=dsqrt((pr1x(i-1,ji)-pl1x(i-1,ji))**2.+(pr1y(i-1,ji)
     + -pl1y(i-1,ji))**2.)

c      WARNING 20190624: Ample inlet not defined here!

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.2 SOBREAMPLES EXTRADOS
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c        write (*,*) "pi 8.2. =",pi

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case classic skin tension k31d=0
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (k31d.eq.0) then

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.2.1 Sobreamples esquerra extrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=0,nribss

c      Initialize sob points from TE to LE

       do k=1,6
       xsob(k)=((100.-(skin(7-k,1)))/100.)*rib(i,23)
       ysob(k)=rib(i,22)*skin(7-k,2)/100.
       end do

c      Longituds u

       u(i,1,7)=0.
       
       do j=1,np(i,2)-1
       u(i,j+1,7)=u(i,j,7)+sqrt((pl2x(i,j)-pl1x(i,j))**2+
     + (pl2y(i,j)-pl1y(i,j))**2)
       end do

c      Sobreamples v      

       v(i,1,7)=rib(i,22)*skin(6,2)/100.

       do j=1,np(i,2)-1

c      LE zone

       if(u(i,j+1,7).le.xsob(2)) then
       xm=(ysob(2)-ysob(1))/(xsob(2)-xsob(1))
       xn=ysob(2)-xm*xsob(2)
       v(i,j+1,7)=xm*(u(i,j+1,7))+xn
       xm1=xm
       xn1=xn
       end if
       
       if(u(i,j+1,7).gt.xsob(2).and.u(i,j+1,7).le.xsob(3)) then
       xm=(ysob(3)-ysob(2))/(xsob(3)-xsob(2))
       xn=ysob(2)-xm*xsob(2)
       v(i,j+1,7)=xm*(u(i,j+1,7))+xn
       xm2=xm
       xn2=xn
       end if

c      Central panel

       if(u(i,j+1,7).gt.xsob(3).and.u(i,j+1,7).le.xsob(4)) then
       xm=(ysob(4)-ysob(3))/(xsob(4)-xsob(3))
       xn=ysob(3)-xm*xsob(3)
       v(i,j+1,7)=xm*(u(i,j+1,7))+xn
       xm2=xm
       xn2=xn
       end if

c      TE zone

       if(u(i,j+1,7).gt.xsob(4).and.u(i,j+1,7).le.xsob(5)) then
       xm=(ysob(5)-ysob(4))/(xsob(5)-xsob(4))
       xn=ysob(4)-xm*xsob(4)
       v(i,j+1,7)=xm*(u(i,j+1,7))+xn
       xm3=xm
       xn3=xn

       end if

       if(u(i,j+1,7).gt.xsob(5)) then
       xm=(ysob(6)-ysob(5))/(xsob(6)-xsob(5))
       xn=ysob(5)-xm*xsob(5)
       v(i,j+1,7)=xm*(u(i,j+1,7))+xn
       xm3=xm
       xn3=xn
       end if

c      Calcula punts esquerra

       xdv=(pl2y(i,j)-pl1y(i,j))
       xdu=(pl2x(i,j)-pl1x(i,j))

       if (xdv.ne.0.) then
       alpl=abs(datan((pl2y(i,j)-pl1y(i,j))/(pl2x(i,j)-pl1x(i,j))))
       else
       alpl=2.*datan(1.0d0)
       end if

       if (xdu.ge.0.and.xdv.ge.0) then ! case 2-I
       siu(j)=-1.
       siv(j)=1.
       end if
       if (xdu.le.0.and.xdv.ge.0) then ! case 2-II
       siu(j)=-1.
       siv(j)=-1.
       end if
       if (xdu.ge.0.and.xdv.le.0) then ! case 2-III
       siu(j)=1.
       siv(j)=1.
       end if
       if (xdu.le.0.and.xdv.le.0) then ! case 2-IV
       siu(j)=1.
       siv(j)=-1.
       end if

c      WARNING!!!!!!!!!!! pl2x,pl2y or pl1x,pl1y?????????
c      Amb "2" fa un salt la vora esquerra...

       u(i,j+1,9)=pl2x(i,j)+siu(j)*v(i,j+1,7)*dsin(alpl)
       v(i,j+1,9)=pl2y(i,j)+siv(j)*v(i,j+1,7)*dcos(alpl)

       u(i,j+1,11)=u(i,j+1,9)+siu(j)*xupp*0.1*dsin(alpl)
       v(i,j+1,11)=v(i,j+1,9)+siv(j)*xupp*0.1*dcos(alpl)

c      Impresió de control
c       if (j.eq.10) then
c       write (*,*) "OOO ",i,u(i,j+1,9),v(i,j+1,9)  
c       end if
       
       end do ! j=1,np(i,2)-1

c      Punt inicial j=1
       
       alpl=abs(datan((pl2y(i,1)-pl1y(i,1))/(pl2x(i,1)-pl1x(i,1))))

c      Potser hauria de ser pl1x i pl1y???? Yes
       u(i,1,9)=pl1x(i,j)+siu(1)*v(i,1,7)*dsin(alpl)
       v(i,1,9)=pl1y(i,j)+siv(1)*v(i,1,7)*dcos(alpl)

       u(i,1,11)=u(i,1,9)+siu(1)*xupp*0.1*dsin(alpl)
       v(i,1,11)=v(i,1,9)+siv(1)*xupp*0.1*dcos(alpl)


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Opció usar subrutina (sobreescriu punts anteriors)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       call puntslat(i,pl1x,pl1y,pl2x,pl2y,1,np(i,2)-1,u,v,xupp,-1)


       end do  ! i

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.2.2 Sobreamples dreta extrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Sobreamples dreta

       do i=0,nribss

c      Initialize sob points

       do k=1,6

       xsob(k)=((100.-(skin(7-k,1)))/100.)*rib(i+1,23)
       ysob(k)=rib(i,22)*skin(7-k,2)/100.

       end do

c      Longitud u

       u(i,1,8)=0.
       
       do j=1,np(i,2)-1

       u(i,j+1,8)=u(i,j,8)+sqrt((pr2x(i,j)-pr1x(i,j))**2+
     + (pr2y(i,j)-pr1y(i,j))**2)

       end do

c      Sobreamples v      

       v(i,1,8)=rib(i,22)*skin(6,2)/100.

       do j=1,np(i,2)-1

c      LE zone

       if(u(i,j+1,8).le.xsob(2)) then
       xm=(ysob(2)-ysob(1))/(xsob(2)-xsob(1))
       xn=ysob(2)-xm*xsob(2)
       v(i,j+1,8)=xm*(u(i,j+1,8))+xn
       xm1=xm
       xn1=xn
       end if

       if(u(i,j+1,8).gt.xsob(2).and.u(i,j+1,8).le.xsob(3)) then
       xm=(ysob(3)-ysob(2))/(xsob(3)-xsob(2))
       xn=ysob(2)-xm*xsob(2)
       v(i,j+1,8)=xm*(u(i,j+1,8))+xn
       xm2=xm
       xn2=xn
       end if

c      Central panel

       if(u(i,j+1,8).gt.xsob(3).and.u(i,j+1,8).le.xsob(4)) then
       xm=(ysob(4)-ysob(3))/(xsob(4)-xsob(3))
       xn=ysob(3)-xm*xsob(3)
       v(i,j+1,8)=xm*(u(i,j+1,8))+xn
       xm2=xm
       xn2=xn
       end if

c      TE zone

       if(u(i,j+1,8).gt.xsob(4).and.u(i,j+1,8).le.xsob(5)) then
       xm=(ysob(5)-ysob(4))/(xsob(5)-xsob(4))
       xn=ysob(4)-xm*xsob(4)
       v(i,j+1,8)=xm*(u(i,j+1,8))+xn
       xm3=xm
       xn3=xn
       end if

       if(u(i,j+1,8).gt.xsob(5)) then
       xm=(ysob(6)-ysob(5))/(xsob(6)-xsob(5))
       xn=ysob(5)-xm*xsob(5)
       v(i,j+1,8)=xm*(u(i,j+1,8))+xn
       xm3=xm
       xn3=xn
       end if

c      Calcula punts dreta

       xdv=(pr2y(i,j)-pr1y(i,j))
       xdu=(pr2x(i,j)-pr1x(i,j))

       if (xdv.ne.0.) then
       alpr=abs(datan((pr2y(i,j)-pr1y(i,j))/(pr2x(i,j)-pr1x(i,j))))
       else
       alpr=2.*datan(1.0d0)
       end if

       if (xdu.ge.0.and.xdv.ge.0) then ! case 3-I
       siu(j)=1.
       siv(j)=-1.
       end if
       if (xdu.le.0.and.xdv.ge.0) then ! case 3-II
       siu(j)=1.
       siv(j)=1.
       end if
       if (xdu.ge.0.and.xdv.le.0) then ! case 3-III
       siu(j)=-1.
       siv(j)=-1.
       end if
       if (xdu.le.0.and.xdv.le.0) then ! case 3-IV
       siu(j)=-1.
       siv(j)=1.
       end if

       u(i,j+1,10)=pr2x(i,j)+siu(j)*v(i,j+1,8)*dsin(alpr)
       v(i,j+1,10)=pr2y(i,j)+siv(j)*v(i,j+1,8)*dcos(alpr)

       u(i,j+1,12)=u(i,j+1,10)+siu(j)*xupp*0.1*dsin(alpr)
       v(i,j+1,12)=v(i,j+1,10)+siv(j)*xupp*0.1*dcos(alpr)

       end do  ! j=1,np(i,2)-1

c      Initial point not defined in previous bucle

       alpr=abs(datan((pr2y(i,1)-pr1y(i,1))/(pr2x(i,1)-pr1x(i,1))))

       u(i,1,10)=pr1x(i,1)+siu(1)*v(i,1,8)*dsin(alpr)
       v(i,1,10)=pr1y(i,1)+siv(1)*v(i,1,8)*dcos(alpr)
       
       u(i,1,12)=u(i,1,10)+siu(1)*xupp*0.1*dsin(alpr)
       v(i,1,12)=v(i,1,10)+siv(1)*xupp*0.1*dcos(alpr)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Opció usar subrutina (sobreescriu punts anteriors)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       call puntslat(i,pr1x,pr1y,pr2x,pr2y,1,np(i,2)-1,u,v,xupp,1)


c      Leading edge segment unformated rib(i,96) extra

       if (i.lt.nribss) then
       j=np(i,2)
       rib(i,96)=dsqrt((u(i,j,9)-u(i,j,10))**2.+
     + ((v(i,j,9)-v(i,j,10))**2.))
       end if

       end do  ! i

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       end if  ! Case classic skin tension k31d=0
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case new skin tension k31d=1 Linear interpolation EXTRADOS
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (k31d.eq.1) then

c       write (*,*) "NOTE: NEW skin tension"

c      Case 1: Linear interpolation and cell width is rib(i,22) in extrados
c      and rib(i,24) in intrados
c      If (ntypei31(i).eq.1) then

c      Initialize sob points
       do i=0,nribss
       do k=1,skinpoints(i)
       xsobnew(i,k)=((100.-(skinnew(i,skinpoints(i)+1-k,1)))/100.)
     + *rib(i,23)
       ysobnew(i,k)=rib(i,22)*skinnew(i,skinpoints(i)+1-k,2)/100.
       end do ! k
       end do ! i (initialize all sob points)

       do i=0,nribss
 
c      Initialize vector extrados left side
       do j=1,np(i,2)
       u(i,j,50)=u(i,j,7)
       u(i,j,51)=u(i,j,8) ! ? verificar significat vectors 50 i 51
       end do  ! j

c      Assign lengths and sob distances
       u(i,1,7)=0.
       u(i,1,8)=0.

       do j=1,np(i,2)
       do k=1,skinpoints(i)-1

c      Left side
       if (u(i,j,7).ge.xsobnew(i,k).and.u(i,j,7).le.xsobnew(i,k+1)
     + *1.001) ! NOTE: Comparar reals és perillós, afegim multiplicador
     + then
       xm=(ysobnew(i,k+1)-ysobnew(i,k))/(xsobnew(i,k+1)-xsobnew(i,k))
       xn=ysobnew(i,k+1)-xm*xsobnew(i,k+1)
       v(i,j,7)=xm*(u(i,j,7))+xn
       end if

       u(i,j+1,7)=u(i,j,7)+sqrt((pl2x(i,j)-pl1x(i,j))**2+
     + (pl2y(i,j)-pl1y(i,j))**2)

       end do ! k

       end do ! j

c      Compute points left side
       call puntslat(i,pl1x,pl1y,pl2x,pl2y,1,np(i,2),u,v,xupp,-1)

       end do  ! i

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Right side: Use length of rib(i+1,23)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Initialize again sob points
       do i=0,nribss
       do k=1,skinpoints(i)
       xsobnew(i,k)=((100.-(skinnew(i+1,skinpoints(i+1)+1-k,1)))/100.)
     + *rib(i+1,23)
       ysobnew(i,k)=rib(i,22)*skinnew(i+1,skinpoints(i+1)+1-k,2)/100.
       end do ! k
       end do ! i (initialize all sob points)

       do i=0,nribss
 
c      Initialize vector extrados left side
       do j=1,np(i,2)
       u(i,j,50)=u(i,j,7)
       u(i,j,51)=u(i,j,8) ! ? verificar significat vectors 50 i 51
       end do  ! j

c      Assign lengths and sob distances
       u(i,1,7)=0.
       u(i,1,8)=0.

       do j=1,np(i,2)
       do k=1,skinpoints(i)

c      Right side
       if (i.lt.nribss) then

       if (u(i,j,8).ge.xsobnew(i+0,k).and.u(i,j,8).le.xsobnew(i+0,k+1)
     + *1.001) ! NOTE: Comparar reals és perillós, afegim multiplicador
     + then
       xm=(ysobnew(i+0,k+1)-ysobnew(i+0,k))/
     +    (xsobnew(i+0,k+1)-xsobnew(i+0,k))
       xn=ysobnew(i+0,k+1)-xm*xsobnew(i+0,k+1)
       v(i,j,8)=xm*(u(i,j,8))+xn
       end if

       u(i,j+1,8)=u(i,j,8)+sqrt((pr2x(i,j)-pr1x(i,j))**2+
     + (pr2y(i,j)-pr1y(i,j))**2)

c      VERIFICAR QUE:
c      u(i,np(i,2),8)=xsobnew(i+1,kmax) !!!!!!!!!!!!!!!!!!
c      I coherencia amb pr* !!!!

       end if

       end do ! k

       end do ! j

c       write (*,*) i,u(i,np(i,2),7),xsobnew(i-1,skinpoints(i)),
c     + u(i,np(i,2),8),xsobnew(i,skinpoints(i))

c      Compute points right side
       call puntslat(i,pr1x,pr1y,pr2x,pr2y,1,np(i,2),u,v,xupp,1)

c      Leading edge segment unformated rib(i,96) extra
       if (i.lt.nribss) then
       j=np(i,2)
       rib(i,96)=dsqrt((u(i,j,9)-u(i,j,10))**2.+
     + ((v(i,j,9)-v(i,j,10))**2.))
       end if

       end do  ! i

c       end if ! end case 1.1

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       end if  ! k31d=1 Linear interpolation EXTRADOS
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.2.3 Reformat right side of extrados panels (optional)
c            "antiprecission"
c      Method not recommended
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Define provisional vector 29, used later in 11.4 (Panels marks)

       do i=0,nribss-1
       do j=1,np(i,2)
       u(i,j,29)=u(i,j,10)
       v(i,j,29)=v(i,j,10)
       end do
       end do

c      Jump to the end if ndif=1000 (no effect)
       if (ndif.ne.1000) then 
      
c      Avoid xndif=0
       if (xndif.eq.0.) then
       xndif=0.01
       end if

c      Salva punts corva interior a vector 29 per a usos posterior
c      rib(i,36)

       do i=0,nribss-1
       do j=1,np(i,2)

       u(i,j,29)=u(i,j,10)
       v(i,j,29)=v(i,j,10)

       end do
       end do

c      Calcula diferencies de longitud costat exterior - interior

c       ndif=15
c       xndif=0.9

       do i=1,nribss-1
       rib(i,80)=0.
       rib(i,79)=0.
       end do

       do i=1,nribss-1

       do j=np(i,2)-ndif,np(i,2)-1

       rib(i,80)=rib(i,80)+sqrt((u(i,j,11)-u(i,j+1,11))**2.+
     + (v(i,j,11)-v(i,j+1,11))**2.)

       rib(i,79)=rib(i,79)+sqrt((u(i-1,j,12)-u(i-1,j+1,12))**2.+
     + (v(i-1,j,12)-v(i-1,j+1,12))**2.)

       end do

       rib(i,81)=(rib(i,80)-rib(i,79))*xndif

c       write (*,*) "rib(i,81) ", i, rib(i,81)

       end do

c      Redefinir punts 10 i 12 del morro dels panells

       do i=1,nribss-1

       xxa=dsqrt((u(i-1,np(i-1,2),9)-u(i-1,np(i-1,2),10))**2.+
     + (v(i-1,np(i-1,2),9)-v(i-1,np(i-1,2),10))**2.)

       tetha3=dacos(rib(i,81)/(2.*xxa))

       tetha1=datan((v(i-1,np(i-1,2),9)-v(i-1,np(i-1,2),10))/
     + (u(i-1,np(i-1,2),10)-u(i-1,np(i-1,2),9)))

       tetha2=pi-tetha3-tetha1

       u(i-1,np(i,2),28)=u(i-1,np(i,2),10)+rib(i,81)*dcos(tetha2)
       v(i-1,np(i,2),28)=v(i-1,np(i,2),10)+rib(i,81)*dsin(tetha2)
      
       end do

c      Alineació del tram modificat      

       do i=1,nribss-1

       tetha4=datan((v(i-1,np(i,2),28)-v(i-1,np(i,2),10))/
     + (u(i-1,np(i,2),28)-u(i-1,np(i,2),10)))

       rib(i,82)=dsqrt((u(i-1,np(i-1,2)-ndif,10)-u(i-1,np(i-1,2),10))
     + **2.+(v(i-1,np(i-1,2)-ndif,10)-v(i-1,np(i-1,2),10))**2.)

       do j=np(i-1,2)-ndif, np(i-1,2)

       xdis=dsqrt((u(i-1,j,10)-u(i-1,np(i-1,2)-ndif,10))**2.+
     + (v(i-1,j,10)-v(i-1,np(i-1,2)-ndif,10))**2.)

       u(i-1,j,10)=u(i-1,j,10)+(xdis**3./(rib(i,82)**3.))*
     + rib(i,81)*dcos(tetha4)
       v(i-1,j,10)=v(i-1,j,10)+(xdis**3./(rib(i,82)**3.))*
     + rib(i,81)*dsin(tetha4)

       end do

       end do

c      Actualitza les vores i punts especials

       do i=0,nribss-2

       do j=np(i,2)-ndif, np(i,2)

       alpr=abs(datan((v(i,j,10)-v(i,j-1,10))/
     + (u(i,j,10)-u(i,j-1,10))))
       u(i,j,12)=u(i,j,10)+xcos*dsin(alpr)
       v(i,j,12)=v(i,j,10)-xcos*dcos(alpr)

       end do

       alple=abs(datan((v(i,np(i,2),10)-v(i,np(i,2),9))/
     + (u(i,np(i,2),10)-u(i,np(i,2),9))))

       u(i,np(i,2),15)=u(i,np(i,2),10)+xupple*0.1*dsin(alple)
       v(i,np(i,2),15)=v(i,np(i,2),10)+xupple*0.1*dcos(alple)

       u(i,np(i,2),25)=u(i,np(i,2),15)+xupp*0.1*dcos(alple)
       v(i,np(i,2),25)=v(i,np(i,2),15)-xupp*0.1*dsin(alple)


       amle=(v(i,np(i,2),10)-v(i,np(i,2),9))/
     + (u(i,np(i,2),10)-u(i,np(i,2),9))

ccccccc Warning pr2y...       
       amler=((pr2y(i,np(i,2)-1)-pr1y(i,np(i,2)-1))/
     + (pr2x(i,np(i,2)-1)-pr1x(i,np(i,2)-1)))

       b1=v(i,np(i,2),15)-amle*u(i,np(i,2),15)
       b2=v(i,np(i,2),12)-amler*u(i,np(i,2),12)

       u(i,np(i,2),27)=(b2-b1)/(amle-amler)
       v(i,np(i,2),27)=amle*u(i,np(i,2),27)+b1

       end do


       end if ! Jump section if ne=1000
       
c14     continue

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.2.4 REFORMAT PANELS FOR PERFECT MATCHING
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Detect if ndif parameter is set for reformat
       if (ndif.eq.1000) then

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     Compute rib and panels lengths (also done in chapter 11. (!!!!))
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=0,nribss

       rib(i,30)=0. ! extra panel left
       rib(i,31)=0. ! extra rib
       rib(i,32)=0. ! extra panel right
       rib(i,33)=0. ! intra panel left
       rib(i,34)=0. ! intra rib
       rib(i,35)=0. ! intra panel right

c      At left
       do j=1,np(i,2)-1

       rib(i,30)=rib(i,30)+sqrt((u(i-1,j,10)-u(i-1,j+1,10))**2.+
     + ((v(i-1,j,10)-v(i-1,j+1,10))**2.))

       rib(i,31)=rib(i,31)+sqrt((u(i,j,3)-u(i,j+1,3))**2.+((v(i,j,3)
     + -v(i,j+1,3))**2.))

       rib(i,32)=rib(i,32)+sqrt((u(i,j,9)-u(i,j+1,9))**2.+((v(i,j,9)
     + -v(i,j+1,9))**2.))

       end do

       do j=np(i,2)+np(i,3),np(i,1)-1

       rib(i,33)=rib(i,33)+sqrt((u(i-1,j,10)-u(i-1,j+1,10))**2.+
     + ((v(i-1,j,10)-v(i-1,j+1,10))**2.))

       rib(i,34)=rib(i,34)+sqrt((u(i,j,3)-u(i,j+1,3))**2.+((v(i,j,3)
     + -v(i,j+1,3))**2.))

       rib(i,35)=rib(i,35)+sqrt((u(i,j,9)-u(i,j+1,9))**2.+((v(i,j,9)
     + -v(i,j+1,9))**2.))

       end do

c      Amplification cofficients
       rib(i,36)=rib(i,30)/rib(i,31)
       rib(i,37)=rib(i,32)/rib(i,31)
       rib(i,38)=rib(i,33)/rib(i,34)
       rib(i,39)=rib(i,35)/rib(i,34)

       rib(0,36)=rib(1,36)
       rib(0,37)=rib(1,36)
       rib(0,38)=rib(1,38)
       rib(0,39)=rib(1,38)

c      Differences with control coefficient xndif

       rib(i,90)=xndif*(rib(i,31)-rib(i,30))
       rib(i,92)=xndif*(rib(i,31)-rib(i,32))

       end do

c      Define rib 0
       rib(0,30)=rib(1,32)
       rib(0,31)=rib(1,31)
       rib(0,32)=rib(1,30)

       rib(0,33)=rib(1,35)
       rib(0,34)=rib(1,34)
       rib(0,35)=rib(1,33)

       rib(0,90)=xndif*(rib(0,31)-rib(0,30))
       rib(0,92)=xndif*(rib(0,31)-rib(0,32))


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Identify point jirl-r where initialize reformating skin(3,1) in %
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=0,nribss

c      Left side

       xirl(i)=rib(i,30)*skin(3,1)/100.

       rib(i,40)=0.
       do j=1,np(i,2)-1
       rib(i,40)=rib(i,40)+sqrt((u(i-1,j,10)-u(i-1,j+1,10))**2.+
     + (v(i-1,j,10)-v(i-1,j+1,10))**2.)
       if (rib(i,40).lt.rib(i,30)-xirl(i)) then
       x40=rib(i,40)
       jirl(i)=j
       end if
       end do

c      Right side

       xirr(i)=rib(i,32)*skin(3,1)/100.

       rib(i,42)=0.
       do j=1,np(i,2)-1
       rib(i,42)=rib(i,42)+sqrt((u(i,j,9)-u(i,j+1,9))**2.+
     + (v(i,j,9)-v(i,j+1,9))**2.)
       if (rib(i,42).lt.rib(i,32)-xirr(i)) then
       x42=rib(i,42)
       jirr(i)=j
       end if
       end do

       end do

c      Assign in rib 0
       jirl(0)=jirl(1)
       jirr(0)=jirr(1)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat the last segments
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat left side - extrados
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=1,nribss

c      Calcule length of the reformating polyline

       dist1=0.
       do j=1,jirl(i)-1
       dist1=dist1+sqrt((v(i-1,j,10)-v(i-1,j+1,10))**2.+
     + (u(i-1,j,10)-u(i-1,j+1,10))**2.)
       end do
       
       dist2=0.
       do j=jirl(i),np(i,2)-1
       dist2=dist2+sqrt((v(i-1,j,10)-v(i-1,j+1,10))**2.+
     + (u(i-1,j,10)-u(i-1,j+1,10))**2.)
       end do

       dist3=dist2+rib(i,90)

       distk=dist3/dist2  ! amplification coefficient

c      Reformat
      
       j=jirl(i-1)-1
       u(i-1,j,30)=u(i-1,j,10)
       v(i-1,j,30)=v(i-1,j,10)

       dis22=0.

       do j=jirl(i),np(i,2)-1

c      Atention whit angle definition using abs tangents
c      Make subroutines
c      Angles and distances, left side

       xdv=(v(i-1,j+1,10)-v(i-1,j,10))
       xdu=(u(i-1,j+1,10)-u(i-1,j,10))
       if (xdu.ne.0.) then
       anglee(j)=abs(datan(xdv/xdu))
       else
       anglee(j)=2.*datan(1.0d0)
       end if

       if (xdu.ge.0.and.xdv.ge.0) then ! case 1-I
       siu(j)=1.
       siv(j)=1.
       end if
       if (xdu.le.0.and.xdv.ge.0) then ! case 1-II
       siu(j)=-1.
       siv(j)=1.
       end if
       if (xdu.ge.0.and.xdv.le.0) then ! case 1-III
       siu(j)=1.
       siv(j)=-1.
       end if
       if (xdu.le.0.and.xdv.le.0) then ! case 1-IV
       siu(j)=-1.
       siv(j)=-1.
       end if

       distee(j)=dsqrt((v(i-1,j,10)-v(i-1,j+1,10))**2.+
     + (u(i-1,j,10)-u(i-1,j+1,10))**2.)

       end do

c      Define

       do j=jirl(i),np(i,2)-1
       u(i-1,j+1,30)=u(i-1,j,10)+siu(j)*distk*distee(j)*dcos(anglee(j))
       v(i-1,j+1,30)=v(i-1,j,10)+siv(j)*distk*distee(j)*dsin(anglee(j))
       u(i-1,j+1,10)=u(i-1,j+1,30)
       v(i-1,j+1,10)=v(i-1,j+1,30)
       end do

       j=np(i,2)+1
       u(i-1,j,10)=u(i-1,j-1,10)+u(i-1,j-1,10)-u(i-1,j-2,10)
       v(i-1,j,10)=v(i-1,j-1,10)+v(i-1,j-1,10)-v(i-1,j-2,10)

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat right side - extrados
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=0,nribss

c      Calcule length of the reformating polyline

       dist1=0.
       do j=1,jirr(i)-1
       dist1=dist1+sqrt((v(i,j,9)-v(i,j+1,9))**2.+
     + (u(i,j,9)-u(i,j+1,9))**2.)
       end do
       
       dist2=0.
       do j=jirr(i),np(i,2)-1
       dist2=dist2+sqrt((v(i,j,9)-v(i,j+1,9))**2.+
     + (u(i,j,9)-u(i,j+1,9))**2.)
       end do

       dist3=dist2+rib(i,92)

       distk=dist3/dist2  ! amplification coefficient

c      Reformat
      
       j=jirr(i-1)-1
       u(i,j,32)=u(i,j,9)
       v(i,j,32)=v(i,j,9)

       do j=jirr(i),np(i,2)-1

c      Atention whit angle definition using abs tangents
c      Make subroutines
c      Angles and distances, left side

       xdv=(v(i,j+1,9)-v(i,j,9))
       xdu=(u(i,j+1,9)-u(i,j,9))
       if (xdu.ne.0.) then
       anglee(j)=abs(datan(xdv/xdu))
       else
       anglee(j)=2.*datan(1.0d0)
       end if

       if (xdu.ge.0.and.xdv.ge.0) then ! case 1-I
       siu(j)=1.
       siv(j)=1.
       end if
       if (xdu.le.0.and.xdv.ge.0) then ! case 1-II
       siu(j)=-1.
       siv(j)=1.
       end if
       if (xdu.ge.0.and.xdv.le.0) then ! case 1-III
       siu(j)=1.
       siv(j)=-1.
       end if
       if (xdu.le.0.and.xdv.le.0) then ! case 1-IV
       siu(j)=-1.
       siv(j)=-1.
       end if

       distee(j)=dsqrt((v(i,j,9)-v(i,j+1,9))**2.+
     + (u(i,j,9)-u(i,j+1,9))**2.)

       end do

c      Define

       do j=jirr(i),np(i,2)-1
       u(i,j+1,32)=u(i,j,9)+siu(j)*distk*distee(j)*dcos(anglee(j))
       v(i,j+1,32)=v(i,j,9)+siv(j)*distk*distee(j)*dsin(anglee(j))
       u(i,j+1,9)=u(i,j+1,32)
       v(i,j+1,9)=v(i,j+1,32)
       end do

       j=np(i,2)+1
       u(i,j,9)=u(i,j-1,9)+u(i,j-1,9)-u(i,j-2,9)
       v(i,j,9)=v(i,j-1,9)+v(i,j-1,9)-v(i,j-2,9)

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Final verification left and right side
c      Can be erased
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      
       do i=1,nribss

       rib(i,40)=0.
       do j=1,np(i,2)-1
       rib(i,40)=rib(i,40)+sqrt((u(i-1,j,10)-u(i-1,j+1,10))**2.+
     + (v(i-1,j,10)-v(i-1,j+1,10))**2.)
       end do
      
       rib(i,42)=0.
       do j=1,np(i,2)-1
       rib(i,42)=rib(i,42)+sqrt((u(i,j,9)-u(i,j+1,9))**2.+
     + (v(i,j,9)-v(i,j+1,9))**2.)
       end do

c       write (*,*) "IGUALS ",i,rib(i,40),rib(i,31),rib(i,42)

       end do

       end if ! end reformat 

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Distorsion calculus
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Leading edge segment formated rib(i,97) extra

       do i=0,nribss-1

       if (i.lt.nribss) then
       j=np(i,2)
       rib(i,97)=dsqrt((u(i,j,9)-u(i,j,10))**2.+
     + ((v(i,j,9)-v(i,j,10))**2.))
c       write (*,*) "rib(i,97) ",i,rib(i,97)
       end if

       end do

       do i=0,nribss-1

c       write (*,*) "DISTORSION 1 LE (mm)",i,(rib(i,97)-rib(i,96))*10
      
       end do

c      Iterations
       do itera=1,5

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     Distorsion correction
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Correction only for case ndif=1000

       if (ndif.eq.1000) then

       do i=1,nribss-1

       k=jirl(i)

       dist=dsqrt(((u(i,k,9)-u(i,np(i,2),9))**2.)+
     + ((v(i,k,9)-v(i,np(i,2),9))**2.))
      
       epsilon=(rib(i,97)-rib(i,96))

c      Angle of rotation
       if (abs(epsilon).lt.0.01) then
       omega=0.
       else
c      Experimental correction
       omega=1.0*dasin(epsilon/dist)*epsilon/(abs(epsilon))
       end if

c      Rotate left side (all correction)

       do j=jirl(i),np(i,2)-1

c      Atention whit angle definition using abs tangents
c      Make subroutines
c      Angles and distances, left side

       xdv=(v(i,j+1,9)-v(i,j,9))
       xdu=(u(i,j+1,9)-u(i,j,9))
       if (xdu.ne.0.) then
       anglee(j)=abs(datan(xdv/xdu))+omega
       else
       anglee(j)=2.*datan(1.0d0)+omega
       end if

       if (xdu.ge.0.and.xdv.ge.0) then ! case 1-I
       siu(j)=1.
       siv(j)=1.
       end if
       if (xdu.le.0.and.xdv.ge.0) then ! case 1-II
       siu(j)=-1.
       siv(j)=1.
       end if
       if (xdu.ge.0.and.xdv.le.0) then ! case 1-III
       siu(j)=1.
       siv(j)=-1.
       end if
       if (xdu.le.0.and.xdv.le.0) then ! case 1-IV
       siu(j)=-1.
       siv(j)=-1.
       end if

       distee(j)=dsqrt((v(i,j,9)-v(i,j+1,9))**2.+
     + (u(i,j,9)-u(i,j+1,9))**2.)

       end do  ! end j

c      Define

       do j=jirr(i),np(i,2)-1
       u(i,j+1,32)=u(i,j,9)+siu(j)*distee(j)*dcos(anglee(j))
       v(i,j+1,32)=v(i,j,9)+siv(j)*distee(j)*dsin(anglee(j))
       u(i,j+1,9)=u(i,j+1,32)
       v(i,j+1,9)=v(i,j+1,32)
       end do

       end do  ! end i

       end if  ! if ndif=1000


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Distorsion 2 calculus
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Leading edge segment formated rib(i,97) extra

       do i=0,nribss-1

       if (i.lt.nribss) then
       j=np(i,2)
       rib(i,97)=dsqrt((u(i,j,9)-u(i,j,10))**2.+
     + ((v(i,j,9)-v(i,j,10))**2.))
       end if

       end do ! i

       end do ! itera


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     8.2.5 Calcule external points
c     Seam borders left (11) and right (12)
c     Points LE 11,12,14,15,24,25
c     Points TE 11,12,14,15,24,25
c     IMPROVED by subroutine extpoints in 2018-12-26
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      icasec=1 tangent
c      icasec=2 orthogonal

       icasecle=1
       icasecte=1

c      Load vectors

c      Saltar cella 0 si gruix nul
       iini=0
       if (cencell.lt.0.01) then
       iini=1
       end if

       do i=iini,nribss

       npi=1
       npf=np(i,2)
       npo=npf-npi+1

c      Copy data in a free vector
       do j=1,npo

       uf(i,j,9)=u(i,npi+j-1,9)
       uf(i,j,10)=u(i,npi+j-1,10)
       uf(i,j,11)=u(i,npi+j-1,11)
       uf(i,j,12)=u(i,npi+j-1,12)
       vf(i,j,9)=v(i,npi+j-1,9)
       vf(i,j,10)=v(i,npi+j-1,10)
       vf(i,j,11)=v(i,npi+j-1,11)
       vf(i,j,12)=v(i,npi+j-1,12)

       ufe(i,j,9)=u(i,npi+j-1,9)
       ufe(i,j,10)=u(i,npi+j-1,10)
       ufe(i,j,11)=u(i,npi+j-1,11)
       ufe(i,j,12)=u(i,npi+j-1,12)
       vfe(i,j,9)=v(i,npi+j-1,9)
       vfe(i,j,10)=v(i,npi+j-1,10)
       vfe(i,j,11)=v(i,npi+j-1,11)
       vfe(i,j,12)=v(i,npi+j-1,12)

       end do

c      Call external points subroutine
c       call extpoints(i,uf,vf,npo,xupp,xupple,xuppte,1)

       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.2.6 Draw sobreamples extrados panels
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
       if (n1draw.eq.1) then ! draw

c      Box (1,3)

c      Avoid central panel if thickness is 0
       iini=0  ! panel 0 (central)
       if (cencell.lt.0.01) then
       iini=1
       end if

       do i=iini,nribss-1
       
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=400.*xkf

cccccccccccccccccccccccccccccccccccccccccccccccccccccc    
c      Draw minirib extrados
cccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (i.ge.0.and.rib(i+1,56).gt.1.and.rib(i+1,56).ne.100
     + .and.atp.ne."ss") then

       xpo1=(u(i,1,9)+u(i,1,10))/2.
       ypo1=(v(i,1,9)+v(i,1,10))/2.
       j=jcve(i+1)
       xpo2=(u(i,j,9)+u(i,j,10))/2.
       ypo2=(v(i,j,9)+v(i,j,10))/2.

c      Avoid division by zero!!!
       if (xpo2-xpo1.ne.0.) then
       alpha=datan((ypo2-ypo1)/(xpo2-xpo1))
       end if
       if (abs(xpo2-xpo1).lt.0.00001) then
       alpha=pi/2.
       end if

       xpo3=xpo1+rib(i+1,60)*dcos(alpha)
       ypo3=ypo1+rib(i+1,60)*dsin(alpha)
       xdesx=xdes*dsin(alpha)
       xdesy=xdes*dcos(alpha)

c      Draw reference points for miniribs in extrados
       call line(psep+xpo1,psey-ypo1,psep+xpo3,psey-ypo3,5)
       call pointg(psep+xpo1-xdesx,psey-ypo1-xdesy,xcir,1)
       call pointg(psep+xpo3-xdesx,psey-ypo3-xdesy,xcir,1)

c      Laser cuting
       xadd=2520.*xkf
       call point(psep+xpo1+xadd,psey-ypo1,1)
       call point(psep+xpo3+xadd,psey-ypo3,1)

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccc

       npo=np(i,2)

c      Call draw panel extrados (complete)
c       call dpanelc(i,uf,vf,npo,psep,psey)

       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.2.7 Dibuixa sobreamples panells extrados Adre
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Box (1,5)

c      Avoid central panel if thickness is 0
       iini=0  ! panel 0 (central)
       if (cencell.lt.0.01) then
       iini=1
       end if

       do i=iini,nribss-1

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Dibuixa marques romanes AD
       call romano(i,psep+5.,psey+0.5,0.0d0,typm6(8)*0.1,7)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
       psep=1970.*xkf+2520.*xkf+seppix(i)*1.0d0
       psey=400.*xkf

c      Draw romano in last panel
       if (i.eq.nribss-1) then
       call romano(i+1,psep+5.,psey+0.5,0.0d0,typm6(8)*0.1,7)
       end if

c      Call draw panel extrados (complete)
c       call dpanelb(i,uf,vf,npo,psep,psey)

       end do

       end if ! n1draw

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.3 SOBREAMPLES VENTS
c      REVISAR, NO FINALITZAT
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      FUNCIONA (amb artificis!) es pot millorar

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.3.1 Sobreamples vents
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       xcos=xlow/10. ! vent sewing allowance

c      Save xlow
       xlowsaved=xlow

c      Avoid central panel if thickness is 0
       iini=0  ! panel 0 (central)
       if (cencell.lt.0.01) then
       iini=1
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Artifici 1:
c      Salva punts 9,10,11,12 a un vector de seguretat
c      per evitar interferencies en calcul de punts extrados a secció 11.4
c      i recupera després de calcul sobreamples de vents
c      que dónen problemes per algun motiu
c      Eliminar aquesta secció i la seva restitució més a baix
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=iini,nribss

       
       do j=1,np(i,1) ! salva tots els punts

       usalvat(i,j,9)=u(i,j,9)
       vsalvat(i,j,9)=v(i,j,9)
       usalvat(i,j,10)=u(i,j,10)
       vsalvat(i,j,10)=v(i,j,10)

       usalvat(i,j,11)=u(i,j,11)
       vsalvat(i,j,11)=v(i,j,11)
       usalvat(i,j,12)=u(i,j,12)
       vsalvat(i,j,12)=v(i,j,12)

       end do
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.3.1 Sobreamples esquerra vents
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=iini,nribss

c      Set sewing border in vents according vent type
       if (k31d.eq.1.and.rib(i+1,165).ge.1) then
       xlow=xupp 
       else
       xlow=xlowsaved
       end if

c      Initialize sob points

c      CASE 0
       if (k31d.eq.0) then
       xsob(1)=0.
       ysob(1)=rib(i,22)*skin(1,2)/100.
       xsob(2)=rib(i,26)
       ysob(2)=rib(i,24)*skin(6,4)/100.
       end if

c      CASE 1.1
       if (k31d.eq.1) then
       xsob(1)=0.
       ysob(1)=rib(i,22)*skinnew(i,1,2)/100.
       xsob(2)=rib(i,26)
       ysob(2)=rib(i,24)*skinnew(i,skinpoints(i),4)/100.
       end if

c      Longituds u

       u(i,np(i,2),7)=0.
       
       do j=np(i,2),np(i,2)+np(i,3)-1
       u(i,j+1,7)=u(i,j,7)+sqrt((pl2x(i,j)-pl1x(i,j))**2+
     + (pl2y(i,j)-pl1y(i,j))**2)
       end do

c      Sobreample v      

       if (k31d.eq.0) then
       v(i,np(i,2),7)=rib(i,22)*skin(1,2)/100.
       end if
       if (k31d.eq.1) then
       v(i,np(i,2),7)=rib(i,22)*skinnew(i,1,2)/100.
       end if

       do j=np(i,2),np(i,2)+np(i,3)-1

       xm=(ysob(2)-ysob(1))/(xsob(2)-xsob(1))
       xn=ysob(2)-xm*xsob(2)

       v(i,j+1,7)=xm*(u(i,j+1,7))+xn

c      Solve some numeric problems!!!?
       if (v(i,j+1,7).le.0.001) then
       v(i,j+1,7)=0.0d0
       end if

       xm1=xm
       xn1=xn  
      
c      Calcula punts esquerra

       xdv=(pl2y(i,j)-pl1y(i,j))
       xdu=(pl2x(i,j)-pl1x(i,j))

       if (xdv.ne.0.) then
       alpl=abs(datan((pl2y(i,j)-pl1y(i,j))/(pl2x(i,j)-pl1x(i,j))))
       else
       alpl=2.*datan(1.0d0)
       end if

       if (xdu.ge.0.and.xdv.ge.0) then ! case 2-I
       siu(j)=-1.
       siv(j)=1.
       end if
       if (xdu.le.0.and.xdv.ge.0) then ! case 2-II
       siu(j)=-1.
       siv(j)=-1.
       end if
       if (xdu.ge.0.and.xdv.le.0) then ! case 2-III
       siu(j)=1.
       siv(j)=1.
       end if
       if (xdu.le.0.and.xdv.le.0) then ! case 2-IV
       siu(j)=1.
       siv(j)=-1.
       end if

       u(i,j,9)=pl1x(i,j)+siu(j)*v(i,j,7)*dsin(alpl)
       v(i,j,9)=pl1y(i,j)+siv(j)*v(i,j,7)*dcos(alpl)

       u(i,j,11)=u(i,j,9)+siu(j)*xlow*0.1*dsin(alpl)
       v(i,j,11)=v(i,j,9)+siv(j)*xlow*0.1*dcos(alpl)

c      PROBLEM with pl2y(i,j) value when j=np(i,2)
c      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       
       end do

       npx=np(i,2)

       alpl=abs(datan((pl2y(i,npx)-pl1y(i,npx))/
     + (pl2x(i,npx)-pl1x(i,npx))))
       alpl2=alpl

c      pl2x(i,npx-1) no correcte
       u(i,npx,9)=pl1x(i,npx)-v(i,npx,7)*dsin(alpl)
       v(i,npx,9)=pl1y(i,npx)+v(i,npx,7)*dcos(alpl)

       u(i,npx,11)=u(i,npx,9)-xlow*0.1*dsin(alpl)
       v(i,npx,11)=v(i,npx,9)+xlow*0.1*dcos(alpl)

       npx=np(i,2)+np(i,3)-1

       alpl=abs(datan((pl2y(i,npx)-pl1y(i,npx))/
     + (pl2x(i,npx)-pl1x(i,npx))))
       alpl2=alpl

c      pl2x(i,npx-1) no correcte
       u(i,npx,9)=pl1x(i,npx)-v(i,npx,7)*dsin(alpl)
       v(i,npx,9)=pl1y(i,npx)+v(i,npx,7)*dcos(alpl)

       u(i,npx,11)=u(i,npx,9)-xlow*0.1*dsin(alpl)
       v(i,npx,11)=v(i,npx,9)+xlow*0.1*dcos(alpl)
     
       end do ! i

       i=2
       if (i.eq.2) then
       do j=np(i,2),np(i,2)+np(i,3)-1
c       write (*,*) "vent 11 ",i,j,u(i,j,11),v(i,j,11)
       end do
       end if



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.3.2 Sobreamples dreta vents
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=iini,nribss-1

c      Set sewing border in vents according vent type
       if (k31d.eq.1.and.rib(i+1,165).ge.1) then
       xlow=xupp 
       else
       xlow=xlowsaved
       end if

c      Initialize sob points

c      Case k31d=0
       if (k31d.eq.0) then
       xsob(1)=0.
       ysob(1)=rib(i,22)*skin(1,2)/100.
       xsob(2)=rib(i,26)
       ysob(2)=rib(i,24)*skin(6,4)/100.
       end if

c      Case k31d=1
       if (k31d.eq.1) then
       xsob(1)=0.
       ysob(1)=rib(i,22)*skinnew(i+1,1,2)/100.
       xsob(2)=rib(i+1,26)
       ysob(2)=rib(i,24)*skinnew(i+1,skinpoints(i+1),4)/100.
       end if

c      Longituds u

       u(i,np(i,2),8)=0.
       
       do j=np(i,2),np(i,2)+np(i,3)-2
       u(i,j+1,8)=u(i,j,8)+sqrt((pr2x(i,j)-pr1x(i,j))**2+
     + (pr2y(i,j)-pr1y(i,j))**2)
       end do

c      Sobreample v      

       if (k31d.eq.0) then
       v(i,np(i,2),8)=rib(i,22)*skin(1,2)/100.
       end if
       if (k31d.eq.1) then
       v(i,np(i,2),8)=rib(i,22)*skinnew(i+1,1,2)/100.
       end if


       do j=np(i,2),np(i,2)+np(i,3)-2

       xm=(ysob(2)-ysob(1))/(xsob(2)-xsob(1))
       xn=ysob(2)-xm*xsob(2)

       v(i,j+1,8)=xm*(u(i,j+1,8))+xn

       xm1=xm
       xn1=xn  
      
c      Calcula punts dreta

       alpr=abs(datan((pr2y(i,j)-pr1y(i,j))/(pr2x(i,j)-pr1x(i,j))))

       u(i,j+1,10)=pr2x(i,j)+v(i,j+1,8)*dsin(alpr)
       v(i,j+1,10)=pr2y(i,j)-v(i,j+1,8)*dcos(alpr)

       u(i,j+1,12)=u(i,j+1,10)+xlow*0.1*dsin(alpr)
       v(i,j+1,12)=v(i,j+1,10)-xlow*0.1*dcos(alpr)

       end do

       npx=np(i,2)

       alpr=abs(datan((pr2y(i,npx)-pr1y(i,npx))/
     + (pr2x(i,npx)-pr1x(i,npx))))
       alpr2=alpr

       u(i,npx,10)=pr1x(i,npx)+v(i,npx,8)*dsin(alpr)
       v(i,npx,10)=pr1y(i,npx)-v(i,npx,8)*dcos(alpr)
       
       u(i,npx,12)=u(i,npx,10)+xlow*0.1*dsin(alpr)
       v(i,npx,12)=v(i,npx,10)-xlow*0.1*dcos(alpr)

       end do ! i

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.3.3 Calcula cantonades vents
c      Versio millorada segons 8.2.5
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Saltar cella 0 si gruix nul
       iini=0
       if (cencell.lt.0.01) then
       iini=1
       end if

       do i=iini,nribss

       npi=np(i,2)
       npf=np(i,2)+np(i,3)-1
       npo=npf-npi+1

c      Copy data in a free vector
       do j=1,npo

       uf(i,j,9)=u(i,npi+j-1,9)
       uf(i,j,10)=u(i,npi+j-1,10)
       uf(i,j,11)=u(i,npi+j-1,11)
       uf(i,j,12)=u(i,npi+j-1,12)
       vf(i,j,9)=v(i,npi+j-1,9)
       vf(i,j,10)=v(i,npi+j-1,10)
       vf(i,j,11)=v(i,npi+j-1,11)
       vf(i,j,12)=v(i,npi+j-1,12)

       ufv(i,j,9)=u(i,npi+j-1,9)
       ufv(i,j,10)=u(i,npi+j-1,10)
       ufv(i,j,11)=u(i,npi+j-1,11)
       ufv(i,j,12)=u(i,npi+j-1,12)
       vfv(i,j,9)=v(i,npi+j-1,9)
       vfv(i,j,10)=v(i,npi+j-1,10)
       vfv(i,j,11)=v(i,npi+j-1,11)
       vfv(i,j,12)=v(i,npi+j-1,12)

       end do

c      Call external points subroutine
c       call extpoints(i,uf,vf,npo,xupp,xupp,xupp,1)

       end do

c      Retore xlow
       xlow=xlowsaved


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.3.4 Vents drawing > send to 8.5.2
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c       if (k31d.eq.1.and.k26d.ne.0) then ! Draw classic vents

c      Saltar cella 0 si gruix nul
       iini=0
       if (cencell.lt.0.01) then
       iini=1
       end if

       do i=iini,nribss-1
       
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=1371.*xkf
       ncontrol=0

c      Control if cell is closed
       if(int(rib(i,14)).eq.0.and.int(rib(i+1,14)).eq.0) then
       ncontrol=1
       end if

       ncontrol=1       

c      Call draw panel extrados (complete)
c      call dpanelc(i,uf,vf,npo,psep,psey)

       end do

c       end if ! Vents case 1


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Artifici 1:
c      Recupera punts 9,10,11,12 del vector de seguretat
c      per evitar interferencies en calcul de punts extrados a secció 11.4
c      i recupera després de calcul sobreamples de vents
c      que dónen problemes per algun motiu
c      Eliminar aquesta secció i la seva restitució més amunt
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=iini,nribss
       do j=1,np(i,1) ! salva tots els punts

       u(i,j,9)=usalvat(i,j,9)
       v(i,j,9)=vsalvat(i,j,9)
       u(i,j,10)=usalvat(i,j,10)
       v(i,j,10)=vsalvat(i,j,10)

       u(i,j,11)=usalvat(i,j,11)
       v(i,j,11)=vsalvat(i,j,11)
       u(i,j,12)=usalvat(i,j,12)
       v(i,j,12)=vsalvat(i,j,12)

       end do
       end do

       i=2
       if (i.eq.2) then
       do j=1,np(i,2)
c      write (*,*) "salvat-11 ",i,u(i,j,11),v(i,j,11)
       end do
       end if



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.4 SOBREAMPLES INTRADOS
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Artifici 2:
c      Recupera un vector per evitar interferencia vents-intrados
c      Veure apartat 7.4.2
c      Vaja truc!!!
       do i=0,nribss
       npx=np(i,2)+np(i,3)-1
       pl1x(i,npx)=pl1x(i,499)
       pl1y(i,npx)=pl1y(i,499)
       pl2x(i,npx)=pl2x(i,499)       
       pl2y(i,npx)=pl2y(i,499)       
       pr1x(i,npx)=pr1x(i,499)
       pr1y(i,npx)=pr1y(i,499)
       pr2x(i,npx)=pr2x(i,499)
       pr2y(i,npx)=pr2y(i,499)
       end do
       
       xcos=xlow/10. ! intrados sewing allowance

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case classic skin tension k31d=0
c      Includes 8.4.1 and 8.4.2
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (k31d.eq.0) then

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.4.1 Sobreamples esquerra intrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=0,nribss

c      Initialize sob points

       do k=1,6

       xsob(k)=((100.-(skin(7-k,3)))/100.)*rib(i,25)
       ysob(k)=rib(i,24)*skin(7-k,4)/100.

       end do

c      Longituds u

       u(i,np(i,2)+np(i,3)-1,7)=0.
       
       do j=np(i,2)+np(i,3)-1,np(i,1)-1

       u(i,j+1,7)=u(i,j,7)+sqrt((pl2x(i,j)-pl1x(i,j))**2+
     + (pl2y(i,j)-pl1y(i,j))**2)

       end do

c      Sobreample v      

       v(i,np(i,2)+np(i,3)-1,7)=rib(i,24)*skin(6,4)/100.

       do j=np(i,2)+np(i,3)-1,np(i,1)-1

c      LE zone

       if(u(i,j+1,7).le.xsob(2)) then

       xm=(ysob(2)-ysob(1))/(xsob(2)-xsob(1))
       xn=ysob(2)-xm*xsob(2)

       v(i,j+1,7)=xm*(u(i,j+1,7))+xn

       xm1=xm
       xn1=xn

       end if
       
       if(u(i,j+1,7).gt.xsob(2).and.u(i,j+1,7).le.xsob(3)) then

       xm=(ysob(3)-ysob(2))/(xsob(3)-xsob(2))
       xn=ysob(2)-xm*xsob(2)

       v(i,j+1,7)=xm*(u(i,j+1,7))+xn

       xm2=xm
       xn2=xn

       end if

c      Central panel

       if(u(i,j+1,7).gt.xsob(3).and.u(i,j+1,7).le.xsob(4)) then

       xm=(ysob(4)-ysob(3))/(xsob(4)-xsob(3))
       xn=ysob(3)-xm*xsob(3)

       v(i,j+1,7)=xm*(u(i,j+1,7))+xn

       xm2=xm
       xn2=xn

       end if

c      TE zone

       if(u(i,j+1,7).gt.xsob(4).and.u(i,j+1,7).le.xsob(5)) then

       xm=(ysob(5)-ysob(4))/(xsob(5)-xsob(4))
       xn=ysob(4)-xm*xsob(4)

       v(i,j+1,7)=xm*(u(i,j+1,7))+xn

       xm3=xm
       xn3=xn

       end if

       if(u(i,j+1,7).gt.xsob(5)) then

       xm=(ysob(6)-ysob(5))/(xsob(6)-xsob(5))
       xn=ysob(5)-xm*xsob(5)

       v(i,j+1,7)=xm*(u(i,j+1,7))+xn

       xm3=xm
       xn3=xn

       end if

c      Calcula punts esquerra

       alpl=abs(datan((pl2y(i,j)-pl1y(i,j))/(pl2x(i,j)-pl1x(i,j))))

       u(i,j+1,9)=pl2x(i,j)-v(i,j+1,7)*dsin(alpl)
       v(i,j+1,9)=pl2y(i,j)+v(i,j+1,7)*dcos(alpl)

       u(i,j+1,11)=u(i,j+1,9)-xlow*0.1*dsin(alpl)
       v(i,j+1,11)=v(i,j+1,9)+xlow*0.1*dcos(alpl)
       
       end do

c       u(i,np(i,1),14)=u(i,np(i,1),9)+xlowte*0.1*dcos(alpl)
c       v(i,np(i,1),14)=v(i,np(i,1),9)+xlowte*0.1*dsin(alpl)
       
       npx=np(i,2)+np(i,3)-1

       alpl=abs(datan((pl2y(i,npx-1)-pl1y(i,npx-1))/
     + (pl2x(i,npx-1)-pl1x(i,npx-1))))
       alpl2=alpl

c      pl2x(i,npx-1) no correcte
       u(i,npx,9)=pl1x(i,npx)-v(i,npx,7)*dsin(alpl)
       v(i,npx,9)=pl1y(i,npx)+v(i,npx,7)*dcos(alpl)

       u(i,npx,11)=u(i,npx,9)-xlow*0.1*dsin(alpl)
       v(i,npx,11)=v(i,npx,9)+xlow*0.1*dcos(alpl)

c       u(i,npx,14)=u(i,npx,9)-xlowle*0.1*dcos(alpl)
c       v(i,npx,14)=v(i,npx,9)-xlowle*0.1*dsin(alpl)

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.4.2 Sobreamples dreta intrados   
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Sobreamples dreta

       do i=0,nribss

c      Initialize sob points

       do k=1,6

       xsob(k)=((100.-(skin(7-k,3)))/100.)*rib(i+1,25)
       ysob(k)=rib(i,24)*skin(7-k,4)/100.

       end do

c      Longitud u

       u(i,np(i,2)+np(i,3)-1,8)=0.

       do j=np(i,2)+np(i,3)-1,np(i,1)-1

       u(i,j+1,8)=u(i,j,8)+sqrt((pr2x(i,j)-pr1x(i,j))**2+
     + (pr2y(i,j)-pr1y(i,j))**2)

       end do

c      Sobreample v      

       v(i,np(i,2)+np(i,3)-1,8)=rib(i,24)*skin(6,4)/100.

       do j=np(i,2)+np(i,3)-2,np(i,1)-1

c      LE zone

       if(u(i,j+1,8).le.xsob(2)) then

       xm=(ysob(2)-ysob(1))/(xsob(2)-xsob(1))
       xn=ysob(2)-xm*xsob(2)

       v(i,j+1,8)=xm*(u(i,j+1,8))+xn

       xm1=xm
       xn1=xn

       end if

       if(u(i,j+1,8).gt.xsob(2).and.u(i,j+1,8).le.xsob(3)) then

       xm=(ysob(3)-ysob(2))/(xsob(3)-xsob(2))
       xn=ysob(2)-xm*xsob(2)

       v(i,j+1,8)=xm*(u(i,j+1,8))+xn

       xm2=xm
       xn2=xn

       end if

c      Central panel

       if(u(i,j+1,8).gt.xsob(3).and.u(i,j+1,8).le.xsob(4)) then

       xm=(ysob(4)-ysob(3))/(xsob(4)-xsob(3))
       xn=ysob(3)-xm*xsob(3)

       v(i,j+1,8)=xm*(u(i,j+1,8))+xn

       xm2=xm
       xn2=xn

       end if

c      TE zone

       if(u(i,j+1,8).gt.xsob(4).and.u(i,j+1,8).le.xsob(5)) then

       xm=(ysob(5)-ysob(4))/(xsob(5)-xsob(4))
       xn=ysob(4)-xm*xsob(4)

       v(i,j+1,8)=xm*(u(i,j+1,8))+xn

       xm3=xm
       xn3=xn

       end if

       if(u(i,j+1,8).gt.xsob(5)) then

       xm=(ysob(6)-ysob(5))/(xsob(6)-xsob(5))
       xn=ysob(5)-xm*xsob(5)

       v(i,j+1,8)=xm*(u(i,j+1,8))+xn

       xm3=xm
       xn3=xn

       end if

c      Calcula punts dreta

       alpr=abs(datan((pr2y(i,j)-pr1y(i,j))/(pr2x(i,j)-pr1x(i,j))))

c      OPTION add corrections in sign (see 8.2.2)
c      But probably in normal intrados panels is not necessary

       u(i,j+1,10)=pr2x(i,j)+v(i,j+1,8)*dsin(alpr)
       v(i,j+1,10)=pr2y(i,j)-v(i,j+1,8)*dcos(alpr)

       u(i,j+1,12)=u(i,j+1,10)+xlow*0.1*dsin(alpr)
       v(i,j+1,12)=v(i,j+1,10)-xlow*0.1*dcos(alpr)

       end do  ! j=np(i,2)+np(i,3)-1,np(i,1)-1

c      Initial point not definined in previous bucle
       
       npx=np(i,2)+np(i,3)-1

       alpr=abs(datan((pr2y(i,npx)-pr1y(i,npx))/
     + (pr2x(i,npx)-pr1x(i,npx))))
       alpr2=alpr

       u(i,npx,10)=pr1x(i,npx)+v(i,npx,8)*dsin(alpr)
       v(i,npx,10)=pr1y(i,npx)-v(i,npx,8)*dcos(alpr)
       
       u(i,npx,12)=u(i,npx,10)+xlow*0.1*dsin(alpr)
       v(i,npx,12)=v(i,npx,10)-xlow*0.1*dcos(alpr)

c      Leading edge segment unformated rib(i,98) intra

       if (i.lt.nribss) then
       j=np(i,2)+np(i,3)-1
       rib(i,98)=dsqrt((u(i,j,9)-u(i,j,10))**2.+
     + ((v(i,j,9)-v(i,j,10))**2.))
       end if

       end do  ! i

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       end if  ! Case classic skin tension k31d=0
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case new skin tension k31d=1 Linear interpolation INTRADOS
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (k31d.eq.1) then

c       write (*,*) "NOTE: NEW skin tension in intrados"

c      Case 1: Linear interpolation and cell width is rib(i,24)
c       if (ntypei31(i).eq.1) then

c      Initialize sob points
       do i=0,nribss
       do k=1,skinpoints(i)
       xsobnew(i,k)=((100.-(skinnew(i,skinpoints(i)+1-k,3)))/100.)
     + *rib(i,25)
       ysobnew(i,k)=rib(i,24)*skinnew(i,skinpoints(i)+1-k,4)/100.
c       write (*,*) i,k,xsobnew(i,k),ysobnew(i,k)
       end do ! k
       end do ! i (initialize all sob points)

       do i=0,nribss
 
c      Initialize vector extrados left side
       do j=np(i,2)+np(i,3)-1,np(i,1)-1
       u(i,j,50)=u(i,j,7)
c      u(i,j,51)=u(i,j,8) ? verificar significat vectors 50 i 51
       end do  ! j

c      Assign lengths and sob distances
       u(i,np(i,2)+np(i,3)-1,7)=0.
       u(i,np(i,2)+np(i,3)-1,8)=0.

       do j=np(i,2)+np(i,3)-1,np(i,1)
       do k=1,skinpoints(i)

c      Left side
       if (u(i,j,7).ge.xsobnew(i,k).and.u(i,j,7).le.xsobnew(i,k+1)
     + *1.001) ! NOTE: Comparar reals és perillós, afegim multiplicador
     + then
       xm=(ysobnew(i,k+1)-ysobnew(i,k))/(xsobnew(i,k+1)-xsobnew(i,k))
       xn=ysobnew(i,k+1)-xm*xsobnew(i,k+1)
       v(i,j,7)=xm*(u(i,j,7))+xn

       end if

       u(i,j+1,7)=u(i,j,7)+sqrt((pl2x(i,j)-pl1x(i,j))**2+
     + (pl2y(i,j)-pl1y(i,j))**2)

c      Right side
       if (i.lt.nribss) then

       if (u(i,j,8).ge.xsobnew(i+1,k).and.u(i,j,8).le.
     + xsobnew(i+1,k+1)
     + *1.001) ! NOTE: Comparar reals és perillós, afegim multiplicador
     + then
       xm=(ysobnew(i+1,k+1)-ysobnew(i+1,k))/
     +    (xsobnew(i+1,k+1)-xsobnew(i+1,k))
       xn=ysobnew(i+1,k+1)-xm*xsobnew(i+1,k+1)
       v(i,j,8)=xm*(u(i,j,8))+xn

       end if

       u(i,j+1,8)=u(i,j,8)+sqrt((pr2x(i,j)-pr1x(i,j))**2+
     + (pr2y(i,j)-pr1y(i,j))**2)

       end if

       end do ! k

       end do ! j

c      Compute points left side
       call puntslat(i,pl1x,pl1y,pl2x,pl2y,np(i,1)-np(i,4)+1,
     + np(i,1)-1,u,v,xlow,-1)

c      Compute points right side
       call puntslat(i,pr1x,pr1y,pr2x,pr2y,np(i,1)-np(i,4)+1,
     + np(i,1)-1,u,v,xlow,1)

c      Leading edge segment unformated rib(i,98) intra
       if (i.lt.nribss) then
       j=np(i,2)+np(i,3)-1
       rib(i,98)=dsqrt((u(i,j,9)-u(i,j,10))**2.+
     + ((v(i,j,9)-v(i,j,10))**2.))
       end if

       end do  ! i

c       end if ! end case 1.1

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       end if  ! k31d=1 Linear interpolation INTRADOS
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.4.3 Not necessary?
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.4.4 REFORMAT PANELS FOR PERFECT MATCHING
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Detect if ndif parameter is set for reformat
       if (ndif.eq.1000) then

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     Compute rib and panels lengths (also done in chapter 11. (!))
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=0,nribss

       rib(i,33)=0. ! intra panel left
       rib(i,34)=0. ! intra rib
       rib(i,35)=0. ! intra panel right

       do j=np(i,2)+np(i,3)-1,np(i,1)-1

       rib(i,33)=rib(i,33)+sqrt((u(i-1,j,10)-u(i-1,j+1,10))**2.+
     + ((v(i-1,j,10)-v(i-1,j+1,10))**2.))

       rib(i,34)=rib(i,34)+sqrt((u(i,j,3)-u(i,j+1,3))**2.+((v(i,j,3)
     + -v(i,j+1,3))**2.))

       rib(i,35)=rib(i,35)+sqrt((u(i,j,9)-u(i,j+1,9))**2.+((v(i,j,9)
     + -v(i,j+1,9))**2.))

       end do

c      Amplification cofficients
       rib(i,38)=rib(i,33)/rib(i,34)
       rib(i,39)=rib(i,35)/rib(i,34)

       rib(0,38)=rib(1,38)
       rib(0,39)=rib(1,38)

c      Differences with control coefficient xndif

       rib(i,93)=xndif*(rib(i,34)-rib(i,33))
       rib(i,95)=xndif*(rib(i,34)-rib(i,35))

       end do

c      Define rib 0
     
       rib(0,33)=rib(1,35)
       rib(0,34)=rib(1,34)
       rib(0,35)=rib(1,33)

       rib(0,93)=xndif*(rib(0,34)-rib(0,33))
       rib(0,95)=xndif*(rib(0,34)-rib(0,35))

c      Define special rib (probably is not necessary)

       rib(nribss,35)=rib(nribss,34)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Identify point jirl-r where initialize reformating skin(3,3) in %
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=0,nribss

c      Left side

       xirl(i)=rib(i,33)*skin(3,3)/100.

       rib(i,43)=0.
       do j=np(i,2)+np(i,3)-1,np(i,1)-1
       rib(i,43)=rib(i,43)+sqrt((u(i-1,j,10)-u(i-1,j+1,10))**2.+
     + (v(i-1,j,10)-v(i-1,j+1,10))**2.)
       if (rib(i,43).lt.xirl(i)) then
       x43=rib(i,43)
       jirl(i)=j
       end if
       end do

c      Right side

       xirr(i)=rib(i,35)*skin(3,3)/100.

       rib(i,45)=0.
       do j=np(i,2)+np(i,3)-1,np(i,1)-1
       rib(i,45)=rib(i,45)+sqrt((u(i,j,9)-u(i,j+1,9))**2.+
     + (v(i,j,9)-v(i,j+1,9))**2.)
       if (rib(i,45).lt.xirr(i)) then
       x45=rib(i,45)
       jirr(i)=j
       end if
       end do

       end do

c      Assign in rib 0
       jirl(0)=jirl(1)
       jirr(0)=jirr(1)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat the last segments
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat left side - intrados
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=1,nribss

c      Calcule length of the reformating polyline

       dist1=0.0d0
       do j=jirl(i),np(i,1)-1
       dist1=dist1+dsqrt((v(i-1,j,10)-v(i-1,j+1,10))**2.+
     + (u(i-1,j,10)-u(i-1,j+1,10))**2.)
       end do
       
       dist2=0.0d0
       do j=np(i,2)+np(i,3)-1,jirl(i)-1
       dist2=dist2+dsqrt((v(i-1,j,10)-v(i-1,j+1,10))**2.+
     + (u(i-1,j,10)-u(i-1,j+1,10))**2.)
       end do

c       write (*,*) "rib(i,33)=",i,dist1+dist2,rib(i,33),
c     + dist1+dist2-rib(i,33)


       dist3=dist2+rib(i,93)

       distk=dist3/dist2  ! amplification coefficient

c      Reformat
      
       j=jirl(i-1)+1
       u(i-1,j,33)=u(i-1,j,10)
       v(i-1,j,33)=v(i-1,j,10)

c      Eliminar dis22!!!!!!!!!!!!!!!!!!!!!
       dis22=0.

       do j=jirl(i),np(i,2)+np(i,3),-1

c      Atention whit angle definition using abs tangents
c      Make subroutines
c      Angles and distances, left side

       xdv=(v(i-1,j-1,10)-v(i-1,j,10))
       xdu=(u(i-1,j-1,10)-u(i-1,j,10))
       if (xdu.ne.0.) then
       anglee(j)=abs(datan(xdv/xdu))
       else
       anglee(j)=2.*datan(1.0d0)
       end if

       if (xdu.ge.0.and.xdv.ge.0) then ! case 1-I
       siu(j)=1.
       siv(j)=1.
       end if
       if (xdu.le.0.and.xdv.ge.0) then ! case 1-II
       siu(j)=-1.
       siv(j)=1.
       end if
       if (xdu.ge.0.and.xdv.le.0) then ! case 1-III
       siu(j)=1.
       siv(j)=-1.
       end if
       if (xdu.le.0.and.xdv.le.0) then ! case 1-IV
       siu(j)=-1.
       siv(j)=-1.
       end if

       distee(j)=dsqrt((v(i-1,j,10)-v(i-1,j-1,10))**2.+
     + (u(i-1,j,10)-u(i-1,j-1,10))**2.)

       end do

c      Define

       do j=jirl(i),np(i,2)+np(i,3),-1
       u(i-1,j-1,30)=u(i-1,j,10)+siu(j)*distk*distee(j)*dcos(anglee(j))
       v(i-1,j-1,30)=v(i-1,j,10)+siv(j)*distk*distee(j)*dsin(anglee(j))
       u(i-1,j-1,10)=u(i-1,j-1,30)
       v(i-1,j-1,10)=v(i-1,j-1,30)
       end do

c      AFEGIR calcul punts extrems!!!!!!!!!!!

c       j=np(i,2)+np(i,3)-1
c       u(i-1,j,10)=u(i-1,j-1,10)+u(i-1,j-1,10)-u(i-1,j-2,10)
c       v(i-1,j,10)=v(i-1,j-1,10)+v(i-1,j-1,10)-v(i-1,j-2,10)

c      VERIFICATION

       dist=0.0d0
       do j=np(i,2)+np(i,3)-1,np(i,1)-1
       dist=dist+sqrt((v(i-1,j,10)-v(i-1,j+1,10))**2.+
     + (u(i-1,j,10)-u(i-1,j+1,10))**2.)
       end do
c       write (*,*) "VERFICACIO L ",i,dist,rib(i,33),rib(i,34),rib(i,35)

       end do ! i

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat right side - intrados
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=0,nribss

c      Calcule length of the reformating polyline

       dist1=0.0d0
       do j=jirr(i),np(i,1)-1
       dist1=dist1+sqrt((v(i,j,9)-v(i,j+1,9))**2.+
     + (u(i,j,9)-u(i,j+1,9))**2.)
       end do
       
       dist2=0.0d0
       do j=np(i,2)+np(i,3)-1,jirr(i)-1
       dist2=dist2+sqrt((v(i,j,9)-v(i,j+1,9))**2.+
     + (u(i,j,9)-u(i,j+1,9))**2.)
       end do

c       write (*,*) "rib(i,35)=",i,dist1+dist2,rib(i,35),
c     + dist1+dist2-rib(i,35)


       dist3=dist2+rib(i,95)

       distk=dist3/dist2  ! amplification coefficient

c      Reformat
      
       j=jirr(i-1)+1
       u(i,j,35)=u(i,j,9)
       v(i,j,35)=v(i,j,9)

       do j=jirl(i),np(i,2)+np(i,3),-1

c      Atention whit angle definition using abs tangents
c      Make subroutines
c      Angles and distances, left side

       xdv=(v(i,j-1,9)-v(i,j,9))
       xdu=(u(i,j-1,9)-u(i,j,9))
       if (xdu.ne.0.) then
       anglee(j)=abs(datan(xdv/xdu))
       else
       anglee(j)=2.*datan(1.0d0)
       end if

       if (xdu.ge.0.and.xdv.ge.0) then ! case 1-I
       siu(j)=1.
       siv(j)=1.
       end if
       if (xdu.le.0.and.xdv.ge.0) then ! case 1-II
       siu(j)=-1.
       siv(j)=1.
       end if
       if (xdu.ge.0.and.xdv.le.0) then ! case 1-III
       siu(j)=1.
       siv(j)=-1.
       end if
       if (xdu.le.0.and.xdv.le.0) then ! case 1-IV
       siu(j)=-1.
       siv(j)=-1.
       end if

       distee(j)=dsqrt((v(i,j,9)-v(i,j-1,9))**2.+
     + (u(i,j,9)-u(i,j-1,9))**2.)

       end do

c      Define

       do j=jirl(i),np(i,2)+np(i,3),-1
       u(i,j-1,32)=u(i,j,9)+siu(j)*distk*distee(j)*dcos(anglee(j))
       v(i,j-1,32)=v(i,j,9)+siv(j)*distk*distee(j)*dsin(anglee(j))
       u(i,j-1,9)=u(i,j-1,32)
       v(i,j-1,9)=v(i,j-1,32)
       end do

c      AFEGIR calcul punts extrems!!!!!!!!!!!

       j=np(i,2)+np(i,3)-2
       u(i,j,9)=u(i,j-1,9)+u(i,j-1,9)-u(i,j,9)
       v(i,j,9)=v(i,j-1,9)+v(i,j-1,9)-v(i,j,9)

c      VERIFICATION

       dist=0.0d0
       do j=np(i,2)+np(i,3)-1,np(i,1)-1
       dist=dist+sqrt((v(i,j,9)-v(i,j+1,9))**2.+
     + (u(i,j,9)-u(i,j+1,9))**2.)
       end do
c       write (*,*) "VERFICACIO R ",i,dist,rib(i,33),rib(i,34),rib(i,35)


       end do ! i

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Final verification left and right side
c      Can be erased
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      
       do i=1,nribss

       rib(i,40)=0.
       do j=1,np(i,2)-1
       rib(i,40)=rib(i,40)+sqrt((u(i-1,j,10)-u(i-1,j+1,10))**2.+
     + (v(i-1,j,10)-v(i-1,j+1,10))**2.)
       end do
      
       rib(i,42)=0.
       do j=1,np(i,2)-1
       rib(i,42)=rib(i,42)+sqrt((u(i,j,9)-u(i,j+1,9))**2.+
     + (v(i,j,9)-v(i,j+1,9))**2.)
       end do

c       write (*,*) "IGUALS ",i,rib(i,40),rib(i,31),rib(i,42)

       end do

       end if ! end reformat 

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Distorsion calculus
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Leading edge segment formated rib(i,99) intra

       do i=0,nribss-1

       if (i.lt.nribss) then
       j=np(i,2)+np(i,3)-1
       rib(i,99)=dsqrt((u(i,j,9)-u(i,j,10))**2.+
     + ((v(i,j,9)-v(i,j,10))**2.))
       end if

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     Distorsion correction
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Correction only for case ndif=1000

c      NOT DISTORSION CORRECTION 1001 !!!!!!!!!!!!!!!!!!!!!!

c      Iterations

       do itera=1,5

       if (ndif.eq.1000) then

c      Not reformating rib 1 to preserve simmetry

       do i=2,nribss-1

       k1=jirl(i)
       k2=np(i,2)+np(i,3)-1

c      Straight distance in reformat area
       dist=dsqrt(((u(i,k1,9)-u(i,k2,9))**2.)+
     + ((v(i,k1,9)-v(i,k2,9))**2.))
      
       epsilon=(rib(i,99)-rib(i,98))

c      Angle of rotation
       if (abs(epsilon).lt.0.01) then
       omega=0.
       else
c      Experimental correction
       omega=1.0*dasin(epsilon/dist)*epsilon/(abs(epsilon))
       end if

c      Rotate left side (all correction)

       do j=jirl(i),np(i,2)+np(i,3),-1

c      Atention whit angle definition using abs tangents
c      Make subroutines
c      Angles and distances, left side

       xdv=(v(i,j-1,9)-v(i,j,9))
       xdu=(u(i,j-1,9)-u(i,j,9))
       if (xdu.ne.0.) then
       anglee(j)=abs(datan(xdv/xdu))-omega
       else
       anglee(j)=2.*datan(1.0d0)-omega
       end if

       if (xdu.ge.0.and.xdv.ge.0) then ! case 1-I
       siu(j)=1.
       siv(j)=1.
       end if
       if (xdu.le.0.and.xdv.ge.0) then ! case 1-II
       siu(j)=-1.
       siv(j)=1.
       end if
       if (xdu.ge.0.and.xdv.le.0) then ! case 1-III
       siu(j)=1.
       siv(j)=-1.
       end if
       if (xdu.le.0.and.xdv.le.0) then ! case 1-IV
       siu(j)=-1.
       siv(j)=-1.
       end if

       distee(j)=dsqrt((v(i,j,9)-v(i,j-1,9))**2.+
     + (u(i,j,9)-u(i,j-1,9))**2.)

       end do  ! end j

c      Define

       do j=jirl(i),np(i,2)+np(i,3),-1
       u(i,j-1,32)=u(i,j,9)+siu(j)*distee(j)*dcos(anglee(j))
       v(i,j-1,32)=v(i,j,9)+siv(j)*distee(j)*dsin(anglee(j))
       u(i,j-1,9)=u(i,j-1,32)
       v(i,j-1,9)=v(i,j-1,32)
       end do

c      AFEGIR calcul punts extrems!!!!!!!!!!! ?
c      com reformat normal

       end do  ! end i

       end if  ! if ndif=1000

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Distorsion 2 calculus
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Leading edge segment formated rib(i,99) extra

       do i=0,nribss-1

       if (i.lt.nribss) then
       j=np(i,2)+np(i,3)-1
       rib(i,99)=dsqrt((u(i,j,9)-u(i,j,10))**2.+
     + ((v(i,j,9)-v(i,j,10))**2.))
       end if

       end do ! i

       end do ! itera


c      DISTORSIONS
       do i=0,nribss-1
c       write (*,*) "99-98 ",rib(i,99),rib(i,98),rib(i,99)-rib(i,98)
       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.4.5 Calcula cantonades panells intrados
c      Versio millorada segons 8.2.5
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     
c      Saltar cella 0 si gruix nul
       iini=0
       if (cencell.lt.0.01) then
       iini=1
       end if

       do i=iini,nribss

       npi=np(i,2)+np(i,3)-1
       npf=np(i,1)
       npo=npf-npi+1

c      Copy data in a free vector
       do j=1,npo

       uf(i,j,9)=u(i,npi+j-1,9)
       uf(i,j,10)=u(i,npi+j-1,10)
       uf(i,j,11)=u(i,npi+j-1,11)
       uf(i,j,12)=u(i,npi+j-1,12)
       vf(i,j,9)=v(i,npi+j-1,9)
       vf(i,j,10)=v(i,npi+j-1,10)
       vf(i,j,11)=v(i,npi+j-1,11)
       vf(i,j,12)=v(i,npi+j-1,12)

       ufi(i,j,9)=u(i,npi+j-1,9)
       ufi(i,j,10)=u(i,npi+j-1,10)
       ufi(i,j,11)=u(i,npi+j-1,11)
       ufi(i,j,12)=u(i,npi+j-1,12)
       vfi(i,j,9)=v(i,npi+j-1,9)
       vfi(i,j,10)=v(i,npi+j-1,10)
       vfi(i,j,11)=v(i,npi+j-1,11)
       vfi(i,j,12)=v(i,npi+j-1,12)

       end do

c      Call external points subroutine
c       call extpoints(i,uf,vf,npo,xupp,xuppte,xupple,1)

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.4.6 Dibuixa sobreamples panells intrados i vores de costura
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (n1draw.eq.1) then ! draw

c      Control if type is not "ss"
       if (atp.ne."ss") then

c      Box

c      Saltar cella 0 si gruix nul
       iini=0
       if (cencell.lt.0.01) then
       iini=1
       end if

       do i=iini,nribss-1
   
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=1291.*xkf

cccccccccccccccccccccccccccccccccccccccccccccccccccccc    
c      Draw minirib intrados
cccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (i.ge.0.and.rib(i+1,56).gt.1.and.rib(i+1,56).ne.100.and
     + .atp.ne."ss") then

       xpo1=(u(i,np(i,1),9)+u(i,np(i,1),10))/2.
       ypo1=(v(i,np(i,1),9)+v(i,np(i,1),10))/2.
       j=jcvi(i+1)
       xpo2=(u(i,j,9)+u(i,j,10))/2.
       ypo2=(v(i,j,9)+v(i,j,10))/2.

c      Evita divisions per zero!!!
       if (xpo2-xpo1.ne.0.) then
       alpha=datan((ypo2-ypo1)/(xpo2-xpo1))
       end if
       if (abs(xpo2-xpo1).lt.0.00001) then
       alpha=pi/2.
       end if

       xpo3=xpo1-rib(i+1,61)*dcos(alpha)
       ypo3=ypo1-rib(i+1,61)*dsin(alpha)
       xdesx=xdes*dsin(alpha)
       xdesy=xdes*dcos(alpha)

c      Draw reference points for miniribs in intrados
       call line(psep+xpo1,psey-ypo1,psep+xpo3,psey-ypo3,5)
       call pointg(psep+xpo1-xdesx,psey-ypo1-xdesy,xcir,1)
       call pointg(psep+xpo3-xdesx,psey-ypo3-xdesy,xcir,1)

c      Laser cuting
       xadd=2520.*xkf
       call point(psep+xpo1+xadd,psey-ypo1,1)
       call point(psep+xpo3+xadd,psey-ypo3,1)

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Call draw panel intrados (complete)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      To 8.5 section

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.4.7 Dibuixa sobreamples panells intrados i vores de costura
c      Adre
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      To 8.5 section


c      End if control if not "ss"
       end if

       end if ! n1draw



cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.5 Draw all panels
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.5.0.1 LAUNCH 3D-shaping calculus
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (k29d.eq.1) then

c      Set vector 47 for 3D airfoil coordinates       
       do i=0,nribss
       do j=1,np(i,1)
       u(i,j,47)=x(i,j)
       v(i,j,47)=y(i,j)
       w(i,j,47)=z(i,j)
       end do
       end do

c      Load "free" vectors in a new vector...
c      "69" points at left  side panel between rib i and i+1
c      "70" points at right side panel between rib i and i+1

       do i=0,nribss-1

c      Extrados
       do j=1,np(i,2)
       u(i,j,69)=ufe(i,j,9)
       v(i,j,69)=vfe(i,j,9)
       u(i,j,70)=ufe(i,j,10)
       v(i,j,70)=vfe(i,j,10)
       end do

c      Vents
       do j=np(i,2),np(i,2)+np(i,3)-1
       u(i,j,69)=ufv(i,j-np(i,2)+1,9)
       v(i,j,69)=vfv(i,j-np(i,2)+1,9)
       u(i,j,70)=ufv(i,j-np(i,2)+1,10)
       v(i,j,70)=vfv(i,j-np(i,2)+1,10)
       end do

c      Intrados
       do j=np(i,2)+np(i,3)-1,np(i,1)
       u(i,j,69)=ufi(i,j-(np(i,2)+np(i,3)-2),9)
       v(i,j,69)=vfi(i,j-(np(i,2)+np(i,3)-2),9)
       u(i,j,70)=ufi(i,j-(np(i,2)+np(i,3)-2),10)
       v(i,j,70)=vfi(i,j-(np(i,2)+np(i,3)-2),10)
       end do

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc      
c      Call main 3d subroutine 
c      Computes median airfoil (48)
c      Computes hautok(i,j)
c      Computes ovalized median airfoil (49)
c      Computes median local 2D airfoil (53)
c      Computes ovalized median local 2D airfoil (54)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Call panels 3D
       do i=1,nribss
       call panels3d(i,rib,np,u,v,w,
     + uppcuts,iupp,kiupp,lowcuts,ilow,kilow,hautok)
       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Call compute zones of influence
c      zinf(i,6,1) first cut extrados
c      zinf(i,6,2) second cut extrados
c      zinf(i,6,4) first cut intrados
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      
       do i=0,nribss
       call czinf(i,rib,np,u,v,w,
     + uppcuts,iupp,kiupp,lowcuts,ilow,kilow,hautok,zinf)
       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.5.0.2 Call tessellation calculus
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Call 3D tessellation
c      nsegments=12 ! increment for more detail

c      Tessellation active cases DXF, DXF ext, STL
       if (pp29(3,1).eq.1.or.pp29(4,1).eq.1.or.pp29(5,1).eq.1) then

       do i=1,nribss
       if (rib(i,2).ge.0.01) then
       call tessella(i,rib,np,u,v,w,hautok,nsegments,tesse3d)
       end if
       end do

       end if ! tessellation


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.5.0.3 Draw ovalized airfoils in 2D
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Box (1,8)
       
       sepxx=700.*xkf
       sepyy=100.*xkf
       kx=0
       ky=0
       kyy=0

       do i=1,nribss

       sepx=6.0*1260.0*xkf+sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*1.0*float(ky)

c      Draw vents (copied from 9.4)

c      ini
       j=np(i,2)
       alpha1=pi+datan((w(i,j,53)-w(i,j-1,53))/(v(i,j,53)-v(i,j-1,53)))
       call line(sepx+v(i,j,53),-w(i,j,53)+sepy,sepx+v(i,j,53)-
     + 4.*dsin(alpha1),-w(i,j,53)-4.*dcos(alpha1)+sepy,1)

       x1=2530.*xkf+sepx+v(i,j,53)+0.1*typm6(4)*dsin(alpha1)
       y1=-w(i,j,53)+sepy+0.1*typm6(4)*dcos(alpha1)
       x2=2530.*xkf+sepx+v(i,j,53)-0.1*(typm5(4)-typm6(4))*dsin(alpha1)
       y2=-0.1*(typm5(4)-typm6(4))*dcos(alpha1)-w(i,j,53)+sepy

       if (typevent.eq.1) then
c      Double point
c       call point(x1,y1,3)
c       call point(x2,y2,3)
       end if

       if (typevent.eq.2) then
c      Segment
c       call linevent(x1,y1,x2,y2,3)
       end if

       if (typevent.eq.3) then
c      Segment 101
c       call segment101(x1,y1,x2,y2,3)
       end if

c      fi
       j=np(i,2)+np(i,3)-1
       alpha1=pi+datan((w(i,j+1,53)-w(i,j-1,53))/(v(i,j+1,53)-
     + v(i,j-1,53)))
       call line(sepx+v(i,j,53),-w(i,j,53)+sepy,sepx+v(i,j,53)-
     + 4.*dsin(alpha1),-w(i,j,53)-4.*dcos(alpha1)+sepy,1)

       x1=2530.*xkf+sepx+v(i,j,53)+0.1*typm6(4)*dsin(alpha1)
       y1=-w(i,j,53)+sepy+0.1*typm6(4)*dcos(alpha1)
       x2=2530.*xkf+sepx+v(i,j,53)-0.1*(typm5(4)-typm6(4))*dsin(alpha1)
       y2=-0.1*(typm5(4)-typm6(4))*dcos(alpha1)-w(i,j,53)+sepy

       if (typevent.eq.1) then
c      Double point
c       call point(x1,y1,3)
c       call point(x2,y2,3)
       end if

       if (typevent.eq.2) then
c      Segment
c       call linevent(x1,y1,x2,y2,3)
       end if

       if (typevent.eq.3) then
c      Segment 101
c       call segment101(x1,y1,x2,y2,3)
       end if

c      Numbering
       call romano(i,sepx+0.89d0*rib(i,5),sepy-1.0d0,0.0d0,
     + typm6(9)*0.1,4)
       call itxt(sepx-16.-84.*(typm3(9)/7.),sepy,typm3(9),0.0d0,i,7)

c      Draw middle 2D airfoil (index 53) and ovalized (index 54)
c      Nota: millorar dibuix SK

       if (atp.ne."ss") then
       do j=1,np(i,1)-1
       call line(sepx+v(i,j,53),sepy-w(i,j,53),sepx+v(i,j+1,53),
     + sepy-w(i,j+1,53),7)
       call line(sepx+v(i,j,54),sepy-w(i,j,54),sepx+v(i,j+1,54),
     + sepy-w(i,j+1,54),4)
       end do ! j
       end if

       if (atp.eq."ss") then
       do j=1,np(i,2)-1
       call line(sepx+v(i,j,53),sepy-w(i,j,53),sepx+v(i,j+1,53),
     + sepy-w(i,j+1,53),7)
       call line(sepx+v(i,j,54),sepy-w(i,j,54),sepx+v(i,j+1,54),
     + sepy-w(i,j+1,54),4)
       end do ! j
       end if

       if (atp.eq."ss".and.rib(i,165).eq.1) then
       do j=np(i,2)-1,np(i,2)+np(i,3)-2
       call line(sepx+v(i,j,53),sepy-w(i,j,53),sepx+v(i,j+1,53),
     + sepy-w(i,j+1,53),7)
       call line(sepx+v(i,j,54),sepy-w(i,j,54),sepx+v(i,j+1,54),
     + sepy-w(i,j+1,54),4)
       end do ! j
       end if

       kx=int((float(i)/6.))
       ky=i-kx*6
       kyy=kyy+1

c      Draw points cuts 3D-shaping
       if (k29d.eq.1) then

       ng=rib(i,169)

c      Extrados points
       if (uppcuts(ng).eq.0) then
       end if

       if (uppcuts(ng).eq.1) then
       j=iupp(1,2,ng)
       call line(sepx+v(i,j,53),sepy-w(i,j,53),
     + sepx+v(i,j,54),sepy-w(i,j,54),3)
       j=iupp(1,3,ng)
       call line(sepx+v(i,j,53),sepy-w(i,j,53),
     + sepx+v(i,j,54),sepy-w(i,j,54),6)
       end if

       if (uppcuts(ng).eq.2) then
       j=iupp(1,2,ng)
       call line(sepx+v(i,j,53),sepy-w(i,j,53),
     + sepx+v(i,j,54),sepy-w(i,j,54),3)
       j=iupp(1,3,ng)
       call line(sepx+v(i,j,53),sepy-w(i,j,53),
     + sepx+v(i,j,54),sepy-w(i,j,54),6)
       j=iupp(2,3,ng)
       call line(sepx+v(i,j,53),sepy-w(i,j,53),
     + sepx+v(i,j,54),sepy-w(i,j,54),2)
       end if

c      Intrados points
       if (atp.ne."ss") then
       if (lowcuts(ng).eq.0) then
       end if
       if (lowcuts(ng).eq.1) then
       j=ilow(1,2,ng)
       call line(sepx+v(i,j,53),sepy-w(i,j,53),
     + sepx+v(i,j,54),sepy-w(i,j,54),32)
       j=ilow(1,3,ng)
       call line(sepx+v(i,j,53),sepy-w(i,j,53),
     + sepx+v(i,j,54),sepy-w(i,j,54),5)
       end if
       end if

       end if ! k29d=1

       end do ! i


       end if ! k29d=1


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (n1draw.eq.1) then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Plotter panels
c      Box (1,3)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Avoid central panel if thickness is 0
       iini=0  ! panel 0 (central)
       if (cencell.lt.0.01) then
       iini=1
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.5.1 Extrados without vents
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Plotter BOX(1,3)

       do i=iini,nribss-1
       
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=400.*xkf

c      Print panel numbers
       xlen=rib(2,2)-rib(1,2)
c      Boxes (0,3),(-1,3)
       if (k29d.eq.1) then
       call itxt2(psep+1.1*xlen,-psey-890.95*xkf*1.0+30.,
     + typm3(9),0.0d0,i+1,7)
       if (atp.ne."ss") then
       call itxt2(psep+1.1*xlen,-psey-890.95*xkf*0.0+30.,
     + typm3(9),0.0d0,i+1,7)
       end if
       end if
c      Boxes (1,3) (2,3)
       call itxt2(psep+1.1*xlen,-psey+890.95*xkf*1.0-64.,
     + typm3(9),0.0d0,i+1,7)
       if (atp.ne."ss") then
       call itxt2(psep+1.1*xlen,-psey+890.95*xkf*2.0-64.,
     + typm3(9),0.0d0,i+1,7)
       end if

c      load data extrados from a free vector

       npi=1
       npf=np(i,2)
       npo=npf-npi+1

       do j=1,npo

       uf(i,j,9)=ufe(i,j,9)
       uf(i,j,10)=ufe(i,j,10)
       uf(i,j,11)=ufe(i,j,11)
       uf(i,j,12)=ufe(i,j,12)
       vf(i,j,9)=vfe(i,j,9)
       vf(i,j,10)=vfe(i,j,10)
       vf(i,j,11)=vfe(i,j,11)
       vf(i,j,12)=vfe(i,j,12)

       end do

c      Print panels extrados without vents
       if (k26d.eq.0.or.rib(i+1,165).ne.1) then
       call extpoints(i,uf,vf,npo,xupp,xupple,xuppte,1)
       call dpanelc(i,uf,vf,npo,psep,psey)
       end if

       end do

c      Laser BOX(1,5)

       do i=iini,nribss-1
       
       psep=1970.*xkf+2520.*xkf+seppix(i)*1.0d0
       psey=400.*xkf

c      Print panels extrados without vents
       if (k26d.eq.0.or.rib(i+1,165).ne.1) then
       call extpoints(i,uf,vf,npo,xupp,xupple,xuppte,1)
       call dpanelb(i,uf,vf,npo,psep,psey)
       end if

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.5.2 Extrados with vents
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Plotter BOX(1,3)

       do i=iini,nribss-1
       
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=400.*xkf

c      load data extrados from a free vector

c      Piece 1
       npi=1
       npf=np(i,2)
       npo1=npf-npi+1

       do j=1,npo1
       uf(i,j,9)=ufe(i,j,9)
       uf(i,j,10)=ufe(i,j,10)
       uf(i,j,11)=ufe(i,j,11)
       uf(i,j,12)=ufe(i,j,12)
       vf(i,j,9)=vfe(i,j,9)
       vf(i,j,10)=vfe(i,j,10)
       vf(i,j,11)=vfe(i,j,11)
       vf(i,j,12)=vfe(i,j,12)
       end do

       npi=np(i,2)
       npf=np(i,2)+np(i,3)-1
       npo2=npf-npi+1

c      Move piece 2 to 1 by translation and rotation
       cs1x=(uf(i,npo1,9)+uf(i,npo1,10))*0.5
       cs1y=(vf(i,npo1,9)+vf(i,npo1,10))*0.5
       cs2x=(ufv(i,1,9)+ufv(i,1,10))*0.5
       cs2y=(vfv(i,1,9)+vfv(i,1,10))*0.5

       alpha=(datan((v(i,npo1,10)-v(i,npo1,9))/
     + (u(i,npo1,10)-u(i,npo1,9))))

c      1) Traslació -cs2x
       do j=1,npo2
       ufb(i,j,9)=ufv(i,j,9)-cs2x
       ufb(i,j,10)=ufv(i,j,10)-cs2x
       ufb(i,j,11)=ufv(i,j,11)-cs2x
       ufb(i,j,12)=ufv(i,j,12)-cs2x
       end do

c      2) Rotació alpha
       do j=1,npo2
       ufa(i,j,9)=ufb(i,j,9)*dcos(alpha)-vfv(i,j,9)*dsin(alpha)
       vfa(i,j,9)=ufb(i,j,9)*dsin(alpha)+vfv(i,j,9)*dcos(alpha)
       ufa(i,j,10)=ufb(i,j,10)*dcos(alpha)-vfv(i,j,10)*dsin(alpha)
       vfa(i,j,10)=ufb(i,j,10)*dsin(alpha)+vfv(i,j,10)*dcos(alpha)
       ufa(i,j,11)=ufb(i,j,11)*dcos(alpha)-vfv(i,j,11)*dsin(alpha)
       vfa(i,j,11)=ufb(i,j,11)*dsin(alpha)+vfv(i,j,11)*dcos(alpha)
       ufa(i,j,12)=ufb(i,j,12)*dcos(alpha)-vfv(i,j,12)*dsin(alpha)
       vfa(i,j,12)=ufb(i,j,12)*dsin(alpha)+vfv(i,j,12)*dcos(alpha)
       end do

c      3) Traslació (cs1x,cs1y)
       do j=1,npo2
       ufb(i,j,9)=ufa(i,j,9)+cs1x
       ufb(i,j,10)=ufa(i,j,10)+cs1x
       ufb(i,j,11)=ufa(i,j,11)+cs1x
       ufb(i,j,12)=ufa(i,j,12)+cs1x
       vfb(i,j,9)=vfa(i,j,9)+cs1y
       vfb(i,j,10)=vfa(i,j,10)+cs1y
       vfb(i,j,11)=vfa(i,j,11)+cs1y
       vfb(i,j,12)=vfa(i,j,12)+cs1y
       end do

c      Load Piece 2
       do j=2,npo2  ! 2 to avoid double definition

       uf(i,j+npo1-1,9)=ufb(i,j,9)
       uf(i,j+npo1-1,10)=ufb(i,j,10)
       uf(i,j+npo1-1,11)=ufb(i,j,11)
       uf(i,j+npo1-1,12)=ufb(i,j,12)
       vf(i,j+npo1-1,9)=vfb(i,j,9)
       vf(i,j+npo1-1,10)=vfb(i,j,10)
       vf(i,j+npo1-1,11)=vfb(i,j,11)
       vf(i,j+npo1-1,12)=vfb(i,j,12)

       end do

       npo=npf

c      Print panels extrados with vents
       
       if (k26d.eq.1.and.rib(i+1,165).eq.1) then
c      WARNING!!! Amples laterals xupp no fan efecte a la subrutina
c      Cal definir abans als vectors u(i,j,11) v u(i,j,12) v
       call extpoints(i,uf,vf,npo,xupp,xupple,xuppte,1)
       call dpanelc(i,uf,vf,npo,psep,psey)
       call line(psep+uf(i,npo1,9),psey-vf(i,npo1,9),
     + psep+uf(i,npo1,10),psey-vf(i,npo1,10),1)


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Print points vents (left)

       xu=uf(i,npo,9)
       xv=vf(i,npo,9)

c      Despla a vores punts de control de costures
       alp=abs(datan((vf(i,npo,9)-vf(i,npo-1,9))/
     + (uf(i,npo,9)-uf(i,npo-1,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,3)
c      Point laser
       call point(psep+xu+2520.*xkf,-xv+psey,7)

c      Print points vents (right)

       xu=uf(i,npo,10)
       xv=vf(i,npo,10)

c      Despla a vores punts de control de costures
       alp=abs(datan((vf(i,npo,10)-vf(i,npo-1,10))/
     + (uf(i,npo,10)-uf(i,npo-1,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,3)
c      Point laser
       call point(psep+xu+2520.*xkf,-xv+psey,7)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       end if

       end do

c      Laser BOX(1,5)

       do i=iini,nribss-1

       psep=1970.*xkf+2520.*xkf+seppix(i)*1.0d0
       psey=400.*xkf

c      Print panels extrados with vents
       if (k26d.eq.1.and.rib(i+1,165).eq.1) then
       call extpoints(i,uf,vf,npo,xupp,xuppte,xupple,1)
       call dpanelb(i,uf,vf,npo,psep,psey)

       end if

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.5.3 Vents amb vores
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=iini,nribss-1
       
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=1371.*xkf

c      load data vents from a free vector

       npi=np(i,2)
       npf=np(i,2)+np(i,3)-1
       npo=npf-npi+1

       do j=1,npo

       uf(i,j,9)=ufv(i,j,9)
       uf(i,j,10)=ufv(i,j,10)
       uf(i,j,11)=ufv(i,j,11)
       uf(i,j,12)=ufv(i,j,12)
       vf(i,j,9)=vfv(i,j,9)
       vf(i,j,10)=vfv(i,j,10)
       vf(i,j,11)=vfv(i,j,11)
       vf(i,j,12)=vfv(i,j,12)

       end do

c      Print panels vents
       if (k26d.eq.1.and.rib(i+1,165).eq.0) then

c       write (*,*) i,xlow,xlowle,xlowte

c      WARNING!!! xlow NOT USED in subroutine (defided previosly in 8.3.1 and 8.3.2)
       call extpoints(i,uf,vf,npo,xlow,xlowle,xupple,1)
       call dpanelc(i,uf,vf,npo,psep,psey)
       end if

c      Vents case -2 (joint to intrados)
c      NO CAL
       if (k26d.eq.1.and.rib(i+1,165).eq.-2) then
c       call extpoints(i,uf,vf,npo,xlow,xlowle,xupple,1)
c       call dpanelc(i,uf,vf,npo,psep,psey)
c       call line(psep+uf(i,npo,9),psey-vf(i,npo,9),psep+uf(i,1,10),
c     + psey-vf(i,1,10),1)
       end if

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.5.4 Intrados without vents
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Control if type is not "ss"
       if (atp.ne."ss") then

       do i=iini,nribss-1
       
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=1291.*xkf

c      load data vents from a free vector

       npi=np(i,2)+np(i,3)-1
       npf=np(i,1)
       npo=npf-npi+1

       do j=1,npo

       uf(i,j,9)=ufi(i,j,9)
       uf(i,j,10)=ufi(i,j,10)
       uf(i,j,11)=ufi(i,j,11)
       uf(i,j,12)=ufi(i,j,12)
       vf(i,j,9)=vfi(i,j,9)
       vf(i,j,10)=vfi(i,j,10)
       vf(i,j,11)=vfi(i,j,11)
       vf(i,j,12)=vfi(i,j,12)

       end do

c      Print panels intrados
       if (k26d.eq.0.or.rib(i+1,165).ge.0) then
       call extpoints(i,uf,vf,npo,xupp,xlowte,xlowle,1)
       call dpanelc(i,uf,vf,npo,psep,psey)
       end if

       end do

c      Laser BOX(1,5)

       do i=iini,nribss-1
       
       psep=1970.*xkf+2520.*xkf+seppix(i)*1.0d0
       psey=1291.*xkf

c      Print panels intrados
       if (k26d.eq.0.or.rib(i+1,165).ge.0) then
       call extpoints(i,uf,vf,npo,xupp,xlowte,xlowle,1)
       call dpanelb(i,uf,vf,npo,psep,psey)
       end if

       end do

       end if  ! control intrados "ss"


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.5.5 Intrados with vents
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Control if type is not "ss"
       if (atp.ne."ss") then

       do i=iini,nribss-1
       
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=1291.*xkf

c      load data intrados from a free vector

       npi=np(i,2)+np(i,3)-1
       npf=np(i,1)
       npo1=npf-npi+1

       do j=1,npo1
       ufa(i,j,9)=ufi(i,j,9)
       ufa(i,j,10)=ufi(i,j,10)
       ufa(i,j,11)=ufi(i,j,11)
       ufa(i,j,12)=ufi(i,j,12)
       vfa(i,j,9)=vfi(i,j,9)
       vfa(i,j,10)=vfi(i,j,10)
       vfa(i,j,11)=vfi(i,j,11)
       vfa(i,j,12)=vfi(i,j,12)
       end do

       cs1x=(ufa(i,1,9)+ufa(i,1,10))*0.5 ! Point 1
       cs1y=(vfa(i,1,9)+vfa(i,1,10))*0.5 ! Point 1
       
       alpha1=(datan((vfa(i,1,10)-vfa(i,1,9))/
     + (ufa(i,1,10)-ufa(i,1,9))))

c      1) Print panels intrados without vents and without LE
       if (k26d.eq.1.and.rib(i+1,165).le.-1) then
       call extpoints(i,ufa,vfa,npo1,xupp,xlowte,xlowle,1)
       call dpanelc1(i,ufa,vfa,npo,psep,psey)
       end if

c      2) Load vents 

       npi=np(i,2)
       npf=np(i,2)+np(i,3)-1
       npo2=npf-npi+1      
             
       do j=1,npo2
       ufb(i,j,9)=ufv(i,j,9)
       ufb(i,j,10)=ufv(i,j,10)
       ufb(i,j,11)=ufv(i,j,11)
       ufb(i,j,12)=ufv(i,j,12)
       vfb(i,j,9)=vfv(i,j,9)
       vfb(i,j,10)=vfv(i,j,10)
       vfb(i,j,11)=vfv(i,j,11)
       vfb(i,j,12)=vfv(i,j,12)
       end do

c      3) Translate vents from point 2 to (0,0)
      
       cs2x=(ufb(i,npo2,9)+ufb(i,npo2,10))*0.5
       cs2y=(vfb(i,npo2,9)+vfb(i,npo2,10))*0.5
       
       do j=1,npo2
       ufb(i,j,9)=ufv(i,j,9)-cs2x
       ufb(i,j,10)=ufv(i,j,10)-cs2x
       ufb(i,j,11)=ufv(i,j,11)-cs2x
       ufb(i,j,12)=ufv(i,j,12)-cs2x
       vfb(i,j,9)=vfv(i,j,9)-cs2y
       vfb(i,j,10)=vfv(i,j,10)-cs2y
       vfb(i,j,11)=vfv(i,j,11)-cs2y
       vfb(i,j,12)=vfv(i,j,12)-cs2y
       end do

c      4) Rotation angle alpha

       alpha2=(datan((vfb(i,npo2,10)-vfb(i,npo2,9))/
     + (ufb(i,npo2,10)-ufb(i,npo2,9))))
       alpha=-(alpha2-alpha1)
      
       do j=1,npo2
       ufc(i,j,9)=ufb(i,j,9)*dcos(alpha)-vfb(i,j,9)*dsin(alpha)
       vfc(i,j,9)=ufb(i,j,9)*dsin(alpha)+vfb(i,j,9)*dcos(alpha)
       ufc(i,j,10)=ufb(i,j,10)*dcos(alpha)-vfb(i,j,10)*dsin(alpha)
       vfc(i,j,10)=ufb(i,j,10)*dsin(alpha)+vfb(i,j,10)*dcos(alpha)
       ufc(i,j,11)=ufb(i,j,11)*dcos(alpha)-vfb(i,j,11)*dsin(alpha)
       vfc(i,j,11)=ufb(i,j,11)*dsin(alpha)+vfb(i,j,11)*dcos(alpha)
       ufc(i,j,12)=ufb(i,j,12)*dcos(alpha)-vfb(i,j,12)*dsin(alpha)
       vfc(i,j,12)=ufb(i,j,12)*dsin(alpha)+vfb(i,j,12)*dcos(alpha)
       end do

c      5) Translate vents from point (0,0) to 1
       
       do j=1,npo2
       uf(i,j,9)=ufc(i,j,9)+cs1x
       uf(i,j,10)=ufc(i,j,10)+cs1x
       uf(i,j,11)=ufc(i,j,11)+cs1x
       uf(i,j,12)=ufc(i,j,12)+cs1x
       vf(i,j,9)=vfc(i,j,9)+cs1y
       vf(i,j,10)=vfc(i,j,10)+cs1y
       vf(i,j,11)=vfc(i,j,11)+cs1y
       vf(i,j,12)=vfc(i,j,12)+cs1y
       end do

c      6) Force last point of vent as first point of intrados (?)

       uf(i,npo2,9)=ufa(i,1,9)
       uf(i,npo2,10)=ufa(i,1,10)
       uf(i,npo2,11)=ufa(i,1,11)
       uf(i,npo2,12)=ufa(i,1,12)
       vf(i,npo2,9)=vfa(i,1,9)
       vf(i,npo2,10)=vfa(i,1,10)
       vf(i,npo2,11)=vfa(i,1,11)
       vf(i,npo2,12)=vfa(i,1,12)
       
c      7) Print vents without TE case -1
       if (k26d.eq.1.and.rib(i+1,165).eq.-1.) then
       call extpoints(i,uf,vf,npo2,xupp,xlowte,xlowle,1)
       call dpanelc2(i,uf,vf,npo2,psep,psey)
      
c      Print points vents (left)

       xu=uf(i,1,9)
       xv=vf(i,1,9)

c      Despla a vores punts de control de costures
       alp=abs(datan((vf(i,1,9)-vf(i,2,9))/
     + (uf(i,1,9)-uf(i,2,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,3)
c      Point laser
       call point(psep+xu+2520.*xkf,-xv+psey,7)

c      Print points vents (right)

       xu=uf(i,1,10)
       xv=vf(i,1,10)

c      Despla a vores punts de control de costures
       alp=abs(datan((vf(i,1,10)-vf(i,2,10))/
     + (uf(i,1,10)-uf(i,2,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,3)
c      Point laser
       call point(psep+xu+2520.*xkf,-xv+psey,7)
       end if


c      8) Print vents without TE case -2
       if (k26d.eq.1.and.rib(i+1,165).eq.-2.) then
       call extpoints(i,uf,vf,npo2,xupp,xlowte,xlowle,1)
       call dpanelcm2(i,uf,vf,npo2,psep,psey)
       do j=1,npo2-1 ! LASER
       call line(psep+2520.*xkf+uf(i,j,12),psey-vf(i,j,12),
     + psep+2520.*xkf+uf(i,j+1,12),psey-vf(i,j+1,12),3)
       end do
       call line(psep+uf(i,npo2,9),psey-vf(i,npo2,9),psep+uf(i,1,10),
     + psey-vf(i,1,10),1)

c      Linia de vora diagonal
       lvalp=datan((vf(i,npo2,9)-vf(i,1,10))/
     + ((uf(i,1,10)-uf(i,npo2,9))))
       lv1u=uf(i,npo2,9)-xlowle*0.1*dsin(lvalp)
       lv1v=vf(i,npo2,9)-xlowle*0.1*dcos(lvalp)
       lv2u=uf(i,1,10)-xlowle*0.1*dsin(lvalp)
       lv2v=vf(i,1,10)-xlowle*0.1*dcos(lvalp)
      
c      Intersection of segments with diagonal
c      Point left
       xru(1)=uf(i,npo2,11)
       xru(2)=uf(i,npo2-1,11)
       xrv(1)=vf(i,npo2,11)
       xrv(2)=vf(i,npo2-1,11)
       xsu(1)=lv1u
       xsu(2)=lv2u
       xsv(1)=lv1v
       xsv(2)=lv2v
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)
       lv3u=xtu
       lv3v=xtv
c      Point right
       xru(1)=uf(i,2,12)
       xru(2)=uf(i,1,12)
       xrv(1)=vf(i,2,12)
       xrv(2)=vf(i,1,12)
       xsu(1)=lv1u
       xsu(2)=lv2u
       xsv(1)=lv1v
       xsv(2)=lv2v
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)
       lv4u=xtu
       lv4v=xtv

c      Print versions
       call line(psep+lv3u,psey-lv3v,psep+lv4u,psey-lv4v,3)
       call line(psep+lv3u,psey-lv3v,psep+uf(i,npo2,11),
     + psey-vf(i,npo2,11),3)
       call line(psep+lv4u,psey-lv4v,psep+uf(i,1,12),psey-vf(i,1,12),3)
       call line(psep+uf(i,npo2,9),psey-vf(i,npo2,9),
     + psep+uf(i,npo2,9)-xlowle*0.1*dsin(lvalp),
     + psey-vf(i,npo2,9)+xlowle*0.1*dcos(lvalp),3)
       call line(psep+uf(i,1,10),psey-vf(i,1,10),
     + psep+uf(i,1,10)-xlowle*0.1*dsin(lvalp),
     + psey-vf(i,1,10)+xlowle*0.1*dcos(lvalp),3)
       call line(psep+uf(i,npo2,9),psey-vf(i,npo2,9),
     + psep+uf(i,npo2,11),psey-vf(i,npo2,11),3)
 
c      Laser version
       call line(psep+2520.*xkf+lv3u,psey-lv3v,psep+
     + 2520.*xkf+lv4u,psey-lv4v,3)
       call line(psep+2520.*xkf+lv3u,psey-lv3v,psep+
     + 2520.*xkf+uf(i,npo2,11),
     + psey-vf(i,npo2,11),3)
       call line(psep+2520.*xkf+lv4u,psey-lv4v,psep+
     + 2520.*xkf+uf(i,1,12),psey-vf(i,1,12),3)

c      Print points vents (left)

       xu=uf(i,1,9)
       xv=vf(i,1,9)

c      Despla a vores punts de control de costures
       alp=abs(datan((vf(i,1,9)-vf(i,2,9))/
     + (uf(i,1,9)-uf(i,2,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)

c      Point imp
c       call pointg(psep+xu,psey-xv,xcir,3)
c      Point laser
c       call point(psep+xu+2520.*xkf,-xv+psey,7)

c      Print points vents (right)

       xu=uf(i,1,10)
       xv=vf(i,1,10)

c      Despla a vores punts de control de costures
       alp=abs(datan((vf(i,1,10)-vf(i,2,10))/
     + (uf(i,1,10)-uf(i,2,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,3)
c      Point laser
       call point(psep+xu+2520.*xkf,-xv+psey,7)
       end if ! case vent -2
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


c      9) Print vents without TE case -3
       if (k26d.eq.1.and.rib(i+1,165).eq.-3.) then
       call extpoints(i,uf,vf,npo2,xupp,xlowte,xlowle,1)
       call dpanelcm3(i,uf,vf,npo2,psep,psey)
       do j=1,npo2-1 ! LASER
       call line(psep+2520.*xkf+uf(i,j,11),psey-vf(i,j,11),
     + psep+2520.*xkf+uf(i,j+1,11),psey-vf(i,j+1,11),3)
       end do
       call line(psep+uf(i,1,9),psey-vf(i,1,9),psep+uf(i,npo2,10),
     + psey-vf(i,npo2,10),1)

c      Linia de vora diagonal
       lvalp=datan((vf(i,npo2,10)-vf(i,1,9))/
     + ((uf(i,npo2,10)-uf(i,1,9))))
       lv1u=uf(i,1,9)+xlowle*0.1*dsin(lvalp)
       lv1v=vf(i,1,9)-xlowle*0.1*dcos(lvalp)
       lv2u=uf(i,npo2,10)+xlowle*0.1*dsin(lvalp)
       lv2v=vf(i,npo2,10)-xlowle*0.1*dcos(lvalp)
     
c      Intersection of segments with diagonal
c      Point left
       xru(1)=uf(i,2,11)
       xru(2)=uf(i,1,11)
       xrv(1)=vf(i,2,11)
       xrv(2)=vf(i,1,11)
       xsu(1)=lv1u
       xsu(2)=lv2u
       xsv(1)=lv1v
       xsv(2)=lv2v
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)
       lv3u=xtu
       lv3v=xtv
c      Point right
       xru(1)=uf(i,npo2,12)
       xru(2)=uf(i,npo2-1,12)
       xrv(1)=vf(i,npo2,12)
       xrv(2)=vf(i,npo2-1,12)
       xsu(1)=lv1u
       xsu(2)=lv2u
       xsv(1)=lv1v
       xsv(2)=lv2v
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)
       lv4u=xtu
       lv4v=xtv

c      Print versions
       call line(psep+lv3u,psey-lv3v,psep+lv4u,psey-lv4v,3)
       call line(psep+lv3u,psey-lv3v,psep+uf(i,1,11),
     + psey-vf(i,1,11),3)
       call line(psep+lv4u,psey-lv4v,psep+uf(i,npo2,12),
     + psey-vf(i,npo2,12),3)
       call line(psep+uf(i,1,9),psey-vf(i,1,9),
     + psep+uf(i,1,9)+xlowle*0.1*dsin(lvalp),
     + psey-vf(i,1,9)+xlowle*0.1*dcos(lvalp),3)
       call line(psep+uf(i,npo2,10),psey-vf(i,npo2,10),
     + psep+uf(i,npo2,10)+xlowle*0.1*dsin(lvalp),
     + psey-vf(i,npo2,10)+xlowle*0.1*dcos(lvalp),3)
       call line(psep+uf(i,npo2,10),psey-vf(i,npo2,10),
     + psep+uf(i,npo2,12),psey-vf(i,npo2,12),3)

c      Laser version
       call line(psep+2520.*xkf+lv3u,psey-lv3v,psep+
     + 2520.*xkf+lv4u,psey-lv4v,3)
       call line(psep+2520.*xkf+lv3u,psey-lv3v,psep+
     + 2520.*xkf+uf(i,1,11),psey-vf(i,1,11),3)
       call line(psep+2520.*xkf+lv4u,psey-lv4v,psep+
     + 2520.*xkf+uf(i,npo2,12),psey-vf(i,npo2,12),3)

c      Print points vents (left)

       xu=uf(i,1,9)
       xv=vf(i,1,9)

c      Despla a vores punts de control de costures
       alp=abs(datan((vf(i,1,9)-vf(i,2,9))/
     + (uf(i,1,9)-uf(i,2,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,3)
c      Point laser
       call point(psep+xu+2520.*xkf,-xv+psey,7)

c      Print points vents (right)

       xu=uf(i,1,10)
       xv=vf(i,1,10)

c      Despla a vores punts de control de costures
       alp=abs(datan((vf(i,1,10)-vf(i,2,10))/
     + (uf(i,1,10)-uf(i,2,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)

c      Point imp
c       call pointg(psep+xu,psey-xv,xcir,3)
c      Point laser
c       call point(psep+xu+2520.*xkf,-xv+psey,7)
       end if ! case vent -3
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc




       end do

c      Laser BOX(1,5)

       do i=iini,nribss-1
       
       psep=1970.*xkf+2520.*xkf+seppix(i)*1.0d0
       psey=1291.*xkf
    
c      Print panels intrados without vents
       if (k26d.eq.1.and.rib(i+1,165).le.-1) then
       call extpoints(i,ufa,vfa,npo1,xupp,xlowte,xlowle,1)
       call dpanelb1(i,ufa,vfa,npo1,psep,psey)
       end if

c      Print vents
       if (k26d.eq.1.and.rib(i+1,165).eq.-1) then
       call extpoints(i,uf,vf,npo2,xupp,xupple,xlowle,1)
       call dpanelb2(i,uf,vf,npo2,psep,psey)
       end if

       end do

       end if  ! control intrados "ss"


       end if ! n1draw section 8.5

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc



cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.6 Draw all panels (with 3D cuts)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (k29d.eq.1) then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Plotter panels
c      BOX (0,3)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Avoid central panel if thickness is 0
       iini=0  ! panel 0 (central)
       if (cencell.lt.0.01) then
       iini=1
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Sign adjustement
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       do i=iini,nribss-1
       is1=1
       is2=1
       is4=1
       if (zinf(i,6,1).lt.0.) then
c       is1=-1
       end if
       if (zinf(i,6,2).lt.0.) then
c       is2=-1
       end if
       if (zinf(i,6,4).lt.0.) then
c       is4=-1
       end if
c       write (*,*) "Signe  ", i,is1,is2,is4
c       write (*,*) "Signe- ", i,is1*-1,-1*is2,-1*is4

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.6.1 Extrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Plotter BOX(-1,3)

c      FORCED RECURSE
c      Please REVIEW all xcirc,xdes denitions!!!!
c      Used in subroutine drwvent to call prinfpv
       do i=0,nribss
       csi(i,50)=xcir
       csi(i,51)=xdes
       end do
cccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      REVISAR!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       zinf(0,6,2)=zinf(1,6,2)
       zinf(0,6,1)=zinf(1,6,1)
       zinf(0,6,4)=zinf(1,6,4)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=iini,nribss-1

       ic2=dint(rib(i+1,165)) ! vent type
       
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=xyshift*xkf-890.95*xyextra*xkf ! remove 890.95 to set BOX (1,3)

c      REDEFINITION (!) for proper printing
       ng=rib(i+1,169)

       if (i.eq.0) then
       ng=rib(1,169)
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Previ BRUTE FORCE, use for subroutine drwvent
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       npi=1
       npf=np(i,2)
       npo=npf-npi+1

       do j=1,npo
       ufa(i,j,9)=ufe(i,j,9)
       ufa(i,j,10)=ufe(i,j,10)
       ufa(i,j,11)=ufe(i,j,11)
       ufa(i,j,12)=ufe(i,j,12)
       vfa(i,j,9)=vfe(i,j,9)
       vfa(i,j,10)=vfe(i,j,10)
       vfa(i,j,11)=vfe(i,j,11)
       vfa(i,j,12)=vfe(i,j,12)
       end do

c       cs1x=(ufa(i,1,9)+ufa(i,1,10))*0.5 ! Point 1
c       cs1y=(vfa(i,1,9)+vfa(i,1,10))*0.5 ! Point 1

c      IN DOUBT... USE BRUTE FORCE!!!!!!!!!!!!!!!!!!!!!
       csi(i,21)=ufa(i,npo,9)
       csi(i,22)=vfa(i,npo,9)
       csi(i,23)=ufa(i,npo,10)
       csi(i,24)=vfa(i,npo,10)
       csi(i,25)=ufa(i,npo,11)
       csi(i,26)=vfa(i,npo,11)
       csi(i,27)=ufa(i,npo,12)
       csi(i,28)=vfa(i,npo,12)
       
c       alpha1=(datan((vfa(i,1,10)-vfa(i,1,9))/
c     + (ufa(i,1,10)-ufa(i,1,9))))

c       csi(i,29)=alpha1
c       csi(i,30)=xlow
c       csi(i,31)=xlowte
c       csi(i,32)=xlowle
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      End BRUTE FORCE
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


cccccccccccccccccccccccccccccccccccccccccccccccccccccc    
c      Draw minirib extrados (copy code from 8.2.6)
cccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (i.ge.0.and.rib(i+1,56).gt.1.and.rib(i+1,56).ne.100
     + .and.atp.ne."ss") then

       xpo1=(u(i,1,9)+u(i,1,10))/2.
       ypo1=(v(i,1,9)+v(i,1,10))/2.
       j=jcve(i+1)
       xpo2=(u(i,j,9)+u(i,j,10))/2.
       ypo2=(v(i,j,9)+v(i,j,10))/2.

c      Avoid division by zero!!!
       if (xpo2-xpo1.ne.0.) then
       alpha=datan((ypo2-ypo1)/(xpo2-xpo1))
       end if
       if (abs(xpo2-xpo1).lt.0.00001) then
       alpha=pi/2.
       end if

       xpo3=xpo1+rib(i+1,60)*dcos(alpha)
       ypo3=ypo1+rib(i+1,60)*dsin(alpha)
       xdesx=xdes*dsin(alpha)
       xdesy=xdes*dcos(alpha)

c      Draw reference points for miniribs in extrados
       call line(psep+xpo1,psey-ypo1,psep+xpo3,psey-ypo3,5)
       call pointg(psep+xpo1-xdesx,psey-ypo1-xdesy,xcir,1)
       call pointg(psep+xpo3-xdesx,psey-ypo3-xdesy,xcir,1)

c      Laser cuting
       xadd=2520.*xkf
       call point(psep+xpo1+xadd,psey-ypo1,1)
       call point(psep+xpo3+xadd,psey-ypo3,1)

       end if
      
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case extrados 0 cuts
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (uppcuts(ng).eq.0) then

c      Extrados panel from TE to LE

       npi=1
       npf=np(i,2)
       npo=npf-npi+1

       do j=1,npo
       uf(i,j,9)=ufe(i,j,9)
       uf(i,j,10)=ufe(i,j,10)
       uf(i,j,11)=ufe(i,j,11)
       uf(i,j,12)=ufe(i,j,12)
       vf(i,j,9)=vfe(i,j,9)
       vf(i,j,10)=vfe(i,j,10)
       vf(i,j,11)=vfe(i,j,11)
       vf(i,j,12)=vfe(i,j,12)
       end do

c      Set panel side lengths part 1
       call llarlr(i,1,1,npo,uf,vf,llarl,llarr)

c      Update vents for perfect matching (BRUTE FORCE)
c      Use vectors auxiliar t
c      !!!!!!!!!!!!!!!!!!!!!!! NO VA NI FA RES ARA!!!!!!!!!!!
       j=1
       uft(i,j,9)=ufe(i,npf,9)
       uft(i,j,10)=ufe(i,npf,10)
       uft(i,j,11)=ufe(i,npf,11)
       uft(i,j,12)=ufe(i,npf,12)
       vft(i,j,9)=vfe(i,npf,9)
       vft(i,j,10)=vfe(i,npf,10)
       vft(i,j,11)=vfe(i,npf,11)
       vft(i,j,12)=vfe(i,npf,12)
       do j=2,np(i,3)
       uft(i,j,9)=ufv(i,j,9)
       uft(i,j,10)=ufv(i,j,10)
       uft(i,j,11)=ufv(i,j,11)
       uft(i,j,12)=ufv(i,j,12)
       vft(i,j,9)=vfv(i,j,9)
       vft(i,j,10)=vfv(i,j,10)
       vft(i,j,11)=vfv(i,j,11)
       vft(i,j,12)=vfv(i,j,12)
       end do

c      Roman marks
       x1=uf(i,1,9)
       y1=vf(i,1,9)
       x2=uf(i,1,10)
       y2=vf(i,1,10)
       y3=1.0d0
       call romanop(i,1,x1,y1,x2,y2,y3,psep,psey,xkf)

c      Print panels extrados without vents
       if (k26d.eq.0.or.rib(i+1,165).le.0) then
       call extpoints(i,uf,vf,npo,xupp,xupple,xuppte,1)
       call dpanelcc(i,uf,vf,npo,psep,psey,3)
       call dpanelcc(i,uf,vf,npo,psep+2520.*xkf,psey,7)
       end if

c      Print equidistant points
       xinil=0.0d0
       xinir=0.0d0
       call xmarksi(i,1,1,npo,uf,vf,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey,xcir,xdes,xkf)

c      Print panels extrados with vents
       if (k26d.eq.1.and.rib(i+1,165).ge.1) then
       call extpoints(i,uf,vf,npo,xupp,xupple,xuppte,1)
       call dpanelcc(i,uf,vf,npo,psep,psey,2)
       call dpanelcc(i,uf,vf,npo,psep+2520.*xkf,psey,6)

c      Set panel side lengths part 4
       call llarlr(i,1,4,np(i,3),ufv,vfv,llarl,llarr)

c      Print vents
       call drwvent(i,np,uf,vf,ufv,vfv,psep,psey,xupp,xupple,
     + xuppte,xkf,1,ic2,csi)   ! case print
       call drwvent(i,np,uf,vf,ufv,vfv,psep+2520.*xkf,psey,xupp,xupple,
     + xuppte,xkf,2,ic2,csi)   ! case laser
       end if
   
       end if ! Extrados 0 cuts

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case extrados 1 cut
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (uppcuts(ng).eq.1) then
c      Extrados panel from TE to first cut
       npo=iupp(1,3,ng)
       do j=1,npo
       uf(i,j,9)=ufe(i,j,9)
       uf(i,j,10)=ufe(i,j,10)
       uf(i,j,11)=ufe(i,j,11)
       uf(i,j,12)=ufe(i,j,12)
       vf(i,j,9)=vfe(i,j,9)
       vf(i,j,10)=vfe(i,j,10)
       vf(i,j,11)=vfe(i,j,11)
       vf(i,j,12)=vfe(i,j,12)
       end do

c      Roman marks
       x1=uf(i,1,9)
       y1=vf(i,1,9)
       x2=uf(i,1,10)
       y2=vf(i,1,10)
       y3=1.0d0
       call romanop(i,1,x1,y1,x2,y2,y3,psep,psey,xkf)

c      Set panel side lengths part 1
       call llarlr(i,1,1,npo,uf,vf,llarl,llarr)

c      Print equidistant points
       xinil=0.0d0
       xinir=0.0d0
       call xmarksi(i,1,1,npo,uf,vf,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey,xcir,xdes,xkf)

       call extpoints(i,uf,vf,npo,xupp,xupp,xuppte,1)
       call dpanelcc(i,uf,vf,npo,psep,psey,2)
       call dpanelcc(i,uf,vf,npo,psep+2520.*xkf,psey,6)
       call arc3p(i,npo,uf,vf,zinf(i+1,6,1),1*is1,psep,psey,1,xupp)
       call arc3p(i,npo,uf,vf,zinf(i+1,6,1),1*is1,psep+2520.*xkf,psey,
     + 2,xupp)

c      Extrados panel from cut to LE
       ysaut=-ysautt

       npi=iupp(1,3,ng)
       npf=np(i,2)
       npo=npf-npi+1

       do j=1,npo
       uf(i,j,9)=ufe(i,j+npi-1,9)
       uf(i,j,10)=ufe(i,j+npi-1,10)
       uf(i,j,11)=ufe(i,j+npi-1,11)
       uf(i,j,12)=ufe(i,j+npi-1,12)
       vf(i,j,9)=vfe(i,j+npi-1,9)
       vf(i,j,10)=vfe(i,j+npi-1,10)
       vf(i,j,11)=vfe(i,j+npi-1,11)
       vf(i,j,12)=vfe(i,j+npi-1,12)
       end do

c      Roman marks
       x1=uf(i,1,9)
       y1=vf(i,1,9)
       x2=uf(i,1,10)
       y2=vf(i,1,10)
       y3=1.0d0
c       call romanop(i,x1,-y1,x2,-y2,y3,psep,psey+ysaut,xkf)

c      Set panel side lengths part 2
       call llarlr(i,1,2,npo,uf,vf,llarl,llarr)

c      Print equidistant points
       xinil=xfinl(i,1,1)
       xinir=xfinr(i,1,1)
       call xmarksi(i,1,2,npo,uf,vf,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey+ysaut,xcir,xdes,xkf)

c      Print panels without vents       
       if (k26d.eq.0.or.rib(i+1,165).le.0) then
       call extpoints(i,uf,vf,npo,xupp,xupple,xupp,1)
       call dpanelcc(i,uf,vf,npo,psep,psey+ysaut,4)
       call dpanelcc(i,uf,vf,npo,psep+2520.*xkf,psey+ysaut,8)
       call arc3p(i,1,uf,vf,zinf(i+1,6,1),-1*is1,psep,psey+ysaut,1,xupp)
       call arc3p(i,1,uf,vf,zinf(i+1,6,1),-1*is1,psep+2520.*xkf,
     + psey+ysaut,2,xupp)



c      CALL ROMANO ARC EXPERIMENTAL
       call romanoparc(i,1,1,uf,vf,zinf(i+1,6,1),-1,psep,psey+ysaut,
     + 1,xkf)



       end if

c      Print panels with vents       
       if (k26d.eq.0.or.rib(i+1,165).ge.1) then
       call extpoints(i,uf,vf,npo,xupp,xupple,xupp,1)
       call dpanelcc(i,uf,vf,npo,psep,psey+ysaut,1)
       call dpanelcc(i,uf,vf,npo,psep+2520.*xkf,psey+ysaut,5)
       call arc3p(i,1,uf,vf,zinf(i+1,6,1),-1*is1,psep,psey+ysaut,1,xupp)
       call arc3p(i,1,uf,vf,zinf(i+1,6,1),-1*is1,psep+2520.*xkf,
     + psey+ysaut,2,xupp)

c      Set panel side lengths part 4
       call llarlr(i,1,4,np(i,3),ufv,vfv,llarl,llarr)



c      CALL ROMANO ARC EXPERIMENTAL
       call romanoparc(i,1,1,uf,vf,zinf(i+1,6,1),-1,psep,psey+ysaut,
     + 1,xkf)



c      Print vents
       call drwvent(i,np,uf,vf,ufv,vfv,psep,psey+ysaut,xupp,xupple,
     + xuppte,xkf,1,ic2,csi)   ! case print
       call drwvent(i,np,uf,vf,ufv,vfv,psep+2520.*xkf,psey+ysaut,xupp,
     + xupple,xuppte,xkf,2,ic2,csi)   ! case laser
       end if

       end if ! Extrados 1 cut

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case extrados 2 cuts
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (uppcuts(ng).eq.2) then

c      Extrados panel from TE to first cut
       npo=iupp(1,3,ng)
       do j=1,npo
       uf(i,j,9)=ufe(i,j,9)
       uf(i,j,10)=ufe(i,j,10)
       uf(i,j,11)=ufe(i,j,11)
       uf(i,j,12)=ufe(i,j,12)
       vf(i,j,9)=vfe(i,j,9)
       vf(i,j,10)=vfe(i,j,10)
       vf(i,j,11)=vfe(i,j,11)
       vf(i,j,12)=vfe(i,j,12)
       end do

c      Roman marks
       x1=uf(i,1,9)
       y1=vf(i,1,9)
       x2=uf(i,1,10)
       y2=vf(i,1,10)
       y3=1.0d0
       call romanop(i,1,x1,y1,x2,y2,y3,psep,psey,xkf)

c      Set panel side lengths part 1
       call llarlr(i,1,1,npo,uf,vf,llarl,llarr)

c      Print equidistant points
       xinil=0.0d0
       xinir=0.0d0
       call xmarksi(i,1,1,npo,uf,vf,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey,xcir,xdes,xkf)

       call extpoints(i,uf,vf,npo,xupp,xupp,xuppte,1)
       call dpanelcc(i,uf,vf,npo,psep,psey,2)
       call dpanelcc(i,uf,vf,npo,psep+2520.*xkf,psey,6)
       call arc3p(i,npo,uf,vf,zinf(i+1,6,1),1*is1,psep,psey,1,xupp)
       call arc3p(i,npo,uf,vf,zinf(i+1,6,1),1*is1,psep+2520.*xkf,psey,2,
     + xupp)

c      Extrados panel from first to second cut
       ysaut=-ysautt
      
       npi=iupp(1,3,ng)
       npf=iupp(2,3,ng)
       npo=npf-npi+1

       do j=1,npo
       uf(i,j,9)=ufe(i,j+npi-1,9)
       uf(i,j,10)=ufe(i,j+npi-1,10)
       uf(i,j,11)=ufe(i,j+npi-1,11)
       uf(i,j,12)=ufe(i,j+npi-1,12)
       vf(i,j,9)=vfe(i,j+npi-1,9)
       vf(i,j,10)=vfe(i,j+npi-1,10)
       vf(i,j,11)=vfe(i,j+npi-1,11)
       vf(i,j,12)=vfe(i,j+npi-1,12)
       end do

c      Set panel side lengths part 2
       call llarlr(i,1,2,npo,uf,vf,llarl,llarr)

c      Print equidistant points
       xinil=xfinl(i,1,1)
       xinir=xfinr(i,1,1)
c       write (*,*) "X ",i,xinil,xinir
       call xmarksi(i,1,1,npo,uf,vf,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey+ysaut,xcir,xdes,xkf)
       call extpoints(i,uf,vf,npo,xupp,xupp,xupp,1)
       call dpanelcc(i,uf,vf,npo,psep,psey+ysaut,1)
       call dpanelcc(i,uf,vf,npo,psep+2520.*xkf,psey+ysaut,5)

       call arc3p(i,1,uf,vf,zinf(i+1,6,1),-1*is1,psep,psey+ysaut,1,xupp)
       call arc3p(i,1,uf,vf,zinf(i+1,6,1),-1*is1,psep+2520.*xkf,psey+
     + ysaut,2,xupp)
       call arc3p(i,npo,uf,vf,zinf(i+1,6,2),1*is2,psep,psey+ysaut,
     + 1,xupp)
       call arc3p(i,npo,uf,vf,zinf(i+1,6,2),1*is2,psep+2520.*xkf,psey+
     + ysaut,2,xupp)


c      CALL ROMANO ARC EXPERIMENTAL
       call romanoparc(i,1,1,uf,vf,zinf(i+1,6,1),-1,psep,psey+ysaut,
     + 1,xkf)

c      Extrados panel from second cut to LE
       ysaut=-ysautt*2.0d0
      
       npi=iupp(2,3,ng)
       npf=np(i,2)
       npo=npf-npi+1

       do j=1,npo
       uf(i,j,9)=ufe(i,j+npi-1,9)
       uf(i,j,10)=ufe(i,j+npi-1,10)
       uf(i,j,11)=ufe(i,j+npi-1,11)
       uf(i,j,12)=ufe(i,j+npi-1,12)
       vf(i,j,9)=vfe(i,j+npi-1,9)
       vf(i,j,10)=vfe(i,j+npi-1,10)
       vf(i,j,11)=vfe(i,j+npi-1,11)
       vf(i,j,12)=vfe(i,j+npi-1,12)
       end do

c      Set panel side lengths part 3
       call llarlr(i,1,3,npo,uf,vf,llarl,llarr)

c      Print equidistant points
       xinil=xfinl(i,1,2)
       xinir=xfinr(i,1,2)
       call xmarksi(i,1,1,npo,uf,vf,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey+ysaut,xcir,xdes,xkf)

c      Print panels without vents       
       if (k26d.eq.0.or.rib(i+1,165).le.0) then
       call extpoints(i,uf,vf,npo,xupp,xupple,xupp,1)
       call dpanelcc(i,uf,vf,npo,psep,psey+ysaut,4)
       call dpanelcc(i,uf,vf,npo,psep+2520.*xkf,psey+ysaut,8)



       call arc3p(i,1,uf,vf,zinf(i+1,6,2),-1*is2,psep,psey+ysaut,1,xupp)
       call arc3p(i,1,uf,vf,zinf(i+1,6,2),-1*is2,psep+2520.*xkf,psey+
     + ysaut,2,xupp)




       end if

c      CALL ROMANO ARC EXPERIMENTAL
       call romanoparc(i,1,1,uf,vf,zinf(i+1,6,2),-1,psep,psey+ysaut,
     + 2,xkf)


c      Print panels with vents       
       if (k26d.eq.0.or.rib(i+1,165).ge.1) then
       call extpoints(i,uf,vf,npo,xupp,xupple,xupp,1)
       call dpanelcc(i,uf,vf,npo,psep,psey+ysaut,1)
       call dpanelcc(i,uf,vf,npo,psep+2520.*xkf,psey+ysaut,5)
       call arc3p(i,1,uf,vf,zinf(i+1,6,2),-1*is2,psep,psey+ysaut,1,xupp)
       call arc3p(i,1,uf,vf,zinf(i+1,6,2),-1*is2,psep+2520.*xkf,psey+
     + ysaut,2,xupp)



c      CALL ROMANO ARC EXPERIMENTAL
       call romanoparc(i,1,1,uf,vf,zinf(i+1,6,2),-1,psep,psey+ysaut,
     + 2,xkf)



c      Set panel side lengths part 4
       call llarlr(i,1,4,np(i,3),ufv,vfv,llarl,llarr)

c      Print vents
       call drwvent(i,np,uf,vf,ufv,vfv,psep,psey+ysaut,xupp,xupple,
     + xuppte,xkf,1,ic2,csi)   ! case print
       call drwvent(i,np,uf,vf,ufv,vfv,psep+2520.*xkf,psey+ysaut,xupp,
     + xupple,xuppte,xkf,2,ic2,csi)   ! case laser
       end if

       ysaut=-ysautt

       end if ! 2 extrados cuts
 
       end do ! rib i

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      8.6.2 Intrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Plotter BOX(0,3) and BOX (0,5)

       if (atp.ne."ss") then

c      Avoid central panel if thickness is 0
       iini=0  ! panel 0 (central)
       if (cencell.lt.0.01) then
       iini=1
       end if

       do i=iini,nribss-1

       ic2=dint(rib(i+1,165)) ! vent type

       psep=1970.*xkf+seppix(i)*1.0d0
       psey=xyshift*xkf-890.95*xyintra*xkf ! remove 890.95 to set BOX (1,3)

c      REDEFINITION (!) for proper printing
       ng=rib(i+1,169)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Previ BRUTE FORCE, use for subroutine drwvent
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       npi=np(i,2)+np(i,3)-1
       npf=np(i,1)
       npo1=npf-npi+1

       do j=1,npo1
       ufa(i,j,9)=ufi(i,j,9)
       ufa(i,j,10)=ufi(i,j,10)
       ufa(i,j,11)=ufi(i,j,11)
       ufa(i,j,12)=ufi(i,j,12)
       vfa(i,j,9)=vfi(i,j,9)
       vfa(i,j,10)=vfi(i,j,10)
       vfa(i,j,11)=vfi(i,j,11)
       vfa(i,j,12)=vfi(i,j,12)
       end do

       cs1x=(ufa(i,1,9)+ufa(i,1,10))*0.5 ! Point 1
       cs1y=(vfa(i,1,9)+vfa(i,1,10))*0.5 ! Point 1

c      IN DOUBT... USE BRUTE FORCE!!!!!!!!!!!!!!!!!!!!!
       csi(i,1)=ufa(i,1,9)
       csi(i,2)=vfa(i,1,9)
       csi(i,3)=ufa(i,1,10)
       csi(i,4)=vfa(i,1,10)
       csi(i,5)=ufa(i,1,11)
       csi(i,6)=vfa(i,1,11)
       csi(i,7)=ufa(i,1,12)
       csi(i,8)=vfa(i,1,12)
       
       alpha1=(datan((vfa(i,1,10)-vfa(i,1,9))/
     + (ufa(i,1,10)-ufa(i,1,9))))

       csi(i,9)=alpha1
       csi(i,10)=xlow
       csi(i,11)=xlowte
       csi(i,12)=xlowle
       csi(i,13)=xupple

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      End BRUTE FORCE
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


cccccccccccccccccccccccccccccccccccccccccccccccccccccc    
c      Draw minirib intrados (copied from 8.4.6)
c      and adding "ysaut"
cccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (lowcuts(ng).eq.1) then
       ysaut=-ysautt
       else
       ysaut=0.0d0
       end if

       if (i.ge.0.and.rib(i+1,56).gt.1.and.rib(i+1,56).ne.100.and
     + .atp.ne."ss") then

       xpo1=(u(i,np(i,1),9)+u(i,np(i,1),10))/2.
       ypo1=(v(i,np(i,1),9)+v(i,np(i,1),10))/2.
       j=jcvi(i+1)
       xpo2=(u(i,j,9)+u(i,j,10))/2.
       ypo2=(v(i,j,9)+v(i,j,10))/2.

c      Evita divisions per zero!!!
       if (xpo2-xpo1.ne.0.) then
       alpha=datan((ypo2-ypo1)/(xpo2-xpo1))
       end if
       if (abs(xpo2-xpo1).lt.0.00001) then
       alpha=pi/2.
       end if

       xpo3=xpo1-rib(i+1,61)*dcos(alpha)
       ypo3=ypo1-rib(i+1,61)*dsin(alpha)
       xdesx=xdes*dsin(alpha)
       xdesy=xdes*dcos(alpha)

c      Draw reference points for miniribs in intrados
       call line(psep+xpo1,psey-ypo1+ysaut,psep+xpo3,psey-ypo3+ysaut,5)
       call pointg(psep+xpo1-xdesx,psey-ypo1-xdesy+ysaut,xcir,1)
       call pointg(psep+xpo3-xdesx,psey-ypo3-xdesy+ysaut,xcir,1)

c      Laser cuting
       xadd=2520.*xkf
       call point(psep+xpo1+xadd,psey-ypo1+ysaut,1)
       call point(psep+xpo3+xadd,psey-ypo3+ysaut,1)

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case intrados 0 cuts
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (lowcuts(ng).eq.0) then

c      Intrados panel from LE to TE

       npi=np(i,2)+np(i,3)-1
       npf=np(i,1)
       npo=npf-npi+1

       do j=1,npo
       uf(i,j,9)=ufi(i,j,9)
       uf(i,j,10)=ufi(i,j,10)
       uf(i,j,11)=ufi(i,j,11)
       uf(i,j,12)=ufi(i,j,12)
       vf(i,j,9)=vfi(i,j,9)
       vf(i,j,10)=vfi(i,j,10)
       vf(i,j,11)=vfi(i,j,11)
       vf(i,j,12)=vfi(i,j,12)
       end do

c      Set panel side lengths part 1
       call llarlr(i,2,1,npo,uf,vf,llarl,llarr)

c      Roman marks
       x1=uf(i,npo,10)
       y1=vf(i,npo,10)
       x2=uf(i,npo,9)
       y2=vf(i,npo,9)
       y3=1.0d0
       call romanop(i,-1,x1,-y1,x2,-y2,y3,psep,psey,xkf)

c      Print equidistant points
       xinil=0.0d0
       xinir=0.0d0
       call xmarksi(i,2,1,npo,uf,vf,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey,xcir,xdes,xkf)

c      Print intrados marks (experimental)
       xinil=0.0d0
       xinir=0.0d0
       call iam(i,2,1,np,npo,uf,vf,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey,xcir,xdes,xkf,
     + typm1,typm2,typm3,typm4,typm5,typm6,xrib)


c      Print intrados without vents
       if (k26d.eq.0.or.rib(i+1,165).ge.0) then
       call extpoints(i,uf,vf,npo,xlow,xlowte,xlowle,1)
       call dpanelcc(i,uf,vf,npo,psep,psey,3)
       call dpanelcc(i,uf,vf,npo,psep+2520.*xkf,psey,7)
       end if

c      Print intrados with vents
       if (k26d.eq.1.and.rib(i+1,165).lt.0) then
       call extpoints(i,uf,vf,npo,xlow,xlowte,xlowle,1)
       call dpanelcc(i,uf,vf,npo,psep,psey,4)
       call dpanelcc(i,uf,vf,npo,psep+2520.*xkf,psey,8)

c      Print vents

c      Print intrados marks (experimental)
       xinil=llarl(i,2,1)
       xinir=llarr(i,2,1)
       call iam(i,2,4,np,np(i,3),ufv,vfv,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey,xcir,xdes,xkf,
     + typm1,typm2,typm3,typm4,typm5,typm6,xrib)

c      Set panel side lengths part 4
       call llarlr(i,2,4,np(i,3),ufv,vfv,llarl,llarr)

       call drwvent(i,np,uf,vf,ufv,vfv,psep,psey,xlow,xlowle,
     + xlowte,xkf,1,ic2,csi)   ! case print
       call drwvent(i,np,uf,vf,ufv,vfv,psep+2520.*xkf,psey,xlow,xlowle,
     + xlowte,xkf,2,ic2,csi)   ! case laser

       end if

c      Think why???????????????????
c      Si no els punts queden desplaçats a l'extrados!!!
       ysaut=-ysautt

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case intrados 1 cut
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (lowcuts(ng).eq.1) then


c      Intrados panel from first cut to TE
       ysaut=-ysautt

       npi=ilow(1,3,ng)-(np(i,2)+np(i,3)-2)
       npf=np(i,1)-(np(i,2)+np(i,3)-2)
       npo=npf-npi+1

       do j=1,npo
       uf(i,j,9)=ufi(i,j+npi-1,9)
       uf(i,j,10)=ufi(i,j+npi-1,10)
       uf(i,j,11)=ufi(i,j+npi-1,11)
       uf(i,j,12)=ufi(i,j+npi-1,12)
       vf(i,j,9)=vfi(i,j+npi-1,9)
       vf(i,j,10)=vfi(i,j+npi-1,10)
       vf(i,j,11)=vfi(i,j+npi-1,11)
       vf(i,j,12)=vfi(i,j+npi-1,12)
       end do

c      Set panel side lengths part 1
       call llarlr(i,2,1,npo,uf,vf,llarl,llarr)

c      Roman marks
       x1=uf(i,npo,10)
       y1=vf(i,npo,10)
       x2=uf(i,npo,9)
       y2=vf(i,npo,9)
       y3=1.0d0
       call romanop(i,-1,x1,-y1,x2,-y2,y3,psep,psey+ysaut,xkf)

c      Print equidistant points
       xinil=0.0d0
       xinir=0.0d0
       call xmarksi(i,2,1,npo,uf,vf,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey+ysaut,xcir,xdes,xkf)



c      Print intrados marks (experimental)
       xinil=0.0d0
       xinir=0.0d0
       call iam(i,2,1,np,npo,uf,vf,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey+ysaut,xcir,xdes,xkf,
     + typm1,typm2,typm3,typm4,typm5,typm6,xrib)



c       if (k26d.eq.0.or.rib(i+1,165).ge.0) then
       call extpoints(i,uf,vf,npo,xlow,xlowte,xlow,1)
       call dpanelcc(i,uf,vf,npo,psep,psey+ysaut,4)
       call dpanelcc(i,uf,vf,npo,psep+2520.*xkf,psey+ysaut,8)
       call arc3p(i,1,uf,vf,zinf(i+1,6,4),-1*is4,psep,psey+ysaut,1,xlow)
       call arc3p(i,1,uf,vf,zinf(i+1,6,4),-1*is4,psep+2520.*xkf,psey+
     + ysaut,2,xlow)
c       end if

c      Extrados panel from LE to first cut
       npi=np(i,2)+np(i,3)-1
       npf=ilow(1,3,ng)
       npo=npf-npi+1

       do j=1,npo
       uf(i,j,9)=ufi(i,j,9)
       uf(i,j,10)=ufi(i,j,10)
       uf(i,j,11)=ufi(i,j,11)
       uf(i,j,12)=ufi(i,j,12)
       vf(i,j,9)=vfi(i,j,9)
       vf(i,j,10)=vfi(i,j,10)
       vf(i,j,11)=vfi(i,j,11)
       vf(i,j,12)=vfi(i,j,12)
       end do

c      Set panel side lengths part 2
       call llarlr(i,2,2,npo,uf,vf,llarl,llarr)

c      Print equidistant points
       xinil=xfinl(i,2,1)
       xinir=xfinr(i,2,1)
       call xmarksi(i,2,2,npo,uf,vf,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey,xcir,xdes,xkf)

c      Print intrados marks (experimental)
       xinil=llarl(i,2,1)
       xinir=llarr(i,2,1)
       call iam(i,2,2,np,npo,uf,vf,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey,xcir,xdes,xkf,
     + typm1,typm2,typm3,typm4,typm5,typm6,xrib)


c      Print without vents
       if (k26d.eq.0.or.rib(i+1,165).ge.0) then
       call extpoints(i,uf,vf,npo,xlow,xlow,xlowle,1)
       call dpanelcc(i,uf,vf,npo,psep,psey,2)
       call dpanelcc(i,uf,vf,npo,psep+2520.*xkf,psey,6)
       call arc3p(i,npo,uf,vf,zinf(i+1,6,4),1*is4,psep,psey,1,xlow)
       call arc3p(i,npo,uf,vf,zinf(i+1,6,4),1*is4,psep+2520.*xkf,psey,2,
     + xlow)
       end if

c      CALL ROMANO ARC EXPERIMENTAL
       call romanoparc(i,-1,npo,uf,vf,zinf(i+1,6,4),1,psep,psey,
     + 1,xkf)

c      Print with vents
       if (k26d.eq.1.and.rib(i+1,165).lt.0) then
       call extpoints(i,uf,vf,npo,xlow,xlow,xlowle,1)
       call dpanelcc(i,uf,vf,npo,psep,psey,1)
       call dpanelcc(i,uf,vf,npo,psep+2520.*xkf,psey,5)
       call arc3p(i,npo,uf,vf,zinf(i+1,6,4),1*is4,psep,psey,1,xlow)
       call arc3p(i,npo,uf,vf,zinf(i+1,6,4),1*is4,psep+2520.*xkf,psey,2,
     + xlow)

c      Set panel side lengths part 4
       call llarlr(i,2,4,np(i,3),ufv,vfv,llarl,llarr)

c      Print vents
       call drwvent(i,np,uf,vf,ufv,vfv,psep,psey,xlow,xlowle,
     + xlowte,xkf,1,ic2,csi)   ! case print
       call drwvent(i,np,uf,vf,ufv,vfv,psep+2520.*xkf,psey,xlow,xlowle,
     + xlowte,xkf,2,ic2,csi)   ! case laser

c      Print intrados marks (experimental)
       xinil=llarl(i,2,1)+llarl(i,2,2)
       xinir=llarr(i,2,1)+llarr(i,2,2)
       call iam(i,2,4,np,np(i,3),ufv,vfv,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey,xcir,xdes,xkf,
     + typm1,typm2,typm3,typm4,typm5,typm6,xrib)

       end if








       end if ! lowcuts=1

       end do ! i

       end if ! "ss"

       end if ! k29d=1

c      Print llarl and llarl. Use in section 11.4 for print equidistant marks
c       write (*,*) "EXTRADOS"
c       do i=1,nribss
c       write (*,*) "part 1 ",i,llarl(i,1,1),llarr(i,1,1)
c       write (*,*) "part 2 ",i,llarl(i,1,2),llarr(i,1,2)
c       write (*,*) "part 3 ",i,llarl(i,1,3),llarr(i,1,3)
c       end do
c       write (*,*) "INTRADOS"
c       do i=1,nribss
c       write (*,*) "part 1 ",i,llarl(i,2,1),llarr(i,2,1)
c       write (*,*) "part 2 ",i,llarl(i,2,2),llarr(i,2,2)
c       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc       
c      9. SINGULAR RIB POINTS
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       
c        write (*,*) "pi 9. =",pi

c      9.1 Compute anchor points

       do i=0,nribss         ! Itera in ribs

       do k=1,6 ! Itera in A,B,C,D,E,F

       do j=1,np(i,1)-1

c       if(u(i,j,3).le.rib(i,5)*rib(i,15+k)/100.and.u(i,j+1,3)
c     + .ge.rib(i,5)*rib(i,15+k)/100.and.j.ge.np(i,2)) then

c      Please, don't compare directly two double precision numbers !!!

       if(real(u(i,j,3)).le.real(rib(i,5)*rib(i,15+k)/100).and.
     + real(u(i,j+1,3)).ge.real(rib(i,5)*rib(i,15+k)/100).and.
     + j.ge.np(i,2)) then

       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xn=v(i,j,3)-xm*u(i,j,3)
       u(i,k,6)=rib(i,5)*rib(i,15+k)/100.0d0
       v(i,k,6)=xm*u(i,k,6)+xn

c       anccount(i,k)=j  ! anchor "j" detection in i rib

c       write (*,*) "Anchor control i,k,j = ",i,k,anccont(i,k)


       end if

       end do

       end do

       end do

c      9.1+ Detecta punts j a extrados propers a ancoratges

       
c        write (*,*) "pi 9.1+ =",pi

       do i=0,nribss         ! Itera in ribs

       do k=1,6 ! Itera in A,B,C,D,E,F

       do j=np(i,2),2,-1

       if(u(i,j,3).le.rib(i,5)*rib(i,15+k)/100..and.u(i,j-1,3)
     + .ge.rib(i,5)*rib(i,15+k)/100..and.j.le.np(i,2)) then

       anccont(i,k)=j

       end if

       end do

       end do

       end do


c      9.1++ Detecta punts j a intrados propers a ancoratges
c      Atenció casos ds i ss (ESTUDIAR)


       do i=0,nribss         ! Itera in ribs

       do k=1,6 ! Itera in A,B,C,D,E,F

       do j=1,np(i,1)-1

       if(u(i,j,3).le.rib(i,5)*rib(i,15+k)/100..and.u(i,j+1,3)
     + .ge.rib(i,5)*rib(i,15+k)/100..and.u(i,j,3).le.u(i,j+1,3)) then

       ancconti(i,k)=j

       end if

       end do

       end do

       end do
       

c      9.2 Compute inlets points

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      ENTRE 9.1+ i 9.2 es perd el valor de pi INEXPLICABLE
       pi=4.0d0*datan(1.0d0)   
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c        write (*,*) "pi 9.2. =",pi

       do i=1,nribss         ! Itera in ribs

       do k=11,12 ! air in out

       do j=1,np(i,1)

       if(u(i,j,3).le.rib(i,5)*rib(i,k)/100.0d0.and.u(i,j+1,3)
     + .ge.rib(i,5)*rib(i,k)/100.0d0.and.j.ge.np(i,2)-1) then

       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xn=v(i,j,3)-xm*u(i,j,3)
       u(i,k-4,6)=rib(i,5)*rib(i,k)/100.0d0
       v(i,k-4,6)=xm*u(i,k,6)+xn

       end if

       end do

       end do

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.3 Draw anchor points in airfoils
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       
c        write (*,*) "pi 9.3 =",pi

c      Box (1,2)

       sepxx=700.*xkf
       sepyy=100.*xkf

       kx=0
       ky=0
       kyy=0

       do i=1,nribss

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky)


c      Normal points A,B,C,D,E,F
       do j=1,6

c      Added case points brakes F j=6 (request from Eric Fontaine)
       if (j.le.rib(i,15).or.(j.eq.6.and.rib(i,21).lt.100.and.
     + rib(i,21).gt.0.)) then

c      9.3.1 Anchor points
       call line(sepx+u(i,j,6),-v(i,j,6)+sepy,sepx+u(i,j,6),
     + -0.+sepy,7)

c      9.3.2 Anchor points in mesa de corte

c      Case 1: classic 3 orange points
       if (typetab.eq.1) then
       call point(2530.*xkf+sepx+u(i,j,6),-v(i,j,6)+
     + sepy+typm6(5),30)
       call point(2530.*xkf+sepx+u(i,j,6),-v(i,j,6)+
     + sepy-1.*typm5(5)+typm6(5),30)
       call point(2530.*xkf+sepx+u(i,j,6),-v(i,j,6)+
     + sepy-2.*typm5(5)+typm6(5),30)
       end if

c      Case 2: rotated 3 orange points
       if (typetab.eq.2) then
c      Define "ji" of the anchor in the other "j" count 1,2,3,4,5
       ji=ancconti(i,j)  ! Compte, aqui "j" és "k"
       alpha1=datan((v(i,ji-1,3)-v(i,ji+1,3))/(u(i,ji-1,3)-u(i,ji+1,3)))
c      Amb desplaçament typm6(5) xdes com a intra
       xpeq=typm6(5)*dsin(alpha1)
       ypeq=typm6(5)*dcos(alpha1)
       call point(2530.*xkf+sepx+u(i,j,6)+xpeq,-v(i,j,6)+
     + sepy+ypeq,30)
       call point(2530.*xkf+sepx+u(i,j,6)+
     + (typm6(5)-1.*typm5(5))*dsin(alpha1),-v(i,j,6)+
     + sepy+(typm6(5)-1.*typm5(5))*dcos(alpha1),30)
       call point(2530.*xkf+sepx+u(i,j,6)+
     + (typm6(5)-2.*typm5(5))*dsin(alpha1),-v(i,j,6)+
     + sepy+(typm6(5)-2.*typm5(5))*dcos(alpha1),30)
       end if

c      Case 3: triangle 2 mm
c      REVISAR CAS ss !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       if (typetab.eq.3) then
c      Define "ji" of the anchor in the other "j" count 1,2,3,4,5
       ji=ancconti(i,j)  ! Compte, aqui "j" és "k"
       alpha1=datan((v(i,ji-1,3)-v(i,ji+1,3))/(u(i,ji-1,3)-u(i,ji+1,3)))
c      Amb desplaçament typm6(5) xdes com a intra
       xpeq=typm6(5)*dsin(alpha1)
       ypeq=typm6(5)*dcos(alpha1)
       call mtriangle(2530.*xkf+sepx+u(i,j,6)+xpeq,-v(i,j,6)+sepy+ypeq,
     + typm5(5),alpha1,30)
       end if

       end if ! Cases control
       end do ! Points A,B,C,D,E,F


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.4 Marca entrada aire a les costelles
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      9.4.1 Cases 0,-1,-2,-3,-4,-6 draw normal inlet LE
       if (rib(i,165).eq.0.or.rib(i,165).eq.-1.or.rib(i,165).eq.-2.or.
     + rib(i,165).eq.-3.or.rib(i,165).eq.-4.or.rib(i,165).eq.-6) then

       j=np(i,2)
       alpha1=pi+datan((v(i,j,3)-v(i,j-1,3))/(u(i,j,3)-u(i,j-1,3)))

       call line(sepx+u(i,j,3),-v(i,j,3)+sepy,sepx+u(i,j,3)-
     + 4.*dsin(alpha1),-v(i,j,3)-4.*dcos(alpha1)+sepy,1)

       x1=2530.*xkf+sepx+u(i,j,3)+0.1*typm6(4)*dsin(alpha1)
       y1=-v(i,j,3)+sepy+0.1*typm6(4)*dcos(alpha1)
       x2=2530.*xkf+sepx+u(i,j,3)-0.1*(typm5(4)-typm6(4))*dsin(alpha1)
       y2=-0.1*(typm5(4)-typm6(4))*dcos(alpha1)-v(i,j,3)+sepy

c      Laser points
       if (typevent.eq.1) then
c      Double point
       call point(x1,y1,3)
       call point(x2,y2,3)
       end if

       if (typevent.eq.2) then
c      Segment
       call linevent(x1,y1,x2,y2,3)
       end if

       if (typevent.eq.3) then
c      Segment 101
       call segment101(x1,y1,x2,y2,3)
       end if

       end if  ! case not 4

c      9.4.2 Case 4,5 draw special displaced LE inlet
       if (rib(i,165).eq.4.or.rib(i,165).eq.5) then

c      Load inlet polyline
       jini=np(i,2)
       jfin=np(i,2)+np(i,3)-1
       do j=jini,jfin
       useg(j)=u(i,j,3)
       vseg(j)=v(i,j,3)
       end do
c      First run to compute only polyline length (vent)
       linter=0.0d0
       call interpseg(jini,jfin,jc,ldif,
     + useg,vseg,ltotal,linter,upoint,vpoint)
c      Second run to interpolation
       linter=ltotal*(1.-csi(i,20)*0.01)
       call interpseg(jini,jfin,jc,ldif,
     + useg,vseg,ltotal,linter,upoint,vpoint)

c      Draw segment
       j=jc+1
       alpha1=pi+datan((v(i,j,3)-v(i,j-1,3))/(u(i,j,3)-u(i,j-1,3)))

       call line(sepx+upoint(1),-vpoint(1)+sepy,sepx+upoint(1)-
     + 4.*dsin(alpha1),-vpoint(1)-4.*dcos(alpha1)+sepy,30)

       x1=2530.*xkf+sepx+upoint(1)+0.1*typm6(4)*dsin(alpha1)
       y1=-vpoint(1)+sepy+0.1*typm6(4)*dcos(alpha1)
       x2=2530.*xkf+sepx+upoint(1)-0.1*(typm5(4)-typm6(4))*dsin(alpha1)
       y2=-0.1*(typm5(4)-typm6(4))*dcos(alpha1)-vpoint(1)+sepy

c      Laser points
       if (typevent.eq.1) then
c      Double point
       call point(x1,y1,3)
       call point(x2,y2,3)
       end if

       if (typevent.eq.2) then
c      Segment
       call linevent(x1,y1,x2,y2,3)
       end if

       if (typevent.eq.3) then
c      Segment 101
       call segment101(x1,y1,x2,y2,3)
       end if

       end if ! Inlet case 4


c      fi inlet (point intrados)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      9.4.3 Cases 0,1,-3,4,6 draw normal TE inlet
       if (rib(i,165).eq.0.or.rib(i,165).eq.1.or.rib(i,165).eq.-3.or.
     + rib(i,165).eq.4.or.rib(i,165).eq.6) then

       j=np(i,2)+np(i,3)-1
       alpha1=pi+datan((v(i,j+1,3)-v(i,j-1,3))/(u(i,j+1,3)-u(i,j-1,3)))

       call line(sepx+u(i,j,3),-v(i,j,3)+sepy,sepx+u(i,j,3)-
     + 4.*dsin(alpha1),-v(i,j,3)-4.*dcos(alpha1)+sepy,1)

       x1=2530.*xkf+sepx+u(i,j,3)+0.1*typm6(4)*dsin(alpha1)
       y1=-v(i,j,3)+sepy+0.1*typm6(4)*dcos(alpha1)
       x2=2530.*xkf+sepx+u(i,j,3)-0.1*(typm5(4)-typm6(4))*dsin(alpha1)
       y2=-0.1*(typm5(4)-typm6(4))*dcos(alpha1)-v(i,j,3)+sepy

c      Laser points
       if (typevent.eq.1) then
c      Double point
       call point(x1,y1,3)
       call point(x2,y2,3)
       end if

       if (typevent.eq.2) then
c      Segment
       call linevent(x1,y1,x2,y2,3)
       end if

       if (typevent.eq.3) then
c      Segment 101
       call segment101(x1,y1,x2,y2,3)
       end if

       end if ! case not -4

c      9.4.4 Case -4,-5 draw special displaced inlet
       if (rib(i,165).eq.-4.or.rib(i,165).eq.-5) then

c      Load inlet polyline
       jini=np(i,2)
       jfin=np(i,2)+np(i,3)-1
       do j=jini,jfin
       useg(j)=u(i,j,3)
       vseg(j)=v(i,j,3)
       end do
c      First run to compute only polyline length (vent)
       linter=0.0d0
       call interpseg(jini,jfin,jc,ldif,
     + useg,vseg,ltotal,linter,upoint,vpoint)
c      Second run to interpolation
       linter=ltotal*(1.-csi(i,20)*0.01)
       call interpseg(jini,jfin,jc,ldif,
     + useg,vseg,ltotal,linter,upoint,vpoint)

c      Draw segment
       j=jc+1
       alpha1=pi+datan((v(i,j,3)-v(i,j-1,3))/(u(i,j,3)-u(i,j-1,3)))
       call line(sepx+upoint(1),-vpoint(1)+sepy,sepx+upoint(1)-
     + 4.*dsin(alpha1),-vpoint(1)-4.*dcos(alpha1)+sepy,30)

       x1=2530.*xkf+sepx+upoint(1)+0.1*typm6(4)*dsin(alpha1)
       y1=-vpoint(1)+sepy+0.1*typm6(4)*dcos(alpha1)
       x2=2530.*xkf+sepx+upoint(1)-0.1*(typm5(4)-typm6(4))*dsin(alpha1)
       y2=-0.1*(typm5(4)-typm6(4))*dcos(alpha1)-vpoint(1)+sepy

c      Laser points
       if (typevent.eq.1) then
c      Double point
       call point(x1,y1,3)
       call point(x2,y2,3)
       end if

       if (typevent.eq.2) then
c      Segment
       call linevent(x1,y1,x2,y2,3)
       end if

       if (typevent.eq.3) then
c      Segment 101
       call segment101(x1,y1,x2,y2,3)
       end if

       end if  ! case -4


c     9.5 Aditional points (junquillos)

       if (narp.ne.0) then ! Only if narp.eq.0 k17d
       do l=1,narp
       call point(2530.*xkf+sepx+xarp(l)*rib(i,5)/100.,
     + -yarp(l)*rib(i,5)/100.+sepy,5)
c       call point(2530.*xkf+sepx+10.8*rib(i,5)/100.,
c     + +5.53*rib(i,5)/100.+sepy,5)
       end do
       end if

       kx=int((float(i)/6.))
       ky=i-kx*6
       kyy=kyy+1

       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.9 MIDDLE PANEL UNLOADED RIBS
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Box (1,6)
c      1260.*4.*xkf
       
       sepxx=1260.*4.*xkf+700.*xkf
       sepyy=100.*xkf
c      sepyy=100

       kx=0
       ky=0
       kyy=0

       do i=1,nribss

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*1.0*float(ky)

c      Detect complete unloaded rib
       if (rib(i,56).eq.100.and.atp.ne."ss") then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.9.1 Define intermediate airfoil beetwen i-1 and i
c      Interpole chord and thickness
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do j=1,np(i,1)
       u(i,j,43)=u(i-1,j,2)*0.5*(rib(i,5)+rib(i-1,5))/100.
       v(i,j,43)=v(i-1,j,2)*(0.5*(rib(i,149)+rib(i-1,149))/
     + rib(i-1,149))*0.5*(rib(i,5)+rib(i-1,5))/100.
       end do

c      Calculate midline in panel

       do j=1,np(i,1)
       u(i,j,44)=(u(i-1,j,9)+u(i-1,j,10))/2.
       v(i,j,44)=(v(i-1,j,9)+v(i-1,j,10))/2.

c       u(i,j,44)=u(i-1,j,9)
c       v(i,j,44)=v(i-1,j,9)

       end do

c      Compare lengths extra in rib (150) and panels (153)
       
       rib(i,150)=0.
       rib(i,153)=0.
       do j=1,np(i,2)-1    
       rib(i,150)=rib(i,150)+dsqrt((u(i,j,43)-u(i,j+1,43))**2.+
     + (v(i,j,43)-v(i,j+1,43))**2.)
       rib(i,153)=rib(i,153)+dsqrt((u(i,j,44)-u(i,j+1,44))**2.+
     + (v(i,j,44)-v(i,j+1,44))**2.)
       end do
       rib(i,156)=rib(i,150)-rib(i,153)

c      Compare lengths vent in rib (151) and panels (154)
c      9-10 Vent panel still not defined (!)
       
       rib(i,151)=0.
       rib(i,154)=0.
       do j=np(i,2),np(i,2)+np(i,3)-2
       rib(i,151)=rib(i,151)+dsqrt((u(i,j,43)-u(i,j+1,43))**2.+
     + (v(i,j,43)-v(i,j+1,43))**2.)
       rib(i,154)=rib(i,154)+dsqrt((u(i,j,44)-u(i,j+1,44))**2.+
     + (v(i,j,44)-v(i,j+1,44))**2.)
       end do
       rib(i,157)=rib(i,151)-rib(i,154)
       j1=np(i,2)
       j2=np(i,2)+np(i,3)-1
c       rib(i,151)=dsqrt((u(i,j1,44)-u(i,j2,44))**2.+
c     + (v(i,j1,44)-v(i,j2,44))**2.)

c      Compare lengths intra in rib (152) and panels (155)
       
       rib(i,152)=0.
       rib(i,155)=0.
       do j=np(i,2)+np(i,3)-1,np(i,1)-1
       rib(i,152)=rib(i,152)+dsqrt((u(i,j,43)-u(i,j+1,43))**2.+
     + (v(i,j,43)-v(i,j+1,43))**2.)
       rib(i,155)=rib(i,155)+dsqrt((u(i,j,44)-u(i,j+1,44))**2.+
     + (v(i,j,44)-v(i,j+1,44))**2.)
       end do
       rib(i,158)=rib(i,152)-rib(i,155)

c       write (*,*) i,rib(i,150),rib(i,153),rib(i,156)
c       write (*,*) i,rib(i,151),rib(i,154),rib(i,157)
c       write (*,*) i,rib(i,152),rib(i,155),rib(i,158)

c      Reformat rib extrados

       do j=1,np(i,2)-1  ! all extrados

       xdv=(v(i,j+1,43)-v(i,j,43))
       xdu=(u(i,j+1,43)-u(i,j,43))
       if (xdu.ne.0.) then
       anglee(j)=abs(datan(xdv/xdu))
       else
       anglee(j)=2.*datan(1.0d0)
       end if

       if (xdu.ge.0.and.xdv.ge.0) then ! case 1-I
       siu(j)=1.
       siv(j)=1.
       end if
       if (xdu.le.0.and.xdv.ge.0) then ! case 1-II
       siu(j)=-1.
       siv(j)=1.
       end if
       if (xdu.ge.0.and.xdv.le.0) then ! case 1-III
       siu(j)=1.
       siv(j)=-1.
       end if
       if (xdu.le.0.and.xdv.le.0) then ! case 1-IV
       siu(j)=-1.
       siv(j)=-1.
       end if

       distee(j)=dsqrt((v(i,j,43)-v(i,j+1,43))**2.+
     + (u(i,j,43)-u(i,j+1,43))**2.)

       end do

c      Define reformated airfoil extrados

       distk=rib(i,153)/rib(i,150)
       do j=1,np(i,2)-1
       u(i,j+1,45)=u(i,j,43)+siu(j)*distk*distee(j)*dcos(anglee(j))
       v(i,j+1,45)=v(i,j,43)+siv(j)*distk*distee(j)*dsin(anglee(j))
       u(i,j+1,43)=u(i,j+1,45)
       v(i,j+1,43)=v(i,j+1,45)
       end do

c      Verify reformated airfoil extrados

       rib(i,150)=0.
       do j=1,np(i,2)-1
       rib(i,150)=rib(i,150)+dsqrt((u(i,j,43)-u(i,j+1,43))**2.+
     + (v(i,j,43)-v(i,j+1,43))**2.)
       end do
c       write (*,*) "RE ",i,rib(i,150),rib(i,153),rib(i,150)-rib(i,153)


c      Reformat rib intrados

       do j=np(i,1),np(i,2)+np(i,3),-1  ! all intrados

       xdv=(v(i,j,43)-v(i,j-1,43))
       xdu=(u(i,j,43)-u(i,j-1,43))
       if (xdu.ne.0.) then
       anglee(j)=abs(datan(xdv/xdu))
       else
       anglee(j)=2.*datan(1.0d0)
       end if

c       write (*,*) "ANGLE ",i,j,anglee(j)

       if (xdu.ge.0.and.xdv.ge.0) then ! case 1-I
       siu(j)=1.
       siv(j)=1.
       end if
       if (xdu.le.0.and.xdv.ge.0) then ! case 1-II
       siu(j)=-1.
       siv(j)=1.
       end if
       if (xdu.ge.0.and.xdv.le.0) then ! case 1-III
       siu(j)=1.
       siv(j)=-1.
       end if
       if (xdu.le.0.and.xdv.le.0) then ! case 1-IV
       siu(j)=-1.
       siv(j)=-1.
       end if

       distee(j)=dsqrt((v(i,j,43)-v(i,j-1,43))**2.+
     + (u(i,j,43)-u(i,j-1,43))**2.)

       end do

c      Define reformated airfoil intrados

       distk=rib(i,155)/rib(i,152)
       do j=np(i,1),np(i,2)+np(i,3),-1        
       u(i,j-1,45)=u(i,j,43)-siu(j)*distk*distee(j)*dcos(anglee(j))
       v(i,j-1,45)=v(i,j,43)-siv(j)*distk*distee(j)*dsin(anglee(j))
       u(i,j-1,43)=u(i,j-1,45)
       v(i,j-1,43)=v(i,j-1,45)
       end do

c      Verify reformated airfoil intrados

       rib(i,152)=0.
       do j=np(i,1),np(i,2)+np(i,3),-1         
       rib(i,152)=rib(i,152)+dsqrt((u(i,j,43)-u(i,j-1,43))**2.+
     + (v(i,j,43)-v(i,j-1,43))**2.)
       end do
c       write (*,*) "RI ",i,rib(i,152),rib(i,155),rib(i,152)-rib(i,155)

c      Reformat vent ds (simplified method)

       if (atp.eq."ds") then

       if (np(i,3).eq.3) then ! interpolate only 1 point
       j=np(i,2)+1
       u(i,j,43)=(u(i,j-1,43)+u(i,j+1,43))*0.5
       v(i,j,43)=(v(i,j-1,43)+v(i,j+1,43))*0.5
       end if

       if (np(i,3).ge.4) then ! interpolate only 2 point
       j=np(i,2)+1
       u(i,j,43)=(2.*u(i,j-1,43)+1.*u(i,j+2,43))/3.
       v(i,j,43)=(2.*v(i,j-1,43)+1.*v(i,j+2,43))/3.
       j=np(i,2)+2
       u(i,j,43)=(1.*u(i,j-2,43)+2.*u(i,j+1,43))/3.
       v(i,j,43)=(1.*v(i,j-2,43)+2.*v(i,j+1,43))/3.
       end if

       end if

c      Reformat vent pc (lineal vent)

       if (atp.eq."pc") then

       xdu=(u(i,np(i,2)+np(i,3)-1,43)-u(i,np(i,2),43))/(np(i,3)-1)
       xdv=(v(i,np(i,2)+np(i,3)-1,43)-v(i,np(i,2),43))/(np(i,3)-1)
       do j=np(i,2),np(i,2)+np(i,3)-2
       u(i,j+1,43)=u(i,j,43)+xdu
       v(i,j+1,43)=v(i,j,43)+xdv
       end do

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.9.2 Compute external cut edges in airfoils (i,j,46)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       xcos=xrib/10. ! rib sewing allowance mm to cm
      
       do j=2,np(i,1)-1

c      Amplification factor
       xcosk=1.0

c      Fer mitja entre j-1 i j+1
       alpha1=(datan((v(i,j+1,43)-v(i,j,43))/((u(i,j+1,43)-u(i,j,43)))))
       alpha2=(datan((v(i,j,43)-v(i,j-1,43))/((u(i,j,43)-u(i,j-1,43)))))

       alpha=0.5*(alpha1+alpha2)

c      Alpha correction in sawtooht mono-surface airfoils
c      Dóna la volta a la vora superior

       if (alpha1.lt.0.and.alpha2.gt.0.and.j.ge.np(i,2)) then
       alpha=alpha+pi
       end if

       u(i,j,46)=u(i,j,43)-xcos*xcosk*dsin(alpha)

       if(v(i,j,43).ge.0.) then
       v(i,j,46)=v(i,j,43)+xcos*xcosk*dcos(alpha)
       end if

       if(v(i,j,43).lt.0.) then
       u(i,j,46)=u(i,j,43)+xcos*xcosk*dsin(alpha)
       v(i,j,46)=v(i,j,43)-xcos*xcosk*dcos(alpha)
       end if

       if(u(i,j,3).eq.0) then
       u(i,j,46)=u(i,j,43)-xcos*xcosk
       v(i,j,46)=v(i,j,43)
       end if

       end do

       j=1

       alpha=(datan((v(i,j+1,43)-v(i,j,43))/((u(i,j+1,43)-u(i,j,43)))))

       u(i,j,46)=u(i,j,43)-xcos*xcosk*dsin(alpha)

       if(v(i,j,43).ge.0.) then
       v(i,j,46)=v(i,j,43)+xcos*xcosk*dcos(alpha)
       end if

       if(v(i,j,43).lt.0.) then
       u(i,j,46)=u(i,j,43)+xcos*xcosk*dsin(alpha)
       v(i,j,46)=v(i,j,43)-xcos*xcosk*dcos(alpha)

       end if

       j=np(i,1)

       alpha=(datan((v(i,j,43)-v(i,j-1,43))/((u(i,j,43)-u(i,j-1,43)))))

       u(i,j,46)=u(i,j,43)-xcos*xcosk*dsin(alpha)

       if(v(i,j,43).ge.0.) then
       v(i,j,46)=v(i,j,43)+xcos*xcosk*dcos(alpha)
       end if

       if(v(i,j,43).le.0.) then
       u(i,j,46)=u(i,j,43)+xcos*xcosk*dsin(alpha)
       v(i,j,46)=v(i,j,43)-xcos*xcosk*dcos(alpha)
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.9.3 Print unloaded ribs, internal line (i,j,43)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c       Now not used

c       do j=1,np(i,2)-1
c       call line(sepx+u(i,j,43),-v(i,j,43)+sepy-sepriy*0.5,
c     + sepx+u(i,j+1,43),-v(i,j+1,43)+sepy-sepriy*0.5,1)
c       end do
c       do j=np(i,2),np(i,2)+np(i,3)-2
c       call line(sepx+u(i,j,43),-v(i,j,43)+sepy-sepriy*0.5,
c     + sepx+u(i,j+1,43),-v(i,j+1,43)+sepy-sepriy*0.5,2)
c       end do
c       do j=np(i,2)+np(i,3)-1,np(i,1)-1
c       call line(sepx+u(i,j,43),-v(i,j,43)+sepy-sepriy*0.5,
c     + sepx+u(i,j+1,43),-v(i,j+1,43)+sepy-sepriy*0.5,3)
c       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.9.4 Print unloaded ribs, external line (i,j,46)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do j=1,np(i,2)-1
       call line(sepx+u(i,j,46),-v(i,j,46)+sepy-sepriy*0.5,
     + sepx+u(i,j+1,46),-v(i,j+1,46)+sepy-sepriy*0.5,1)
       end do
       do j=np(i,2),np(i,2)+np(i,3)-2
       call line(sepx+u(i,j,46),-v(i,j,46)+sepy-sepriy*0.5,
     + sepx+u(i,j+1,46),-v(i,j+1,46)+sepy-sepriy*0.5,2)
       end do
       do j=np(i,2)+np(i,3)-1,np(i,1)-1
       call line(sepx+u(i,j,46),-v(i,j,46)+sepy-sepriy*0.5,
     + sepx+u(i,j+1,46),-v(i,j+1,46)+sepy-sepriy*0.5,1)
       end do

       j=1
       call line(sepx+u(i,j,46),-v(i,j,46)+sepy-sepriy*0.5,
     + sepx+u(i,j,43),-v(i,j,43)+sepy-sepriy*0.5,1)
       j=np(i,1)
       call line(sepx+u(i,j,46),-v(i,j,46)+sepy-sepriy*0.5,
     + sepx+u(i,j,43),-v(i,j,43)+sepy-sepriy*0.5,1)
      
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.9.5 Draw romano and itxt mark in rib
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc     
       j=1
       x1=sepx+u(i,j,43)
       y1=-v(i,j,43)+sepy-sepriy*0.5
       call romano(i,x1-20.,y1,0.0d0,typm6(9)*0.1,7)
       call itxt(x1,y1,5.0d0,0.0d0,i,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.9.6 Draw vents
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      ini
       j=np(i,2)

       alpha1=datan((v(i,j,43)-v(i,j-1,43))/(u(i,j,43)-u(i,j-1,43)))
      
       call point(sepx+u(i,j,43)+xdes*dsin(alpha1),
     + -v(i,j,43)+sepy-sepriy*0.5+xdes*dcos(alpha1),3)
       call point(sepx+u(i,j,43)-1.8*dsin(alpha1),
     + -1.8*dcos(alpha1)-v(i,j,43)+sepy-sepriy*0.5,3)

c      fi
       j=np(i,2)+np(i,3)-1

       alpha1=datan((v(i,j+1,43)-v(i,j-1,43))/(u(i,j+1,43)-u(i,j-1,43)))
       
       call point(sepx+u(i,j,43)+xdes*dsin(alpha1),
     + -v(i,j,43)+sepy-sepriy*0.5+xdes*dcos(alpha1),3)
       call point(sepx+u(i,j,43)-2.*dsin(alpha1),
     + -2*dcos(alpha1)-v(i,j,43)+sepy-sepriy*0.5,3)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.9.7 Marks extrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do k=1,60  ! Up to 60 marks

c      Partial lengths init

       rib(i,40)=0.
       rib(i,41)=0.
       rib(i,42)=0.
       rib(i,43)=0.
       rib(i,44)=0.
       rib(i,45)=0.

       xmk=xmark*float(k)

       do j=1,np(i,2)-1

       xprev=rib(i,41)

       rib(i,41)=rib(i,41)+sqrt((u(i,j,43)-u(i,j+1,43))**2.+((v(i,j,43)
     + -v(i,j+1,43))**2.))

       xpost=rib(i,41)

       if(xmk.lt.xpost.and.xmk.ge.xprev) then

c      dibuixa marca

       dist=dsqrt((u(i,j,43)-u(i,j+1,43))**2.+((v(i,j,43)
     + -v(i,j+1,43))**2.))

       dist1=xmk-xprev

       xu=u(i,j,43)+(u(i,j+1,43)-u(i,j,43))*(dist1/dist)
       xv=v(i,j,43)+(v(i,j+1,43)-v(i,j,43))*(dist1/dist)

c      Despla a vores punts de control de costures
       alp=(datan((v(i,j+1,43)-v(i,j,43))/(u(i,j+1,43)-u(i,j,43))))
       if (xv.lt.0.) then
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
       end if
       if (xv.ge.0.) then
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)
       end if

c      Dibuixa punt a les costelles

       call point(sepx+xu,sepy-sepriy*0.5-xv,7)
       
       end if 

       end do ! j extrados

       end do ! mark K

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.9.8 Marks intrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do k=1,60

c      Partial lengths init

       rib(i,40)=0.
       rib(i,41)=0.
       rib(i,42)=0.
       rib(i,43)=0.
       rib(i,44)=0.
       rib(i,45)=0.

       xmk=xmark*float(k)

       do j=np(i,1),np(i,2)+np(i,3),-1

       xprev=rib(i,44)

       rib(i,44)=rib(i,44)+sqrt((u(i,j,43)-u(i,j-1,43))**2.+((v(i,j,43)
     + -v(i,j-1,43))**2.))

       xpost=rib(i,44)

       if(xmk.lt.xpost.and.xmk.ge.xprev) then

c      dibuixa marca

       dist=dsqrt((u(i,j,43)-u(i,j-1,43))**2.+((v(i,j,43)
     + -v(i,j-1,43))**2.))

       dist1=xmk-xprev

       xu=u(i,j,43)+(u(i,j-1,43)-u(i,j,43))*(dist1/dist)
       xv=v(i,j,43)+(v(i,j-1,43)-v(i,j,43))*(dist1/dist)

c      Despla a vores punts de control de costures
       alp=(datan((v(i,j,43)-v(i,j-1,43))/(u(i,j,43)-u(i,j-1,43))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)

c      Dibuixa punt a les costelles
       call point(sepx+xu,sepy-sepriy*0.5-xv,7)

       end if

       end do ! j intrados

       end do ! k


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.9.9 Draw holes in unloaded ribs
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
       do l=1,nhols11

c       write (*,*) i,nhols11,ii11

c      Dibuixa forat tipus 11 (alleugerament elliptics)
     
       xx0=(hol(ii11,l,2))*0.5*(rib(i-1,5)+rib(i,5))/100.0d0+sepx
       yy0=(-(hol(ii11,l,3))*0.5*(rib(i-1,5)+rib(i,5))
     + /100.0d0+sepy-sepriy*0.5)
       xxa=(hol(ii11,l,4))*0.5*(rib(i-1,5)+rib(i,5))/100.0d0
       yyb=((hol(ii11,l,5))*0.5*(rib(i-1,5)+rib(i,5))/100.0d0)

       call ellipse(xx0,yy0,xxa,yyb,(hol(ii11,l,6)),1)

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Change airfoil location
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       end if  ! Calcule and draw rib i

       kx=int((float(i)/6.))
       ky=i-kx*6
       kyy=kyy+1

       end do ! rib i


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.9.10 Draw equidistant points in panels
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.9.10.1 Extrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=0,nribss

       psep=1970.*xkf+2520.*xkf+seppix(i)*1.0d0
       psey=400.*xkf

c      Detect complete unloaded rib
       if (rib(i,56).eq.100.and.atp.ne."ss") then

c      Initial point

       j=1
       xu=u(i,j,44)
       xv=v(i,j,44)

       alp=abs(datan((v(i,j+1,44)-v(i,j,44))/(u(i,j+1,44)-u(i,j,44))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)

       call point(psep+xu-seppix(i),psey-xv,4)
       call point(psep+xu-seppix(i)-2520.*xkf,psey-xv,4)

c      Final point

       j=np(i,2)
       xu=u(i,j,44)
       xv=v(i,j,44)

       alp=abs(datan((v(i,j-1,44)-v(i,j,44))/(u(i,j-1,44)-u(i,j,44))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)

       call point(psep+xu-seppix(i),psey-xv,4)
       call point(psep+xu-seppix(i)-2520.*xkf,psey-xv,4)

c      Internal equidistant points

       do k=1,60  ! Up to 60 marks

c      Partial lengths init

       rib(i,40)=0.
       rib(i,41)=0.
       rib(i,42)=0.
       rib(i,43)=0.
       rib(i,44)=0.
       rib(i,45)=0.

       xmk=xmark*float(k)

       do j=1,np(i,2)-1

       xprev=rib(i,41)

       rib(i,41)=rib(i,41)+sqrt((u(i,j,44)-u(i,j+1,44))**2.+
     + ((v(i,j,44)-v(i,j+1,44))**2.))

       xpost=rib(i,41)

       if(xmk.lt.xpost.and.xmk.ge.xprev) then

c      dibuixa marca

       dist=dsqrt((u(i,j,44)-u(i,j+1,44))**2.+((v(i,j,44)
     + -v(i,j+1,44))**2.))

       dist1=xmk-xprev

       xu=u(i,j,44)+(u(i,j+1,44)-u(i,j,44))*(dist1/dist)
       xv=v(i,j,44)+(v(i,j+1,44)-v(i,j,44))*(dist1/dist)

c      Despla a vores punts de control de costures
c       alp=(datan((v(i,j+1,44)-v(i,j,44))/(u(i,j+1,44)-u(i,j,44))))
c       if (xv.lt.0.) then
c       xu=xu+xdes*dsin(alp)
c       xv=xv-xdes*dcos(alp)
c       end if
c       if (xv.ge.0.) then
c       xu=xu-xdes*dsin(alp)
c       xv=xv+xdes*dcos(alp)
c       end if

c      Dibuixa punt a les costelles

c       call point(psep+xu-seppix(i),psey-xv,1)

c      Despla a vores punts de control de costures
       alp=(datan((v(i,j+1,44)-v(i,j,44))/(u(i,j+1,44)-u(i,j,44))))
       if (xv.lt.0.) then
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
       end if
       if (xv.ge.0.) then
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)
       end if

       call point(psep+xu-seppix(i),psey-xv,1)
       call point(psep+xu-seppix(i)-2520.*xkf,psey-xv,1)

       end if ! xmk

       end do ! j extrados

       end do ! mark K

       end if ! unloaded rib

       end do ! rib i


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      9.9.10.2 Intrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=0,nribss

       psep=1970.*xkf+2520.*xkf+seppix(i)*1.0d0
       psey=1291.*xkf

c      Detect complete unloaded rib
       if (rib(i,56).eq.100.and.atp.ne."ss") then

c      Initial point

       j=np(i,1)
       xu=u(i,j,44)
       xv=v(i,j,44)

       alp=abs(datan((v(i,j-1,44)-v(i,j,44))/(u(i,j-1,44)-u(i,j,44))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)

       call point(psep+xu-seppix(i),psey-xv,4)
       call point(psep+xu-seppix(i)-2520.*xkf,psey-xv,4)

c      Final point

       j=np(i,2)+np(i,3)-1
       xu=u(i,j,44)
       xv=v(i,j,44)

       alp=abs(datan((v(i,j-1,44)-v(i,j,44))/(u(i,j-1,44)-u(i,j,44))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)

       call point(psep+xu-seppix(i),psey-xv,4)
       call point(psep+xu-seppix(i)-2520.*xkf,psey-xv,4)

c      Internal equidistant points

       do k=1,60  ! Up to 60 marks

c      Partial lengths init

       rib(i,40)=0.
       rib(i,41)=0.
       rib(i,42)=0.
       rib(i,43)=0.
       rib(i,44)=0.
       rib(i,45)=0.

       xmk=xmark*float(k)

       do j=np(i,1),np(i,2)+np(i,3),-1

       xprev=rib(i,43)

       rib(i,43)=rib(i,43)+sqrt((u(i,j,44)-u(i,j-1,44))**2.+
     + ((v(i,j,44)-v(i,j-1,44))**2.))

       xpost=rib(i,43)

       if(xmk.lt.xpost.and.xmk.ge.xprev) then

c      dibuixa marca

       dist=dsqrt((u(i,j,44)-u(i,j-1,44))**2.+((v(i,j,44)
     + -v(i,j-1,44))**2.))

       dist1=xmk-xprev

       xu=u(i,j,44)+(u(i,j-1,44)-u(i,j,44))*(dist1/dist)
       xv=v(i,j,44)+(v(i,j-1,44)-v(i,j,44))*(dist1/dist)

c      Despla a vores punts de control de costures
c       alp=(datan((v(i,j+1,44)-v(i,j,44))/(u(i,j+1,44)-u(i,j,44))))
c       if (xv.lt.0.) then
c       xu=xu+xdes*dsin(alp)
c       xv=xv-xdes*dcos(alp)
c       end if
c       if (xv.ge.0.) then
c       xu=xu-xdes*dsin(alp)
c       xv=xv+xdes*dcos(alp)
c       end if

c      Dibuixa punt a les costelles

c       call point(psep+xu-seppix(i),psey-xv,1)

c      Despla a vores punts de control de costures
       alp=(datan((v(i,j-1,44)-v(i,j,44))/(u(i,j-1,44)-u(i,j,44))))
c       if (xv.lt.0.) then
c       xu=xu+xdes*dsin(alp)
c       xv=xv-xdes*dcos(alp)
c       end if
c       if (xv.ge.0.) then
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)
c       end if

       call point(psep+xu-seppix(i),psey-xv,1)
       call point(psep+xu-seppix(i)-2520.*xkf,psey-xv,1)

       end if ! xmk

       end do ! j extrados

       end do ! mark K

       end if ! unloaded rib

       end do ! rib i


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      10. CALAGE
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      
c        write (*,*) "pi 10. =",pi

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      10.1 Basic calculus
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       calag=(calage/100.0d0)*rib(1,5) ! calage in cm
       hcp=clengl+clengr            ! height karabiners-canopy
       hcpp=hcp ! hcp value saved (lost further...!)
       cple=(cpress/100.0d0)*rib(1,5)  ! center or pressure in cm
       assiette=dasin(((cple-calag)/hcp))*(180.0d0/pi)
       afinesse=(datan(1.0d0/planeig))*(180.0d0/pi)
       aoa=afinesse-assiette

c       write (*,*) ">>>>>>>>>>>>>>>>"
c       write (*,*) planeig,pi
c       write (*,*) afinesse,assiette



cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      10.1+ Angle beetween glide path and airfoil plane (phii)
c            Angle beetween glide path and chord line (chii)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      afinesse = glide path angle       
       alpha_ii=afinesse*pi/180.0d0 ! conversion to radians

c      assiette angle (tetha), by convention positive BELOW horizon, and negative OVER horizon
c      (gamma=alpha+tetha)
       assiette_ii=assiette*pi/180.0d0 ! conversion to radians
       if (iflag_assiette.eq.1) then ! use assiette defined by user
       assiette_ii=assiette2003*pi/180.0d0 ! conversion to radians
       end if

c      Now let's use a trick...
c      We want to compare the angles between profile planes or chords with the flight path
c      We will modify the angle of trajectory to take into account the angle of assiette, 
c      since the ones we are interested in calculating are the relative angles phii and chii. 
c      That is, instead of turning the whole wing the angle of assiette, 
c      we will turn the angle of trajectory, which is easier.
       alpha_ii=alpha_ii-assiette_ii

c      For each rib
       do i=0,nribss

c      Plane defined by the space airfoil using points
c      j=1, j=int((np(i,2)/2), j=np(i,2)
c      points: initial, medium upper surface, leading edge
c      Warning! Solve the case thickness = 0.0 !!!
       j1=1
       j2=int((np(i,2)/2.0))
       j3=np(i,2)
       x1=x(i,j1)
c       x2=x(i,j2)
       x2=x_apap(i)
       x3=x(i,j3)
       y1=y(i,j1)
c       y2=y(i,j2)
       y2=y_apap(i)
       y3=y(i,j3)
       z1=z(i,j1)
c       z2=z(i,j2)
       z2=z_apap(i)
       z3=z(i,j3)

       Apla=(y2-y1)*(z3-z1)-(z2-z1)*(y3-y1)
       Bpla=(z2-z1)*(x3-x1)-(x2-x1)*(z3-z1)
       Cpla=(x2-x1)*(y3-y1)-(y2-y1)*(x3-x1)

c      Director cosines of glidepath line
       l_line=0.0d0
       m_line=-dcos(alpha_ii)
       n_line=dsin(alpha_ii)

c      Angle phii between plane and line
c      Handbook of Mathematics, Bronshtein and Semendyayev. Mir, Moscow.
       phii(i)=dasin((Apla*l_line+Bpla*m_line+Cpla*n_line)/
     + (dsqrt((Apla*Apla+Bpla*Bpla+Cpla*Cpla)*
     + (l_line*l_line+m_line*m_line+n_line*n_line))))

c      Director cosines of the chord line
c      First point is nose point j=np(i,6), last point is nose point j=1
       l2_line=(x(i,1)-x(i,np(i,6)))/rib(i,5)
       m2_line=(y(i,1)-y(i,np(i,6)))/rib(i,5)
       n2_line=(z(i,1)-z(i,np(i,6)))/rib(i,5)

c      Angle between two lines in space
c      Handbook of Mathematics, Bronshtein and Semendyayev. Mir, Moscow.
       chii(i)=pi-dacos((l_line*l2_line+m_line*m2_line+n_line*n2_line)/
     + dsqrt((l_line*l_line+m_line*m_line+n_line*n_line)*
     + (l2_line*l2_line+m2_line*m2_line+n2_line*n2_line)))

c       write (*,*) i,np(i,6), -phii(i)*180.0d0/pi,chii(i)*180.0d0/pi
c       write (*,*) i,phii(i)*180.0d0/pi,chii(i)*180.0d0/pi,
c     + l2_line,m2_line,n2_line

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      10.2 Karabiners location
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       xkar=clengk/2.
       ykar=calag+rib(1,3)
       zkar=hcp

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      10.3 Dibuixa calage
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Box (2,1)

       x0=0.
       y0=900.*xkf

c      Central airfoil
       i=1

       do j=1,np(i,1)-1

       call line(x0+u(i,j,3),-v(i,j,3)+y0,x0+u(i,j+1,3),
     + -v(i,j+1,3)+y0,1)

       end do

c      Chord
       call line(x0,y0,x0+rib(i,5),y0,8)

c      Pilot-CP and Pilot-C
       call line(x0+ykar,y0+0.,x0+ykar,y0+zkar,1)
       call line(x0+cple,y0+0.,x0+ykar,y0+zkar,3)

c      Assiette and AoA angles
       call line(x0+cple,y0+0.,x0-100.,y0-(100.+cple)*
     + dtan(-assiette*pi/180.),4)
       call line(x0+cple,y0+0.,x0-100.,y0+(100.+cple)*
     + dtan(aoa*pi/180.),5)

       xtext="pilot"
       call txt(x0+ykar+20.,y0+zkar,10.0d0,0.0d0,xtext,7)
       xtext="C"
       call txt(x0+ykar,y0-10.,10.0d0,0.0d0,xtext,7)
       xtext="Pp"
       call txt(x0+cple,y0-10.,10.0d0,0.0d0,xtext,7)
       
c      Write text about calage parameters
       xtext="calage= "
       call txt(x0-220*xkf,y0+60.,10.0d0,0.0d0,xtext,7)
       write (xtext, '(F5.2)') calage
       call txt(x0-50*xkf,y0+60.,10.0d0,0.0d0,xtext,7)
       
       xtext="plumb point= "
       call txt(x0-220*xkf,y0+80,10.0d0,0.0d0,xtext,7)
       write (xtext, '(F5.2)') cpress
       call txt(x0-50*xkf,y0+80,10.0d0,0.0d0,xtext,7)
       
       xtext="glide ratio= "
       call txt(x0-220*xkf,y0+100,10.0d0,0.0d0,xtext,7)
       write (xtext, '(F5.2)') planeig
       call txt(x0-50*xkf,y0+100,10.0d0,0.0d0,xtext,7)
       
       xtext="glide angle= "
       call txt(x0-220*xkf,y0+120,10.0d0,0.0d0,xtext,7)
       write (xtext, '(F5.2)') afinesse
       call txt(x0-50*xkf,y0+120,10.0d0,0.0d0,xtext,7)
       
       xtext="angle of attack= "
       call txt(x0-220*xkf,y0+140,10.0d0,0.0d0,xtext,7)
       write (xtext, '(F5.2)') aoa
       call txt(x0-50*xkf,y0+140,10.0d0,0.0d0,xtext,7)
       
       xtext="assiette= "
       call txt(x0-220*xkf,y0+160,10.0d0,0.0d0,xtext,7)
       write (xtext, '(F5.2)') assiette
       call txt(x0-50*xkf,y0+160,10.0d0,0.0d0,xtext,7)


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     11. CALCULA LONGITUDS EXTRA INTRA EN PANELLS I PERFILS. MARKS
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     WARNING: Additional vent marks in section 8.5 (!)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      
c        write (*,*) "pi 11. =",pi

c      11.1 Extrados

       do i=1,nribss

       rib(i,30)=0. ! extra panel left
       rib(i,31)=0. ! extra rib
       rib(i,32)=0. ! extra panel right
       rib(i,33)=0. ! intra panel left
       rib(i,34)=0. ! intra rib
       rib(i,35)=0. ! intra panel right

c      Compute lengths extrados
       do j=1,np(i,2)-1

c      WARNING longituds a dreta i esquerra de la costella extrados!
c      Arreglat amb el vector 29 definit mes enrera

c       rib(i,30)=rib(i,30)+sqrt((u(i-1,j,29)-u(i-1,j+1,29))**2.+
c     + ((v(i-1,j,29)-v(i-1,j+1,29))**2.))

c      ATENCIO, veure si compatible amb cas reformat especial

       rib(i,30)=rib(i,30)+sqrt((u(i-1,j,10)-u(i-1,j+1,10))**2.+
     + ((v(i-1,j,10)-v(i-1,j+1,10))**2.))

       rib(i,31)=rib(i,31)+sqrt((u(i,j,3)-u(i,j+1,3))**2.+((v(i,j,3)
     + -v(i,j+1,3))**2.))

       rib(i,32)=rib(i,32)+sqrt((u(i,j,9)-u(i,j+1,9))**2.+((v(i,j,9)
     + -v(i,j+1,9))**2.))

       end do

c      Compute lengths intrados
       do j=np(i,2)+np(i,3),np(i,1)-1

       rib(i,33)=rib(i,33)+sqrt((u(i-1,j,10)-u(i-1,j+1,10))**2.+
     + ((v(i-1,j,10)-v(i-1,j+1,10))**2.))

       rib(i,34)=rib(i,34)+sqrt((u(i,j,3)-u(i,j+1,3))**2.+((v(i,j,3)
     + -v(i,j+1,3))**2.))

       rib(i,35)=rib(i,35)+sqrt((u(i,j,9)-u(i,j+1,9))**2.+((v(i,j,9)
     + -v(i,j+1,9))**2.))

       end do

c      Amplification cofficients
       rib(i,36)=rib(i,30)/rib(i,31)
       rib(i,37)=rib(i,32)/rib(i,31)
       rib(i,38)=rib(i,33)/rib(i,34)
       rib(i,39)=rib(i,35)/rib(i,34)

       rib(0,36)=rib(1,36)
       rib(0,37)=rib(1,36)
       rib(0,38)=rib(1,38)
       rib(0,39)=rib(1,38)

c       write (*,*) "rib(i,36) ",i, rib(i,36), rib(i,30)

       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     AND COMPUTE AGAIN!!! "AMPLICATION" COEFFICIENTS
c     in new vectors rib(i,190) to rib(i,201)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Initilize vectors
       do i=0,nribss-1
       rib(i,190)=0. ! rib extra i
       rib(i,191)=0. ! panel extra left i
       rib(i,192)=0. ! rib extra i+1
       rib(i,193)=0. ! panel extra right i
       rib(i,194)=0. ! k 191/190
       rib(i,195)=0. ! k 193/192
       rib(i,196)=0. ! rib intra i
       rib(i,197)=0. ! panel intra left i
       rib(i,198)=0. ! rib intra i+1
       rib(i,199)=0. ! panel intra right i
       rib(i,200)=0. ! k 197/196
       rib(i,201)=0. ! k 199/198
       end do

       do i=0,nribss-1 ! for all ribs at left

c      A. Compute lengths extrados
       do j=1,np(i,2)-1
c      WARNING longituds a dreta i esquerra de la costella extrados!
c      Arreglat amb el vector 29 definit mes enrera
c       rib(i,30)=rib(i,30)+sqrt((u(i-1,j,29)-u(i-1,j+1,29))**2.+
c     + ((v(i-1,j,29)-v(i-1,j+1,29))**2.))
c      ATENCIO, veure si compatible amb cas reformat especial
       rib(i,190)=rib(i,190)+sqrt((u(i,j,3)-u(i,j+1,3))**2.+((v(i,j,3)
     + -v(i,j+1,3))**2.))
       rib(i,191)=rib(i,191)+sqrt((u(i,j,9)-u(i,j+1,9))**2.+((v(i,j,9)
     + -v(i,j+1,9))**2.))
       rib(i,192)=rib(i,192)+sqrt((u(i+1,j,3)-u(i+1,j+1,3))**2.+
     + ((v(i+1,j,3)-v(i+1,j+1,3))**2.))
       rib(i,193)=rib(i,193)+sqrt((u(i,j,10)-u(i,j+1,10))**2.+
     + ((v(i,j,10)-v(i,j+1,10))**2.))
       end do
       rib(i,194)=rib(i,191)/rib(i,190) ! Extrados left
       rib(i,195)=rib(i,193)/rib(i,192) ! Extrados right

c       write (*,*) i,"extra ",rib(i,194),rib(i,195)

c      B. Compute lengths intrados
       do j=np(i,2)+np(i,3)-1,np(i,1)-1
       rib(i,196)=rib(i,196)+sqrt((u(i,j,3)-u(i,j+1,3))**2.+((v(i,j,3)
     + -v(i,j+1,3))**2.))
       rib(i,197)=rib(i,197)+sqrt((u(i,j,9)-u(i,j+1,9))**2.+((v(i,j,9)
     + -v(i,j+1,9))**2.))
       rib(i,198)=rib(i,198)+sqrt((u(i+1,j,3)-u(i+1,j+1,3))**2.+
     + ((v(i+1,j,3)-v(i+1,j+1,3))**2.))
       rib(i,199)=rib(i,199)+sqrt((u(i,j,10)-u(i,j+1,10))**2.+
     + ((v(i,j,10)-v(i,j+1,10))**2.))
       end do ! j
       rib(i,200)=rib(i,197)/rib(i,196) ! Intrados left
       rib(i,201)=rib(i,199)/rib(i,198) ! Intrados right

c       write (*,*) i,"intra ",rib(i,200),rib(i,201)

       end do ! i ribs


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      11.2 Comprovació de longituds
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c       do i=1,nribss

c       write (*,*) "Extrados ", i, rib(i,30), rib(i,31), rib(i,32) 

c       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc      
c      11.3 Dibuixa marques a costelles
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       sepxx=700.*xkf
       sepyy=100.*xkf

       kx=0
       ky=0
       kyy=0

c      Verify thickness of last rib
       
       xsum=0.
       ic=0
       i=nribss
       do j=1,np(i,1)
       xsum=xsum+abs(v(i,j,3))
       end do
       if (xsum.ne.0.0) then
       ic=1
       end if

ccccccccccccccccccccccccccccccccccccccccccccccc
c     11.3.1 Extrados
ccccccccccccccccccccccccccccccccccccccccccccccc

c      Iteration in ribs    
       do i=1,nribss-1+ic

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Punt TE
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       j=1

       xu=u(i,j,3)
       xv=v(i,j,3)

c      Despla a vores punts de control de costures
       alp=pi/2.
       if (xv.lt.0.) then
c       xu=xu+xdes*dsin(alp)
c       xv=xv-xdes*dcos(alp)
       end if
       if (xv.ge.0.) then
c       xu=xu+xdes*dsin(alp)
c       xv=xv-xdes*dcos(alp)
       end if

       call pointg(sepx+xu,sepy-xv,xcir,4)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Punts interiors
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Equidistant points in ribs extrados (print)

       do k=1,60

c      Partial lengths init

       rib(i,40)=0.
       rib(i,41)=0.
       rib(i,42)=0.
       rib(i,43)=0.
       rib(i,44)=0.
       rib(i,45)=0.

       xmk=xmark*float(k)

       do j=1,np(i,2)-1

       xprev=rib(i,41)

       rib(i,41)=rib(i,41)+sqrt((u(i,j,3)-u(i,j+1,3))**2.+((v(i,j,3)
     + -v(i,j+1,3))**2.))

       xpost=rib(i,41)

       if(xmk.lt.xpost.and.xmk.ge.xprev) then

c      dibuixa marca

       dist=dsqrt((u(i,j,3)-u(i,j+1,3))**2.+((v(i,j,3)
     + -v(i,j+1,3))**2.))

       dist1=xmk-xprev

       xu=u(i,j,3)+(u(i,j+1,3)-u(i,j,3))*(dist1/dist)
       xv=v(i,j,3)+(v(i,j+1,3)-v(i,j,3))*(dist1/dist)

c      Despla a vores punts de control de costures
       alp=(datan((v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))))
       if (xv.lt.0.) then
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
       end if
       if (xv.ge.0.) then
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)
       end if

       call pointg(sepx+xu,sepy-xv,xcir,3)

c      Dibuixa punt a les costelles de la taula de tall
c      2530 per ajustar a BOX(1,4)
       call point(2530.*xkf+sepx+xu,sepy-xv,7)
       
       end if

       end do ! j extrados

c      new
       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      11.3.2 Intrados
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Punts interiors

       do k=1,60

c      Partial lengths init

       rib(i,40)=0.
       rib(i,41)=0.
       rib(i,42)=0.
       rib(i,43)=0.
       rib(i,44)=0.
       rib(i,45)=0.

       xmk=xmark*float(k)

c      Comprova si el parapent es tipus "ds" or "pc"
c      If type "ss" not needed

       if (atp.eq."ds".or.atp.eq."pc") then

       do j=np(i,1),np(i,2)+np(i,3),-1

       xprev=rib(i,44)

       rib(i,44)=rib(i,44)+sqrt((u(i,j,3)-u(i,j-1,3))**2.+((v(i,j,3)
     + -v(i,j-1,3))**2.))

       xpost=rib(i,44)

       if(xmk.lt.xpost.and.xmk.ge.xprev) then

c      dibuixa marca

       dist=dsqrt((u(i,j,3)-u(i,j-1,3))**2.+((v(i,j,3)
     + -v(i,j-1,3))**2.))

       dist1=xmk-xprev

       xu=u(i,j,3)+(u(i,j-1,3)-u(i,j,3))*(dist1/dist)
       xv=v(i,j,3)+(v(i,j-1,3)-v(i,j,3))*(dist1/dist)

c      Despla a vores punts de control de costures
       alp=(datan((v(i,j,3)-v(i,j-1,3))/(u(i,j,3)-u(i,j-1,3))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)

       call pointg(sepx+xu,sepy-xv,xcir,3)

c      Dibuixa punt a les costelles de la taula de tall
c      2530 per ajustar a BOX(1,4)
       call point(2530.*xkf+sepx+xu,sepy-xv,7)
     
       end if

       end do ! j intrados

c      Final verificació ds
       end if

       end do ! k

       kx=int((float(i)/6.))
       ky=i-kx*6
       kyy=kyy+1
       
       end do  ! i

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      11.4 Panels marks
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      11.4.1 Extrados panels mark 
c      Case classic
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (n1draw.eq.1) then ! Draw marks classic

       do i=0,nribss-1
       
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=400.*xkf

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      11.4.1.2 Marks extrados left  
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Initial and final points

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Initial point
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       j=1

       xu=u(i,j,9)
       xv=v(i,j,9)

c      Despla a vores punts de control de costures
       alp=abs(datan((v(i,j+1,9)-v(i,j,9))/(u(i,j+1,9)-u(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,4)

c      Point laser       
       call point(psep+xu+2520.*xkf,-xv+psey,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Final point
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       j=np(i,2)

       xu=u(i,j,9)
       xv=v(i,j,9)

c      Despla a vores punts de control de costures
       alp=abs(datan((v(i,j-1,9)-v(i,j,9))/(u(i,j-1,9)-u(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,4)

c      Point laser      
       call point(psep+xu+2520.*xkf,-xv+psey,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Interior points
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do k=1,60

c      Partial lengths init

       rib(i,40)=0.
       rib(i,41)=0.
       rib(i,42)=0.
       rib(i,43)=0.
       rib(i,44)=0.
       rib(i,45)=0.

       xmk=xmark*float(k)

       xmk=xmk*rib(i,36) ! amplificacio de segment
      
c      Dibuixa a extrados left     

       do j=1,np(i,2)-1

       xprev=rib(i,40)

       rib(i,40)=rib(i,40)+sqrt((u(i,j,9)-u(i,j+1,9))**2.+((v(i,j,9)
     + -v(i,j+1,9))**2.))

       xpost=rib(i,40)

       if(xmk.le.xpost.and.xmk.ge.xprev) then

c      dibuixa marca

       dist=dsqrt((u(i,j,9)-u(i,j+1,9))**2.+((v(i,j,9)
     + -v(i,j+1,9))**2.))

       dist1=xmk-xprev

       xu=u(i,j,9)+(u(i,j+1,9)-u(i,j,9))*(dist1/dist)
       xv=v(i,j,9)+(v(i,j+1,9)-v(i,j,9))*(dist1/dist)

c      Despla a vores punts de control de costures
       alp=abs(datan((v(i,j+1,9)-v(i,j,9))/(u(i,j+1,9)-u(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,3)

c      Point laser
       call point(psep+xu+2520.*xkf,-xv+psey,7)
       
       end if

       end do ! j extrados left

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      11.4.1.3 Marks Panel extrados right
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Interiors
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       xmk=xmark*float(k)

       xmk=xmk*rib(i,37) ! amplificacio de segment

c      Dibuixa a extrados right     

       do j=1,np(i,2)-1

       xprev=rib(i,42)

       rib(i,42)=rib(i,42)+sqrt((u(i,j,10)-u(i,j+1,10))**2.+((v(i,j,10)
     + -v(i,j+1,10))**2.))

       xpost=rib(i,42)

       if(xmk.le.xpost.and.xmk.ge.xprev) then

c      dibuixa marca

       dist=dsqrt((u(i,j,10)-u(i,j+1,10))**2.+((v(i,j,10)
     + -v(i,j+1,10))**2.))

       dist1=xmk-xprev

       xu=u(i,j,10)+(u(i,j+1,10)-u(i,j,10))*(dist1/dist)
       xv=v(i,j,10)+(v(i,j+1,10)-v(i,j,10))*(dist1/dist)

c      Despla a vores punts de control de costures
       alp=abs(datan((v(i,j+1,10)-v(i,j,10))/(u(i,j+1,10)-u(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,3)

c      Point laser     
       call point(psep+xu+2520.*xkf,-xv+psey,7)
       
       end if

       end do ! j extrados right

       end do ! k

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Initial and final mark points outside the k-60-loop
c      Note by Pawel 20190507
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Initial point
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       j=1

       xu=u(i,j,10)
       xv=v(i,j,10)

c      Despla a vores punts de control de costures
       alp=abs(datan((v(i,j+1,10)-v(i,j,10))/(u(i,j+1,10)-u(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,4)

c      Point laser       
       call point(psep+xu+2520.*xkf,-xv+psey,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Final point
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       j=np(i,2)

       xu=u(i,j,10)
       xv=v(i,j,10)

c      Despla a vores punts de control de costures
       alp=abs(datan((v(i,j-1,10)-v(i,j,10))/(u(i,j-1,10)-u(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)

       call pointg(psep+xu,psey-xv,xcir,4)

c      Point laser       
       call point(psep+xu+2520.*xkf,-xv+psey,7)

       end do ! i extrados points

       end if ! n1draw points extrados right (and left?) 








ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Marks in case k29d = 1
       if (k29d.eq.1) then

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      11.4.1-3D Extrados panel marks
c      Case 3D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
           
       do i=iini,nribss-1

       ic2=dint(rib(i+1,165)) ! vent type
       
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=xyshift*xkf-890.95*xyextra*xkf ! remove 890.95 to set BOX (1,3)

c      REDEFINITION (!) for proper printing
       ng=rib(i+1,169)

       if (i.eq.0) then
       ng=rib(1,169)
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      11.4.1.2-3D Marks
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Extrados points, case 3D, initial and final left and right
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Falta els punts dels vents!

       do j=1,npo
c       write (*,*) i,j,j9,j10,xcir,xdes
       end do
     
c      Case 0 cuts
       if (uppcuts(ng).eq.0) then
       npi=1
       npf=np(i,2)
       call prinifp(i,npi,npf,u,v,psep,psey,xcir,xdes,xkf)
       end if

c      Case 1 cut
       if (uppcuts(ng).eq.1) then
       npi=1
       npf=iupp(1,3,ng)
       call prinifp(i,npi,npf,u,v,psep,psey,xcir,xdes,xkf)
       npi=iupp(1,3,ng)
       npf=np(i,2)
       call prinifp(i,npi,npf,u,v,psep,psey+ysaut,xcir,xdes,xkf)
       end if

c      Case 2 cuts
       if (uppcuts(ng).eq.2) then
       npi=1
       npf=iupp(1,3,ng)
       call prinifp(i,npi,npf,u,v,psep,psey,xcir,xdes,xkf)
       npi=iupp(1,3,ng)
       npf=iupp(2,3,ng)
       call prinifp(i,npi,npf,u,v,psep,psey+ysaut,xcir,xdes,xkf)
       npi=iupp(2,3,ng)
       npf=np(i,2)
       call prinifp(i,npi,npf,u,v,psep,psey+ysaut*2.,xcir,xdes,xkf)
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Intrados points, case 3D, initial and final left and right
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc






       end do ! i ribs


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      11.4.2-3D Intrados panel marks
c      Case 3D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


c      Plotter BOX(0,3) and BOX (0,5)

       if (atp.ne."ss") then

c      Avoid central panel if thickness is 0
       iini=0  ! panel 0 (central)
       if (cencell.lt.0.01) then
       iini=1
       end if

       do i=iini,nribss-1

       ic2=dint(rib(i+1,165)) ! vent type

       psep=1970.*xkf+seppix(i)*1.0d0
       psey=xyshift*xkf-890.95*xyintra*xkf ! remove 890.95 to set BOX (1,3)

c      REDEFINITION (!) for proper printing
       ng=rib(i+1,169)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Intrados points, case 3D, initial and final left and right
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Falta els punts dels vents!
     
c      Case 0 cuts
       if (lowcuts(ng).eq.0) then
       npi=np(i,2)+np(i,3)-1
       npf=np(i,1)
       call prinifp(i,npi,npf,u,v,psep,psey,xcir,xdes,xkf)
       end if

c      Case 1 cut
       if (lowcuts(ng).eq.1) then
       npi=np(i,2)+np(i,3)-1
       npf=ilow(1,3,ng)
       call prinifp(i,npi,npf,u,v,psep,psey,xcir,xdes,xkf)
       npi=ilow(1,3,ng)
       npf=np(i,1)
       call prinifp(i,npi,npf,u,v,psep,psey+ysaut,xcir,xdes,xkf)
       end if

       end do ! i ribs

       end if ! "ss"


       end if ! k29d = 1













ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      11.4.2 Intrados panel marks
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (n1draw.eq.1) then ! draw

c      Control if type is not "ss"
       if (atp.ne."ss") then

       do i=0,nribss-1
       
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=1291.*xkf

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      11.4.2.1 Intrados panel marks Left
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Initial
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       j=np(i,2)+np(i,3)-1

       xu=u(i,j,9)
       xv=v(i,j,9)

c      Despla a vores punts de control de costures
       alp=abs(datan((v(i,j,9)-v(i,j+1,9))/(u(i,j,9)-u(i,j+1,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,4)

c      Point laser       
       call point(psep+xu+2520.*xkf,-xv+psey,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Final
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       j=np(i,1)

       xu=u(i,j,9)
       xv=v(i,j,9)

c      Despla a vores punts de control de costures
       alp=abs(datan((v(i,j-1,9)-v(i,j,9))/(u(i,j-1,9)-u(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,4)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Point laser       
       call point(psep+xu+2520.*xkf,-xv+psey,7)
c      Per calcular angle vora de fuga:
       xlll=psep+xu
       ylll=-xv+psey
c      See lep-2.73 to undestand use of thesse variables
cccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     Interior
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do k=1,60

c      Partial lengths init

       rib(i,40)=0.
       rib(i,41)=0.
       rib(i,42)=0.
       rib(i,43)=0.
       rib(i,44)=0.
       rib(i,45)=0.

       xmk=xmark*float(k)

       xmk=xmk*rib(i,38) ! amplificacio de segment
      
c      Dibuixa a intrados left     

       do j=np(i,1),np(i,2)+np(i,3),-1

       xprev=rib(i,43)

       rib(i,43)=rib(i,43)+sqrt((u(i,j,9)-u(i,j-1,9))**2.+((v(i,j,9)
     + -v(i,j-1,9))**2.))

       xpost=rib(i,43)

       if(xmk.le.xpost.and.xmk.ge.xprev) then

c      dibuixa marca

       dist=dsqrt((u(i,j,9)-u(i,j-1,9))**2.+((v(i,j,9)
     + -v(i,j-1,9))**2.))

       dist1=xmk-xprev

       xu=u(i,j,9)+(u(i,j-1,9)-u(i,j,9))*(dist1/dist)
       xv=v(i,j,9)+(v(i,j-1,9)-v(i,j,9))*(dist1/dist)

c      Despla a vores punts de control de costures
       alp=abs(datan((v(i,j-1,9)-v(i,j,9))/(u(i,j-1,9)-u(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,3)

c      Point laser      
       call point(psep+xu+2520.*xkf,-xv+psey,7)
       
       end if

       end do ! j intrados left

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      11.4.2.2 Marks Panel intrados right
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Interior
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       xmk=xmark*float(k)

       xmk=xmk*rib(i,39) ! amplificacio de segment

c      Dibuixa a intrados right     

       do j=np(i,1),np(i,2)+np(i,3),-1

       xprev=rib(i,45)

       rib(i,45)=rib(i,45)+sqrt((u(i,j,10)-u(i,j-1,10))**2.+((v(i,j,10)
     + -v(i,j-1,10))**2.))

       xpost=rib(i,45)

       if(xmk.le.xpost.and.xmk.ge.xprev) then

c      dibuixa marca

       dist=dsqrt((u(i,j,10)-u(i,j-1,10))**2.+((v(i,j,10)
     + -v(i,j-1,10))**2.))

       dist1=xmk-xprev

       xu=u(i,j,10)+(u(i,j-1,10)-u(i,j,10))*(dist1/dist)
       xv=v(i,j,10)+(v(i,j-1,10)-v(i,j,10))*(dist1/dist)

c      Despla a vores punts de control de costures
       alp=abs(datan((v(i,j-1,10)-v(i,j,10))/(u(i,j-1,10)-u(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,3)

c      Point laser       
       call point(psep+xu+2520.*xkf,-xv+psey,7)
       
       end if

       end do ! j intrados right

       end do ! k

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Initial and final mark points outside the k-60-loop
c      Note by Pawel 20190507
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Initial
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       j=np(i,2)+np(i,3)-1

       xu=u(i,j,10)
       xv=v(i,j,10)

c      Despla a vores punts de control de costures
       alp=abs(datan((v(i,j,10)-v(i,j+1,10))/(u(i,j,10)-u(i,j+1,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,4)

c      Point laser       
       call point(psep+xu+2520.*xkf,-xv+psey,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Final
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       j=np(i,1)

       xu=u(i,j,10)
       xv=v(i,j,10)

c      Despla a vores punts de control de costures
       alp=abs(datan((v(i,j-1,10)-v(i,j,10))/(u(i,j-1,10)-u(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)

c      Point imp
       call pointg(psep+xu,psey-xv,xcir,4)
       call point(psep+xu+2520.*xkf,-xv+psey,7)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


cccccccccccccccccccccccccccccccccccccccccccccccccccc
c      11.4.2.4 Roman numbers in intrados
c      Dibuixa marques romanes AD
cccccccccccccccccccccccccccccccccccccccccccccccccccc

c      xlll, ylll computed above       

       xrrr=psep+xu
       yrrr=-xv+psey
       alprom=abs(atan((yrrr-ylll)/(xrrr-xlll)))

       call romano(i+1,psep-5.*dcos(alprom)+xu+2520.*xkf, 
     + -xv+psey-0.7*dcos(alprom)-5.*dsin(alprom),pi-alprom,
     + typm6(8)*0.1,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      11.4.3 Anchor points mark in intrados (Experimental)
c      2015-09-06 Request by Scott
c      2018-01-20 Request by Nicolas
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Draw intrados marks
       icontrolmi=1

       if (icontrolmi.eq.1) then

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Left side
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do klz=1,rib(i,15) ! rib(i,15)=anchors number

       xlen=0.
       j=np(i,1)
       xlenp=dsqrt((v(i,j,9)-v(i,j-1,9))**2.+(u(i,j,9)-u(i,j-1,9))**2.)

       do j=np(i,1),np(i,2)+1,-1

c      Detect and draw anchor point
       if (rib(i,130+klz).ge.xlen.and.rib(i,130+klz).lt.xlenp) then

c       write (*,*) "Anchors ",i,j,klz,xlen,rib(i,130+klz),xlenp

       rib(i,107)=rib(i,130+klz)-xlen
       rib(i,108)=dsqrt((v(i,j,9)-v(i,j-1,9))**2.+(u(i,j,9)-u(i,j-1,9))
     + **2.)

c      Interpolate
       xequis=u(i,j,9)-(rib(i,107)*(u(i,j,9)-u(i,j-1,9)))/
     + rib(i,108)
       yequis=v(i,j,9)-(rib(i,107)*(v(i,j,9)-v(i,j-1,9)))/
     + rib(i,108)

c      Define anchor points in planar panel
       xanchoril(i,klz)=xequis
       yanchoril(i,klz)=yequis

c      Draw
       xdu=u(i,j,9)-u(i,j-1,9)
       xdv=v(i,j,9)-v(i,j-1,9)

       if (xdu.ne.0) then
       alpha=-(datan(xdv/xdu))
       end if
       if (xdu.eq.0.) then
       alpha=pi/2.
       end if
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case imp
c      Line 4*xrib in plotting panels
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Case all
       call line(psep+xequis,psey-yequis,psep+xequis-0.4*xrib*
     + dsin(-alpha),psey-yequis-0.4*xrib*dcos(-alpha),30)
       
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case laser
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       xpeq=xequis+1.*xdes*dsin(-alpha)
       ypeq=yequis-1.*xdes*dcos(-alpha)

       xdesp=1.0*(0.5*(xrib-20.*xdes))/10.
c       xdesp=typm6(5)
c      REVISAR

       xdesp1x=xdesp*dsin(-alpha)
       xdesp1y=-xdesp*dcos(-alpha)
       xdesp2x=2.*xdesp*dsin(-alpha)
       xdesp2y=-2.*xdesp*dcos(-alpha)

c      Case 1: classic 3 orange points
       if (typm4(5).eq.1) then
       call point (psep+xpeq+2520*xkf,psey-ypeq,30)
       call point (psep+xpeq+xdesp1x+2520*xkf,psey-ypeq-xdesp1y,30)
       call point (psep+xpeq+xdesp2x+2520*xkf,psey-ypeq-xdesp2y,30)
       end if

c      Case 2: Controled 3 orange points
       if (typm4(5).eq.2) then
       xpeq=xequis+1.*typm6(5)*dsin(-alpha)
       ypeq=yequis-1.*typm6(5)*dcos(-alpha)
       xdesp1x=typm5(5)*dsin(-alpha)
       xdesp1y=-typm5(5)*dcos(-alpha)
       xdesp2x=2.*typm5(5)*dsin(-alpha)
       xdesp2y=-2.*typm5(5)*dcos(-alpha)
       call point (psep+xpeq+2520*xkf,psey-ypeq,30)
       call point (psep+xpeq+xdesp1x+2520*xkf,psey-ypeq-xdesp1y,30)
       call point (psep+xpeq+xdesp2x+2520*xkf,psey-ypeq-xdesp2y,30)
       end if

c      Case 3: triangle h mm
       if (typm4(5).eq.3) then
       xpeq=xequis-typm6(5)*dsin(alpha)
       ypeq=yequis+typm6(5)*dcos(alpha)
       call mtriangle(psep+xpeq+2520*xkf,psey-ypeq,typm5(5),-alpha,1)
       end if

       end if

       xlen=xlen+sqrt((v(i,j,9)-v(i,j-1,9))**2.+(u(i,j,9)-u(i,j-1,9))
     + **2.)
       xlenp=xlen+sqrt((v(i,j-1,9)-v(i,j-2,9))**2.+
     + (u(i,j-1,9)-u(i,j-2,9))**2.)

       end do ! j

       end do ! klz


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Right side
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do klz=1,rib(i+1,15)

       xlen=0.
       j=np(i,1)
       xlenp=dsqrt((v(i,j,10)-v(i,j-1,10))**2.+(u(i,j,10)-u(i,j-1,10))
     + **2.)

       do j=np(i,1),np(i,2)+1,-1

c      Detect and draw anchor point
       if (rib(i+1,130+klz).ge.xlen.and.rib(i+1,130+klz).lt.xlenp) then

c       write (*,*) "Anchors ",i,j,klz,xlen,rib(i,130+klz),xlenp

       rib(i+1,107)=rib(i+1,130+klz)-xlen
       rib(i+1,108)=dsqrt((v(i,j,10)-v(i,j-1,10))**2.+(u(i,j,10)-
     + u(i,j-1,10))**2.)

c      Interpolate
       xequis=u(i,j,10)-(rib(i+1,107)*(u(i,j,10)-u(i,j-1,10)))/
     + rib(i+1,108)
       yequis=v(i,j,10)-(rib(i+1,107)*(v(i,j,10)-v(i,j-1,10)))/
     + rib(i+1,108)

c      Define anchor points in planar panel
       xanchorir(i,klz)=xequis
       yanchorir(i,klz)=yequis

c      Draw
       alpha=-(datan((v(i,j,10)-v(i,j-1,10))/(u(i,j,10)-u(i,j-1,10))))

       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case imp
c      Line 4*xrib in plotting panels
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       call line(psep+xequis,psey-yequis,psep+xequis+0.4*xrib*
     + dsin(-alpha),psey-yequis+0.4*xrib*dcos(-alpha),30)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case laser
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       xpeq=xequis-1.*xdes*dsin(-alpha)
       ypeq=yequis+1.*xdes*dcos(-alpha)

       xdesp=1.0*(0.5*(xrib-20.*xdes))/10.
c      REVISAR
c       xdesp=typm6(5)

       xdesp1x=xdesp*dsin(-alpha)
       xdesp1y=-xdesp*dcos(-alpha)
       xdesp2x=2.*xdesp*dsin(-alpha)
       xdesp2y=-2.*xdesp*dcos(-alpha)

c      Case 1: classic 3 orange points
       if (typm4(5).eq.1) then
       call point (psep+xpeq+2520*xkf,psey-ypeq,30)
       call point (psep+xpeq-xdesp1x+2520*xkf,psey-ypeq+xdesp1y,30)
       call point (psep+xpeq-xdesp2x+2520*xkf,psey-ypeq+xdesp2y,30)
       end if

c      Case 2: controled 3 orange points
       if (typm4(5).eq.2) then
       xpeq=xequis+1.*typm6(5)*dsin(-alpha)
       ypeq=yequis-1.*typm6(5)*dcos(-alpha)
       xdesp1x=typm5(5)*dsin(-alpha)
       xdesp1y=-typm5(5)*dcos(-alpha)
       xdesp2x=2.*typm5(5)*dsin(-alpha)
       xdesp2y=-2.*typm5(5)*dcos(-alpha)
       call point (psep+xpeq+2520*xkf,psey-ypeq,30)
       call point (psep+xpeq-xdesp1x+2520*xkf,psey-ypeq+xdesp1y,30)
       call point (psep+xpeq-xdesp2x+2520*xkf,psey-ypeq+xdesp2y,30)
       end if

c      Case 3: triangle 2 mm
       if (typm4(5).eq.3) then
       xpeq=xequis-typm6(5)*dsin(-alpha)
       ypeq=yequis+typm6(5)*dcos(-alpha)
       call mtriangle(psep+xpeq+2520*xkf,psey-ypeq,typm5(5),-alpha+pi,1)
       end if

       end if

       xlen=xlen+dsqrt((v(i,j,10)-v(i,j-1,10))**2.+(u(i,j,10)-
     + u(i,j-1,10))**2.)
       xlenp=xlen+dsqrt((v(i,j-1,10)-v(i,j-2,10))**2.+
     + (u(i,j-1,10)-u(i,j-2,10))**2.)

       end do ! j

       end do ! klz

       end if ! icontrol-mi

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       end do ! i

c      End if control is not "ss"
       end if

       end if ! n1draw




cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      12. LINES
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c        write (*,*) "pi 12. =",pi
c        pi=4.0d0*datan(1.)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      12.1 Write lines matrix
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do ii=1,slp

       do j=1,cam(ii)

c       write (*,*) ii,j, mc(ii,j,2), mc(ii,j,3), mc(ii,j,4), mc(ii,j,5),
c     + mc(ii,j,6), mc(ii,j,7)," - "  ,mc(ii,j,14), mc(ii,j,15)


       end do
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      12.2 Identifica les cordes a calcular
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       ic1=0
       ic2=1

       do ii=1,slp      ! Itera en numero de plans

       do k=2,8,2       ! Explora fins 4 nivells
       
       do j=1,cam(ii)-1 ! Itera en camins de cada pla

       if (mc(ii,j,1).le.4.and.k.le.8) then ! Detecta fins 4 nivells
       a=dfloat(mc(ii,j,k))
       b=dfloat(mc(ii,j,k+1))
       aa=dfloat(mc(ii,j+1,k))
       bb=dfloat(mc(ii,j+1,k+1))
       endif

       if (mc(ii,j,1).eq.5.and.k.eq.10) then ! Llegeix nivell 5
       a=dfloat(mc(ii,j,k))
       b=dfloat(mc(ii,j,k+1))
       aa=dfloat(mc(ii,j+1,k))
       bb=dfloat(mc(ii,j+1,k+1))
       endif

       if (a.ne.0.0d0.and.b.ne.0.0d0) then ! count pair line

c      While pair is equal, increase counter
       if (a.eq.aa.and.b.eq.bb) then

       ic2=ic2+1 ! comptabilitza cordes iguals

c      Si arribem a final del cami comptabilitzar la corda
       if (j.eq.cam(ii)-1) then

       ic1=ic1+1

       corda(ic1,1)=ii                    !planol
       corda(ic1,2)=mc(ii,j+1,k)          !nivell
       corda(ic1,3)=mc(ii,j+1,k+1)        !ordre
       corda(ic1,4)=ic2                   !punts d'acció
       corda(ic1,5)=mc(ii,j+1,1)          !ramificacions del camĂ­
       corda(ic1,6)=mc(ii,j+1,14)         !final row
       corda(ic1,7)=mc(ii,j+1,15)         !final rib

c      Assign types
       corda(ic1,30+mc(ii,j+1,k))=mc(ii,j+1,30+mc(ii,j+1,k))

       ic2=1

       end if

       end if

c      Si canvia la corda al mateix nivell
       if (a.ne.aa.or.b.ne.bb) then

c       write (*,*) "Ep ",b,bb

       ic1=ic1+1

       corda(ic1,1)=ii                  !planol
       corda(ic1,2)=mc(ii,j,k)          !nivell
       corda(ic1,3)=mc(ii,j,k+1)        !ordre
       corda(ic1,4)=ic2                 !punts d'acciĂł
       corda(ic1,5)=mc(ii,j,1)          !ramificacions del camĂ­
       corda(ic1,6)=mc(ii,j,14)         !final row
       corda(ic1,7)=mc(ii,j,15)         !final rib

c      Assign types
       corda(ic1,30+mc(ii,j,k))=mc(ii,j,30+mc(ii,j,k))

       ic2=1

       end if

c      Si arribem a l'ultima linia i no es zero
       if (j.eq.cam(ii)-1) then

       a=dfloat(mc(ii,j,k))
       b=dfloat(mc(ii,j,k+1))
       aa=dfloat(mc(ii,j+1,k))
       bb=dfloat(mc(ii,j+1,k+1))

c      Last level
       if ((a.ne.aa.or.b.ne.bb).and.(aa.ne.0.0d0.and.bb.ne.0.0d0)) then

       ic1=ic1+1

       corda(ic1,1)=ii                    !planol
       corda(ic1,2)=mc(ii,j+1,k)          !nivell
       corda(ic1,3)=mc(ii,j+1,k+1)        !ordre
       corda(ic1,4)=ic2                   !punts d'accio
       corda(ic1,5)=mc(ii,j+1,1)          !ramificacions del camĂ­
       corda(ic1,6)=mc(ii,j+1,14)         !final row
       corda(ic1,7)=mc(ii,j+1,15)         !final rib

c      Assign types
       corda(ic1,30+mc(ii,j+1,k))=mc(ii,j+1,30+mc(ii,j+1,k))

       ic2=1

       end if ! last level

       end if ! last line not zero

       end if ! count pair line

       end do  ! j path
       end do  ! k level 2 4 6 8 10 
       end do  ! ii plan

       cordam=ic1 ! maxim nombre de cordes

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      12.3 Compute anchor points in 3D space
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Need simplification as uses same code as section 6 (!!!!!)

       do i=1,nribss+1

       tetha=rib(i,8)*pi/180.
       rot_z=rib(i,250)*pi/180.0
       pos=rib(i,5)*rib(i,251)/100.0

       do j=1,rib(i,15) ! anchor number


c      Call to subroutine xyzt
c       u_aux(i,j,1)=u(i,j,6)
c       v_aux(i,j,1)=v(i,j,6)
c       w_aux(i,j,1)=0.0d0
c       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
c       w(i,j,19)=w_aux(i,j,5)
c       u(i,j,19)=u_aux(i,j,5)
c       v(i,j,19)=v_aux(i,j,5)


c       goto 2


c      Airfoil anchor washin coordinates
c      Note the parameter -rib(i,50) and review section 6.8 (!)
       u(i,j,17)=(u(i,j,6)-(rib(i,10)/100.)*rib(i,5))*dcos(tetha)+
     + v(i,j,6)*dsin(tetha)+(rib(i,10)/100.)*rib(i,5)
       v(i,j,17)=(-u(i,j,6)+(rib(i,10)/100.)*rib(i,5))*dsin(tetha)+
     + v(i,j,6)*dcos(tetha)-rib(i,50)

c      Airfoil rotation in Z-axis. ( View section 6, MUST be the same )

       wnew(j)=-u(i,j,17)*dsin(rot_z)+pos*dsin(rot_z)
       unew(j)=u(i,j,17)*dcos(rot_z)+pos*(1-dcos(rot_z))
       vnew(j)=v(i,j,17)
       u(i,j,4)=unew(j)
       v(i,j,4)=vnew(j)
       w(i,j,4)=wnew(j)

c      Airfoil anchor (u,v,w) espace coordinates
c       u(i,j,18)=u(i,j,17)
c       v(i,j,18)=v(i,j,17)*dcos(rib(i,9)*pi/180.)
c       w(i,j,18)=-v(i,j,17)*dsin(rib(i,9)*pi/180.)

c      Airfoils rotation in Y-axis
       w(i,j,18)=-w(i,j,4)*dcos(rib(i,9)*pi/180.)-
     + v(i,j,4)*dsin(rib(i,9)*pi/180.)
       u(i,j,18)=u(i,j,4)
       v(i,j,18)=-w(i,j,4)*dsin(rib(i,9)*pi/180.)+
     + v(i,j,4)*dcos(rib(i,9)*pi/180.)

c      Airfoil anchor (x,y,z) absolute coordinates

       u(i,j,19)=rib(i,6)-w(i,j,18)
       v(i,j,19)=rib(i,3)+u(i,j,18)
       w(i,j,19)=rib(i,7)-v(i,j,18)

c 2      continue
    
       end do
       end do

       i=0
       do j=1,rib(1,15)
       u(i,j,19)=-u(1,j,19)
       v(i,j,19)=v(1,j,19)
       w(i,j,19)=w(1,j,19)
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     12.4 Compute singular rib points in 3D space
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=0,nribss+1

       tetha=rib(i,8)*pi/180.0d0
       rot_z=rib(i,250)*pi/180.0
       pos=rib(i,5)*rib(i,251)/100.0

       do j=6,8 ! singular point number, brakes, inlet in, inlet out

c      Airfoil anchor washin coordinates
       u(i,j,17)=(u(i,j,6)-(rib(i,10)/100.)*rib(i,5))*dcos(tetha)+
     + v(i,j,6)*dsin(tetha)+(rib(i,10)/100.)*rib(i,5)
       v(i,j,17)=(-u(i,j,6)+(rib(i,10)/100.)*rib(i,5))*dsin(tetha)+
     + v(i,j,6)*dcos(tetha)-rib(i,50)

c      Airfoil rotation in Z-axis. ( View section 6, MUST be the same )

       wnew(j)=-u(i,j,17)*dsin(rot_z)+pos*dsin(rot_z)
       unew(j)=u(i,j,17)*dcos(rot_z)+pos*(1-dcos(rot_z))
       vnew(j)=v(i,j,17)
       u(i,j,4)=unew(j)
       v(i,j,4)=vnew(j)
       w(i,j,4)=wnew(j)

c      Airfoil anchor (u,v,w) espace coordinates
c       u(i,j,18)=u(i,j,17)
c       v(i,j,18)=v(i,j,17)*dcos(rib(i,9)*pi/180.0d0)
c       w(i,j,18)=-v(i,j,17)*dsin(rib(i,9)*pi/180.0d0)

c      Airfoils rotation in Y-axis
       w(i,j,18)=-w(i,j,4)*dcos(rib(i,9)*pi/180.)-
     + v(i,j,4)*dsin(rib(i,9)*pi/180.)
       u(i,j,18)=u(i,j,4)
       v(i,j,18)=-w(i,j,4)*dsin(rib(i,9)*pi/180.)+
     + v(i,j,4)*dcos(rib(i,9)*pi/180.)

c      Airfoil anchor (x,y,z) absolute coordinates

       u(i,j,19)=rib(i,6)-w(i,j,18)
       v(i,j,19)=rib(i,3)+u(i,j,18)
       w(i,j,19)=rib(i,7)-v(i,j,18)

c      Brake distribution

       if (j.eq.6) then

       xprib=(rib(i,2)/rib(nribss,2))*100.0d0
       
       if (xprib.ge.bd(1,1).and.xprib.lt.bd(2,1)) then
       xm=(bd(2,2)-bd(1,2))/(bd(2,1)-bd(1,1))
       xb=bd(1,2)-xm*bd(1,1)
       xxl=xm*xprib+xb
       xlx=xxl*dsin(rib(i,9)*pi/180.)
       xly=xxl*dcos(rib(i,9)*pi/180.)
       end if

       if (xprib.ge.bd(2,1).and.xprib.lt.bd(3,1)) then
       xm=(bd(3,2)-bd(2,2))/(bd(3,1)-bd(2,1))
       xb=bd(2,2)-xm*bd(2,1)
       xxl=xm*xprib+xb
       xlx=xxl*dsin(rib(i,9)*pi/180.)
       xly=xxl*dcos(rib(i,9)*pi/180.)
       end if

       if (xprib.ge.bd(3,1).and.xprib.lt.bd(4,1)) then
       xm=(bd(4,2)-bd(3,2))/(bd(4,1)-bd(3,1))
       xb=bd(3,2)-xm*bd(3,1)
       xxl=xm*xprib+xb
       xlx=xxl*dsin(rib(i,9)*pi/180.)
       xly=xxl*dcos(rib(i,9)*pi/180.)
       end if

       if (xprib.ge.bd(4,1).and.xprib.le.bd(5,1)) then
       xm=(bd(5,2)-bd(4,2))/(bd(5,1)-bd(4,1))
       xb=bd(4,2)-xm*bd(4,1)
       xxl=xm*xprib+xb
       xlx=xxl*dsin(rib(i,9)*pi/180.)
       xly=xxl*dcos(rib(i,9)*pi/180.)
       end if

       u(i,j,19)=u(i,j,19)+xlx
       w(I,j,19)=w(i,j,19)-xly

       end if
    
       end do
       end do


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      12.4+ Redefineix punts ancoratge per a parapents tipus ss
c      Atencio als parametres atp i kaaa
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Punts tipus 19 definits a extrados
       if (atp.eq."ss") then

       do i=0,nribss
       do j=1,rib(i,15)

c      Desa ancoratges originals a vector 20       
       u(i,j,20)=u(i,j,19)
       v(i,j,20)=v(i,j,19)
       w(i,j,20)=w(i,j,19)

c      Defineix ancoratges virtuals extrados       
       jp=anccont(i,j)

       u(i,j,19)=(x(i,jp)+x(i,jp-1))/2.
       v(i,j,19)=(y(i,jp)+y(i,jp-1))/2.
       w(i,j,19)=(z(i,jp)+z(i,jp-1))/2.

c      Activar kaaa=1 nomes al fer suspentes banda A deixar morro on es
    
       if (kaaa.eq.1) then
       u(i,1,19)=u(i,1,20)
       v(i,1,19)=v(i,1,20)
       w(i,1,19)=w(i,1,20)
       end if

c       write (*,*) "19 ss ",i,j,u(i,j,19),v(i,j,19),w(i,j,19)
c       write (*,*) "20 ds ",i,j,u(i,j,20),v(i,j,20),w(i,j,20)


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      ESPECIAL BHL-PAMPA
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c      if rib(i,56) eq 0 not rotate triangle

       if (rib(i,56).eq.0.) then
       u(i,j,19)=u(i,j,20)
       v(i,j,19)=v(i,j,20)
       w(i,j,19)=w(i,j,20)
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      ESPECIAL BHL-PAMPA
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       end do
       end do
       
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     12.4++ Calcula carregues a cada ancoratge
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Calcula suma de ribs i suma de pesos relatius

       rib1t=0.
       rib2t=0.
       rib3t=0.
       xloadtot=0.

       do i=1,nribss

       if (rib(i,55).ne.0) then
       rib1t=rib1t+rib(i,5)
       rib2t=rib2t+rib(i,55)
       rib3t=rib3t+rib(i,5)*rib(i,55)
       end if

       end do

c       write (*,*) "rib1t, rib2t ", rib1t, rib2t

c      Assigna carregues a cada ancoratge       
       do i=1,nribss

       if (rib(i,55).ne.0) then

       do j=1,rib(i,15)
       aload(i,j)=(csusl/2.)*(cdis(int(rib(i,15)),j)/100.)*
     + (rib(i,55)*rib(i,5)/rib3t)

c       write (*,*) "A ", i, j, aload(i,j)
       xloadtot=xloadtot+aload(i,j)

       end do

       end if

       end do

c       write (*,*) "LOAD TOTAL: ",2.*xloadtot


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     12.5 Linies d'accio de cada corda
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Important
c      zcontrol=0 geometric action points, 
c      zcontrol=1 pondered ap
c      zcontrol=2 pondered ap 
c      comprovar les divergčncies

c      zcontrol=0

c      Defineix punt final de la linia d'accio de cada corda

       do i=1,cordam ! For all lines

       xcorda(i,3)=0.
       ycorda(i,3)=0.
       zcorda(i,3)=0.
       corda(i,8)=0.
       xload(i)=0.

       do ii=1,slp    !For all plans

       do k=2,8,2     ! For all levels (max=4)

       do j=1,cam(ii) ! For all paths

       if (ii.eq.corda(i,1)) then

       if (corda(i,2).eq.mc(ii,j,k).and.mc(ii,j,k+1).eq.corda(i,3)) then

       if (zcontrol.eq.0) then

c      0. Suma de les coordenades dels ancoratges finals
       xcorda(i,3)=xcorda(i,3)+u(mc(ii,j,15),mc(ii,j,14),19)
       ycorda(i,3)=ycorda(i,3)+v(mc(ii,j,15),mc(ii,j,14),19)
       zcorda(i,3)=zcorda(i,3)+w(mc(ii,j,15),mc(ii,j,14),19)

c      Carrega total a linia i
       xload(i)=xload(i)+aload(mc(ii,j,15),mc(ii,j,14))

       end if

       if(zcontrol.eq.1) then

c      1. Suma coordanades ancoratges ponderades per la long de rib
       xcorda(i,3)=xcorda(i,3)+u(mc(ii,j,15),mc(ii,j,14),19)*
     + rib(corda(i,7),5)
       ycorda(i,3)=ycorda(i,3)+v(mc(ii,j,15),mc(ii,j,14),19)*
     + rib(corda(i,7),5)
       zcorda(i,3)=zcorda(i,3)+w(mc(ii,j,15),mc(ii,j,14),19)*
     + rib(corda(i,7),5)

c      Suma longitud de ribs associats a i
       corda(i,8)=corda(i,8)+rib(corda(i,7),5)

       xload(i)=xload(i)+aload(mc(ii,j,15),mc(ii,j,14))

       end if

       if(zcontrol.eq.2) then

c      2. Coordenades ponderades per rib i pes relatiu
       xcorda(i,3)=xcorda(i,3)+u(mc(ii,j,15),mc(ii,j,14),19)*
     + rib(corda(i,7),5)*rib(corda(i,7),55)
       ycorda(i,3)=ycorda(i,3)+v(mc(ii,j,15),mc(ii,j,14),19)*
     + rib(corda(i,7),5)*rib(corda(i,7),55)
       zcorda(i,3)=zcorda(i,3)+w(mc(ii,j,15),mc(ii,j,14),19)*
     + rib(corda(i,7),5)*rib(corda(i,7),55)

       corda(i,8)=corda(i,8)+rib(corda(i,7),5)*rib(corda(i,7),55)

       xload(i)=xload(i)+aload(mc(ii,j,15),mc(ii,j,14))

       end if


       if(zcontrol.eq.3) then

c      3. Coordenades ponderades pel pes
       xcorda(i,3)=xcorda(i,3)+u(mc(ii,j,15),mc(ii,j,14),19)*
     + aload(mc(ii,j,15),mc(ii,j,14))
       ycorda(i,3)=ycorda(i,3)+v(mc(ii,j,15),mc(ii,j,14),19)*
     + aload(mc(ii,j,15),mc(ii,j,14))
       zcorda(i,3)=zcorda(i,3)+w(mc(ii,j,15),mc(ii,j,14),19)*
     + aload(mc(ii,j,15),mc(ii,j,14))

       corda(i,8)=corda(i,8)+aload(mc(ii,j,15),mc(ii,j,14))

       xload(i)=xload(i)+aload(mc(ii,j,15),mc(ii,j,14))

       end if


       end if

       end if

       end do

       end do

       end do

c      Center of gravity line i
       
       if(zcontrol.eq.0) then
       xcorda(i,3)=xcorda(i,3)/float(corda(i,4))
       ycorda(i,3)=ycorda(i,3)/float(corda(i,4))
       zcorda(i,3)=zcorda(i,3)/float(corda(i,4))
       end if

       if(zcontrol.eq.1) then
       xcorda(i,3)=xcorda(i,3)/corda(i,8)
       ycorda(i,3)=ycorda(i,3)/corda(i,8)
       zcorda(i,3)=zcorda(i,3)/corda(i,8)
       end if

       if(zcontrol.eq.2) then
       xcorda(i,3)=xcorda(i,3)/corda(i,8)
       ycorda(i,3)=ycorda(i,3)/corda(i,8)
       zcorda(i,3)=zcorda(i,3)/corda(i,8)
       end if

       if(zcontrol.eq.3) then
       xcorda(i,3)=xcorda(i,3)/xload(i)
       ycorda(i,3)=ycorda(i,3)/xload(i)
       zcorda(i,3)=zcorda(i,3)/xload(i)
       end if

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      12.6 Punts inicial i final de cada corda
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      12.6.1 LEVEL 1 (risers)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=1,cordam

       if (corda(i,2).eq.1) then

c      Cordes 1 tenen l'inici a mosquetons principals
       xcorda(i,1)=xkar
       ycorda(i,1)=ykar
       zcorda(i,1)=zkar

c      Equacio parametrica de la recta que passa per P1-P3

       dist=dsqrt((xcorda(i,3)-xcorda(i,1))**2+(ycorda(i,3)-
     + ycorda(i,1))**2+(zcorda(i,3)-zcorda(i,1))**2)

       cdl=(xcorda(i,3)-xcorda(i,1))/dist
       cdm=(ycorda(i,3)-ycorda(i,1))/dist
       cdn=(zcorda(i,3)-zcorda(i,1))/dist

c      Parametre necesari a la distancia objectiu
c      Cases risers 0 or 1
       x33(10)=x33(corda(i,1)) ! clengr
       t=x33(10)/(sqrt(cdl*cdl+cdm*cdm+cdn*cdn))

c      Punt P2 amb equacio parametrica
       xcorda(i,2)=xcorda(i,1)+cdl*t
       ycorda(i,2)=ycorda(i,1)+cdm*t
       zcorda(i,2)=zcorda(i,1)+cdn*t

       ii=corda(i,1)

       x1line(ii,1,corda(i,3))=xcorda(i,1)
       y1line(ii,1,corda(i,3))=ycorda(i,1)
       z1line(ii,1,corda(i,3))=zcorda(i,1)
       x2line(ii,1,corda(i,3))=xcorda(i,2)
       y2line(ii,1,corda(i,3))=ycorda(i,2)
       z2line(ii,1,corda(i,3))=zcorda(i,2)

c      comprobacio

       disto=dsqrt((xcorda(i,2)-xcorda(i,1))**2+(ycorda(i,2)-
     + ycorda(i,1))**2+(zcorda(i,2)-zcorda(i,1))**2)

       end if

       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      12.6.2 LEVEL 2
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=1,cordam

       if (corda(i,2).eq.2) then

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      LEVEL 2 Si només dos nivells
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (corda(i,5).eq.2) then !directe a l'ancoratge

       xcorda(i,1)=x2line(corda(i,1),1,1)
       ycorda(i,1)=y2line(corda(i,1),1,1)
       zcorda(i,1)=z2line(corda(i,1),1,1)
      
       xcorda(i,2)=u(corda(i,7),corda(i,6),19)
       ycorda(i,2)=v(corda(i,7),corda(i,6),19)
       zcorda(i,2)=w(corda(i,7),corda(i,6),19)

       ii=corda(i,1)

       x1line(ii,2,corda(i,3))=xcorda(i,1)
       y1line(ii,2,corda(i,3))=ycorda(i,1)
       z1line(ii,2,corda(i,3))=zcorda(i,1)
       x2line(ii,2,corda(i,3))=xcorda(i,2)
       y2line(ii,2,corda(i,3))=ycorda(i,2)
       z2line(ii,2,corda(i,3))=zcorda(i,2)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Correccions necessaries a parapents ss (a nivell 2)
c      Calcula angles de gir phi0=phi1-phi2 a aplicar a triangles ss
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Per que es perd el valor de pi?
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c       pi=4.0d0*datan(1.)

       if (atp.eq."ss") then

       phi1(ii,2,corda(i,3))=(180./pi)*datan((x2line(ii,2,corda(i,3))-
     + x1line(ii,2,corda(i,3)))/(z1line(ii,2,corda(i,3))-
     + z2line(ii,2,corda(i,3))))

       if (kaaa.eq.1.and.corda(i,6).eq.1) then
       phi2(ii,2,corda(i,3))=0.
       else
       phi2(ii,2,corda(i,3))=(180./pi)*datan((u(corda(i,7),corda(i,6),19
     + )-u(corda(i,7),corda(i,6),20))/(w(corda(i,7),corda(i,6),20
     + )-w(corda(i,7),corda(i,6),19)))
       end if

       phi2(ii,2,corda(i,3))=rib(corda(i,7),9)

       phi0(ii,2,corda(i,3))=phi1(ii,2,corda(i,3))-phi2(ii,2,corda(i,3))

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      LEVEL 2 Si tres nivells
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (corda(i,5).eq.3) then ! tres nivells

       xcorda(i,1)=x2line(corda(i,1),1,1)
       ycorda(i,1)=y2line(corda(i,1),1,1)
       zcorda(i,1)=z2line(corda(i,1),1,1)
                    
       dist=dsqrt((xcorda(i,3)-xcorda(i,1))**2+(ycorda(i,3)-
     + ycorda(i,1))**2+(zcorda(i,3)-zcorda(i,1))**2)

       cdl=(xcorda(i,3)-xcorda(i,1))/dist
       cdm=(ycorda(i,3)-ycorda(i,1))/dist
       cdn=(zcorda(i,3)-zcorda(i,1))/dist

c      Parametre necesari a la distancia objectiu

       d13=dsqrt((xcorda(i,3)-xcorda(i,1))**2+(ycorda(i,3)-ycorda(i,1))
     + **2+(zcorda(i,3)-zcorda(i,1))**2)
       
       t=(d13-raml(3,3))/(sqrt(cdl*cdl+cdm*cdm+cdn*cdn))

c      Punt P2 amb equacio parametrica
       xcorda(i,2)=xcorda(i,1)+cdl*t
       ycorda(i,2)=ycorda(i,1)+cdm*t
       zcorda(i,2)=zcorda(i,1)+cdn*t

       ii=corda(i,1)

       x1line(ii,2,corda(i,3))=xcorda(i,1)
       y1line(ii,2,corda(i,3))=ycorda(i,1)
       z1line(ii,2,corda(i,3))=zcorda(i,1)
       x2line(ii,2,corda(i,3))=xcorda(i,2)
       y2line(ii,2,corda(i,3))=ycorda(i,2)
       z2line(ii,2,corda(i,3))=zcorda(i,2)
       
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      LEVEL 2 Si quatre nivells
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (corda(i,5).eq.4) then ! Quatre nivells

       xcorda(i,1)=x2line(corda(i,1),1,1)
       ycorda(i,1)=y2line(corda(i,1),1,1)
       zcorda(i,1)=z2line(corda(i,1),1,1)
                    
       dist=dsqrt((xcorda(i,3)-xcorda(i,1))**2+(ycorda(i,3)-
     + ycorda(i,1))**2+(zcorda(i,3)-zcorda(i,1))**2)

       cdl=(xcorda(i,3)-xcorda(i,1))/dist
       cdm=(ycorda(i,3)-ycorda(i,1))/dist
       cdn=(zcorda(i,3)-zcorda(i,1))/dist

c      Parametre necesari a la distancia objectiu

       d13=dsqrt((xcorda(i,3)-xcorda(i,1))**2+(ycorda(i,3)-ycorda(i,1))
     + **2+(zcorda(i,3)-zcorda(i,1))**2)
       
       t=(d13-raml(4,3))/(sqrt(cdl*cdl+cdm*cdm+cdn*cdn))

c      Punt P2 amb equacio parametrica
       xcorda(i,2)=xcorda(i,1)+cdl*t
       ycorda(i,2)=ycorda(i,1)+cdm*t
       zcorda(i,2)=zcorda(i,1)+cdn*t

       ii=corda(i,1)

       x1line(ii,2,corda(i,3))=xcorda(i,1)
       y1line(ii,2,corda(i,3))=ycorda(i,1)
       z1line(ii,2,corda(i,3))=zcorda(i,1)
       x2line(ii,2,corda(i,3))=xcorda(i,2)
       y2line(ii,2,corda(i,3))=ycorda(i,2)
       z2line(ii,2,corda(i,3))=zcorda(i,2)

       end if

       end if

       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      12.6.3 LEVEL 3
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Inici al final de les cordes 2

       do i=1,cordam

       if (corda(i,2).eq.3) then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Si només 3 nivells
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (corda(i,5).eq.3) then !directe a l'ancoratge

c      Explora mc i troba quin origen emprar
       do kk=1,slp
       do k=1,cam(kk)

       if (corda(i,2).eq.mc(kk,k,6).and.mc(kk,k,7).eq.corda(i,3)) then

       comp1(kk)=mc(kk,k,4)
       comp2(kk)=mc(kk,k,5)

       end if

       end do
       
       end do

c      Origen
       xcorda(i,1)=x2line(corda(i,1),2,int(comp2(corda(i,1))))
       ycorda(i,1)=y2line(corda(i,1),2,int(comp2(corda(i,1))))
       zcorda(i,1)=z2line(corda(i,1),2,int(comp2(corda(i,1))))

c      Final
       xcorda(i,2)=u(corda(i,7),corda(i,6),19)
       ycorda(i,2)=v(corda(i,7),corda(i,6),19)
       zcorda(i,2)=w(corda(i,7),corda(i,6),19)

       ii=corda(i,1)

       x1line(ii,3,corda(i,3))=xcorda(i,1)
       y1line(ii,3,corda(i,3))=ycorda(i,1)
       z1line(ii,3,corda(i,3))=zcorda(i,1)
       x2line(ii,3,corda(i,3))=xcorda(i,2)
       y2line(ii,3,corda(i,3))=ycorda(i,2)
       z2line(ii,3,corda(i,3))=zcorda(i,2)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Correccions necessaries a parapents ss (a nivell 3)
c      Calcula angles de gir phi0=phi1-phi2 a aplicar a triangles ss
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Per que es perd el valor de pi?
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c       pi=4.0d0*datan(1.)

       if (atp.eq."ss") then

       phi1(ii,3,corda(i,3))=(180./pi)*datan((x2line(ii,3,corda(i,3))-
     + x1line(ii,3,corda(i,3)))/(z1line(ii,3,corda(i,3))-
     + z2line(ii,3,corda(i,3))))

       if (kaaa.eq.1.and.corda(i,6).eq.1) then
       phi2(ii,3,corda(i,3))=0.
       else
       phi2(ii,3,corda(i,3))=(180./pi)*datan((u(corda(i,7),corda(i,6),19
     + )-u(corda(i,7),corda(i,6),20))/(w(corda(i,7),corda(i,6),20
     + )-w(corda(i,7),corda(i,6),19)))
       end if

       phi2(ii,3,corda(i,3))=rib(corda(i,7),9)

       phi0(ii,3,corda(i,3))=phi1(ii,3,corda(i,3))-phi2(ii,3,corda(i,3))

c       write (*,*) ii, corda(i,2), corda(i,3), "phi0= ", 
c     + phi0(ii,3,corda(i,3))

c       write (*,*) "girs ",i,corda(i,1),corda(i,3),phi1(ii,4,corda(i,3))
c     + ,phi2(ii,4,corda(i,3)),phi0(ii,4,corda(i,3))

c      Fi angles de gir

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
       end if

c      Si hi ha quatre nivells
       if (corda(i,5).eq.4) then

c      Explora mc i troba quin origen emprar
       do kk=1,slp
       do k=1,cam(kk)

       if (corda(i,2).eq.mc(kk,k,6).and.mc(kk,k,7).eq.corda(i,3)) then

       comp1(kk)=mc(kk,k,4)
       comp2(kk)=mc(kk,k,5)

       end if

       end do
       
       end do

c      Origen
       xcorda(i,1)=x2line(corda(i,1),2,int(comp2(corda(i,1))))
       ycorda(i,1)=y2line(corda(i,1),2,int(comp2(corda(i,1))))
       zcorda(i,1)=z2line(corda(i,1),2,int(comp2(corda(i,1))))

       dist=dsqrt((xcorda(i,3)-xcorda(i,1))**2+(ycorda(i,3)-
     + ycorda(i,1))**2+(zcorda(i,3)-zcorda(i,1))**2)

       cdl=(xcorda(i,3)-xcorda(i,1))/dist
       cdm=(ycorda(i,3)-ycorda(i,1))/dist
       cdn=(zcorda(i,3)-zcorda(i,1))/dist

c      Parametre necesari a la distancia objectiu

       d13=dsqrt((xcorda(i,3)-xcorda(i,1))**2+(ycorda(i,3)-ycorda(i,1))
     + **2+(zcorda(i,3)-zcorda(i,1))**2)
       
c       t=(raml(4,4)-dl3)/(sqrt(cdl*cdl+cdm*cdm+cdn*cdn))
        
        t=(raml(4,3)-raml(4,4))/(sqrt(cdl*cdl+cdm*cdm+cdn*cdn))

c      Punt P2 amb equacio parametrica
       xcorda(i,2)=xcorda(i,1)+cdl*t
       ycorda(i,2)=ycorda(i,1)+cdm*t
       zcorda(i,2)=zcorda(i,1)+cdn*t

       ii=corda(i,1)

       x1line(ii,3,corda(i,3))=xcorda(i,1)
       y1line(ii,3,corda(i,3))=ycorda(i,1)
       z1line(ii,3,corda(i,3))=zcorda(i,1)
       x2line(ii,3,corda(i,3))=xcorda(i,2)
       y2line(ii,3,corda(i,3))=ycorda(i,2)
       z2line(ii,3,corda(i,3))=zcorda(i,2)
       
       end if

       end if

       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     12.6.4 LEVEL 4
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Inici al final de les cordes 3

       do i=1,cordam

       if (corda(i,2).eq.4) then

       if (corda(i,5).eq.4) then !directe a l'ancoratge

c      Explora mc i troba quin origen emprar
       do kk=1,slp
       do k=1,cam(kk)

       if (corda(i,2).eq.mc(kk,k,8).and.mc(kk,k,9).eq.corda(i,3)) then

       comp1(kk)=mc(kk,k,6)
       comp2(kk)=mc(kk,k,7)

       end if

       end do
       
       end do

c      Origen
       xcorda(i,1)=x2line(corda(i,1),3,int(comp2(corda(i,1))))
       ycorda(i,1)=y2line(corda(i,1),3,int(comp2(corda(i,1))))
       zcorda(i,1)=z2line(corda(i,1),3,int(comp2(corda(i,1))))

c      Final als ancoratges (parapents ds)
       xcorda(i,2)=u(corda(i,7),corda(i,6),19)
       ycorda(i,2)=v(corda(i,7),corda(i,6),19)
       zcorda(i,2)=w(corda(i,7),corda(i,6),19)

       ii=corda(i,1)

       x1line(ii,4,corda(i,3))=xcorda(i,1)
       y1line(ii,4,corda(i,3))=ycorda(i,1)
       z1line(ii,4,corda(i,3))=zcorda(i,1)
       x2line(ii,4,corda(i,3))=xcorda(i,2)
       y2line(ii,4,corda(i,3))=ycorda(i,2)
       z2line(ii,4,corda(i,3))=zcorda(i,2)


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Correccions necessaries a parapents ss (a nivell 4)
c      Calcula angles de gir phi0=phi1-phi2 a aplicar a triangles ss
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Per que es perd el valor de pi?
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c       pi=4.0d0*datan(1.)

       if (atp.eq."ss") then

       phi1(ii,4,corda(i,3))=(180./pi)*datan((x2line(ii,4,corda(i,3))-
     + x1line(ii,4,corda(i,3)))/(z1line(ii,4,corda(i,3))-
     + z2line(ii,4,corda(i,3))))

       if (kaaa.eq.1.and.corda(i,6).eq.1) then
       phi2(ii,4,corda(i,3))=0.
       else
       phi2(ii,4,corda(i,3))=(180./pi)*datan((u(corda(i,7),corda(i,6),19
     + )-u(corda(i,7),corda(i,6),20))/(w(corda(i,7),corda(i,6),20
     + )-w(corda(i,7),corda(i,6),19)))
       end if

       phi2(ii,4,corda(i,3))=rib(corda(i,7),9)

       phi0(ii,4,corda(i,3))=phi1(ii,4,corda(i,3))-phi2(ii,4,corda(i,3))

c       write (*,*) "girs ",i,corda(i,1),corda(i,3),phi1(ii,4,corda(i,3))
c     + ,phi2(ii,4,corda(i,3)),phi0(ii,4,corda(i,3))

c      Fi angles de gir

       end if
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
       end if

       end if

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     12.7 Gir dels triangles parapents ss
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      calque = "triangles" (Note Ludovic G. 2018-05-12)

       if (atp.eq."ss") then

c      Verify thickness of last rib (escrit ja a 11.3)
       
       xsum=0.
       ic=0
       i=nribss
       do j=1,np(i,1)
       xsum=xsum+abs(v(i,j,3))
       end do
       if (xsum.ne.0.0) then
       ic=1
       end if

c      Calcula punt 4 situat al triangle 1-2-3

c      Recorre punts de l'extrados

       do i=1,cordam

c      No estabilo
       if (corda(i,7).ne.nribss*float(ic-1)*float(ic-1)) then

       ii=corda(i,1)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      12.7.1 Gir cordes en quart nivell
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Gir en cordes de tercer nivell
       if (corda(i,2).eq.4) then

c      write (*,*) "corda(i,2)=", corda(i,2), corda(i,5)

       if (corda(i,5).eq.4) then !directe a l'ancoratge

       jp=anccont(corda(i,7),corda(i,6))

c      MODIF Ludovic G. 2018-05-12
c      Note: do the same at "gir cordes tercer nivell"
c      New parameter idelta is a function of extradps points np(i,2)

c      idelta=np(i,2)*6/100  ! Ludovic
c      Warnig!!! BHL2-16 fails using previous!
       idelta=3 ! Previous definition by Pere

       xpt1=x(corda(i,7),jp-idelta)
       ypt1=y(corda(i,7),jp-idelta)
       zpt1=z(corda(i,7),jp-idelta)

       xpt2=x(corda(i,7),jp+idelta)
       ypt2=y(corda(i,7),jp+idelta)
       zpt2=z(corda(i,7),jp+idelta)

       xpt3=u(corda(i,7),corda(i,6),20)
       ypt3=v(corda(i,7),corda(i,6),20)
       zpt3=w(corda(i,7),corda(i,6),20)

c      Dibuixa els triangles a girar

       call line3d(xpt1,ypt1,zpt1,xpt2,ypt2,zpt2,1)
       call line3d(xpt1,ypt1,zpt1,xpt3,ypt3,zpt3,1)
       call line3d(xpt2,ypt2,zpt2,xpt3,ypt3,zpt3,1)

c      Calcula punt 4

c      Cosinus directors rectes 2-1 i 3-1

       xd21=dsqrt((xpt1-xpt2)**2.+(ypt1-ypt2)**2.+(zpt1-zpt2)**2.)
       xd31=dsqrt((xpt1-xpt3)**2.+(ypt1-ypt3)**2.+(zpt1-zpt3)**2.)
       xd32=dsqrt((xpt2-xpt3)**2.+(ypt2-ypt3)**2.+(zpt2-zpt3)**2.)

       cl21=(xpt1-xpt2)/xd21
       cm21=(ypt1-ypt2)/xd21
       cn21=(zpt1-zpt2)/xd21

       cl31=(xpt1-xpt3)/xd31
       cm31=(ypt1-ypt3)/xd31
       cn31=(zpt1-zpt3)/xd31

c      Punt 4 a recta que passa per 1-2 parametrica xt

       xt=xd31*(cl21*cl21+cm21*cm21+cn21*cn21)*
     + (cl21*cl31+cm21*cm31+cn21*cn31)

       xpt4=xpt1-cl21*xt
       ypt4=ypt1-cm21*xt
       zpt4=zpt1-cn21*xt

       call line3d(xpt4,ypt4,zpt4,xpt3,ypt3,zpt3,7)

       xd41=dsqrt((xpt1-xpt4)**2.+(ypt1-ypt4)**2.+(zpt1-zpt4)**2.)
      
       cl41=(xpt1-xpt4)/xd41
       cm41=(ypt1-ypt4)/xd41
       cn41=(zpt1-zpt4)/xd41

       xd43=dsqrt((xpt3-xpt4)**2.+(ypt3-ypt4)**2.+(zpt3-zpt4)**2.)

       cl43=(xpt3-xpt4)/xd43
       cm43=(ypt3-ypt4)/xd43
       cn43=(zpt3-zpt4)/xd43

c      Planol 1-2-3 (determinant)

       A1=(ypt2-ypt1)*(zpt3-zpt1)-(zpt2-zpt1)*(ypt3-ypt1)
       B1=(zpt2-zpt1)*(xpt3-xpt1)-(xpt2-xpt1)*(zpt3-zpt1)
       C1=(xpt2-xpt1)*(ypt3-ypt1)-(ypt2-ypt1)*(xpt3-xpt1)
       D1=-A1*xpt1-B1*ypt1-C1*zpt1

c      Punt 5 situat a la recta normal a 1-2-3 per 4

       xpt5=xpt4+A1*0.1
       ypt5=ypt4+B1*0.1
       zpt5=zpt4+C1*0.1

c      Eix normal al pla 1-2-3
c       call line3d(xpt4,ypt4,zpt4,xpt5,ypt5,zpt5,1)

       xd45=dsqrt((xpt5-xpt4)**2.+(ypt5-ypt4)**2.+(zpt5-zpt4)**2.)

       cl45=(xpt5-xpt4)/xd45
       cm45=(ypt5-ypt4)/xd45
       cn45=(zpt5-zpt4)/xd45

c       phi0(ii,corda(i,2),corda(i,3))=0.

       xptp6=xd43*dsin((pi/180.)*phi0(ii,4,corda(i,3)))
       yptp6=0.
       zptp6=-xd43*dcos((pi/180.)*phi0(ii,4,corda(i,3)))

c      "-" sign before cn41 in ypt6 be aware, review!!! however works!

       xpt6=cl45*xptp6+cm45*yptp6-cn45*zptp6+xpt4
       ypt6=cl41*xptp6+cm41*yptp6+cn41*zptp6+ypt4
       zpt6=cl43*xptp6+cm43*yptp6-cn43*zptp6+zpt4

c      Truc per ajustar posicio Y !!!!!!!!!!!!!!!!!
c      Funciona força be
c      REVISAR !!!!!!!!!!!!!!!!!!!!!!!!!!!!
c      ypt6=ypt3

c       write (*,*) "ypt6 ypt4 phi0 ", ypt6, ypt4, 
c     + phi0(ii,4,corda(i,3))

c      Segona definició, per recta perpendicular al pla 1-2-3
 
       xt=xd43*dcos((pi/180.)*phi0(ii,4,corda(i,3)))
       xpt7=xpt4+cl43*xt
       ypt7=ypt4+cm43*xt
       zpt7=zpt4+cn43*xt
c       call line3d(0.,0.,0.,xpt7,ypt7,zpt7,5)

       xt=(((xd43*xd43*(dsin((pi/180.)*phi0(ii,4,corda(i,3)))))/
     + (sqrt(A1*A1+B1*B1+C1*C1))))

c       write (*,*) "xt ", xt

c       xpt6=xpt7+A1*xt
c       ypt6=ypt7+B1*xt
c       zpt6=zpt7+C1*xt

***************************************************************
*      Codi introduit per Ludovic G. en data 20180419
*      Jo he de revisar
*      Merci!
***************************************************************

       iv=corda(i,7)
       if (rib(iv,56).eq.0.) then
       xpt6=u(corda(i,7),corda(i,6),19)
       ypt6=v(corda(i,7),corda(i,6),19)
       zpt6=w(corda(i,7),corda(i,6),19)
       end if

***************************************************************

c      Dibuixa triangles girats

       if (kaaa.eq.0.or.corda(i,6).ne.1) then
       call line3d(xpt3,ypt3,zpt3,xpt6,ypt6,zpt6,1)
       call line3d(xpt1,ypt1,zpt1,xpt6,ypt6,zpt6,2)
       call line3d(xpt2,ypt2,zpt2,xpt6,ypt6,zpt6,2)
       end if

       u(corda(i,7),corda(i,6),19)=xpt6
       v(corda(i,7),corda(i,6),19)=ypt6
       w(corda(i,7),corda(i,6),19)=zpt6

c      No gira b.a. si kaaa=1

       if (kaaa.eq.1.and.corda(i,6).eq.1) then
       u(corda(i,7),corda(i,6),19)=u(corda(i,7),corda(i,6),20)
       v(corda(i,7),corda(i,6),19)=v(corda(i,7),corda(i,6),20)
       w(corda(i,7),corda(i,6),19)=w(corda(i,7),corda(i,6),20)
       end if


       end if

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      12.7.2 Gir cordes en tercer nivell
c      opcionalment es podria fer servir rutina anterior amb corda(i,2)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Gir en cordes de tercer nivell
       if (corda(i,2).eq.3) then

c      write (*,*) "corda(i,2)=", corda(i,2), corda(i,5)

       if (corda(i,5).eq.3) then !directe a l'ancoratge

       jp=anccont(corda(i,7),corda(i,6))

       xpt1=x(corda(i,7),jp-3)
       ypt1=y(corda(i,7),jp-3)
       zpt1=z(corda(i,7),jp-3)

       xpt2=x(corda(i,7),jp+3)
       ypt2=y(corda(i,7),jp+3)
       zpt2=z(corda(i,7),jp+3)

       xpt3=u(corda(i,7),corda(i,6),20)
       ypt3=v(corda(i,7),corda(i,6),20)
       zpt3=w(corda(i,7),corda(i,6),20)

c      Dibuixa els triangles a girar

       call line3d(xpt1,ypt1,zpt1,xpt2,ypt2,zpt2,1)
       call line3d(xpt1,ypt1,zpt1,xpt3,ypt3,zpt3,1)
       call line3d(xpt2,ypt2,zpt2,xpt3,ypt3,zpt3,1)

c      Calcula punt 4

c      Cosinus directors rectes 2-1 i 3-1

       xd21=dsqrt((xpt1-xpt2)**2.+(ypt1-ypt2)**2.+(zpt1-zpt2)**2.)
       xd31=dsqrt((xpt1-xpt3)**2.+(ypt1-ypt3)**2.+(zpt1-zpt3)**2.)
       xd32=dsqrt((xpt2-xpt3)**2.+(ypt2-ypt3)**2.+(zpt2-zpt3)**2.)

       cl21=(xpt1-xpt2)/xd21
       cm21=(ypt1-ypt2)/xd21
       cn21=(zpt1-zpt2)/xd21

       cl31=(xpt1-xpt3)/xd31
       cm31=(ypt1-ypt3)/xd31
       cn31=(zpt1-zpt3)/xd31

c      Punt 4 a recta que passa per 1-2 parametrica xt

       xt=xd31*(cl21*cl21+cm21*cm21+cn21*cn21)*
     + (cl21*cl31+cm21*cm31+cn21*cn31)

       xpt4=xpt1-cl21*xt
       ypt4=ypt1-cm21*xt
       zpt4=zpt1-cn21*xt

       call line3d(xpt4,ypt4,zpt4,xpt3,ypt3,zpt3,7)

       xd41=dsqrt((xpt1-xpt4)**2.+(ypt1-ypt4)**2.+(zpt1-zpt4)**2.)
       xd43=dsqrt((xpt3-xpt4)**2.+(ypt3-ypt4)**2.+(zpt3-zpt4)**2.)

       cl43=(xpt3-xpt4)/xd43
       cm43=(ypt3-ypt4)/xd43
       cn43=(zpt3-zpt4)/xd43
      
c      Planol 1-2-3 (determinant)

       A1=(ypt2-ypt1)*(zpt3-zpt1)-(zpt2-zpt1)*(ypt3-ypt1)
       B1=(zpt2-zpt1)*(xpt3-xpt1)-(xpt2-xpt1)*(zpt3-zpt1)
       C1=(xpt2-xpt1)*(ypt3-ypt1)-(ypt2-ypt1)*(xpt3-xpt1)
       D1=-A1*xpt1-B1*ypt1-C1*zpt1

c      Punt 5 situat a la recta normal a 1-2-3 per 4

       xpt5=xpt4+A1*1.
       ypt5=ypt4+B1*1.
       zpt5=zpt4+C1*1.

c       call line3d(xpt4,ypt4,zpt4,xpt5,ypt5,zpt5,4)

       xd45=dsqrt((xpt5-xpt4)**2.+(ypt5-ypt4)**2.+(zpt5-zpt4)**2.)

       cl45=(xpt5-xpt4)/xd45
       cm45=(ypt5-ypt4)/xd45
       cn45=(zpt5-zpt4)/xd45

c      Transformacio de coordenades per traslacio i rotacio

       xptp6=xd43*dsin((pi/180.)*phi0(ii,3,corda(i,3)))
       yptp6=0.
       zptp6=xd43*dcos((pi/180.)*phi0(ii,3,corda(i,3)))

       xpt6=cl45*xptp6+cm45*yptp6+cn45*zptp6+xpt4
       ypt6=cl21*xptp6+cm21*yptp6-cn21*zptp6+ypt4
       zpt6=cl43*xptp6+cm43*yptp6+cn43*zptp6+zpt4


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      ESPECIAL BHL-PAMPA
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c       iv=corda(i,7)
c       if (iv.eq.0.or.iv.eq.1.or.iv.eq.4.or.iv.eq.5.or.iv.eq.8.or.
c     + iv.eq.9) then
c       xpt6=u(corda(i,7),corda(i,6),19)
c       ypt6=v(corda(i,7),corda(i,6),19)
c       zpt6=w(corda(i,7),corda(i,6),19)
c
c       end if

       iv=corda(i,7)
       if (rib(iv,56).eq.0.) then
       xpt6=u(corda(i,7),corda(i,6),19)
       ypt6=v(corda(i,7),corda(i,6),19)
       zpt6=w(corda(i,7),corda(i,6),19)
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      ESPECIAL BHL-PAMPA
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


c      Dibuixa triangles girats

       if (kaaa.eq.0.or.corda(i,6).ne.1) then
       call line3d(xpt3,ypt3,zpt3,xpt6,ypt6,zpt6,1)
       call line3d(xpt1,ypt1,zpt1,xpt6,ypt6,zpt6,2)
       call line3d(xpt2,ypt2,zpt2,xpt6,ypt6,zpt6,2)
       end if

       u(corda(i,7),corda(i,6),19)=xpt6
       v(corda(i,7),corda(i,6),19)=ypt6
       w(corda(i,7),corda(i,6),19)=zpt6

c      No gira b.a. si kaaa=1

       if (kaaa.eq.1.and.corda(i,6).eq.1) then
       u(corda(i,7),corda(i,6),19)=u(corda(i,7),corda(i,6),20)
       v(corda(i,7),corda(i,6),19)=v(corda(i,7),corda(i,6),20)
       w(corda(i,7),corda(i,6),19)=w(corda(i,7),corda(i,6),20)
       end if


       end if

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       end if

       end do

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     12.8 Longituds de les cordes
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=1,cordam

       xx2=x2line(corda(i,1),corda(i,2),corda(i,3))
       xx1=x1line(corda(i,1),corda(i,2),corda(i,3))
       yy2=y2line(corda(i,1),corda(i,2),corda(i,3))
       yy1=y1line(corda(i,1),corda(i,2),corda(i,3))
       zz2=z2line(corda(i,1),corda(i,2),corda(i,3))
       zz1=z1line(corda(i,1),corda(i,2),corda(i,3))

c      Si parapent ss actualitza posicio ancoratges
       if (atp.eq."ss") then

c      Actualitza nivell 4
       if (corda(i,2).eq.4.and.corda(i,5).eq.4) then

       xx2=u(corda(i,7),corda(i,6),19)
       yy2=v(corda(i,7),corda(i,6),19)
       zz2=w(corda(i,7),corda(i,6),19)

       x2line(corda(i,1),corda(i,2),corda(i,3))=xx2
       y2line(corda(i,1),corda(i,2),corda(i,3))=yy2
       z2line(corda(i,1),corda(i,2),corda(i,3))=zz2

       end if     

c      Actualitza nivell 3
       if (corda(i,2).eq.3.and.corda(i,5).eq.3) then

       xx2=u(corda(i,7),corda(i,6),19)
       yy2=v(corda(i,7),corda(i,6),19)
       zz2=w(corda(i,7),corda(i,6),19)

       x2line(corda(i,1),corda(i,2),corda(i,3))=xx2
       y2line(corda(i,1),corda(i,2),corda(i,3))=yy2
       z2line(corda(i,1),corda(i,2),corda(i,3))=zz2

       end if     

c      Actualitza nivell 2
       if (corda(i,2).eq.2.and.corda(i,5).eq.2) then

       xx2=u(corda(i,7),corda(i,6),19)
       yy2=v(corda(i,7),corda(i,6),19)
       zz2=w(corda(i,7),corda(i,6),19)

       x2line(corda(i,1),corda(i,2),corda(i,3))=xx2
       y2line(corda(i,1),corda(i,2),corda(i,3))=yy2
       z2line(corda(i,1),corda(i,2),corda(i,3))=zz2

       end if

       end if

       xline(i)=dsqrt((xx2-xx1)**2+(yy2-yy1)**2+(zz2-zz1)**2)
       xline2(i)=dsqrt((xcorda(i,2)-xcorda(i,1))**2+
     + (ycorda(i,2)-ycorda(i,1))**2+(zcorda(i,2)-zcorda(i,1))**2)

c      write (*,*) "xline, xline2 ",i,xline(i),xline2(i)

c      write (*,*) "loads ",i, xline(i), xload(i)

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     12.9 Correccions elastiques
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c       write(*,*) "i, xline(i), corda(i,1), corda(i,2), csus(corda(i,1),
c     + corda(i,2)), xload(i), xlide(i)"

       cttt2=0.
       cttt3=0.
       cttt4=0.

       do i=1,cordam

       xlide(i)=xline(i)*(xload(i)/10.)*csus(corda(i,1),corda(i,2))/100.

       if (corda(i,2).eq.1) then
       xlide(i)=0.
       end if

       xlifi(i)=xline(i)-xlide(i)

       if (corda(i,2).eq.2) then
       cttt2=cttt2+xload(i)
       end if

       if (corda(i,2).eq.3) then
       cttt3=cttt3+xload(i)
       end if

       if (corda(i,2).eq.4) then
       cttt4=cttt4+xload(i)
       end if

       end do

c       write (*,*) "Carrega total: ", cttt2*2., cttt3*2., cttt4*2.

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     12.10 Dibuixar cordes 2D
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       corda1=cordam

       do i=1,corda1

       x0=(1260.-160.)*xkf
       y0=1800.*xkf

       x00=1260.*xkf*float(corda(i,1)-1)

c      Colors definition (not used since 2.70 version!)
c      Use iccolor(i) vector
       if (corda(i,1).eq.1) then
       icc=1 ! line color
       end if
       if (corda(i,1).eq.2) then
       icc=30 ! line color
       end if
       if (corda(i,1).eq.3) then
       icc=3 ! line color
       end if
       if (corda(i,1).eq.4) then
       icc=4 ! line color
       end if
       if (corda(i,1).eq.5) then
       icc=5 ! line color
       end if
       if (corda(i,1).eq.6) then
       icc=6 ! line color
       end if

       if (i37c.eq.0) then ! Use colors by risers
       call line(x1line(corda(i,1),corda(i,2),corda(i,3))+x0+x00,
     + z1line(corda(i,1),corda(i,2),corda(i,3))+y0,
     + x2line(corda(i,1),corda(i,2),corda(i,3))+x0+x00,
     + z2line(corda(i,1),corda(i,2),corda(i,3))+y0,iccolor(corda(i,1)))
       end if

       if (i37c.eq.1) then ! Use colors according table 34
       corda(i,40)=corda(i,30+corda(i,2)) ! Type on line i
       iccolor34(i)=int(tyline(corda(i,40),10))
       call line(x1line(corda(i,1),corda(i,2),corda(i,3))+x0+x00,
     + z1line(corda(i,1),corda(i,2),corda(i,3))+y0,
     + x2line(corda(i,1),corda(i,2),corda(i,3))+x0+x00,
     + z2line(corda(i,1),corda(i,2),corda(i,3))+y0,iccolor34(i))
       end if

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      14. BRAKE CALCULUS
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      14.2 Identifica les cordes a calcular
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       ic1=cordam
       ic2=1

       ii=slp+1 ! Pla de frens

       do k=2,8,2 ! Explora fins 4 nivells
       
       do j=1,cam(ii)-1 ! Itera en camins de cada pla

       a=dfloat(mc(ii,j,k))
       b=dfloat(mc(ii,j,k+1))
       aa=dfloat(mc(ii,j+1,k))
       bb=dfloat(mc(ii,j+1,k+1))

       if (a.ne.0.0d0.and.b.ne.0.0d0) then ! saltar cordes 0 0

c      Mentre la corda sigui igual augmentar comptador
       if (a.eq.aa.and.b.eq.bb) then

       ic2=ic2+1 ! comptabilitza cordes iguals

c      Si arribem a final del camĂ­ comptabilitzar la corda
       if (j.eq.cam(ii)-1) then

       ic1=ic1+1

c       write (*,*) "corda ", ic1, ic2, " = ", mc(ii,j,k),mc(ii,j,k+1)

       corda(ic1,1)=ii                    !planol
       corda(ic1,2)=mc(ii,j+1,k)          !nivell
       corda(ic1,3)=mc(ii,j+1,k+1)        !ordre
       corda(ic1,4)=ic2                   !punts d'acciĂł
       corda(ic1,5)=mc(ii,j+1,1)          !ramificacions del camĂ­
       corda(ic1,6)=mc(ii,j+1,14)         !final row
       corda(ic1,7)=mc(ii,j+1,15)         !final rib

c      Assign types
       corda(ic1,30+mc(ii,j+1,k))=mc(ii,j+1,30+mc(ii,j+1,k))

       ic2=1

       end if ! Last line

       end if ! while same level

c      Si canvia la corda al mateix nivell
       if (a.ne.aa.or.b.ne.bb) then

       ic1=ic1+1

c       write (*,*) "corda ", ic1, ic2, " = ", mc(ii,j,k),mc(ii,j,k+1)

       corda(ic1,1)=ii                  !planol
       corda(ic1,2)=mc(ii,j,k)          !nivell
       corda(ic1,3)=mc(ii,j,k+1)        !ordre
       corda(ic1,4)=ic2                 !punts d'acciĂł
       corda(ic1,5)=mc(ii,j,1)          !ramificacions del camĂ­
       corda(ic1,6)=mc(ii,j,14)         !final row
       corda(ic1,7)=mc(ii,j,15)         !final rib

c      Assign types
       corda(ic1,30+mc(ii,j,k))=mc(ii,j,30+mc(ii,j,k))
    
       ic2=1

       end if

c      Si arribem a l'ultima linia i no es zero
       if (j.eq.cam(ii)-1) then

       a=dfloat(mc(ii,j,k))
       b=dfloat(mc(ii,j,k+1))
       aa=dfloat(mc(ii,j+1,k))
       bb=dfloat(mc(ii,j+1,k+1))

       if ((a.ne.aa.or.b.ne.bb).and.(aa.ne.0.0d0.and.bb.ne.0.0d0)) then

       ic1=ic1+1

       corda(ic1,1)=ii                    !planol
       corda(ic1,2)=mc(ii,j+1,k)          !nivell
       corda(ic1,3)=mc(ii,j+1,k+1)        !ordre
       corda(ic1,4)=ic2                   !punts d'acciĂł
       corda(ic1,5)=mc(ii,j+1,1)          !ramificacions del camĂ­
       corda(ic1,6)=mc(ii,j+1,14)         !final row
       corda(ic1,7)=mc(ii,j+1,15)         !final rib

c      Assign types
       corda(ic1,30+mc(ii,j+1,k))=mc(ii,j+1,30+mc(ii,j+1,k))
       
       ic2=1

       end if

       end if

       end if

       end do
       end do

       cordat=ic1 ! maxim nombre de cordes inclos les de fre

c      Correction for brakes, use type 6 instead of 1 for main line
       if (icase_brakes.eq.0) then ! set automatic brake description
       corda(cordam+1,31)=6
       end if


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      14.3 Compute anchor points in 3D space
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Need simplification as uses same code as section 6 (!!!!!)

       do i=1,nribss

       tetha=rib(i,8)*pi/180.
       rot_z=rib(i,250)*pi/180.0
       pos=rib(i,5)*rib(i,251)/100.0

       do j=1,rib(i,15) ! anchor number

c      Airfoil anchor washin coordinates
       u(i,j,17)=(u(i,j,6)-(rib(i,10)/100.)*rib(i,5))*dcos(tetha)+
     + v(i,j,6)*dsin(tetha)+(rib(i,10)/100.)*rib(i,5)
       v(i,j,17)=(-u(i,j,6)+(rib(i,10)/100.)*rib(i,5))*dsin(tetha)+
     + v(i,j,6)*dcos(tetha)-rib(i,50)

c      Airfoil rotation in Z-axis. ( View section 6, MUST be the same )

       wnew(j)=-u(i,j,17)*dsin(rot_z)+pos*dsin(rot_z)
       unew(j)=u(i,j,17)*dcos(rot_z)+pos*(1-dcos(rot_z))
       vnew(j)=v(i,j,17)
       u(i,j,4)=unew(j)
       v(i,j,4)=vnew(j)
       w(i,j,4)=wnew(j)

c      Airfoil anchor (u,v,w) espace coordinates
c       u(i,j,18)=u(i,j,17)
c       v(i,j,18)=v(i,j,17)*dcos(rib(i,9)*pi/180.)
c       w(i,j,18)=-v(i,j,17)*dsin(rib(i,9)*pi/180.)

c      Airfoils rotation in Y-axis
       w(i,j,18)=-w(i,j,4)*dcos(rib(i,9)*pi/180.)-
     + v(i,j,4)*dsin(rib(i,9)*pi/180.)
       u(i,j,18)=u(i,j,4)
       v(i,j,18)=-w(i,j,4)*dsin(rib(i,9)*pi/180.)+
     + v(i,j,4)*dcos(rib(i,9)*pi/180.)

c      Airfoil anchor (x,y,z) absolute coordinates

c       Comment ???????????????????????????? !!!!!
c       u(i,j,19)=rib(i,6)-w(i,j,18)
c       v(i,j,19)=rib(i,3)+u(i,j,18)
c       w(i,j,19)=rib(i,7)-v(i,j,18) 
     

       end do
       end do

       do i=1,nribss
       do j=1,rib(i,15)

       end do

       end do
       
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     14.4 Linies d'accio de cada corda
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Recompute anchors of the brakes, for fractional option

       ii=slp+1
       do j=1,cam(ii)
       if (mc(ii,j,15).lt.nribss) then
       i=mc(ii,j,15)
       u(i,6,19)=(1-brake(j,2))*u(i,6,19)+brake(j,2)*u(i+1,6,19)
       v(i,6,19)=(1-brake(j,2))*v(i,6,19)+brake(j,2)*v(i+1,6,19)
       w(i,6,19)=(1-brake(j,2))*w(i,6,19)+brake(j,2)*w(i+1,6,19)
       end if
       end do

c      Linies d'acció

       do i=cordam+1,cordat ! For all lines

       xcorda(i,3)=0.
       ycorda(i,3)=0.
       zcorda(i,3)=0.

       ii=slp+1 !For brake plans

       do k=2,8,2 ! For all levels

       do j=1,cam(ii) ! For all paths

       if (ii.eq.corda(i,1)) then

       if (corda(i,2).eq.mc(ii,j,k).and.mc(ii,j,k+1).eq.corda(i,3)) then

c      Adaptat a punts d'ancoratge de frens (6)
       xcorda(i,3)=xcorda(i,3)+u(mc(ii,j,15),mc(ii,j,14),19)
       ycorda(i,3)=ycorda(i,3)+v(mc(ii,j,15),mc(ii,j,14),19)
       zcorda(i,3)=zcorda(i,3)+w(mc(ii,j,15),mc(ii,j,14),19)

       end if

       end if

       end do

       end do

c      Center of gravity line i
       xcorda(i,3)=xcorda(i,3)/dfloat(corda(i,4))
       ycorda(i,3)=ycorda(i,3)/dfloat(corda(i,4))
       zcorda(i,3)=zcorda(i,3)/dfloat(corda(i,4))

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      14.5 Punts inicial i final de cada corda
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Level 1 (main brake line)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=cordam+1,cordat

       if (corda(i,2).eq.1) then

c      Frens iniciats sota maillons bandes darrera
       xcorda(i,1)=x2line(slp,1,1)
       ycorda(i,1)=y2line(slp,1,1)
       zcorda(i,1)=z2line(slp,1,1)

c      Equacio parametrica de la recta que passa per P1-P3

       dist=dsqrt((xcorda(i,3)-xcorda(i,1))**2.0d0+(ycorda(i,3)-
     + ycorda(i,1))**2.0d0+(zcorda(i,3)-zcorda(i,1))**2.0d0)

       cdl=(xcorda(i,3)-xcorda(i,1))/dist
       cdm=(ycorda(i,3)-ycorda(i,1))/dist
       cdn=(zcorda(i,3)-zcorda(i,1))/dist

c      Parametre necessari a la distancia objectiu

       t=clengb/(dsqrt(cdl*cdl+cdm*cdm+cdn*cdn))

c      Punt P2 amb equacio parametrica
       xcorda(i,2)=xcorda(i,1)+cdl*t
       ycorda(i,2)=ycorda(i,1)+cdm*t
       zcorda(i,2)=zcorda(i,1)+cdn*t

       ii=corda(i,1)

       x1line(ii,1,corda(i,3))=xcorda(i,1)
       y1line(ii,1,corda(i,3))=ycorda(i,1)
       z1line(ii,1,corda(i,3))=zcorda(i,1)
       x2line(ii,1,corda(i,3))=xcorda(i,2)
       y2line(ii,1,corda(i,3))=ycorda(i,2)
       z2line(ii,1,corda(i,3))=zcorda(i,2)

c      comprovacio

       disto=dsqrt((xcorda(i,2)-xcorda(i,1))**2+(ycorda(i,2)-
     + ycorda(i,1))**2+(zcorda(i,2)-zcorda(i,1))**2)

       end if

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Level 2
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=cordam+1,cordat

       if (corda(i,2).eq.2) then

       if (corda(i,5).eq.2) then ! un nivell adicional


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      REVISAT 2013-05-17 !!!!!!!!!!!!!!!!!!

c      Explora mc i troba quin origen emprar
       kk=slp+1
       do k=1,cam(kk)

       if (corda(i,2).eq.mc(kk,k,4).and.mc(kk,k,5).eq.corda(i,3)) then

       comp1(kk)=mc(kk,k,2)
       comp2(kk)=mc(kk,k,3)

       end if

       end do

c      Origen
       xcorda(i,1)=x2line(corda(i,1),1,int(comp2(corda(i,1))))
       ycorda(i,1)=y2line(corda(i,1),1,int(comp2(corda(i,1))))
       zcorda(i,1)=z2line(corda(i,1),1,int(comp2(corda(i,1))))

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc




c       xcorda(i,1)=x2line(corda(i,1),corda(i,2),corda(i,3))
c       ycorda(i,1)=y2line(corda(i,1),corda(i,2),corda(i,3))
c       zcorda(i,1)=z2line(corda(i,1),corda(i,2),corda(i,3))      

       xcorda(i,2)=u(corda(i,7),corda(i,6),19)
       ycorda(i,2)=v(corda(i,7),corda(i,6),19)
       zcorda(i,2)=w(corda(i,7),corda(i,6),19)

       ii=corda(i,1)

       x1line(ii,2,corda(i,3))=xcorda(i,1)
       y1line(ii,2,corda(i,3))=ycorda(i,1)
       z1line(ii,2,corda(i,3))=zcorda(i,1)
       x2line(ii,2,corda(i,3))=xcorda(i,2)
       y2line(ii,2,corda(i,3))=ycorda(i,2)
       z2line(ii,2,corda(i,3))=zcorda(i,2)
       
       end if

       if (corda(i,5).eq.3) then ! dos nivells adicionals

c       write (*,*) ">>> ", i, corda(i,1), corda(i,2), corda(i,3) 

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      REVISAT 2013-05-03 !!!!!!!!!!!!!!!!!!

c      Explora mc i troba quin origen emprar
       kk=slp+1
       do k=1,cam(kk)

       if (corda(i,2).eq.mc(kk,k,4).and.mc(kk,k,5).eq.corda(i,3)) then

       comp1(kk)=mc(kk,k,2)
       comp2(kk)=mc(kk,k,3)

       end if

       end do

c      Origen
       xcorda(i,1)=x2line(corda(i,1),1,int(comp2(corda(i,1))))
       ycorda(i,1)=y2line(corda(i,1),1,int(comp2(corda(i,1))))
       zcorda(i,1)=z2line(corda(i,1),1,int(comp2(corda(i,1))))

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


c       write (*,*) ">>> ", xcorda(i,1), ycorda(i,1),zcorda(i,1)
                    
       dist=dsqrt((xcorda(i,3)-xcorda(i,1))**2.0d0+(ycorda(i,3)-
     + ycorda(i,1))**2.0d0+(zcorda(i,3)-zcorda(i,1))**2.0d0)

       cdl=(xcorda(i,3)-xcorda(i,1))/dist
       cdm=(ycorda(i,3)-ycorda(i,1))/dist
       cdn=(zcorda(i,3)-zcorda(i,1))/dist

c      Parametre necesari a la distancia objectiu

       d13=dsqrt((xcorda(i,3)-xcorda(i,1))**2.0d0+(ycorda(i,3)-
     + ycorda(i,1))**2.0d0+(zcorda(i,3)-zcorda(i,1))**2.0d0)
       
       t=(d13-raml(5,3))/(dsqrt(cdl*cdl+cdm*cdm+cdn*cdn))

c      Punt P2 amb equacio parametrica
       xcorda(i,2)=xcorda(i,1)+cdl*t
       ycorda(i,2)=ycorda(i,1)+cdm*t
       zcorda(i,2)=zcorda(i,1)+cdn*t

       ii=corda(i,1)

       x1line(ii,2,corda(i,3))=xcorda(i,1)
       y1line(ii,2,corda(i,3))=ycorda(i,1)
       z1line(ii,2,corda(i,3))=zcorda(i,1)
       x2line(ii,2,corda(i,3))=xcorda(i,2)
       y2line(ii,2,corda(i,3))=ycorda(i,2)
       z2line(ii,2,corda(i,3))=zcorda(i,2)
       
       end if

       if (corda(i,5).eq.4) then ! Tres nivells adicionals

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      REVISAT 2013-05-03 !!!!!!!!!!!!!!!!!!

c      Explora mc i troba quin origen emprar
       kk=slp+1
       do k=1,cam(kk)

       if (corda(i,2).eq.mc(kk,k,4).and.mc(kk,k,5).eq.corda(i,3)) then

       comp1(kk)=mc(kk,k,2)
       comp2(kk)=mc(kk,k,3)

       end if

       end do

c      Origen
       xcorda(i,1)=x2line(corda(i,1),1,int(comp2(corda(i,1))))
       ycorda(i,1)=y2line(corda(i,1),1,int(comp2(corda(i,1))))
       zcorda(i,1)=z2line(corda(i,1),1,int(comp2(corda(i,1))))


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c       xcorda(i,1)=x2line(corda(i,1),corda(i,2),corda(i,3))
c       ycorda(i,1)=y2line(corda(i,1),corda(i,2),corda(i,3))
c       zcorda(i,1)=z2line(corda(i,1),corda(i,2),corda(i,3))
                    
       dist=dsqrt((xcorda(i,3)-xcorda(i,1))**2+(ycorda(i,3)-
     + ycorda(i,1))**2+(zcorda(i,3)-zcorda(i,1))**2)

       cdl=(xcorda(i,3)-xcorda(i,1))/dist
       cdm=(ycorda(i,3)-ycorda(i,1))/dist
       cdn=(zcorda(i,3)-zcorda(i,1))/dist

c      Parametre necesari a la distancia objectiu

       d13=dsqrt((xcorda(i,3)-xcorda(i,1))**2+(ycorda(i,3)-ycorda(i,1))
     + **2+(zcorda(i,3)-zcorda(i,1))**2)
       
       t=(d13-raml(6,3))/(dsqrt(cdl*cdl+cdm*cdm+cdn*cdn))

c      Punt P2 amb equacio parametrica
       xcorda(i,2)=xcorda(i,1)+cdl*t
       ycorda(i,2)=ycorda(i,1)+cdm*t
       zcorda(i,2)=zcorda(i,1)+cdn*t

       ii=corda(i,1)

       x1line(ii,2,corda(i,3))=xcorda(i,1)
       y1line(ii,2,corda(i,3))=ycorda(i,1)
       z1line(ii,2,corda(i,3))=zcorda(i,1)
       x2line(ii,2,corda(i,3))=xcorda(i,2)
       y2line(ii,2,corda(i,3))=ycorda(i,2)
       z2line(ii,2,corda(i,3))=zcorda(i,2)

       end if

       end if

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Level 3
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Inici al final de les cordes 2

       do i=cordam+1,cordat

       if (corda(i,2).eq.3) then

       if (corda(i,5).eq.3) then !directe a l'ancoratge

c      Explora mc i troba quin origen emprar
       kk=slp+1
       do k=1,cam(kk)

       if (corda(i,2).eq.mc(kk,k,6).and.mc(kk,k,7).eq.corda(i,3)) then

       comp1(kk)=mc(kk,k,4)
       comp2(kk)=mc(kk,k,5)

       end if

       end do

c      Origen
       xcorda(i,1)=x2line(corda(i,1),2,int(comp2(corda(i,1))))
       ycorda(i,1)=y2line(corda(i,1),2,int(comp2(corda(i,1))))
       zcorda(i,1)=z2line(corda(i,1),2,int(comp2(corda(i,1))))

       xcorda(i,2)=u(corda(i,7),corda(i,6),19)
       ycorda(i,2)=v(corda(i,7),corda(i,6),19)
       zcorda(i,2)=w(corda(i,7),corda(i,6),19)

       ii=corda(i,1)

       x1line(ii,3,corda(i,3))=xcorda(i,1)
       y1line(ii,3,corda(i,3))=ycorda(i,1)
       z1line(ii,3,corda(i,3))=zcorda(i,1)
       x2line(ii,3,corda(i,3))=xcorda(i,2)
       y2line(ii,3,corda(i,3))=ycorda(i,2)
       z2line(ii,3,corda(i,3))=zcorda(i,2)
       
       end if

c      Si hi ha quatre nivells
       if (corda(i,5).eq.4) then

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      LEVEL 2
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      LEVEL 3
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Explora mc i troba quin origen emprar
       kk=slp+1
       do k=1,cam(kk)

       if (corda(i,2).eq.mc(kk,k,6).and.mc(kk,k,7).eq.corda(i,3)) then

       comp1(kk)=mc(kk,k,4)
       comp2(kk)=mc(kk,k,5)

       end if
       
       end do

c      Origen
       xcorda(i,1)=x2line(corda(i,1),2,int(comp2(corda(i,1))))
       ycorda(i,1)=y2line(corda(i,1),2,int(comp2(corda(i,1))))
       zcorda(i,1)=z2line(corda(i,1),2,int(comp2(corda(i,1))))

       dist=dsqrt((xcorda(i,3)-xcorda(i,1))**2+(ycorda(i,3)-
     + ycorda(i,1))**2+(zcorda(i,3)-zcorda(i,1))**2)

       cdl=(xcorda(i,3)-xcorda(i,1))/dist
       cdm=(ycorda(i,3)-ycorda(i,1))/dist
       cdn=(zcorda(i,3)-zcorda(i,1))/dist

c      Parametre necesari a la distancia objectiu

       d13=dsqrt((xcorda(i,3)-xcorda(i,1))**2.0d0+(ycorda(i,3)-
     + ycorda(i,1))**2.0d0+(zcorda(i,3)-zcorda(i,1))**2.0d0)
       
c       t=(raml(6,4)-dl3)/(sqrt(cdl*cdl+cdm*cdm+cdn*cdn))
       t=(raml(6,3)-raml(6,4))/(dsqrt(cdl*cdl+cdm*cdm+cdn*cdn))

c      Punt P2 amb equacio parametrica
       xcorda(i,2)=xcorda(i,1)+cdl*t
       ycorda(i,2)=ycorda(i,1)+cdm*t
       zcorda(i,2)=zcorda(i,1)+cdn*t

       ii=corda(i,1)

       x1line(ii,3,corda(i,3))=xcorda(i,1)
       y1line(ii,3,corda(i,3))=ycorda(i,1)
       z1line(ii,3,corda(i,3))=zcorda(i,1)
       x2line(ii,3,corda(i,3))=xcorda(i,2)
       y2line(ii,3,corda(i,3))=ycorda(i,2)
       z2line(ii,3,corda(i,3))=zcorda(i,2)
       
       end if

       end if

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Level 4
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Inici al final de les cordes 3

       do i=cordam+1,cordat

       if (corda(i,2).eq.4) then

       if (corda(i,5).eq.4) then !directe a l'ancoratge

c      Explora mc i troba quin origen emprar
       kk=slp+1
       do k=1,cam(kk)

       if (corda(i,2).eq.mc(kk,k,8).and.mc(kk,k,9).eq.corda(i,3)) then

       comp1(kk)=mc(kk,k,6)
       comp2(kk)=mc(kk,k,7)

       end if
       
       end do

c      Origen
       xcorda(i,1)=x2line(corda(i,1),3,int(comp2(corda(i,1))))
       ycorda(i,1)=y2line(corda(i,1),3,int(comp2(corda(i,1))))
       zcorda(i,1)=z2line(corda(i,1),3,int(comp2(corda(i,1))))

       xcorda(i,2)=u(corda(i,7),corda(i,6),19)
       ycorda(i,2)=v(corda(i,7),corda(i,6),19)
       zcorda(i,2)=w(corda(i,7),corda(i,6),19)

       ii=corda(i,1)

       x1line(ii,4,corda(i,3))=xcorda(i,1)
       y1line(ii,4,corda(i,3))=ycorda(i,1)
       z1line(ii,4,corda(i,3))=zcorda(i,1)
       x2line(ii,4,corda(i,3))=xcorda(i,2)
       y2line(ii,4,corda(i,3))=ycorda(i,2)
       z2line(ii,4,corda(i,3))=zcorda(i,2)
       
       end if

       end if

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     14.6 Longituds de les cordes
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


      do i=cordam+1,cordat

      xx2=x2line(corda(i,1),corda(i,2),corda(i,3))
      xx1=x1line(corda(i,1),corda(i,2),corda(i,3))
      yy2=y2line(corda(i,1),corda(i,2),corda(i,3))
      yy1=y1line(corda(i,1),corda(i,2),corda(i,3))
      zz2=z2line(corda(i,1),corda(i,2),corda(i,3))
      zz1=z1line(corda(i,1),corda(i,2),corda(i,3))

      xline(i)=dsqrt((xx2-xx1)**2+(yy2-yy1)**2+(zz2-zz1)**2)

      xlide(i)=0.0d0
      xlifi(i)=xline(i)

      end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     14.7 Dibuixar brakes 2D
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=cordam+1,cordat

       x0=(1260.-160.)*xkf
       y0=(1800.+890.95)*xkf

       x00=1260.*xkf*float(corda(i,1)-1)

       if (i37c.eq.0) then ! Use colors by risers
       call line(x1line(corda(i,1),corda(i,2),corda(i,3))+x0+x00,
     + z1line(corda(i,1),corda(i,2),corda(i,3))+y0,
     + x2line(corda(i,1),corda(i,2),corda(i,3))+x0+x00,
     + z2line(corda(i,1),corda(i,2),corda(i,3))+y0,iccolor(6))
c     + z2line(corda(i,1),corda(i,2),corda(i,3))+y0,corda(i,1))
       end if

       if (i37c.eq.1) then ! Use colors according table 34
       corda(i,40)=corda(i,30+corda(i,2)) ! Type on line i
       iccolor34(i)=int(tyline(corda(i,40),10))
       call line(x1line(corda(i,1),corda(i,2),corda(i,3))+x0+x00,
     + z1line(corda(i,1),corda(i,2),corda(i,3))+y0,
     + x2line(corda(i,1),corda(i,2),corda(i,3))+x0+x00,
     + z2line(corda(i,1),corda(i,2),corda(i,3))+y0,iccolor34(i))
       end if

       end do

c      Dibuixa distribucio de frenat

       x0=(1260.+890.)*xkf
       y0=(1800.+1000.)*xkf

       xf=rib(nribss,2)/100.

       string1="BRAKE_DISTRIBUTION"
       string2="CENTER"
       string3="WING_TIP"

       call txt(x0,y0-100.*xkf,10.0d0,0.0d0,string1,7)
       call txt(x0,y0-80.*xkf,10.0d0,0.0d0,string2,7)
       call txt(x0+100.*xf,y0-80.*xkf,10.0d0,0.0d0,string3,7)


       call line(x0,y0,x0+rib(nribss,2),y0,4)

       do k=1,5
       call line(x0+bd(k,1)*xf,y0,x0+bd(k,1)*xf,y0-bd(k,2),1)

       write (xstring,'(F6.2)') bd(k,1)
       call txt(x0+bd(k,1)*xf-20.,y0+30.*xkf,10.0d0,0.0d0,xstring,7)

       write (xstring,'(F6.2)') bd(k,2)
       call txt(x0+bd(k,1)*xf-20.,y0-50.*xkf,10.0d0,0.0d0,xstring,7)

       end do

       do k=1,4
       call line(x0+bd(k,1)*xf,y0-bd(k,2),x0+bd(k+1,1)*xf,
     + y0-bd(k+1,2),iccolor(6))
       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      14.8 Set more lines properties by types
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Compute lengths of each type
       do k=1,k34n  ! in all types
       lentype(k)=0.0d0 ! initial lenght of type k
       lentypewl(k)=0.0d0 ! initial lenght of type k without loops

c      Line lengths by types
       do i=1,cordat
       corda(i,40)=corda(i,30+corda(i,2)) ! Type on line i
       if (corda(i,40).eq.jltype(k)) then
       lentype(k)=lentype(k)+xlifi(i)+2.*tyline(k,9)
       lentypewl(k)=lentypewl(k)+xlifi(i)
       end if
c       write (*,*) i, corda(i,40),jltype(k),xlifi(i),lentype(k),
c     + lentypewl(k)
       end do

       end do ! k type

c      Total lengths
       xlength1=0.0d0 ! with loops
       xlength2=0.0d0 ! witout loops

c      Exclude risers
       do k=2,k34n  
       xlength1=xlength1+lentype(k)
       xlength2=xlength2+lentypewl(k)
       end do   
       xlength1=xlength1/50. ! x 2 and meters with loops
       xlength2=xlength2/50. ! x 2 and meters without loops

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      14.9 More lines properties
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Define some lines properties

c      Initialize values
       do i=1,nribss
       do k=0,50
       xlimo(i,k)=0.0d0
       end do
       end do

       do i=1,cordat
       xlimo(i,0)=xlifi(i)  ! Lenght without loops cm
       xlimo(i,1)=xlifi(i)+2.*tyline(corda(i,40),9) ! with loops cm
       xlimo(i,2)=(xlimo(i,1)/100.)*tyline(corda(i,40),7) ! weight g
       xlimo(i,3)=xlimo(i,1)*10.*tyline(corda(i,40),2) ! area mm2
       xlimo(i,30)=0.0d0 ! area reduction
       if (corda(i,2).eq.1.and.tylinea(corda(i,40),1).eq."r") then ! case r don't count loops
       xlimo(i,3)=xlimo(i,0)*10.*tyline(corda(i,40),2) ! area mm2
       end if
c      Case spliced loops
c      According experiences by E. Fontaine, the equivalent diameter on spliced part is D*sqrt(2.)
c      Then reduce total line area in xlimo(i,30)=2*D*lloop*(sqrt(2.)-2)
       if (tylinea(corda(i,40),8).eq."p".and.
     + tylinea(corda(i,40),1).ne."r") then ! reduce line frontal area
       xlimo(i,30)=2.*tyline(corda(i,40),2)*
     + 10.*tyline(corda(i,40),9)*(dsqrt(2.0d0)-2.0d0)
       xlimo(i,3)=xlimo(i,3)+xlimo(i,30) ! Spliced reduction
       end if
       xlimo(i,10)=(xcorda(i,1)+xcorda(i,2))/2. ! cdg x cm
       xlimo(i,11)=(ycorda(i,1)+ycorda(i,2))/2. ! cdg y cm
       xlimo(i,12)=(zcorda(i,1)+zcorda(i,2))/2. ! cdg z cm
       end do

c      Risers weight kg
       xlimog(14)=0.0d0 ! risers weight
       do i=1,cordam
       if (corda(i,2).eq.1) then
       xlimog(14)=xlimog(14)+(xlimo(i,1)/100.)*tyline(corda(i,40),7)
       end if
       end do
       xlimog(14)=xlimog(14)/500. ! kg both sides

c      Risers frontal surface
       xlimog(15)=0.0d0 ! risers surface
       do i=1,cordam
       if (corda(i,2).eq.1) then
       if (tylinea(corda(i,40),1).eq."c") then ! cylindrical risers count loops
       xlimog(15)=xlimog(15)+(xlimo(i,1)*10.)*tyline(corda(i,40),2)
       end if
       if (tylinea(corda(i,40),1).eq."r") then ! rectangular risers not count loops
       xlimog(15)=xlimog(15)+(xlimo(i,0)*10.)*tyline(corda(i,40),2)
c       write (*,*) i,xlimo(i,0),tyline(corda(i,40),2)
       end if
       end if
       end do
       xlimog(15)=2.*xlimog(15)/1000000. ! m2
       
c      Compute derived properties
       xlimog(2)=0.0d0 ! Lines weight (g)
       xlimog(3)=0.0d0 ! Lines area (m2)
       xlimog(10)=0.0d0 ! Lines x mass center
       xlimog(11)=0.0d0 ! Lines y mass center
       xlimog(12)=0.0d0 ! Lines z mass center

       do i=1,cordat
       xlimog(2)=xlimog(2)+2.*xlimo(i,2) ! weight g
       xlimog(3)=xlimog(3)+2.*xlimo(i,3) ! area mm2
       xlimog(10)=xlimog(10)+xlimo(i,10)*xlimo(i,2) ! x semiwing
       xlimog(11)=xlimog(11)+xlimo(i,11)*xlimo(i,2) ! y semiwing
       xlimog(12)=xlimog(12)+xlimo(i,12)*xlimo(i,2) ! z semiwing
       end do
       xlimog(10)=0.0d0                   ! cm
       xlimog(11)=2.*xlimog(11)/xlimog(2) ! cm
       xlimog(12)=2.*xlimog(12)/xlimog(2) ! cm
       xlimog(2)=xlimog(2)/1000.    ! total lines weight kg inc risers
       xlimog(3)=xlimog(3)/1000000. ! total lines area m2 inc risers

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Lines and risers drag coefficients
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      x35ro = air mass density 1.225 kg/m3
c      x35v  = speed m/s
c      x35mu = air dynamic viscosity 18.46 x 1e-6 Pascalsˇs

c      Reynolds numbers by types tyline(k,20)
       do k=1,k34n
       tyline(k,20)=(x35ro*x35v*tyline(k,2)*1e-3)/(x35mu*1e-6)
       end do

c      Reynolds number operating in each line xlimo(1,20)
       do i=1,cordat
       xlimo(i,20)=tyline(corda(i,40),20)
       end do

c      Drag coefficient in each line xlimo(1,21)
c      Weisener and its simple equation for a cylinder
c      Source: De Villiers, HEGALA v6 report
       do i=1,cordat
       xlimo(i,21)=(10.*xlimo(i,20)**(-2./3.))+1.0d0
c      Correction for rectangular risers, increment Cd
       if (corda(i,2).eq.1.and.tylinea(corda(i,40),1).eq."r") then
       xlimo(i,21)=1.98
       end if
       end do

c      Global line drag coeffcient
       x35dlcoef=0.0d0
       do i=1,cordat
       x35dlcoef=x35dlcoef+(xlimo(i,3)*1e-6)*xlimo(i,21)
       end do
       x35dlcoef=x35dlcoef/(0.5*xlimog(3)) ! use half line area
       

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      15. Marques de colors
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      15.1 Extrados marks
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Marques colors extrados panell i
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do k=1,npce ! ribs number with color marks

c      l=mark number in k rib
       do l=1,npc2e(k) ! marks in rib k

c      Detect if mark is exactly in the rib

       if (xpc2e(k,l).eq.0) then

       i=npc1e(k) ! rib number corresponding to k order

c      Detect segment (j,j+1) where color changes
       do j=1,np(i,2)-1

       if ((100.-(u(i,j,2)).le.xpc1e(k,l).and.
     + (100.-u(i,j+1,2)).gt.xpc1e(k,l))) then

       jcontrol=j        

       end if

       end do

c      Calcula longitud extrados fins punt j

       xle(k,l)=0.
       xleinc(k,l)=0.

       do j=1,jcontrol-1
       xle(k,l)=xle(k,l)+sqrt(((v(i,j+1,2)-v(i,j,2))**2)+
     + ((u(i,j+1,2)-u(i,j,2))**2))
       end do

c      Interpolacio punt color

       xmc=(v(i,j+1,2)-v(i,j,2))/(u(i,j+1,2)-u(i,j,2))
       xbc=v(i,j,2)-xmc*u(i,j,2)
       
       xpc3e(k,l)=100.-xpc1e(k,l)
       ypc3e(k,l)=xmc*xpc3e(k,l)+xbc

       xleinc(k,l)=dsqrt(((ypc3e(k,l)-v(i,j,2))**2)+
     + ((xpc3e(k,l)-u(i,j,2))**2))

       xle(k,l)=xle(k,l)+xleinc(k,l)
       
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Dibuixa marques color esquerra panell i
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Localitza punts 
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=xyshift*xkf

       j=jcontrol

       xu=u(i,j,9)
       xv=v(i,j,9)

c      Calcula punt de color
       alp=abs(datan((v(i,j+1,9)-v(i,j,9))/(u(i,j+1,9)-u(i,j,9))))
       xu=xu+(xleinc(k,l)*(rib(i,5)/100.))*dcos(alp)
       xv=xv+(xleinc(k,l)*(rib(i,5)/100.))*dsin(alp)

c      Dibuixa creu
       call line(psep+xu-3.,-(xv)+psey,psep+xu+3.,
     + -(xv)+psey,7)
       call line(psep+xu,-(xv-3.)+psey,psep+xu,
     + -(xv+3.)+psey,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Dibuixa marques color dreta panell i-1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c       if (i.eq.nribss) then


       i=i-1

c      Localitza punts 
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=xyshift*xkf

       j=jcontrol

       xu=u(i,j,10)
       xv=v(i,j,10)

c      Calcula punt de color
       alp=abs(datan((v(i,j+1,10)-v(i,j,10))/(u(i,j+1,10)-u(i,j,10))))
       xu=xu+(xleinc(k,l)*(rib(i,5)/100.))*dcos(alp)
       xv=xv+(xleinc(k,l)*(rib(i,5)/100.))*dsin(alp)

c      Dibuixa creu
       call line(psep+xu-3.,-(xv)+psey,psep+xu+3.,
     + -(xv)+psey,7)
       call line(psep+xu,-(xv-3.)+psey,psep+xu,
     + -(xv+3.)+psey,7)

c       i=i+1


       end if

       end do

       end do ! rib c colors
 


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      15.2 Intrados marks
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Control if type is not "ss"
       if (atp.ne."ss") then
       
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Marques colors intrados panell i
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do k=1,npci ! ribs number with color marks

c      l=mark number in k rib
       do l=1,npc2i(k) ! marks in rib k

c      Detect if mark is exactly in the rib

       if (xpc2i(k,l).eq.0) then

       i=npc1i(k) ! rib number corresponding to k order

c      Detect segment (j,j-1) where color changes

       do j=np(i,1),np(i,2)+1,-1

       if ((100.-(u(i,j,2)).le.xpc1i(k,l).and.
     + (100.-u(i,j-1,2)).gt.xpc1i(k,l))) then

       jcontrol=j        

       end if

       end do  ! in j

c      Calcula longitud extrados fins punt j

       xli(k,l)=0.
       xliinc(k,l)=0.

       do j=np(i,1),jcontrol+1,-1
       xli(k,l)=xli(k,l)+sqrt(((v(i,j-1,2)-v(i,j,2))**2)+
     + ((u(i,j-1,2)-u(i,j,2))**2))
       end do

c      Interpolacio punt color

       xmc=(v(i,j,2)-v(i,j-1,2))/(u(i,j,2)-u(i,j-1,2))
       xbc=v(i,j-1,2)-xmc*u(i,j-1,2)
       
       xpc3i(k,l)=100.-xpc1i(k,l)
       ypc3i(k,l)=xmc*xpc3i(k,l)+xbc

       xliinc(k,l)=dsqrt(((ypc3i(k,l)-v(i,j,2))**2)+
     + ((xpc3i(k,l)-u(i,j,2))**2))

       xli(k,l)=xli(k,l)+xliinc(k,l)
       
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Dibuixa marques color esquerra panell i
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Localitza punts 
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=(890.95+xyshift)*xkf

       j=jcontrol

       xu=u(i,j,9)
       xv=v(i,j,9)

c      Calcula punt de color
       alp=abs(datan((v(i,j,9)-v(i,j-1,9))/(u(i,j,9)-u(i,j-1,9))))
       xu=xu-(xliinc(k,l)*(rib(i,5)/100.))*dcos(alp)
       xv=xv-(xliinc(k,l)*(rib(i,5)/100.))*dsin(alp)

c      Dibuixa creu
       call line(psep+xu-3.,-(xv)+psey,psep+xu+3.,
     + -(xv)+psey,7)
       call line(psep+xu,-(xv-3.)+psey,psep+xu,
     + -(xv+3.)+psey,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Dibuixa marques color dreta panell i-1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=i-1

c      Localitza punts 
       psep=1970.*xkf+seppix(i)*1.0d0
       psey=(890.95+xyshift)*xkf

       j=jcontrol

       xu=u(i,j,10)
       xv=v(i,j,10)

c      Calcula punt de color
       alp=abs(datan((v(i,j,10)-v(i,j-1,10))/(u(i,j,10)-u(i,j-1,10))))
       xu=xu-(xliinc(k,l)*(rib(i,5)/100.))*dcos(alp)
       xv=xv-(xliinc(k,l)*(rib(i,5)/100.))*dsin(alp)

c      Dibuixa creu
       call line(psep+xu-3.,-(xv)+psey,psep+xu+3.,
     + -(xv)+psey,7)
       call line(psep+xu,-(xv-3.)+psey,psep+xu,
     + -(xv+3.)+psey,7)

       i=1+1

       end if

       end do

       end do ! rib c colors intra

       end if ! not "ss"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16. H V and HV ribs
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       xvrib=xvrib/10.

c       write (*,*) "xvrib=",xvrib
       
c       do i=0,nribss

c      Impressions de control
c       ii=1

c       write (*,*) "u(i,ii,6) ",i,ii,u(i,ii,6)
c       write (*,*) "np(i,2) ",i, np(i,2),np(i,1)
c       write (*,*) "jcon(i,ii,2) ",jcon(i,ii,2)

c       end do

       do k=1,nhvr

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.1 H straps Type 1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


       if (hvr(k,2).eq.1) then

c      Control central cell width
       if (hvr(k,3).gt.0.or.cencell.gt.0.01) then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.1.1 Line i (2)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)
       ii=hvr(k,4)

       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,2)=ucnt(i,ii,3)-hvr(k,7)
       ucnt(i,ii,4)=ucnt(i,ii,3)+hvr(k,7)

c      Points 2,3,4 interpolation in rib i
       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,2).and.u(i,j+1,3).ge.ucnt(i,ii,2)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,2)=xm*ucnt(i,ii,2)+xb
       jcon(i,ii,2)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       jcon(i,ii,3)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,4).and.u(i,j+1,3).ge.ucnt(i,ii,4)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,4)=xm*ucnt(i,ii,4)+xb
       jcon(i,ii,4)=j
       end if

       end do
         

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat line 2-3-4 in n regular spaces   
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       uinc=0.
       vinc=0.

       do j=1,21
       ucnt2(i,ii,j)=ucnt(i,ii,2)+uinc
       uinc=uinc+(ucnt(i,ii,4)-ucnt(i,ii,2))/20.

c      warning u=v
c       write (*,*) "u-v ", i,j,u(i,j,3),v(i,j,3)

c      Between 2 and jcon(i,ii,2)+1
       if (ucnt2(i,ii,j).le.u(i,jcon(i,ii,2)+1,3)) then
       xm=(v(i,jcon(i,ii,2)+1,3)-vcnt(i,ii,2))/(u(i,jcon(i,ii,2)+1,3)-
     + ucnt(i,ii,2))
       xb=vcnt(i,ii,2)-xm*ucnt(i,ii,2)
       vcnt2(i,ii,j)=xm*ucnt2(i,ii,j)+xb
       end if

c      Between jcon(i,ii,2)+1 and jcon(i,ii,4)

       if (ucnt2(i,ii,j).ge.u(i,jcon(i,ii,2)+1,3).and.ucnt2(i,ii,j)
     + .le.u(i,jcon(i,ii,4),3)) then
c      
       do l=jcon(i,ii,2)+1,jcon(i,ii,4)-1

c      Seleccionar tram d'interpolació

       if (ucnt2(i,ii,j).ge.u(i,l,3).and.ucnt2(i,ii,j).le.u(i,l+1,3)) 
     + then
       xm=(v(i,l+1,3)-v(i,l,3))/(u(i,l+1,3)-u(i,l,3))
       xb=v(i,l,3)-xm*u(i,l,3)
       end if
       end do
       vcnt2(i,ii,j)=xm*ucnt2(i,ii,j)+xb
c       write (*,*) "xm, xb ", xm,xb
       end if

c      Between jcon(i,ii,4) and 4       
       if (ucnt2(i,ii,j).gt.u(i,jcon(i,ii,4),3)) then
       xm=(vcnt(i,ii,4)-v(i,jcon(i,ii,4),3))/(ucnt(i,ii,4)-
     + u(i,jcon(i,ii,4),3))
       xb=vcnt(i,ii,4)-xm*ucnt(i,ii,4)
       vcnt2(i,ii,j)=xm*ucnt2(i,ii,j)+xb
       end if

c       write (*,*) "Line 2 ",i,j,ucnt2(i,ii,j),vcnt2(i,ii,j)

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.1.2 Line i+1 (3)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,5)
       ii=hvr(k,6)

       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,2)=ucnt(i,ii,3)-(hvr(k,7)+hvr(k,20))
       ucnt(i,ii,4)=ucnt(i,ii,3)+(hvr(k,7)+hvr(k,20))

c       write (*,*) "> ",i,ii,hvr(k,20)

c      Points 2,3,4 interpolation in rib i
       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,2).and.u(i,j+1,3).ge.ucnt(i,ii,2)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,2)=xm*ucnt(i,ii,2)+xb
       jcon(i,ii,2)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       jcon(i,ii,3)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,4).and.u(i,j+1,3).ge.ucnt(i,ii,4)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,4)=xm*ucnt(i,ii,4)+xb
       jcon(i,ii,4)=j
       end if

       end do
         
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat line 2-3-4 in n regular spaces   
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       uinc=0.
       vinc=0.

       do j=1,21
       ucnt3(i,ii,j)=ucnt(i,ii,2)+uinc
       uinc=uinc+(ucnt(i,ii,4)-ucnt(i,ii,2))/20.

c      Between 2 and jcon(i,ii,2)+1
       if (ucnt3(i,ii,j).le.u(i,jcon(i,ii,2)+1,3)) then
       xm=(v(i,jcon(i,ii,2)+1,3)-vcnt(i,ii,2))/(u(i,jcon(i,ii,2)+1,3)-
     + ucnt(i,ii,2))
       xb=vcnt(i,ii,2)-xm*ucnt(i,ii,2)
       vcnt3(i,ii,j)=xm*ucnt3(i,ii,j)+xb
       end if

c      Between jcon(i,ii,2)+1 and jcon(i,ii,4)

       if (ucnt3(i,ii,j).ge.u(i,jcon(i,ii,2)+1,3).and.ucnt3(i,ii,j)
     + .le.u(i,jcon(i,ii,4),3)) then
c      
       do l=jcon(i,ii,2)+1,jcon(i,ii,4)-1

c      Seleccionar tram d'interpolació

       if (ucnt3(i,ii,j).ge.u(i,l,3).and.ucnt3(i,ii,j).le.u(i,l+1,3)) 
     + then
       xm=(v(i,l+1,3)-v(i,l,3))/(u(i,l+1,3)-u(i,l,3))
       xb=v(i,l,3)-xm*u(i,l,3)
       end if
       end do
       vcnt3(i,ii,j)=xm*ucnt3(i,ii,j)+xb
       end if

c      Between jcon(i,ii,4) and 4       
       if (ucnt3(i,ii,j).gt.u(i,jcon(i,ii,4),3)) then
       xm=(vcnt(i,ii,4)-v(i,jcon(i,ii,4),3))/(ucnt(i,ii,4)-
     + u(i,jcon(i,ii,4),3))
       xb=vcnt(i,ii,4)-xm*ucnt(i,ii,4)
       vcnt3(i,ii,j)=xm*ucnt3(i,ii,j)+xb
       end if

       end do ! j

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.1.3 Lines 2 and 3 transportation on the space
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Rib i (Line 2)

       i=hvr(k,3)
       ii=hvr(k,4)

       tetha=rib(i,8)*pi/180.
       rot_z=rib(i,250)*pi/180.0
       pos=rib(i,5)*rib(i,251)/100.0

  
       do j=1,21
       ru(i,j,3)=ucnt2(i,ii,j)
       rv(i,j,3)=vcnt2(i,ii,j)-rib(i,50)
       end do

       do j=1,21

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       hx2(i,j,ii)=rx(i,j)
       hy2(i,j,ii)=ry(i,j)
       hz2(i,j,ii)=rz(i,j)

       end do


c       write(*,*) "Ep: ",hx2(0,1,1)

c      Rib i+1 (Line 3)

       i=hvr(k,5)
       ii=hvr(k,6)

       tetha=rib(i,8)*pi/180.

       do j=1,21
       ru(i,j,3)=ucnt3(i,ii,j)
       rv(i,j,3)=vcnt3(i,ii,j)-rib(i,50)
c      COMPTE AMB el rib(i,50) A ESTUDIAR       
       end do

       do j=1,21

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       hx3(i-1,j,ii)=rx(i,j)
       hy3(i-1,j,ii)=ry(i,j)
       hz3(i-1,j,ii)=rz(i,j)

       end do


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.1.4 H-rib 2-3 in 2D model
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)

       px0=0.
       py0=0.
       ptheta=0.

       do j=1,21

c      Distances between points
       pa=dsqrt((rx(i+1,j)-rx(i,j))**2.+(ry(i+1,j)-ry(i,j))**2.+
     + (rz(i+1,j)-rz(i,j))**2.)
       pb=dsqrt((rx(i+1,j+1)-rx(i,j))**2.+(ry(i+1,j+1)-ry(i,j))**2.+
     + (rz(i+1,j+1)-rz(i,j))**2.)
       pc=dsqrt((rx(i+1,j+1)-rx(i+1,j))**2.+(ry(i+1,j+1)-ry(i+1,j))**2.+
     + (rz(i+1,j+1)-rz(i+1,j))**2.)
       pd=dsqrt((rx(i+1,j)-rx(i,j+1))**2.+(ry(i+1,j)-ry(i,j+1))**2.+
     + (rz(i+1,j)-rz(i,j+1))**2.)
       pe=dsqrt((rx(i,j+1)-rx(i,j))**2.+(ry(i,j+1)-ry(i,j))**2.+
     + (rz(i,j+1)-rz(i,j))**2.)
       pf=dsqrt((rx(i+1,j+1)-rx(i,j+1))**2.+(ry(i+1,j+1)-ry(i,j+1))**2.+
     + (rz(i+1,j+1)-rz(i,j+1))**2.)
       
       pa2r=(pa*pa-pb*pb+pc*pc)/(2.*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

       pb2t=(pb*pb-pe*pe+pf*pf)/(2.*pb)
       pb1t=pb-pb2t
       pht=dsqrt(pf*pf-pb2t*pb2t)
       
       pw1=datan(phr/pa1r)
       phu=pb1t*tan(pw1)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0
       
       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

c      Iteration
       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Tensa cintes. Calcula i imprimeix distancies...
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       j=10


       hdist(i)=dsqrt((pl1y(i,j)-pr1y(i,j))**2.+
     + (pl1x(i,j)-pr1x(i,J))**2.)
       hangle(i)=datan((pr1y(i,j)-pl1y(i,j))/(pr1x(i,j)-pl1x(i,j)))

c      Ajusta tensió de la cinta

c      Note: if use variable htens not work, I renamed htensi

       htens=htensi

       do j=1,21

       pr1x(i,j)=pr1x(i,j)-htensi*hdist(i)*dcos(hangle(i))
       pr1y(i,j)=pr1y(i,j)-htensi*hdist(i)*dsin(hangle(i))
       pr2x(i,j)=pr2x(i,j)-htensi*hdist(i)*dcos(hangle(i))
       pr2y(i,j)=pr2y(i,j)-htensi*hdist(i)*dsin(hangle(i))

       end do

c      Cintes tensades
       j=10

       hdist(i)=dsqrt((pl1y(i,j)-pr1y(i,j))**2.+
     + (pl1x(i,j)-pr1x(i,J))**2.)
       hangle(i)=datan((pr1y(i,j)-pl1y(i,j))/(pr1x(i,j)-pl1x(i,j)))

c       write (*,*) "dist tensades ", i, "-", i+1, hdist(i), hangle(i)

c      Drawing in 2D model
       
       psep=3300.*xkf+xrsep*float(i)
       psey=800.*xkf+yrsep*float(ii)+sepri1_y

c       write (*,*) i,ii,psep,psey

       j=1

       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),30)

       j=21

       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),30)

       do j=1,21-1

c      Dibuixa limit esquerre
c       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pl2x(i,j),
c     + psey+pl2y(i,j),1)

c      Dibuixa limit dret
c       call line(psep+pr1x(i,j),psey+pr1y(i,j),psep+pr2x(i,j),
c     + psey+pr2y(i,j),1)


c       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
c     + psey+pr1y(i,j),4)


c      Vores de costura esquerra
       alpl=-(datan((pl1y(i,j)-pl2y(i,j))/(pl1x(i,j)-pl2x(i,j))))
       if (alpl.lt.0.) then
       alpl=alpl+pi
       end if

       lvcx(i,j)=psep+pl1x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j)=psey+pl1y(i,j)-xvrib*dcos(alpl)

c      Vores de costura dreta
       alpr=-(datan((pr1y(i,j)-pr2y(i,j))/(pr1x(i,j)-pr2x(i,j))))
       if (alpr.lt.0.) then
       alpr=alpr+pi
       end if

       rvcx(i,j)=psep+pr1x(i,j)+xvrib*dsin(alpr)
       rvcy(i,j)=psey+pr1y(i,j)+xvrib*dcos(alpr)

c      Tancament lateral inici
       if (j.eq.1) then
       call line(psep+pl1x(i,j)-xvrib*dsin(alpl),psey+pl1y(i,j)
     + -xvrib*dcos(alpl),psep+pl1x(i,j),psey+pl1y(i,j),30)
       call line(psep+pr1x(i,j)+xvrib*dsin(alpr),psey+pr1y(i,j)
     + +xvrib*dcos(alpr),psep+pr1x(i,j),psey+pr1y(i,j),30)
       end if

c      Tancament lateral fi
       if (j.eq.20) then
       call line(psep+pl2x(i,j)-xvrib*dsin(alpl),psey+pl2y(i,j)
     + -xvrib*dcos(alpl),psep+pl2x(i,j),psey+pl2y(i,j),30)
       call line(psep+pr2x(i,j)+xvrib*dsin(alpr),psey+pr2y(i,j)
     + +xvrib*dcos(alpr),psep+pr2x(i,j),psey+pr2y(i,j),30)

       lvcx(i,j+1)=psep+pl2x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j+1)=psey+pl2y(i,j)-xvrib*dcos(alpl)
       
       rvcx(i,j+1)=psep+pr2x(i,j)+xvrib*dsin(alpr)
       rvcy(i,j+1)=psey+pr2y(i,j)+xvrib*dcos(alpr)

       end if

       end do

c      Dibuixa punt central de control de costura AD

       alpl=-(datan((pl1y(i,1)-pl2y(i,20))/(pl1x(i,1)-pl2x(i,20))))
       if (alpl.lt.0.) then
       alpl=alpl+pi
       end if

       xpx=(pl1x(i,1)+pl2x(i,20))/2.-xdes*dsin(alpl)
       xpy=(pl1y(i,1)+pl2y(i,20))/2.-xdes*dcos(alpl)

       call point(psep+xpx,psey+xpy,3)

       alpr=-(datan((pr1y(i,1)-pr2y(i,20))/(pr1x(i,1)-pr2x(i,20))))
       if (alpr.lt.0.) then
       alpr=alpr+pi
       end if

       xpx=(pr1x(i,1)+pr2x(i,20))/2.+xdes*dsin(alpr)
       xpy=(pr1y(i,1)+pr2y(i,20))/2.+xdes*dcos(alpr)

       call point(psep+xpx,psey+xpy,1)


c      Etiqueta cintes en romans AD

       pi=4.0d0*datan(1.0d0)

       xpx=(pl1x(i,1)+pl2x(i,20))/2.-xdes*dsin(alpl)
       xpy=(pl1y(i,1)+pl2y(i,20))/2.-xdes*dcos(alpl)

c       alpl=(datan((pl2y(i,20)-pl1y(i,1))/(pl2x(i,20)-pl1x(i,1))))

c      write (*,*) "romano", hvr(k,3), hvr(k,4), xvrib, alpl

       xpx2=psep+xpx+0.4*hvr(k,7)*dcos(alpl)-0.6*xvrib*dsin(alpl)
       xpy2=psey+xpy-0.4*hvr(k,7)*dsin(alpl)-0.6*xvrib*dcos(alpl)
       
       call romano(int(hvr(k,3)),xpx2,xpy2,alpl,typm6(10)*0.1,7)

       xpx2=psep+xpx-0.6*hvr(k,7)*dcos(alpl)-0.6*xvrib*dsin(alpl)
       xpy2=psey+xpy+0.6*hvr(k,7)*dsin(alpl)-0.6*xvrib*dcos(alpl)
       
       call romano(int(hvr(k,4)),xpx2,xpy2,alpl,typm6(10)*0.1,7)

c       call line(psep+xpx,psey+xpy,psep+xpx+4.*dcos(alpl),
c     + psey+xpy+4.*dsin(alpl),1)

c      H-rib length
       hvr(k,15)=dsqrt((lvcx(i,1)-rvcx(i,1))**2.+
     + (lvcy(i,1)-rvcy(i,1))**2.)
     
c      Numera cintes H en decimals (VH type 1)
       call itxt(psep-xrsep+83.*xkf-120.*(typm3(10)/10.),psey-10,
     + typm3(10),0.0d0,i,7)
       call itxt(psep+hvr(k,15)-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i+1,7)

       pi=4.0d0*datan(1.0d0)

c      Dibuixa vores amb segments completament enllaçats       

       do j=1,20

       call line(lvcx(i,j),lvcy(i,j),lvcx(i,j+1),lvcy(i,j+1),30)
       call line(rvcx(i,j),rvcy(i,j),rvcx(i,j+1),rvcy(i,j+1),30)

       end do

       end if

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.2 V ribs partial (Type 2)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,2).eq.2) then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.2.1 Rib i
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Define main points

       i=hvr(k,3)    ! rib i
       ii=hvr(k,4)   ! row ii

       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,1)=ucnt(i,ii,3)-hvr(k,8)
       ucnt(i,ii,2)=ucnt(i,ii,3)-hvr(k,7)
       ucnt(i,ii,4)=ucnt(i,ii,3)+hvr(k,7)
       ucnt(i,ii,5)=ucnt(i,ii,3)+hvr(k,8)
       ucnt(i,ii,6)=ucnt(i,ii,1)
       ucnt(i,ii,7)=ucnt(i,ii,3)
       ucnt(i,ii,8)=ucnt(i,ii,5)
       ucnt(i,ii,9)=ucnt(i,ii,1)
       ucnt(i,ii,10)=ucnt(i,ii,3)
       ucnt(i,ii,11)=ucnt(i,ii,5)


c      Points 2,3,4 interpolation in rib i
       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,2).and.u(i,j+1,3).ge.ucnt(i,ii,2)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,2)=xm*ucnt(i,ii,2)+xb
       jcon(i,ii,2)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       jcon(i,ii,3)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,4).and.u(i,j+1,3).ge.ucnt(i,ii,4)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,4)=xm*ucnt(i,ii,4)+xb
       jcon(i,ii,4)=j
       end if

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat line 2-3-4 in n regular spaces   
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       uinc=0.
       vinc=0.

       do j=1,21
       ucnt2(i,ii,j)=ucnt(i,ii,2)+uinc
       uinc=uinc+(ucnt(i,ii,4)-ucnt(i,ii,2))/20.

c      Between 2 and jcon(i,ii,2)+1
       if (ucnt2(i,ii,j).le.u(i,jcon(i,ii,2)+1,3)) then
       xm=(v(i,jcon(i,ii,2)+1,3)-vcnt(i,ii,2))/(u(i,jcon(i,ii,2)+1,3)-
     + ucnt(i,ii,2))
       xb=vcnt(i,ii,2)-xm*ucnt(i,ii,2)
       vcnt2(i,ii,j)=xm*ucnt2(i,ii,j)+xb
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Between jcon(i,ii,2)+1 and jcon(i,ii,4)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ucnt2(i,ii,j).ge.u(i,jcon(i,ii,2)+1,3).and.ucnt2(i,ii,j)
     + .le.u(i,jcon(i,ii,4),3)) then
c      
       do l=jcon(i,ii,2)+1,jcon(i,ii,4)-1

c      Seleccionar tram d'interpolació

       if (ucnt2(i,ii,j).ge.u(i,l,3).and.ucnt2(i,ii,j).le.u(i,l+1,3)) 
     + then
       xm=(v(i,l+1,3)-v(i,l,3))/(u(i,l+1,3)-u(i,l,3))
       xb=v(i,l,3)-xm*u(i,l,3)
       end if
       end do
c       xm=(v(i,jcon(i,ii,2)+j,3)-v(i,jcon(i,ii,2)+j-1,3))/
c     + (u(i,jcon(i,ii,2)+j,3)-u(i,jcon(i,ii,2)+j-1,3))
c       xb=v(i,jcon(i,ii,2)+j-1,3)-xm*u(i,jcon(i,ii,2)+j-1,3)
       vcnt2(i,ii,j)=xm*ucnt2(i,ii,j)+xb
       end if

c      Between jcon(i,ii,4) and 4       
       if (ucnt2(i,ii,j).gt.u(i,jcon(i,ii,4),3)) then
       xm=(vcnt(i,ii,4)-v(i,jcon(i,ii,4),3))/(ucnt(i,ii,4)-
     + u(i,jcon(i,ii,4),3))
       xb=vcnt(i,ii,4)-xm*ucnt(i,ii,4)
       vcnt2(i,ii,j)=xm*ucnt2(i,ii,j)+xb
       end if

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.2.2 Rib i-1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)-1
       ii=hvr(k,4)

       hvr(k,19)=hvr(k,8)+hvr(k,15)

       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,1)=ucnt(i,ii,3)-hvr(k,19)
       ucnt(i,ii,2)=ucnt(i,ii,3)-hvr(k,7)
       ucnt(i,ii,4)=ucnt(i,ii,3)+hvr(k,7)
       ucnt(i,ii,5)=ucnt(i,ii,3)+hvr(k,19)
       ucnt(i,ii,6)=ucnt(i,ii,1)
       ucnt(i,ii,7)=ucnt(i,ii,3)
       ucnt(i,ii,8)=ucnt(i,ii,5)
       ucnt(i,ii,9)=ucnt(i,ii,1)
       ucnt(i,ii,10)=ucnt(i,ii,3)
       ucnt(i,ii,11)=ucnt(i,ii,5)

c      Points 1,3,5 interpolation in rib i-1
       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,1).and.u(i,j+1,3).ge.ucnt(i,ii,1)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,1)=xm*ucnt(i,ii,1)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,5).and.u(i,j+1,3).ge.ucnt(i,ii,5)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,5)=xm*ucnt(i,ii,5)+xb
       end if

       end do

c      Points 9,10,11 interpolation in rib i-1
       do j=1,np(i,2)

       if (u(i,j,3).ge.ucnt(i,ii,9).and.u(i,j+1,3).le.ucnt(i,ii,9)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,9)=xm*ucnt(i,ii,9)+xb
       end if

       if (u(i,j,3).ge.ucnt(i,ii,10).and.u(i,j+1,3).le.ucnt(i,ii,10)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,10)=xm*ucnt(i,ii,10)+xb
       end if

       if (u(i,j,3).ge.ucnt(i,ii,11).and.u(i,j+1,3).le.ucnt(i,ii,11)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,11)=xm*ucnt(i,ii,11)+xb
       end if

       end do

c      Calculus of 6,7,8 points in rib i-1
       vcnt(i,ii,6)=(vcnt(i,ii,9)-vcnt(i,ii,1))*(hvr(k,9)/100.)+
     + vcnt(i,ii,1)
       vcnt(i,ii,7)=(vcnt(i,ii,10)-vcnt(i,ii,3))*(hvr(k,9)/100.)+
     + vcnt(i,ii,3)
       vcnt(i,ii,8)=(vcnt(i,ii,11)-vcnt(i,ii,5))*(hvr(k,9)/100.)+
     + vcnt(i,ii,5)

c      Redefinition of points 6,8 if angle is not 90 

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      AQUÍ ÉS EL PROBLEMA!!!!!!!!!!!!!!
c      no és hvr(k,8) ans una valor afectat per hvr(k,17).... o similar!!!!
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

    
       if (hvr(k,10).ne.90.) then
       ucnt(i,ii,6)=ucnt(i,ii,7)-hvr(k,19)*dcos((pi/180.)*hvr(k,10))
       ucnt(i,ii,8)=ucnt(i,ii,7)+hvr(k,19)*dcos((pi/180.)*hvr(k,10))
       vcnt(i,ii,6)=vcnt(i,ii,7)-hvr(k,19)*dsin((pi/180.)*hvr(k,10))
       vcnt(i,ii,8)=vcnt(i,ii,7)+hvr(k,19)*dsin((pi/180.)*hvr(k,10))
       end if

c      Divide line 6-8 in n segments

       uinc=0.
       vinc=0.
       do j=1,21
       ucnt1(i,ii,j)=ucnt(i,ii,6)+uinc
       uinc=uinc+(ucnt(i,ii,8)-ucnt(i,ii,6))/20.
       vcnt1(i,ii,j)=vcnt(i,ii,6)+vinc
       vinc=vinc+(vcnt(i,ii,8)-vcnt(i,ii,6))/20.
       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.2.3 Rib i+1
cccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)+1
       ii=hvr(k,4)

       hvr(k,19)=hvr(k,8)+hvr(k,17)

       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,1)=ucnt(i,ii,3)-hvr(k,19)
       ucnt(i,ii,2)=ucnt(i,ii,3)-hvr(k,7)
       ucnt(i,ii,4)=ucnt(i,ii,3)+hvr(k,7)
       ucnt(i,ii,5)=ucnt(i,ii,3)+hvr(k,19)
       ucnt(i,ii,6)=ucnt(i,ii,1)
       ucnt(i,ii,7)=ucnt(i,ii,3)
       ucnt(i,ii,8)=ucnt(i,ii,5)
       ucnt(i,ii,9)=ucnt(i,ii,1)
       ucnt(i,ii,10)=ucnt(i,ii,3)
       ucnt(i,ii,11)=ucnt(i,ii,5)

c      NOTE: uso hvr(k,17) car hvr(k,16) no donava be
c       write (*,*) "2>",hvr(k,1),hvr(k,15),hvr(k,8),hvr(k,17)


c      Points 1,3,5 interpolation in rib i+1
       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,1).and.u(i,j+1,3).ge.ucnt(i,ii,1)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,1)=xm*ucnt(i,ii,1)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,5).and.u(i,j+1,3).ge.ucnt(i,ii,5)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,5)=xm*ucnt(i,ii,5)+xb
       end if

       end do

c      Points 9,10,11 interpolation in rib i+1
       do j=1,np(i,2)

       if (u(i,j,3).ge.ucnt(i,ii,9).and.u(i,j+1,3).le.ucnt(i,ii,9)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,9)=xm*ucnt(i,ii,9)+xb
       end if

       if (u(i,j,3).ge.ucnt(i,ii,10).and.u(i,j+1,3).le.ucnt(i,ii,10)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,10)=xm*ucnt(i,ii,10)+xb
       end if

       if (u(i,j,3).ge.ucnt(i,ii,11).and.u(i,j+1,3).le.ucnt(i,ii,11)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,11)=xm*ucnt(i,ii,11)+xb
       end if

       end do

c      Calculus of 6,7,8 points in rib i+1
       vcnt(i,ii,6)=(vcnt(i,ii,9)-vcnt(i,ii,1))*(hvr(k,9)/100.)+
     + vcnt(i,ii,1)
       vcnt(i,ii,7)=(vcnt(i,ii,10)-vcnt(i,ii,3))*(hvr(k,9)/100.)+
     + vcnt(i,ii,3)
       vcnt(i,ii,8)=(vcnt(i,ii,11)-vcnt(i,ii,5))*(hvr(k,9)/100.)+
     + vcnt(i,ii,5)

c      Redefinition of points 6,8 if angle is not 90     
       if (hvr(k,10).ne.90.) then
       ucnt(i,ii,6)=ucnt(i,ii,7)-hvr(k,19)*dcos((pi/180.)*hvr(k,10))
       ucnt(i,ii,8)=ucnt(i,ii,7)+hvr(k,19)*dcos((pi/180.)*hvr(k,10))
       vcnt(i,ii,6)=vcnt(i,ii,7)-hvr(k,19)*dsin((pi/180.)*hvr(k,10))
       vcnt(i,ii,8)=vcnt(i,ii,7)+hvr(k,19)*dsin((pi/180.)*hvr(k,10))
       end if

c      Divide line 6-8 in n segments

       uinc=0.
       vinc=0.
       do j=1,21
       ucnt3(i,ii,j)=ucnt(i,ii,6)+uinc
       uinc=uinc+(ucnt(i,ii,8)-ucnt(i,ii,6))/20.
       vcnt3(i,ii,j)=vcnt(i,ii,6)+vinc
       vinc=vinc+(vcnt(i,ii,8)-vcnt(i,ii,6))/20.
       end do

c      Rib localisation
       i=hvr(k,3)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.2.4 V-ribs lines 1 2 3 transportation to 3D espace
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Rib i-1 (Line 1)

       i=hvr(k,3)-1

       tetha=rib(i,8)*pi/180.

       do j=1,21
       ru(i,j,3)=ucnt1(i,ii,j)
       rv(i,j,3)=vcnt1(i,ii,j)-rib(i,50)
       end do

       do j=1,21

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       rx1(i+1,j,ii)=rx(i,j)
       ry1(i+1,j,ii)=ry(i,j)
       rz1(i+1,j,ii)=rz(i,j)

       end do

c      Rib i (Line 2)

       i=hvr(k,3)

       tetha=rib(i,8)*pi/180.
       
       do j=1,21
       ru(i,j,3)=ucnt2(i,ii,j)
       rv(i,j,3)=vcnt2(i,ii,j)-rib(i,50)
       end do

       do j=1,21

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       rx2(i,j,ii)=rx(i,j)
       ry2(i,j,ii)=ry(i,j)
       rz2(i,j,ii)=rz(i,j)

       end do

c      Rib i+1 (Line 3)

       i=hvr(k,3)+1

       tetha=rib(i,8)*pi/180.

       do j=1,21
       ru(i,j,3)=ucnt3(i,ii,j)
       rv(i,j,3)=vcnt3(i,ii,j)-rib(i,50)
c      COMPTE AMB el rib(i,50) A ESTUDIAR       
       end do

       do j=1,21

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       rx3(i-1,j,ii)=rx(i,j)
       ry3(i-1,j,ii)=ry(i,j)
       rz3(i-1,j,ii)=rz(i,j)

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.2.5.X V-ribs 1-2 and 2-3 in 3D model
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Return to rib i
       i=hvr(k,3)

c      Rib 1-2 (blue)

       if (hvr(k,5).eq.1) then
       do j=1,21
       call line3d(rx1(i,j,ii),ry1(i,j,ii),rz1(i,j,ii),
     + rx2(i,j,ii),ry2(i,j,ii),rz2(i,j,ii),5)
       call line3d(-rx1(i,j,ii),ry1(i,j,ii),rz1(i,j,ii),
     + -rx2(i,j,ii),ry2(i,j,ii),rz2(i,j,ii),5)
       end do
       end if

c      Rib 2-3 (red)
       if (hvr(k,6).eq.1) then
       do j=1,21
       call line3d(rx3(i,j,ii),ry3(i,j,ii),rz3(i,j,ii),
     + rx2(i,j,ii),ry2(i,j,ii),rz2(i,j,ii),1)
       call line3d(-rx3(i,j,ii),ry3(i,j,ii),rz3(i,j,ii),
     + -rx2(i,j,ii),ry2(i,j,ii),rz2(i,j,ii),1)
       end do
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.2.5 V-ribs calculus and drawing in 3D and 2D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.2.5.1 V-rib 1-2 in 2D model (blue)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)-1

       px0=0.
       py0=0.
       ptheta=0.

       do j=1,21

c      Distances between points
       pa=dsqrt((rx(i+1,j)-rx(i,j))**2.+(ry(i+1,j)-ry(i,j))**2.+
     + (rz(i+1,j)-rz(i,j))**2.)
       pb=dsqrt((rx(i+1,j+1)-rx(i,j))**2.+(ry(i+1,j+1)-ry(i,j))**2.+
     + (rz(i+1,j+1)-rz(i,j))**2.)
       pc=dsqrt((rx(i+1,j+1)-rx(i+1,j))**2.+(ry(i+1,j+1)-ry(i+1,j))**2.+
     + (rz(i+1,j+1)-rz(i+1,j))**2.)
       pd=dsqrt((rx(i+1,j)-rx(i,j+1))**2.+(ry(i+1,j)-ry(i,j+1))**2.+
     + (rz(i+1,j)-rz(i,j+1))**2.)
       pe=dsqrt((rx(i,j+1)-rx(i,j))**2.+(ry(i,j+1)-ry(i,j))**2.+
     + (rz(i,j+1)-rz(i,j))**2.)
       pf=dsqrt((rx(i+1,j+1)-rx(i,j+1))**2.+(ry(i+1,j+1)-ry(i,j+1))**2.+
     + (rz(i+1,j+1)-rz(i,j+1))**2.)
       
       pa2r=(pa*pa-pb*pb+pc*pc)/(2.*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

       pb2t=(pb*pb-pe*pe+pf*pf)/(2.*pb)
       pb1t=pb-pb2t
       pht=dsqrt(pf*pf-pb2t*pb2t)
       
       pw1=datan(phr/pa1r)
       phu=pb1t*dtan(pw1)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0
       
       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

c      Iteration
       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))
       
       end do

c      Drawing in 2D model
       
       psep=3300.*xkf+xrsep*float(i)
       psey=800.*xkf+yrsep*float(ii)

       if (hvr(k,5).eq.1) then

       j=1

c      Costat vora atac
       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),5)

       j=21
c      Costat fuga
       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),5)

c      Marca punts MC a l'esquerra

       alpha=-(datan((pl1y(i,1)-pl2y(i,20))/(pl1x(i,1)-pl2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp6=pl1x(i,1)-xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp6=pl1y(i,1)-xdes*dcos(alpha)+2.*xdes*dsin(alpha)
       xp8=pl1x(i,21)-xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp8=pl1y(i,21)-xdes*dcos(alpha)-2.*xdes*dsin(alpha)
       xp7=0.5*(xp6+xp8)
       yp7=0.5*(yp6+yp8)

       call point(psep+xp6,psey+yp6,1)
       call point(psep+xp7,psey+yp7,1)
       call point(psep+xp8,psey+yp8,1)

c     Romano costat esquerra

      sl=1.
       
      xpx=(pl1x(i,1)+pl2x(i,20))/2.-xdes*dsin(alpha)
      xpy=(pl1y(i,1)+pl2y(i,20))/2.-xdes*dcos(alpha)

      xpx2=psep+xpx+0.5*hvr(k,8)*dcos(alpha)-0.3*xvrib*dsin(alpha)
      xpy2=psey+xpy-0.5*hvr(k,8)*dsin(alpha)-0.3*xvrib*dcos(alpha) 

      call romano(i,xpx2,xpy2,alpha,typm6(10)*0.1,7)

      xpx2=psep+xpx-0.5*hvr(k,8)*dcos(alpha)-0.3*xvrib*dsin(alpha)
      xpy2=psey+xpy+0.5*hvr(k,8)*dsin(alpha)-0.3*xvrib*dcos(alpha) 

      call romano(int(hvr(k,4)),xpx2,xpy2,alpha,typm6(10)*0.1,7)


c      Marca punts MC a la dreta

       alpha=-(datan((pr1y(i,1)-pr2y(i,20))/(pr1x(i,1)-pr2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp7=0.5*(pr1x(i,1)+pr2x(i,20))+xdes*dsin(alpha)
       yp7=0.5*(pr1y(i,1)+pr2y(i,20))+xdes*dcos(alpha)

       call point(psep+xp7,psey+yp7,3)


c     Romano costat dret

      sr=1.
       
      xpx=(pr1x(i,1)+pr2x(i,20))/2.+xdes*dsin(alpha)
      xpy=(pr1y(i,1)+pr2y(i,20))/2.+xdes*dcos(alpha)

      xpx2=psep+xpx+0.3*hvr(k,7)*dcos(alpha)+0.3*xvrib*dsin(alpha)
      xpy2=psey+xpy-0.3*hvr(k,7)*dsin(alpha)+0.3*xvrib*dcos(alpha) 

      call romano(i+1,xpx2,xpy2,alpha,typm6(10)*0.1,7)
       
       do j=1,21-1

c      Vores de costura esquerra
       alpl=-(datan((pl1y(i,j)-pl2y(i,j))/(pl1x(i,j)-pl2x(i,j))))
       if (alpl.lt.0.) then
       alpl=alpl+pi
       end if

       lvcx(i,j)=psep+pl1x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j)=psey+pl1y(i,j)-xvrib*dcos(alpl)

c      Vores de costura dreta
       alpr=-(datan((pr1y(i,j)-pr2y(i,j))/(pr1x(i,j)-pr2x(i,j))))
       if (alpr.lt.0.) then
       alpr=alpr+pi
       end if

       rvcx(i,j)=psep+pr1x(i,j)+xvrib*dsin(alpr)
       rvcy(i,j)=psey+pr1y(i,j)+xvrib*dcos(alpr)

c      Tancament lateral inici
       if (j.eq.1) then
       call line(psep+pl1x(i,j)-xvrib*dsin(alpl),psey+pl1y(i,j)
     + -xvrib*dcos(alpl),psep+pl1x(i,j),psey+pl1y(i,j),5)
       call line(psep+pr1x(i,j)+xvrib*dsin(alpr),psey+pr1y(i,j)
     + +xvrib*dcos(alpr),psep+pr1x(i,j),psey+pr1y(i,j),5)
       end if

c      Tancament lateral fi
       if (j.eq.20) then
       call line(psep+pl2x(i,j)-xvrib*dsin(alpl),psey+pl2y(i,j)
     + -xvrib*dcos(alpl),psep+pl2x(i,j),psey+pl2y(i,j),5)
       call line(psep+pr2x(i,j)+xvrib*dsin(alpr),psey+pr2y(i,j)
     + +xvrib*dcos(alpr),psep+pr2x(i,j),psey+pr2y(i,j),5)

       lvcx(i,j+1)=psep+pl2x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j+1)=psey+pl2y(i,j)-xvrib*dcos(alpl)

       rvcx(i,j+1)=psep+pr2x(i,j)+xvrib*dsin(alpr)
       rvcy(i,j+1)=psey+pr2y(i,j)+xvrib*dcos(alpr)

       end if

c      V-rib length
       hvr(k,15)=dsqrt((lvcx(i,1)-rvcx(i,1))**2.+
     + (lvcy(i,1)-rvcy(i,1))**2.)

c      Numera cintes V (Type 2 left side, blue)
       call itxt(psep-xrsep+83.*xkf-120.*(typm3(10)/10.),psey-10,
     + typm3(10),0.0d0,i,7)
       call itxt(psep+hvr(k,15)-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i+1,7)
   
       end do

c      Dibuixa vores amb segments completament enllaçats       
       do j=1,20

       call line(lvcx(i,j),lvcy(i,j),lvcx(i,j+1),lvcy(i,j+1),5)
       call line(rvcx(i,j),rvcy(i,j),rvcx(i,j+1),rvcy(i,j+1),5)

       end do

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.2.5.2 V-rib 2-3 in 2D model (red)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)

       px0=0.
       py0=0.
       ptheta=0.

       do j=1,21

c      Distances between points
       pa=dsqrt((rx(i+1,j)-rx(i,j))**2.+(ry(i+1,j)-ry(i,j))**2.+
     + (rz(i+1,j)-rz(i,j))**2.)
       pb=dsqrt((rx(i+1,j+1)-rx(i,j))**2.+(ry(i+1,j+1)-ry(i,j))**2.+
     + (rz(i+1,j+1)-rz(i,j))**2.)
       pc=dsqrt((rx(i+1,j+1)-rx(i+1,j))**2.+(ry(i+1,j+1)-ry(i+1,j))**2.+
     + (rz(i+1,j+1)-rz(i+1,j))**2.)
       pd=dsqrt((rx(i+1,j)-rx(i,j+1))**2.+(ry(i+1,j)-ry(i,j+1))**2.+
     + (rz(i+1,j)-rz(i,j+1))**2.)
       pe=dsqrt((rx(i,j+1)-rx(i,j))**2.+(ry(i,j+1)-ry(i,j))**2.+
     + (rz(i,j+1)-rz(i,j))**2.)
       pf=dsqrt((rx(i+1,j+1)-rx(i,j+1))**2.+(ry(i+1,j+1)-ry(i,j+1))**2.+
     + (rz(i+1,j+1)-rz(i,j+1))**2.)
       
       pa2r=(pa*pa-pb*pb+pc*pc)/(2.*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

       pb2t=(pb*pb-pe*pe+pf*pf)/(2.*pb)
       pb1t=pb-pb2t
       pht=dsqrt(pf*pf-pb2t*pb2t)
       
       pw1=datan(phr/pa1r)
       phu=pb1t*dtan(pw1)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0
       
       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

c      Iteration
       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))
       
       
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Drawing in 2D model
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
       psep=3300.*xkf+xrsep*float(i)
       psey=800.*xkf+yrsep*float(ii)

       if (hvr(k,6).eq.1) then

       j=1

c      Costat vora d'atac
       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),1)

       j=21
c      Costat fuga
       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),1)


c      Marca punts MC a l'esquerra

       alpha=-(datan((pl1y(i,1)-pl2y(i,20))/(pl1x(i,1)-pl2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp7=0.5*(pl1x(i,1)+pl1x(i,21))-xdes*dsin(alpha)
       yp7=0.5*(pl1y(i,1)+pl1y(i,21))-xdes*dcos(alpha)

       call point(psep+xp7,psey+yp7,1)

c      Romano costat esquerra

       sl=1.
       
       xpx=(pl1x(i,1)+pl2x(i,20))/2.-sl*xdes*dsin(alpha)
       xpy=(pl1y(i,1)+pl2y(i,20))/2.-sl*xdes*dcos(alpha)

       xpx2=psep+xpx+0.3*hvr(k,7)*dcos(alpha)-0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy-0.3*hvr(k,7)*dsin(alpha)-0.3*xvrib*dcos(alpha) 

       call romano(i,xpx2,xpy2,alpha,typm6(10)*0.1,7)

c      Marca punts MC a la dreta

       alpha=-(datan((pr1y(i,1)-pr2y(i,20))/(pr1x(i,1)
     + -pr2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp6=pr1x(i,1)+xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp6=pr1y(i,1)+xdes*dcos(alpha)+2.*xdes*dsin(alpha)
       xp8=pr1x(i,21)+xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp8=pr1y(i,21)+xdes*dcos(alpha)-2.*xdes*dsin(alpha)
       xp7=0.5*(xp6+xp8)
       yp7=0.5*(yp6+yp8)

       call point(psep+xp6,psey+yp6,1)
       call point(psep+xp7,psey+yp7,1)
       call point(psep+xp8,psey+yp8,1)

c      Romano costat dret

       sr=1.
       
       xpx=(pr1x(i,1)+pr2x(i,20))/2.+xdes*dsin(alpha)
       xpy=(pr1y(i,1)+pr2y(i,20))/2.+xdes*dcos(alpha)

       xpx2=psep+xpx+0.5*hvr(k,8)*dcos(alpha)+0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy-0.5*hvr(k,8)*dsin(alpha)+0.3*xvrib*dcos(alpha) 

       call romano(i+1,xpx2,xpy2,alpha,typm6(10)*0.1,7)

       xpx2=psep+xpx-0.5*hvr(k,8)*dcos(alpha)+0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy+0.5*hvr(k,8)*dsin(alpha)+0.3*xvrib*dcos(alpha) 

       call romano(int(hvr(k,4)),xpx2,xpy2,alpha,typm6(10)*0.1,7)

c      Vores de costura

       do j=1,21-1

c      Vores de costura esquerra
       alpl=-(datan((pl1y(i,j)-pl2y(i,j))/(pl1x(i,j)-pl2x(i,j))))
       if (alpl.lt.0.) then
       alpl=alpl+pi
       end if

       lvcx(i,j)=psep+pl1x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j)=psey+pl1y(i,j)-xvrib*dcos(alpl)

c      Vores de costura dreta
       alpr=-(datan((pr1y(i,j)-pr2y(i,j))/(pr1x(i,j)-pr2x(i,j))))
       if (alpr.lt.0.) then
       alpr=alpr+pi
       end if

       rvcx(i,j)=psep+pr1x(i,j)+xvrib*dsin(alpr)
       rvcy(i,j)=psey+pr1y(i,j)+xvrib*dcos(alpr)

c      Tancament lateral inici
       if (j.eq.1) then
       call line(psep+pl1x(i,j)-xvrib*dsin(alpl),psey+pl1y(i,j)
     + -xvrib*dcos(alpl),psep+pl1x(i,j),psey+pl1y(i,j),1)
       call line(psep+pr1x(i,j)+xvrib*dsin(alpr),psey+pr1y(i,j)
     + +xvrib*dcos(alpr),psep+pr1x(i,j),psey+pr1y(i,j),1)
       end if

c      Tancament lateral fi
       if (j.eq.20) then
       call line(psep+pl2x(i,j)-xvrib*dsin(alpl),psey+pl2y(i,j)
     + -xvrib*dcos(alpl),psep+pl2x(i,j),psey+pl2y(i,j),1)
       call line(psep+pr2x(i,j)+xvrib*dsin(alpr),psey+pr2y(i,j)
     + +xvrib*dcos(alpr),psep+pr2x(i,j),psey+pr2y(i,j),1)

       lvcx(i,j+1)=psep+pl2x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j+1)=psey+pl2y(i,j)-xvrib*dcos(alpl)

       rvcx(i,j+1)=psep+pr2x(i,j)+xvrib*dsin(alpr)
       rvcy(i,j+1)=psey+pr2y(i,j)+xvrib*dcos(alpr)

       end if

c      Numera cintes V
c       call itxt(psep-20-xrsep,psey-10,10.0d0,0.0d0,i,7)
c       call itxt(psep+20-xrsep,psey-10,10.0d0,0.0d0,i+1,7)

c      V-rib length
       hvr(k,15)=dsqrt((lvcx(i,1)-rvcx(i,1))**2.+
     + (lvcy(i,1)-rvcy(i,1))**2.)

c      Numera cintes V (Type 2 right side, red)
       call itxt(psep-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i,7)
       call itxt(psep+hvr(k,15)-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i+1,7)

       end do

c      Dibuixa vores amb segments completament enllaçats       
       do j=1,20

       call line(lvcx(i,j),lvcy(i,j),lvcx(i,j+1),lvcy(i,j+1),1)
       call line(rvcx(i,j),rvcy(i,j),rvcx(i,j+1),rvcy(i,j+1),1)

       end do

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.2.5.3 Drawing V-ribs in 2D ribs, Print and MC
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Box (1,2)

       sepxx=700.*xkf
       sepyy=100.*xkf

c      Rib i-1
       kx=int((float(i-2)/6.))
       ky=i-1-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

       if (hvr(k,5).eq.1) then

c      Segment
       call line(sepx+ucnt(i-1,ii,6),-vcnt(i-1,ii,6)+sepy,
     + sepx+ucnt(i-1,ii,8),-vcnt(i-1,ii,8)+sepy,1)
       call line(sepx+2530.*xkf+ucnt(i-1,ii,6),-vcnt(i-1,ii,6)+sepy,
     + sepx+2530.*xkf+ucnt(i-1,ii,8),-vcnt(i-1,ii,8)+sepy,1)

c      Punts marcatge V-rib
       alpha=datan((vcnt(i-1,ii,8)-vcnt(i-1,ii,6))/
     + (ucnt(i-1,ii,8)-ucnt(i-1,ii,6)))
       xp6=ucnt(i-1,ii,6)-xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp6=vcnt(i-1,ii,6)+xdes*dcos(alpha)+2.*xdes*dsin(alpha)
       xp8=ucnt(i-1,ii,8)-xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp8=vcnt(i-1,ii,8)+xdes*dcos(alpha)-2.*xdes*dsin(alpha)
       xp7=0.5*(xp6+xp8)
       yp7=0.5*(yp6+yp8)
       call point(sepx+xp6,sepy-yp6,1)
       call point(sepx+xp7,sepy-yp7,1)
       call point(sepx+xp8,sepy-yp8,1)
       call point(sepx+2530.*xkf+xp6,sepy-yp6,1)
       call point(sepx+2530.*xkf+xp7,sepy-yp7,1)
       call point(sepx+2530.*xkf+xp8,sepy-yp8,1)

       end if

c      Rib i (center)

       kx=int((float(i-1)/6.))
       ky=i-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

       call line(sepx+ucnt(i,ii,2),-vcnt(i,ii,2)+sepy,
     + sepx+ucnt(i,ii,4),-vcnt(i,ii,4)+sepy,4)

c      Rib i+1
       kx=int((float(i)/6.))
       ky=i+1-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

       if (hvr(k,6).eq.1) then

c      Segment
       call line(sepx+ucnt(i+1,ii,6),-vcnt(i+1,ii,6)+sepy,
     + sepx+ucnt(i+1,ii,8),-vcnt(i+1,ii,8)+sepy,5)
       call line(sepx+2530.*xkf+ucnt(i+1,ii,6),-vcnt(i+1,ii,6)+sepy,
     + sepx+2530.*xkf+ucnt(i+1,ii,8),-vcnt(i+1,ii,8)+sepy,5)

c      Punts marcatge V-rib
       alpha=datan((vcnt(i+1,ii,8)-vcnt(i+1,ii,6))/
     + (ucnt(i+1,ii,8)-ucnt(i+1,ii,6)))
       xp6=ucnt(i+1,ii,6)-xdes*dsin(alpha)
       yp6=vcnt(i+1,ii,6)+xdes*dcos(alpha)
       xp8=ucnt(i+1,ii,8)-xdes*dsin(alpha)
       yp8=vcnt(i+1,ii,8)+xdes*dcos(alpha)
       xp7=0.5*(xp6+xp8)
       yp7=0.5*(yp6+yp8)
       call point(sepx+xp6,sepy-yp6,1)
       call point(sepx+xp7,sepy-yp7,1)
       call point(sepx+xp8,sepy-yp8,1)
       call point(sepx+2530.*xkf+xp6,sepy-yp6,1)
       call point(sepx+2530.*xkf+xp7,sepy-yp7,1)
       call point(sepx+2530.*xkf+xp8,sepy-yp8,1)

       end if

       end if ! Type 2



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3 V ribs full Type 3
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.1 V-ribs full but independent strips
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.1.1 Rib i
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,2).eq.3) then

c      Define main points 2,3,4,9,10,11

       i=hvr(k,3)    ! rib i
       ii=hvr(k,4)   ! row ii

       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,1)=ucnt(i,ii,3)-hvr(k,8)
       ucnt(i,ii,2)=ucnt(i,ii,3)-hvr(k,7)
       ucnt(i,ii,4)=ucnt(i,ii,3)+hvr(k,7)
       ucnt(i,ii,5)=ucnt(i,ii,3)+hvr(k,8)
       ucnt(i,ii,6)=ucnt(i,ii,1)
       ucnt(i,ii,7)=ucnt(i,ii,3)
       ucnt(i,ii,8)=ucnt(i,ii,5)
       ucnt(i,ii,9)=ucnt(i,ii,1)
       ucnt(i,ii,10)=ucnt(i,ii,3)
       ucnt(i,ii,11)=ucnt(i,ii,5)

c      Points 2,3,4 interpolation in rib i
       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,2).and.u(i,j+1,3).ge.ucnt(i,ii,2)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,2)=xm*ucnt(i,ii,2)+xb
       jcon(i,ii,2)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       jcon(i,ii,3)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,4).and.u(i,j+1,3).ge.ucnt(i,ii,4)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,4)=xm*ucnt(i,ii,4)+xb
       jcon(i,ii,4)=j
       end if

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat line 2-3-4 in n regular spaces   
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       uinc=0.
       vinc=0.

       do j=1,21
       ucnt2(i,ii,j)=ucnt(i,ii,2)+uinc
       uinc=uinc+(ucnt(i,ii,4)-ucnt(i,ii,2))/20.

c      Between 2 and jcon(i,ii,2)+1
       if (ucnt2(i,ii,j).le.u(i,jcon(i,ii,2)+1,3)) then
       xm=(v(i,jcon(i,ii,2)+1,3)-vcnt(i,ii,2))/(u(i,jcon(i,ii,2)+1,3)-
     + ucnt(i,ii,2))
       xb=vcnt(i,ii,2)-xm*ucnt(i,ii,2)
       vcnt2(i,ii,j)=xm*ucnt2(i,ii,j)+xb
       end if

c      Between jcon(i,ii,2)+1 and jcon(i,ii,4)

       if (ucnt2(i,ii,j).ge.u(i,jcon(i,ii,2)+1,3).and.ucnt2(i,ii,j)
     + .le.u(i,jcon(i,ii,4),3)) then
c      
       do l=jcon(i,ii,2)+1,jcon(i,ii,4)-1

c      Seleccionar tram d'interpolació

       if (ucnt2(i,ii,j).ge.u(i,l,3).and.ucnt2(i,ii,j).le.u(i,l+1,3)) 
     + then
       xm=(v(i,l+1,3)-v(i,l,3))/(u(i,l+1,3)-u(i,l,3))
       xb=v(i,l,3)-xm*u(i,l,3)
       end if
       end do
c       xm=(v(i,jcon(i,ii,2)+j,3)-v(i,jcon(i,ii,2)+j-1,3))/
c     + (u(i,jcon(i,ii,2)+j,3)-u(i,jcon(i,ii,2)+j-1,3))
c       xb=v(i,jcon(i,ii,2)+j-1,3)-xm*u(i,jcon(i,ii,2)+j-1,3)
c      !!!!!!!!!!!!!Revisar
       vcnt2(i,ii,j)=xm*ucnt2(i,ii,j)+xb
       end if

c      Between jcon(i,ii,4) and 4       
       if (ucnt2(i,ii,j).gt.u(i,jcon(i,ii,4),3)) then
       xm=(vcnt(i,ii,4)-v(i,jcon(i,ii,4),3))/(ucnt(i,ii,4)-
     + u(i,jcon(i,ii,4),3))
       xb=vcnt(i,ii,4)-xm*ucnt(i,ii,4)
       vcnt2(i,ii,j)=xm*ucnt2(i,ii,j)+xb
       end if

       end do



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.1.2 Rib i-1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)-1
       ii=hvr(k,4)

       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,1)=ucnt(i,ii,3)-(hvr(k,8)+hvr(k,15))
       ucnt(i,ii,2)=ucnt(i,ii,3)-hvr(k,7)
       ucnt(i,ii,4)=ucnt(i,ii,3)+hvr(k,7)
       ucnt(i,ii,5)=ucnt(i,ii,3)+(hvr(k,8)+hvr(k,15))
       ucnt(i,ii,6)=ucnt(i,ii,1)
       ucnt(i,ii,7)=ucnt(i,ii,3)
       ucnt(i,ii,8)=ucnt(i,ii,5)
       ucnt(i,ii,9)=ucnt(i,ii,1)
       ucnt(i,ii,10)=ucnt(i,ii,3)
       ucnt(i,ii,11)=ucnt(i,ii,5)

c      Points 1,3,5 interpolation in rib i-1
       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,1).and.u(i,j+1,3).ge.ucnt(i,ii,1)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,1)=xm*ucnt(i,ii,1)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,5).and.u(i,j+1,3).ge.ucnt(i,ii,5)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,5)=xm*ucnt(i,ii,5)+xb
       end if

       end do

c      Points 9,10,11 interpolation in rib i-1
       do j=1,np(i,2)

       if (u(i,j,3).gt.ucnt(i,ii,9).and.u(i,j+1,3).le.ucnt(i,ii,9)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,9)=xm*ucnt(i,ii,9)+xb
       jcon(i,ii,9)=j+1
       end if

       if (u(i,j,3).gt.ucnt(i,ii,10).and.u(i,j+1,3).le.ucnt(i,ii,10)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,10)=xm*ucnt(i,ii,10)+xb
       jcon(i,ii,10)=j+1
       end if

       if (u(i,j,3).gt.ucnt(i,ii,11).and.u(i,j+1,3).le.ucnt(i,ii,11)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,11)=xm*ucnt(i,ii,11)+xb
       jcon(i,ii,11)=j+1
       end if

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat 9-10-11 in n spaces (rib i-1)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
   
c      Reformat in 20 spaces

       n1vr=jcon(i,ii,9)-jcon(i,ii,11)+1    
       n2vr=20+1

c      Load data polyline
       xlin1(1)=ucnt(i,ii,9)
       ylin1(1)=vcnt(i,ii,9)
       do j=2,n1vr-1
       xlin1(j)=u(i,jcon(i,ii,9)-j+1,3)
       ylin1(j)=v(i,jcon(i,ii,9)-j+1,3)
c      MIRAR SI CAL +-1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       end do
       xlin1(n1vr)=ucnt(i,ii,11)
       ylin1(n1vr)=vcnt(i,ii,11)

c      Call subroutine vector redistribution

       call vredis(xlin1,ylin1,xlin3,ylin3,n1vr,n2vr)

c      Load result polyline

       do j=1,n2vr
       ucnt1(i,ii,j)=xlin3(j)
       vcnt1(i,ii,j)=ylin3(j)
       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.1.3 Rib i+1
cccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)+1
       ii=hvr(k,4)

       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,1)=ucnt(i,ii,3)-(hvr(k,8)+hvr(k,16))
       ucnt(i,ii,2)=ucnt(i,ii,3)-hvr(k,7)
       ucnt(i,ii,4)=ucnt(i,ii,3)+hvr(k,7)
       ucnt(i,ii,5)=ucnt(i,ii,3)+(hvr(k,8)+hvr(k,16))
       ucnt(i,ii,6)=ucnt(i,ii,1)
       ucnt(i,ii,7)=ucnt(i,ii,3)
       ucnt(i,ii,8)=ucnt(i,ii,5)
       ucnt(i,ii,9)=ucnt(i,ii,1)
       ucnt(i,ii,10)=ucnt(i,ii,3)
       ucnt(i,ii,11)=ucnt(i,ii,5)

c      Points 1,3,5 interpolation in rib i+1
       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,1).and.u(i,j+1,3).ge.ucnt(i,ii,1)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,1)=xm*ucnt(i,ii,1)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,5).and.u(i,j+1,3).ge.ucnt(i,ii,5)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,5)=xm*ucnt(i,ii,5)+xb
       end if

       end do

c      Points 9,10,11 interpolation in rib i+1
       do j=1,np(i,2)

       if (u(i,j,3).gt.ucnt(i,ii,9).and.u(i,j+1,3).le.ucnt(i,ii,9)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,9)=xm*ucnt(i,ii,9)+xb
       jcon(i,ii,9)=j+1
       end if

       if (u(i,j,3).gt.ucnt(i,ii,10).and.u(i,j+1,3).le.ucnt(i,ii,10)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,10)=xm*ucnt(i,ii,10)+xb
       jcon(i,ii,10)=j+1
       end if

       if (u(i,j,3).gt.ucnt(i,ii,11).and.u(i,j+1,3).le.ucnt(i,ii,11)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,11)=xm*ucnt(i,ii,11)+xb
       jcon(i,ii,11)=j+1
       end if

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat 9-10-11 in n spaces (rib i+1)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Experimental version     
c      Reformat in 20 spaces

       n1vr=jcon(i,ii,9)-jcon(i,ii,11)+1
       n2vr=20+1

c      Load data polyline
       xlin1(1)=ucnt(i,ii,9)
       ylin1(1)=vcnt(i,ii,9)
       do j=2,n1vr-1
       xlin1(j)=u(i,jcon(i,ii,9)-j+1,3)
       ylin1(j)=v(i,jcon(i,ii,9)-j+1,3)
c      MIRAR SI CAL +-1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       end do
       xlin1(n1vr)=ucnt(i,ii,11)
       ylin1(n1vr)=vcnt(i,ii,11)

c      Call subroutine vector redistribution

       call vredis(xlin1,ylin1,xlin3,ylin3,n1vr,n2vr)

c      Load result polyline

       do j=1,n2vr
       ucnt3(i,ii,j)=xlin3(j)
       vcnt3(i,ii,j)=ylin3(j)
       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Rib localisation
       i=hvr(k,3)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.1.4 V-ribs lines 1 2 3 transportation to 3D espace
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Rib i-1 (Line 1)

       i=hvr(k,3)-1

       tetha=rib(i,8)*pi/180.

       do j=1,21
       ru(i,j,3)=ucnt1(i,ii,j)
       rv(i,j,3)=vcnt1(i,ii,j)-rib(i,50)
       end do

       do j=1,21

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       rx1(i+1,j,ii)=rx(i,j)
       ry1(i+1,j,ii)=ry(i,j)
       rz1(i+1,j,ii)=rz(i,j)

       end do

c      Rib i (Line 2)

       i=hvr(k,3)

       tetha=rib(i,8)*pi/180.
       
       do j=1,21
       ru(i,j,3)=ucnt2(i,ii,j)
       rv(i,j,3)=vcnt2(i,ii,j)-rib(i,50)
       end do

       do j=1,21

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       rx2(i,j,ii)=rx(i,j)
       ry2(i,j,ii)=ry(i,j)
       rz2(i,j,ii)=rz(i,j)

       end do

c      Rib i+1 (Line 3)

       i=hvr(k,3)+1

       tetha=rib(i,8)*pi/180.

       do j=1,21
       ru(i,j,3)=ucnt3(i,ii,j)
       rv(i,j,3)=vcnt3(i,ii,j)-rib(i,50)
c      COMPTE AMB el rib(i,50) A ESTUDIAR       
       end do

       do j=1,21

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       rx3(i-1,j,ii)=rx(i,j)
       ry3(i-1,j,ii)=ry(i,j)
       rz3(i-1,j,ii)=rz(i,j)

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.1.5 V-ribs calculus and drawing in 3D and 2D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.1.5.1 V-rib 1-2 in 2D model (blue)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)-1

       px0=0.
       py0=0.
       ptheta=0.

       do j=1,21

c      Distances between points
       pa=dsqrt((rx(i+1,j)-rx(i,j))**2.+(ry(i+1,j)-ry(i,j))**2.+
     + (rz(i+1,j)-rz(i,j))**2.)
       pb=dsqrt((rx(i+1,j+1)-rx(i,j))**2.+(ry(i+1,j+1)-ry(i,j))**2.+
     + (rz(i+1,j+1)-rz(i,j))**2.)
       pc=dsqrt((rx(i+1,j+1)-rx(i+1,j))**2.+(ry(i+1,j+1)-ry(i+1,j))**2.+
     + (rz(i+1,j+1)-rz(i+1,j))**2.)
       pd=dsqrt((rx(i+1,j)-rx(i,j+1))**2.+(ry(i+1,j)-ry(i,j+1))**2.+
     + (rz(i+1,j)-rz(i,j+1))**2.)
       pe=dsqrt((rx(i,j+1)-rx(i,j))**2.+(ry(i,j+1)-ry(i,j))**2.+
     + (rz(i,j+1)-rz(i,j))**2.)
       pf=dsqrt((rx(i+1,j+1)-rx(i,j+1))**2.+(ry(i+1,j+1)-ry(i,j+1))**2.+
     + (rz(i+1,j+1)-rz(i,j+1))**2.)
       
       pa2r=(pa*pa-pb*pb+pc*pc)/(2.*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

       pb2t=(pb*pb-pe*pe+pf*pf)/(2.*pb)
       pb1t=pb-pb2t
       pht=dsqrt(pf*pf-pb2t*pb2t)
       
       pw1=datan(phr/pa1r)
       phu=pb1t*dtan(pw1)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0
       
       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

c      Iteration
       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))
       
       end do

c      Drawing in 2D model
       
       psep=3300.*xkf+xrsep*float(i)
       psey=800.*xkf+yrsep*float(ii)

       if (hvr(k,5).eq.1) then

       j=1
c      Costat vora atac
       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),5)

       j=21
c      Costat fuga
       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),5)

c      Marca punts MC a l'esquerra

       alpha=-(datan((pl1y(i,1)-pl2y(i,20))/(pl1x(i,1)-pl2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp6=pl1x(i,1)-xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp6=pl1y(i,1)-xdes*dcos(alpha)+2.*xdes*dsin(alpha)
       xp8=pl1x(i,21)-xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp8=pl1y(i,21)-xdes*dcos(alpha)-2.*xdes*dsin(alpha)
       xp7=0.5*(xp6+xp8)
       yp7=0.5*(yp6+yp8)

       call point(psep+xp6,psey+yp6,1)
c       call point(psep+xp7,psey+yp7,1)
       call point(psep+xp8,psey+yp8,1)

c     Romano costat esquerra

      sl=1.
       
      xpx=(pl1x(i,1)+pl2x(i,20))/2.-xdes*dsin(alpha)
      xpy=(pl1y(i,1)+pl2y(i,20))/2.-xdes*dcos(alpha)

      xpx2=psep+xpx+0.5*hvr(k,8)*dcos(alpha)-0.3*xvrib*dsin(alpha)
      xpy2=psey+xpy-0.5*hvr(k,8)*dsin(alpha)-0.3*xvrib*dcos(alpha) 

      call romano(i,xpx2,xpy2,alpha,typm6(10)*0.1,7)

      xpx2=psep+xpx-0.5*hvr(k,8)*dcos(alpha)-0.3*xvrib*dsin(alpha)
      xpy2=psey+xpy+0.5*hvr(k,8)*dsin(alpha)-0.3*xvrib*dcos(alpha) 

      call romano(int(hvr(k,4)),xpx2,xpy2,alpha,typm6(10)*0.1,7)


c      Marca punts MC a la dreta

       alpha=-(datan((pr1y(i,1)-pr2y(i,20))/(pr1x(i,1)-pr2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp7=0.5*(pr1x(i,1)+pr2x(i,20))+xdes*dsin(alpha)
       yp7=0.5*(pr1y(i,1)+pr2y(i,20))+xdes*dcos(alpha)

       call point(psep+xp7,psey+yp7,3)


c     Romano costat dret

      sr=1.
       
      xpx=(pr1x(i,1)+pr2x(i,20))/2.+xdes*dsin(alpha)
      xpy=(pr1y(i,1)+pr2y(i,20))/2.+xdes*dcos(alpha)

      xpx2=psep+xpx+0.3*hvr(k,7)*dcos(alpha)+0.3*xvrib*dsin(alpha)
      xpy2=psey+xpy-0.3*hvr(k,7)*dsin(alpha)+0.3*xvrib*dcos(alpha) 

      call romano(i+1,xpx2,xpy2,alpha,typm6(10)*0.1,7)
       
       do j=1,21-1

c      Vores de costura esquerra
       alpl=-(datan((pl1y(i,j)-pl2y(i,j))/(pl1x(i,j)-pl2x(i,j))))
       if (alpl.lt.0.) then
       alpl=alpl+pi
       end if

       lvcx(i,j)=psep+pl1x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j)=psey+pl1y(i,j)-xvrib*dcos(alpl)

c      Vores de costura dreta
       alpr=-(datan((pr1y(i,j)-pr2y(i,j))/(pr1x(i,j)-pr2x(i,j))))
       if (alpr.lt.0.) then
       alpr=alpr+pi
       end if

       rvcx(i,j)=psep+pr1x(i,j)+xvrib*dsin(alpr)
       rvcy(I,j)=psey+pr1y(i,j)+xvrib*dcos(alpr)

c      Tancament lateral inici
       if (j.eq.1) then
       call line(psep+pl1x(i,j)-xvrib*dsin(alpl),psey+pl1y(i,j)
     + -xvrib*dcos(alpl),psep+pl1x(i,j),psey+pl1y(i,j),5)
       call line(psep+pr1x(i,j)+xvrib*dsin(alpr),psey+pr1y(i,j)
     + +xvrib*dcos(alpr),psep+pr1x(i,j),psey+pr1y(i,j),5)
       end if

c      Tancament lateral fi
       if (j.eq.20) then
       call line(psep+pl2x(i,j)-xvrib*dsin(alpl),psey+pl2y(i,j)
     + -xvrib*dcos(alpl),psep+pl2x(i,j),psey+pl2y(i,j),5)
       call line(psep+pr2x(i,j)+xvrib*dsin(alpr),psey+pr2y(i,j)
     + +xvrib*dcos(alpr),psep+pr2x(i,j),psey+pr2y(i,j),5)

       lvcx(i,j+1)=psep+pl2x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j+1)=psey+pl2y(i,j)-xvrib*dcos(alpl)

       rvcx(i,j+1)=psep+pr2x(i,j)+xvrib*dsin(alpr)
       rvcy(i,j+1)=psey+pr2y(i,j)+xvrib*dcos(alpr)

       end if

c      V-rib length
       hvr(k,15)=dsqrt((lvcx(i,1)-rvcx(i,1))**2.+
     + (lvcy(i,1)-rvcy(i,1))**2.)

c      Numera cintes V Type 3
       call itxt(psep-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i,7)
       call itxt(psep+hvr(k,15)-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i+1,7)
       
       end do

c      Dibuixa vores amb segments completament enllaçats       
       do j=1,20

       call line(lvcx(i,j),lvcy(i,j),lvcx(i,j+1),lvcy(i,j+1),5)
       call line(rvcx(i,j),rvcy(i,j),rvcx(i,j+1),rvcy(i,j+1),5)

       end do

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.1.5.2 V-rib 2-3 in 2D model (red)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)

       px0=0.
       py0=0.
       ptheta=0.

       do j=1,21

c      Distances between points
       pa=dsqrt((rx(i+1,j)-rx(i,j))**2.+(ry(i+1,j)-ry(i,j))**2.+
     + (rz(i+1,j)-rz(i,j))**2.)
       pb=dsqrt((rx(i+1,j+1)-rx(i,j))**2.+(ry(i+1,j+1)-ry(i,j))**2.+
     + (rz(i+1,j+1)-rz(i,j))**2.)
       pc=dsqrt((rx(i+1,j+1)-rx(i+1,j))**2.+(ry(i+1,j+1)-ry(i+1,j))**2.+
     + (rz(i+1,j+1)-rz(i+1,j))**2.)
       pd=dsqrt((rx(i+1,j)-rx(i,j+1))**2.+(ry(i+1,j)-ry(i,j+1))**2.+
     + (rz(i+1,j)-rz(i,j+1))**2.)
       pe=dsqrt((rx(i,j+1)-rx(i,j))**2.+(ry(i,j+1)-ry(i,j))**2.+
     + (rz(i,j+1)-rz(i,j))**2.)
       pf=dsqrt((rx(i+1,j+1)-rx(i,j+1))**2.+(ry(i+1,j+1)-ry(i,j+1))**2.+
     + (rz(i+1,j+1)-rz(i,j+1))**2.)
       
       pa2r=(pa*pa-pb*pb+pc*pc)/(2.*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

       pb2t=(pb*pb-pe*pe+pf*pf)/(2.*pb)
       pb1t=pb-pb2t
       pht=dsqrt(pf*pf-pb2t*pb2t)
       
       pw1=datan(phr/pa1r)
       phu=pb1t*dtan(pw1)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0
       
       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

c      Iteration
       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))
       
       
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Drawing in 2D model
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
       psep=3300.*xkf+xrsep*float(i)
       psey=800.*xkf+yrsep*float(ii)

       if (hvr(k,6).eq.1) then

       j=1

c      Costat vora d'atac
       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),1)

       j=21
c      Costat fuga
       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),1)


c      Marca punts MC a l'esquerra

       alpha=-(datan((pl1y(i,1)-pl2y(i,20))/(pl1x(i,1)-pl2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp7=0.5*(pl1x(i,1)+pl1x(i,21))-xdes*dsin(alpha)
       yp7=0.5*(pl1y(i,1)+pl1y(i,21))-xdes*dcos(alpha)

       call point(psep+xp7,psey+yp7,1)

c      Romano costat esquerra

       sl=1.
       
       xpx=(pl1x(i,1)+pl2x(i,20))/2.-sl*xdes*dsin(alpha)
       xpy=(pl1y(i,1)+pl2y(i,20))/2.-sl*xdes*dcos(alpha)

       xpx2=psep+xpx+0.3*hvr(k,7)*dcos(alpha)-0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy-0.3*hvr(k,7)*dsin(alpha)-0.3*xvrib*dcos(alpha) 

       call romano(i,xpx2,xpy2,alpha,typm6(10)*0.1,7)

c      Marca punts MC a la dreta

       alpha=-(datan((pr1y(i,1)-pr2y(i,20))/(pr1x(i,1)
     + -pr2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp6=pr1x(i,1)+xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp6=pr1y(i,1)+xdes*dcos(alpha)+2.*xdes*dsin(alpha)
       xp8=pr1x(i,21)+xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp8=pr1y(i,21)+xdes*dcos(alpha)-2.*xdes*dsin(alpha)
       xp7=0.5*(xp6+xp8)
       yp7=0.5*(yp6+yp8)

       call point(psep+xp6,psey+yp6,1)
c       call point(psep+xp7,psey+yp7,1)
       call point(psep+xp8,psey+yp8,1)

c      Romano costat dret

       sr=1.
       
       xpx=(pr1x(i,1)+pr2x(i,20))/2.+xdes*dsin(alpha)
       xpy=(pr1y(i,1)+pr2y(i,20))/2.+xdes*dcos(alpha)

       xpx2=psep+xpx+0.5*hvr(k,8)*dcos(alpha)+0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy-0.5*hvr(k,8)*dsin(alpha)+0.3*xvrib*dcos(alpha) 

       call romano(i+1,xpx2,xpy2,alpha,typm6(10)*0.1,7)

       xpx2=psep+xpx-0.5*hvr(k,8)*dcos(alpha)+0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy+0.5*hvr(k,8)*dsin(alpha)+0.3*xvrib*dcos(alpha) 

       call romano(int(hvr(k,4)),xpx2,xpy2,alpha,typm6(10)*0.1,7)

c      Vores de costura

       do j=1,21-1

c      Vores de costura esquerra
       alpl=-(datan((pl1y(i,j)-pl2y(i,j))/(pl1x(i,j)-pl2x(i,j))))
       if (alpl.lt.0.) then
       alpl=alpl+pi
       end if

       lvcx(i,j)=psep+pl1x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j)=psey+pl1y(i,j)-xvrib*dcos(alpl)

c      Vores de costura dreta
       alpr=-(datan((pr1y(i,j)-pr2y(i,j))/(pr1x(i,j)-pr2x(i,j))))
       if (alpr.lt.0.) then
       alpr=alpr+pi
       end if

       rvcx(i,j)=psep+pr1x(i,j)+xvrib*dsin(alpr)
       rvcy(i,j)=psey+pr1y(i,j)+xvrib*dcos(alpr)

c      Tancament lateral inici
       if (j.eq.1) then
       call line(psep+pl1x(i,j)-xvrib*dsin(alpl),psey+pl1y(i,j)
     + -xvrib*dcos(alpl),psep+pl1x(i,j),psey+pl1y(i,j),1)
       call line(psep+pr1x(i,j)+xvrib*dsin(alpr),psey+pr1y(i,j)
     + +xvrib*dcos(alpr),psep+pr1x(i,j),psey+pr1y(i,j),1)
       end if

c      Tancament lateral fi
       if (j.eq.20) then
       call line(psep+pl2x(i,j)-xvrib*dsin(alpl),psey+pl2y(i,j)
     + -xvrib*dcos(alpl),psep+pl2x(i,j),psey+pl2y(i,j),1)
       call line(psep+pr2x(i,j)+xvrib*dsin(alpr),psey+pr2y(i,j)
     + +xvrib*dcos(alpr),psep+pr2x(i,j),psey+pr2y(i,j),1)

       lvcx(i,j+1)=psep+pl2x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j+1)=psey+pl2y(i,j)-xvrib*dcos(alpl)

       rvcx(i,j+1)=psep+pr2x(i,j)+xvrib*dsin(alpr)
       rvcy(i,j+1)=psey+pr2y(i,j)+xvrib*dcos(alpr)

       end if

c      V-rib length
       hvr(k,15)=dsqrt((lvcx(i,1)-rvcx(i,1))**2.+
     + (lvcy(i,1)-rvcy(i,1))**2.)

c      Numera cintes V Type 3
       call itxt(psep-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i,7)
       call itxt(psep+hvr(k,15)-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i+1,7)

       end do

c      Dibuixa vores amb segments completament enllaçats       
       do j=1,20

       call line(lvcx(i,j),lvcy(i,j),lvcx(i,j+1),lvcy(i,j+1),1)
       call line(rvcx(i,j),rvcy(i,j),rvcx(i,j+1),rvcy(i,j+1),1)

       end do

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.1.5.3 Drawing V-ribs marks in 2D ribs
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Drawing in 2D ribs printing
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Box (1,2)

       sepxx=700.*xkf
       sepyy=100.*xkf

c      Rib i-1
       kx=int((float(i-2)/6.))
       ky=i-1-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

       if (hvr(k,5).eq.1) then
       call line(sepx+ucnt(i-1,ii,9),-vcnt(i-1,ii,9)+sepy,
     + sepx+ucnt(i-1,ii,11),-vcnt(i-1,ii,11)+sepy,4)

c      Draw 3 point in 9 and 11

       alpha=(datan((v(i-1,jcon(i-1,ii,9)-1,3)-v(i-1,jcon(i-1,ii,9)+1,
     + 3))/(u(i-1,jcon(i-1,ii,9)-1,3)-u(i-1,jcon(i-1,ii,9)+1,3))))
       if (alpha.lt.0.) then
c       alpha=alpha+pi
       end if

       xpeq=ucnt(i-1,ii,9)-1.*xdes*dsin(alpha)
       ypeq=vcnt(i-1,ii,9)+1.*xdes*dcos(alpha)

       call point(sepx+xpeq,sepy-ypeq,92)
       call point(sepx+xpeq+1*dsin(alpha),sepy-ypeq+1*dcos(alpha),92)
       call point(sepx+xpeq+2*dsin(alpha),sepy-ypeq+2*dcos(alpha),92)

       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,2)
       call point(2530.*xkf+sepx+xpeq+1*dsin(alpha),sepy-ypeq+
     + 1*dcos(alpha),92)
       call point(2530.*xkf+sepx+xpeq+2*dsin(alpha),sepy-ypeq+
     + 2*dcos(alpha),92)


       alpha=(datan((v(i-1,jcon(i-1,ii,11)-1,3)-v(i-1,jcon(i-1,ii,11)+1,
     + 3))/(u(i-1,jcon(i-1,ii,11)-1,3)-u(i-1,jcon(i-1,ii,11)+1,3))))
       if (alpha.lt.0.) then
c       alpha=alpha+pi
       end if

       xpeq=ucnt(i-1,ii,11)-1.*xdes*dsin(alpha)
       ypeq=vcnt(i-1,ii,11)+1.*xdes*dcos(alpha)

       call point(sepx+xpeq,sepy-ypeq,92)
       call point(sepx+xpeq+1*dsin(alpha),sepy-ypeq+1*dcos(alpha),92)
       call point(sepx+xpeq+2*dsin(alpha),sepy-ypeq+2*dcos(alpha),92)

       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,92)
       call point(2530.*xkf+sepx+xpeq+1*dsin(alpha),sepy-ypeq+
     + 1*dcos(alpha),92)
       call point(2530.*xkf+sepx+xpeq+2*dsin(alpha),sepy-ypeq+
     + 2*dcos(alpha),92)

c      Marks in V-rib
       alpha=datan((vcnt(i-1,ii,11)-vcnt(i-1,ii,9))/
     + (ucnt(i-1,ii,11)-ucnt(i-1,ii,9)))

       xp9=ucnt(i-1,ii,9)-xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp9=vcnt(i-1,ii,9)+xdes*dcos(alpha)+2.*xdes*dsin(alpha)

       xp11=ucnt(i-1,ii,11)-xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp11=vcnt(i-1,ii,11)+xdes*dcos(alpha)-2.*xdes*dsin(alpha)

       xu=sepx+xp9
       xv=-sepy+yp9
c       call pointg(xu,xv,xcir,1)
       xu=sepx+xp11
       xv=-sepy+yp11
c       call pointg(xu,xv,xcir,1)

       end if

c      Rib i (center)
       kx=int((float(i-1)/6.))
       ky=i-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

       call line(sepx+ucnt(i,ii,2),-vcnt(i,ii,2)+sepy,
     + sepx+ucnt(i,ii,4),-vcnt(i,ii,4)+sepy,4)

c      Rib i+1
       kx=int((float(i)/6.))
       ky=i+1-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

       if (hvr(k,6).eq.1) then
       call line(sepx+ucnt(i+1,ii,9),-vcnt(i+1,ii,9)+sepy,
     + sepx+ucnt(i+1,ii,11),-vcnt(i+1,ii,11)+sepy,3)

c      Punts marcatge V-rib
       alpha=datan((vcnt(i+1,ii,11)-vcnt(i+1,ii,9))/
     + (ucnt(i+1,ii,11)-ucnt(i+1,ii,9)))

       xp9=ucnt(i+1,ii,9)-xdes*dsin(alpha)
       yp9=vcnt(i+1,ii,9)+xdes*dcos(alpha)

       xp11=ucnt(i+1,ii,11)-xdes*dsin(alpha)
       yp11=vcnt(i+1,ii,11)+xdes*dcos(alpha)

       xu=sepx+xp9
       xv=-sepy+yp9
c       call pointg(xu,xv,xcir,1)
       xu=sepx+xp11
       xv=-sepy+yp11
c       call pointg(xu,xv,xcir,1)

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Drawing V-ribs in 2D ribs mesa corte
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Box (1,2)

       sepxx=700.*xkf
       sepyy=100.*xkf

c      Rib i-1
       kx=int((float(i-2)/6.))
       ky=i-1-kx*6

       sepx=2530.*xkf+sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

       if (hvr(k,5).eq.1) then
c      Segment               
       call line(sepx+ucnt(i-1,ii,9),-vcnt(i-1,ii,9)+sepy,
     + sepx+ucnt(i-1,ii,11),-vcnt(i-1,ii,11)+sepy,4)

c      Punts marcatge V-rib
       alpha=datan((vcnt(i-1,ii,11)-vcnt(i-1,ii,9))/
     + (ucnt(i-1,ii,11)-ucnt(i-1,ii,9)))

       xp9=ucnt(i-1,ii,9)-xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp9=vcnt(i-1,ii,9)+xdes*dcos(alpha)+2.*xdes*dsin(alpha)

       xp11=ucnt(i-1,ii,11)-xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp11=vcnt(i-1,ii,11)+xdes*dcos(alpha)-2.*xdes*dsin(alpha)

       call point(sepx+xp9,sepy-yp9,3)
       call point(sepx+xp11,sepy-yp11,3)

       end if


c      Rib i+1
       kx=int((float(i)/6.))
       ky=i+1-kx*6

       sepx=2530.*xkf+sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

       if (hvr(k,6).eq.1) then
c      Segment  
       call line(sepx+ucnt(i+1,ii,9),-vcnt(i+1,ii,9)+sepy,
     + sepx+ucnt(i+1,ii,11),-vcnt(i+1,ii,11)+sepy,3)


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Draw 3 point in 9 and 11

       alpha=(datan((v(i+1,jcon(i+1,ii,9)-1,3)-v(i+1,jcon(i+1,ii,9)+1,
     + 3))/(u(i+1,jcon(i+1,ii,9)-1,3)-u(i+1,jcon(i+1,ii,9)+1,3))))
       if (alpha.lt.0.) then
c       alpha=alpha+pi
       end if

       xpeq=ucnt(i+1,ii,9)-1.*xdes*dsin(alpha)
       ypeq=vcnt(i+1,ii,9)+1.*xdes*dcos(alpha)

       call point(sepx+xpeq,sepy-ypeq,92)
       call point(sepx+xpeq+1*dsin(alpha),sepy-ypeq+1*dcos(alpha),92)
       call point(sepx+xpeq+2*dsin(alpha),sepy-ypeq+2*dcos(alpha),92)

       call point(-2530.*xkf+sepx+xpeq,sepy-ypeq,92)
       call point(-2530.*xkf+sepx+xpeq+1*dsin(alpha),sepy-ypeq+
     + 1*dcos(alpha),92)
       call point(-2530.*xkf+sepx+xpeq+2*dsin(alpha),sepy-ypeq+
     + 2*dcos(alpha),92)


       alpha=(datan((v(i+1,jcon(i+1,ii,11)-1,3)-v(i+1,jcon(i+1,ii,11)+1,
     + 3))/(u(i+1,jcon(i+1,ii,11)-1,3)-u(i+1,jcon(i+1,ii,11)+1,3))))
       if (alpha.lt.0.) then
c       alpha=alpha+pi
       end if

       xpeq=ucnt(i+1,ii,11)-1.*xdes*dsin(alpha)
       ypeq=vcnt(i+1,ii,11)+1.*xdes*dcos(alpha)

       call point(sepx+xpeq,sepy-ypeq,92)
       call point(sepx+xpeq+1*dsin(alpha),sepy-ypeq+1*dcos(alpha),92)
       call point(sepx+xpeq+2*dsin(alpha),sepy-ypeq+2*dcos(alpha),92)

       call point(-2530.*xkf+sepx+xpeq,sepy-ypeq,5)
       call point(-2530.*xkf+sepx+xpeq+1*dsin(alpha),sepy-ypeq+
     + 1*dcos(alpha),92)
       call point(-2530.*xkf+sepx+xpeq+2*dsin(alpha),sepy-ypeq+
     + 2*dcos(alpha),92)



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

           
c      Punts marcatge V-rib
       alpha=datan((vcnt(i+1,ii,11)-vcnt(i+1,ii,9))/
     + (ucnt(i+1,ii,11)-ucnt(i+1,ii,9)))

       xp9=ucnt(i+1,ii,9)-xdes*dsin(alpha)
       yp9=vcnt(i+1,ii,9)+xdes*dcos(alpha)

       xp11=ucnt(i+1,ii,11)-xdes*dsin(alpha)
       yp11=vcnt(i+1,ii,11)+xdes*dcos(alpha)

       call point(sepx+xp9,sepy-yp9,3)
       call point(sepx+xp11,sepy-yp11,3)

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw V-rib type 3 in 3D model
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Left rib
       if (hvr(k,5).eq.1) then

       do j=1,21
       call line3d(rx2(i,j,ii),ry2(i,j,ii),rz2(i,j,ii),
     + rx1(i,j,ii),ry1(i,j,ii),rz1(i,j,ii),4)
       call line3d(-rx2(i,j,ii),ry2(i,j,ii),rz2(i,j,ii),
     + -rx1(i,j,ii),ry1(i,j,ii),rz1(i,j,ii),4)
       end do

       end if


c      Right rib
       if (hvr(k,6).eq.1) then

       do j=1,21
       call line3d(rx2(i,j,ii),ry2(i,j,ii),rz2(i,j,ii),
     + rx3(i,j,ii),ry3(i,j,ii),rz3(i,j,ii),3)
       call line3d(-rx2(i,j,ii),ry2(i,j,ii),rz2(i,j,ii),
     + -rx3(i,j,ii),ry3(i,j,ii),rz3(i,j,ii),3)
       end do

       end if


c      end if V-rib type 3

       end if




ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.2 Continuous full V-rib type-5
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,2).eq.5) then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.2.1 Rib i points 2,3,4
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Define main points 2,3,4,9,10,11
c      See schema for points interpretation

       i=hvr(k,3)    ! rib i
c      PLEASE make max hvr(k,4)=rib(i,15)
       ii=hvr(k,4)   ! row ii
      
       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,2)=ucnt(i,ii,3)-hvr(k,10)
       ucnt(i,ii,4)=ucnt(i,ii,3)+hvr(k,10)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Points 2,3,4 interpolation in rib i
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,2).and.u(i,j+1,3).ge.ucnt(i,ii,2)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,2)=xm*ucnt(i,ii,2)+xb
       jcon(i,ii,2)=j

c      First 2
       if (ii.eq.1) then
       xtu2(i)=ucnt(i,ii,2)
       xtv2(i)=vcnt(i,ii,2)
       jcon2(i,ii,2)=jcon(i,ii,2)

c      Calcule te-2, variable rib(i,102)
       rib(i,102)=0.
       do jj=np(i,1),jcon2(i,ii,2)+2,-1
       rib(i,102)=rib(i,102)+sqrt((u(i,jj-1,3)-u(i,jj,3))**2+
     + (v(i,jj-1,3)-v(i,jj,3))**2)
       end do
       rib(i,102)=rib(i,102)+sqrt((u(i,jcon2(i,ii,2)+1,3)-ucnt(i,ii,2))
     + **2+(v(i,jcon2(i,ii,2)+1,3)-vcnt(i,ii,2))**2)

       end if

       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       jcon(i,ii,3)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,4).and.u(i,j+1,3).ge.ucnt(i,ii,4)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,4)=xm*ucnt(i,ii,4)+xb
       jcon(i,ii,4)=j

c      Last 4
       if (ii.eq.rib(i,15)) then
       xtu4(i)=ucnt(i,ii,4)
       xtv4(i)=vcnt(i,ii,4)
       jcon4(i,ii,4)=jcon(i,ii,4)

c      Calcule te-4
       rib(i,104)=0.
       do jj=np(i,1),jcon4(i,ii,4)+2,-1
       rib(i,104)=rib(i,104)+sqrt((u(i,jj-1,3)-u(i,jj,3))**2+
     + (v(i,jj-1,3)-v(i,jj,3))**2)
       end do
       rib(i,104)=rib(i,104)+sqrt((u(i,jcon4(i,ii,4)+1,3)-ucnt(i,ii,4))
     + **2+(v(i,jcon4(i,ii,4)+1,3)-vcnt(i,ii,4))**2)
c      Verificar graficament que OK

       end if

       end if

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Continue calculus c ii max
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,4).eq.rib(i,15)) then

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat line "2" in n spaces
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Reformat in 120 spaces
       n1vr=jcon4(i,int(rib(i,15)),4)-jcon2(i,1,2)+1
       n2vr=121

c      Load data polyline
       xlin1(1)=xtu2(i)
       ylin1(1)=xtv2(i)
       do j=2,n1vr-1
       xlin1(j)=u(i,jcon2(i,1,2)+j-1,3)
       ylin1(j)=v(i,jcon2(i,1,2)+j-1,3)
c      MIRAR SI CAL +-1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       end do
       xlin1(n1vr)=xtu4(i)
       ylin1(n1vr)=xtv4(i)
      
c      Call subroutine vector redistribution

       call vredis(xlin1,ylin1,xlin3,ylin3,n1vr,n2vr)

c      Load result polyline

       do j=1,n2vr
       ucnt2(i,ii,j)=xlin3(j)
       vcnt2(i,ii,j)=ylin3(j)
c       write (*,*) "Line 2f: ", j, xlin3(j),ylin3(j)
       end do
       
       end if ! Enf if in ii max
   

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.2.2 Points 9-10-11 in Rib i-1 and reformat
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      We only need first "9" and last "11"

       i=hvr(k,3)-1
       ii=hvr(k,4)

       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,1)=ucnt(i,ii,3)-hvr(k,10)
       ucnt(i,ii,2)=ucnt(i,ii,3)-hvr(k,10)
       ucnt(i,ii,4)=ucnt(i,ii,3)+hvr(k,10)
       ucnt(i,ii,5)=ucnt(i,ii,3)+hvr(k,10)
       ucnt(i,ii,6)=ucnt(i,ii,1)
       ucnt(i,ii,7)=ucnt(i,ii,3)
       ucnt(i,ii,8)=ucnt(i,ii,5)
       ucnt(i,ii,9)=ucnt(i,ii,1)
       ucnt(i,ii,10)=ucnt(i,ii,3)
       ucnt(i,ii,11)=ucnt(i,ii,5)

c      Points 2,3,4 interpolation in rib i-1
       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,2).and.u(i,j+1,3).ge.ucnt(i,ii,2)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,2)=xm*ucnt(i,ii,2)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,4).and.u(i,j+1,3).ge.ucnt(i,ii,4)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,4)=xm*ucnt(i,ii,4)+xb
       end if

       end do

c      Points 9,10,11 interpolation in rib i-1 (not used)
       do j=1,np(i,2)

       if (u(i,j,3).gt.ucnt(i,ii,9).and.u(i,j+1,3).le.ucnt(i,ii,9)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,9)=xm*ucnt(i,ii,9)+xb
       jcon(i,ii,9)=j+1
       end if

       if (u(i,j,3).gt.ucnt(i,ii,10).and.u(i,j+1,3).le.ucnt(i,ii,10)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,10)=xm*ucnt(i,ii,10)+xb
       jcon(i,ii,10)=j+1
       end if

       if (u(i,j,3).gt.ucnt(i,ii,11).and.u(i,j+1,3).le.ucnt(i,ii,11)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,11)=xm*ucnt(i,ii,11)+xb
       jcon(i,ii,11)=j+1
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Detect first 9 and last 11 (rib i-1)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      First 9
       if (ii.eq.1) then

c      Line "r"
       xru(1)=ucnt(i,ii,2)
       xrv(1)=vcnt(i,ii,2)
       xru(2)=ucnt(i,ii,2)-1.
       xrv(2)=vcnt(i,ii,2)+dtan(hvr(k,7)*pi/180.)

c      Look at segments near "A"
       do ki=jcon(i,ii,10),np(i,2)

c      Line "s"
       xsu(1)=u(i,ki,3)
       xsv(1)=v(i,ki,3)
       xsu(2)=u(i,ki+1,3)
       xsv(2)=v(i,ki+1,3)

       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       if (xsu(1).ge.xtu.and.xsu(2).lt.xtu.and.xsv(2).ge.0.) then
       xtu9(i)=xtu
       xtv9(i)=xtv
       jcon9(i,ii,2)=ki+1
       end if
     
       end do

c      Dibuix provisional, but in vertical rib!    
c       call line(xru(1),-300-xrv(1),xtu9(i),-300-xtv9(i),7)

       end if   ! First 9

       
c      Last 11
       if (ii.eq.rib(i,15)) then

c      Line "r"
       xru(1)=ucnt(i,ii,4)
       xrv(1)=vcnt(i,ii,4)
       xru(2)=ucnt(i,ii,4)+1.
       xrv(2)=vcnt(i,ii,4)+dtan(hvr(k,8)*pi/180.)

c      Look at segments near "A"
       do ki=1,np(i,2)

c      Line "s"
       xsu(1)=u(i,ki,3)
       xsv(1)=v(i,ki,3)
       xsu(2)=u(i,ki+1,3)
       xsv(2)=v(i,ki+1,3)

       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       if (xsu(1).ge.xtu.and.xsu(2).lt.xtu.and.xsv(2).ge.0.) then
       xtu11(i)=xtu
       xtv11(i)=xtv
       jcon11(i,ii,2)=ki+1

c      Calcule te-11
       rib(i,105)=0.
       do jj=1,jcon11(i,ii,2)-2

       rib(i,105)=rib(i,105)+sqrt((u(i,jj+1,3)-u(i,jj,3))**2+
     + (v(i,jj+1,3)-v(i,jj,3))**2)
       end do
ccccccc Ep! rib(1,105) NO.........!ccccccccccccccccccccccccccccccccccc
c       Error corregit 2018-05-12
c       rib(i,105)=rib(1,105)+sqrt((u(i,jcon11(i,ii,2)-1,3)-xtu11(i))
c     + **2+(v(i,jcon11(i,ii,2)-1,3)-xtv11(i))**2)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       rib(i,105)=rib(i,105)+sqrt((u(i,jcon11(i,ii,2)-1,3)-xtu11(i))
     + **2+(v(i,jcon11(i,ii,2)-1,3)-xtv11(i))**2)


       end if
     
       end do

c      Dibuix provisional, but in vertical rib!
c       call line(xru(1),-300-xrv(1),xtu11(i),-300-xtv11(i),7)

       end if   ! Last 11

       end do   ! in points upper surface

c      Calculus of partial lengths in rib i-1

c      Calculus of te-11 length
       if (ii.eq.rib(i,15)) then
       xlte11(i)=0.
       do kl=1,jcon11(i,ii,2)-2
       xlte11(i)=xlte11(i)+sqrt((u(i,kl+1,3)-u(i,kl,3))**2+
     + (v(i,kl+1,3)-v(i,kl,3))**2)
       end do 
       kl=jcon11(i,ii,2)-1
       xlte11(i)=xlte11(i)+sqrt((u(i,kl,3)-xtu11(i))**2+
     + (v(i,kl,3)-xtv11(i))**2)
       end if

c      Calculus of le-9 length
       if (ii.eq.1) then
c       write (*,*) "Epppp   ", jcon9(i,ii,2),np(i,2)
       xlle9(i)=0.
       do kl=jcon9(i,ii,2),np(i,2)-1
       xlle9(i)=xlle9(i)+sqrt((u(i,kl+1,3)-u(i,kl,3))**2+
     + (v(i,kl+1,3)-v(i,kl,3))**2)
       end do 
       kl=jcon9(i,ii,2)
       xlle9(i)=xlle9(i)+sqrt((u(i,kl,3)-xtu9(i))**2+
     + (v(i,kl,3)-xtv9(i))**2)
       end if


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat line 1 (9-11) in n spaces (rib i-1)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c       if (ii.eq.rib(i+1,15)) then ! why i+1?
       if (ii.eq.rib(i,15)) then


c      Reformat in 120 spaces

       n1vr=jcon9(i,1,2)-jcon11(i,int(rib(i,15)),2)+1    
       n2vr=121

c      Load data polyline
       xlin1(1)=xtu9(i)
       ylin1(1)=xtv9(i)
       do j=2,n1vr-1
       xlin1(j)=u(i,jcon9(i,1,2)-j+1,3)
       ylin1(j)=v(i,jcon9(i,1,2)-j+1,3)
c      MIRAR SI CAL +-1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       end do
       xlin1(n1vr)=xtu11(i)
       ylin1(n1vr)=xtv11(i)

c      Esborrar?       
       do j=1,n1vr-1
c       call line(xlin1(j),-300-ylin1(j),xlin1(j+1),-300-ylin1(j+1),3)
       end do

c      Call subroutine vector redistribution

       call vredis(xlin1,ylin1,xlin3,ylin3,n1vr,n2vr)

c      Load result polyline

       do j=1,n2vr
       ucnt1(i,ii,j)=xlin3(j)
       vcnt1(i,ii,j)=ylin3(j)
       end do

       end if ! ii=rib(i+1,15)


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.2.3 Points 9-10-11 in Rib i+1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      We only need first "9" and last "11"

       i=hvr(k,3)+1
       ii=hvr(k,4)

       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,1)=ucnt(i,ii,3)-hvr(k,10)
       ucnt(i,ii,2)=ucnt(i,ii,3)-hvr(k,10)
       ucnt(i,ii,4)=ucnt(i,ii,3)+hvr(k,10)
       ucnt(i,ii,5)=ucnt(i,ii,3)+hvr(k,10)
       ucnt(i,ii,6)=ucnt(i,ii,1)
       ucnt(i,ii,7)=ucnt(i,ii,3)
       ucnt(i,ii,8)=ucnt(i,ii,5)
       ucnt(i,ii,9)=ucnt(i,ii,1)
       ucnt(i,ii,10)=ucnt(i,ii,3)
       ucnt(i,ii,11)=ucnt(i,ii,5)

c      Points 2,3,4 interpolation in rib i+1
       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,2).and.u(i,j+1,3).ge.ucnt(i,ii,2)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,2)=xm*ucnt(i,ii,2)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,4).and.u(i,j+1,3).ge.ucnt(i,ii,4)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,4)=xm*ucnt(i,ii,4)+xb
       end if

       end do

c      Points 9,10,11 interpolation in rib i+1 (not used)
       do j=1,np(i,2)

       if (u(i,j,3).gt.ucnt(i,ii,9).and.u(i,j+1,3).le.ucnt(i,ii,9)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,9)=xm*ucnt(i,ii,9)+xb
       jcon(i,ii,9)=j+1
       end if

       if (u(i,j,3).gt.ucnt(i,ii,10).and.u(i,j+1,3).le.ucnt(i,ii,10)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,10)=xm*ucnt(i,ii,10)+xb
       jcon(i,ii,10)=j+1
       end if

       if (u(i,j,3).gt.ucnt(i,ii,11).and.u(i,j+1,3).le.ucnt(i,ii,11)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,11)=xm*ucnt(i,ii,11)+xb
       jcon(i,ii,11)=j+1
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Detect first 9 and last 11 (rib i+1)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      First 9
       if (ii.eq.1) then

c      Line "r"
       xru(1)=ucnt(i,ii,2)
       xrv(1)=vcnt(i,ii,2)
       xru(2)=ucnt(i,ii,2)-1.
       xrv(2)=vcnt(i,ii,2)+dtan(hvr(k,7)*pi/180.)

c      Look at segments near "A"
       do ki=jcon(i,ii,10),np(i,2)

c      Line "s"
       xsu(1)=u(i,ki,3)
       xsv(1)=v(i,ki,3)
       xsu(2)=u(i,ki+1,3)
       xsv(2)=v(i,ki+1,3)

       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       if (xsu(1).ge.xtu.and.xsu(2).lt.xtu.and.xsv(2).ge.0.) then
       xtu9(i)=xtu
       xtv9(i)=xtv
       jcon9(i,ii,2)=ki+1
       end if
     
       end do

       end if   ! First 9

c      Last 11
       if (ii.eq.rib(i,15)) then

c      Line "r"
       xru(1)=ucnt(i,ii,4)
       xrv(1)=vcnt(i,ii,4)
       xru(2)=ucnt(i,ii,4)+1.
       xrv(2)=vcnt(i,ii,4)+dtan(hvr(k,8)*pi/180.)

c      Look at segments near "A"
       do ki=1,np(i,2)

c      Line "s"
       xsu(1)=u(i,ki,3)
       xsv(1)=v(i,ki,3)
       xsu(2)=u(i,ki+1,3)
       xsv(2)=v(i,ki+1,3)

       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       if (xsu(1).ge.xtu.and.xsu(2).lt.xtu.and.xsv(2).ge.0.) then
       xtu11(i)=xtu
       xtv11(i)=xtv
       jcon11(i,ii,2)=ki+1

c      Calcule te-11
       rib(i,105)=0.
       do jj=1,jcon11(i,ii,2)-2
       rib(i,105)=rib(i,105)+sqrt((u(i,jj+1,3)-u(i,jj,3))**2+
     + (v(i,jj+1,3)-v(i,jj,3))**2)
       end do
       rib(i,105)=rib(i,105)+sqrt((u(i,jcon11(i,ii,2)-1,3)-xtu11(i))
     + **2+(v(i,jcon11(i,ii,2)-1,3)-xtv11(i))**2)

       end if
     
       end do

       end if   ! Last 11

       end do

c      Calculus of partial lengths in rib i+1

c      Calculus of te-11 length
       if (ii.eq.rib(i,15)) then
       xrte11(i)=0.
       do kl=1,jcon11(i,ii,2)-2
       xrte11(i)=xrte11(i)+sqrt((u(i,kl+1,3)-u(i,kl,3))**2+
     + (v(i,kl+1,3)-v(i,kl,3))**2)
       end do 
       kl=jcon11(i,ii,2)-1
       xrte11(i)=xrte11(i)+sqrt((u(i,kl,3)-xtu11(i))**2+
     + (v(i,kl,3)-xtv11(i))**2)
       end if

c      Calculus of le-9 length
       if (ii.eq.1) then
c       write (*,*) "Epppp   ", jcon9(i,ii,2),np(i,2)
       xrle9(i)=0.
       do kl=jcon9(i,ii,2),np(i,2)-1
       xrle9(i)=xrle9(i)+sqrt((u(i,kl+1,3)-u(i,kl,3))**2+
     + (v(i,kl+1,3)-v(i,kl,3))**2)
       end do 
       kl=jcon9(i,ii,2)
       xrle9(i)=xrle9(i)+sqrt((u(i,kl,3)-xtu9(i))**2+
     + (v(i,kl,3)-xtv9(i))**2)
c       write (*,*) "xrle9 ok ",i,xrle9(i)
       end if

c      Calculus of partial lengths in rib i (intrados)

c      Calculus of te-4 length
       if (ii.eq.rib(i,15)) then

             end if

c      Calculus of le-2 length
       if (ii.eq.1) then

             end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat line 3 9-11 in n spaces (rib i+1)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      if (ii.eq.rib(i-1,15)) then ! why i-1?
       if (ii.eq.rib(i,15)) then

c      Reformat in 120 spaces

       n1vr=jcon9(i,1,2)-jcon11(i,int(rib(i,15)),2)+1    
       n2vr=121

c      Load data polyline
       xlin1(1)=xtu9(i)
       ylin1(1)=xtv9(i)
       do j=2,n1vr-1
       xlin1(j)=u(i,jcon9(i,1,2)-j+1,3)
       ylin1(j)=v(i,jcon9(i,1,2)-j+1,3)
c      MIRAR SI CAL +-1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       end do
       xlin1(n1vr)=xtu11(i)
       ylin1(n1vr)=xtv11(i)

       do j=1,n1vr-1
c       call line(xlin1(j),-312-ylin1(j),xlin1(j+1),-312-ylin1(j+1),6)
       end do

c      Call subroutine vector redistribution

       call vredis(xlin1,ylin1,xlin3,ylin3,n1vr,n2vr)

       do j=1,n2vr-1
c       call line(xlin3(j),-310-ylin3(j),xlin3(j+1),-310-ylin3(j+1),4)
       end do

c      Load result polyline

       do j=1,n2vr
       ucnt3(i,ii,j)=xlin3(j)
       vcnt3(i,ii,j)=ylin3(j)
       end do

       end if ! ii=rib(i-1,15)


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Rib localisation
       i=hvr(k,3)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ii.eq.rib(i,15)) then
       i=hvr(k,3)-1
       do j=1,121
c       write (*,*) "C2: ",ucnt1(i,ii,j),vcnt1(i,ii,j)
       end do
c       write (*,*) "control ", i,ii,j,n2vr
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.2.4 Lines 1 2 3 transportation to 3D espace
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ii.eq.rib(i,15)) then

c      Rib i-1 (Line 1)

       i=hvr(k,3)-1

       tetha=rib(i,8)*pi/180.

       do j=1,121
       ru(i,j,3)=ucnt1(i,ii,j)
       rv(i,j,3)=vcnt1(i,ii,j)-rib(i,50)
c       write (*,*) "C3: ",ucnt1(i,ii,j),vcnt1(i,ii,j)
       end do
c       write (*,*) "control ", i,ii,j,n2vr

c      ESBORRAR
c       do j=1,n2vr-1
c       call line(300+ru(i,j,3),-300-rv(i,j,3),
c     + 300+ru(i,j+1,3),-300-rv(i,j+1,3),1)
c       end do


       do j=1,121

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       rx1(i+1,j,ii)=rx(i,j)
       ry1(i+1,j,ii)=ry(i,j)
       rz1(i+1,j,ii)=rz(i,j)

c       write (*,*) j, rx(i,j),ry(i,j),rz(i,j)


       end do

c      Rib i (Line 2)

       i=hvr(k,3)

       tetha=rib(i,8)*pi/180.
       
       do j=1,121
       ru(i,j,3)=ucnt2(i,ii,j)
       rv(i,j,3)=vcnt2(i,ii,j)-rib(i,50)
       end do

       do j=1,121

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       rx2(i,j,ii)=rx(i,j)
       ry2(i,j,ii)=ry(i,j)
       rz2(i,j,ii)=rz(i,j)

       end do

c      Rib i+1 (Line 3)

       i=hvr(k,3)+1

       tetha=rib(i,8)*pi/180.

       do j=1,121
       ru(i,j,3)=ucnt3(i,ii,j)
       rv(i,j,3)=vcnt3(i,ii,j)-rib(i,50)
c      COMPTE AMB el rib(i,50) A ESTUDIAR       
       end do

       do j=1,121

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       rx3(i-1,j,ii)=rx(i,j)
       ry3(i-1,j,ii)=ry(i,j)
       rz3(i-1,j,ii)=rz(i,j)

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.2.5 V-ribs full Type 5 calculus and drawing in 3D and 2D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc       
c      16.3.2.5.1 Left rib Type 5 (blue) 1-2
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      AQUEST IF es tanca al final del rib 15??????????????????
       if (ii.eq.rib(i,15)) then

       i=hvr(k,3)-1

c      Call flattening subroutine

       call flatt(i,n2vr,rx,ry,rz,
     + pl1x,pl1y,pl2x,pl2y,pr1x,pr1y,pr2x,pr2y)

c      Rotate ribs in 2D
c      Align using right side
       angle=datan((pr1x(i,121)-pr1x(i,1))/(pr1y(i,121)-pr1y(i,1)))
       angle=angle*180./pi
       angle2=angle

       xc=dcos(angle*pi/180.0d0)
       xs=dsin(angle*pi/180.0d0)
      
       do j=1,n2vr
       px9o(j)=xc*pl1x(i,j)-xs*pl1y(i,j)
       py9o(j)=xs*pl1x(i,j)+xc*pl1y(i,j)
       end do
       do j=1,n2vr
       pl1x(i,j)=px9o(j)
       pl1y(i,j)=py9o(j)
       end do

       do j=1,n2vr
       px9o(j)=xc*pl2x(i,j)-xs*pl2y(i,j)
       py9o(j)=xs*pl2x(i,j)+xc*pl2y(i,j)
       end do
       do j=1,n2vr
       pl2x(i,j)=px9o(j)
       pl2y(i,j)=py9o(j)
       end do

       do j=1,n2vr
       px9o(j)=xc*pr1x(i,j)-xs*pr1y(i,j)
       py9o(j)=xs*pr1x(i,j)+xc*pr1y(i,j)
       end do
       do j=1,n2vr
       pr1x(i,j)=px9o(j)
       pr1y(i,j)=py9o(j)
       end do

       do j=1,n2vr
       px9o(j)=xc*pr2x(i,j)-xs*pr2y(i,j)
       py9o(j)=xs*pr2x(i,j)+xc*pr2y(i,j)
       end do
       do j=1,n2vr
       pr2x(i,j)=px9o(j)
       pr2y(i,j)=py9o(j)
       end do
      
c      Drawing in 2D model (BOX 2,7)
       
       psep=5820.*xkf+xrsep*1.6*float(i)-150
       psey=800.*xkf+yrsep*float(ii)-500.

       if (hvr(k,5).eq.1) then

c      Draw basic contour, left and right
       do j=1,120
       call line(psep+pl1x(i,j),psey+pl1y(i,j),
     + psep+pl1x(i,j+1),psey+pl1y(i,j+1),5)
       call line(psep+pr1x(i,j),psey+pr1y(i,j),
     + psep+pr1x(i,j+1),psey+pr1y(i,j+1),5)
       end do

       j=1
       call line(psep+pl1x(i,j),psey+pl1y(i,j),
     + psep+pr1x(i,j),psey+pr1y(i,j),5)

c      xsegment definition
       xsegment=dsqrt((pl1x(i,j)-pr1x(i,j))**2+
     + (pl1y(i,j)-pr1y(i,j))**2)
c      xrvlen
       xrvlen=dsqrt((pr1x(i,1)-pr1x(i,121))**2+
     + (pr1y(i,1)-pr1y(i,121))**2)

       j=121
       call line(psep+pl1x(i,j),psey+pl1y(i,j),
     + psep+pr1x(i,j),psey+pr1y(i,j),5)


c      External edges calculus and drawing

       do j=1,121

c      Edges left
       alpl=-(datan((pl1y(i,j)-pl2y(i,j))/(pl1x(i,j)-pl2x(i,j))))
       if (alpl.lt.0.) then
       alpl=alpl+pi
       end if
c      Correction in alpl
       if (j.eq.120) then
       alpl120=alpl
       end if
       if (j.eq.121) then
       alpl=alpl120
       end if

       lvcx(i,j)=psep+pl1x(i,j)-xrib*0.1*dsin(alpl)
       lvcy(i,j)=psey+pl1y(i,j)-xrib*0.1*dcos(alpl)

c      Edges right
       alpr=-(datan((pr1y(i,j)-pr2y(i,j))/(pr1x(i,j)-pr2x(i,j))))
       if (alpr.lt.0.) then
       alpr=alpr+pi
       end if
c      Correction in alpr
       if (j.eq.120) then
       alpr120=alpr
       end if
       if (j.eq.121) then
       alpr=alpr120
       end if

       rvcx(i,j)=psep+pr1x(i,j)+xrib*0.1*dsin(alpr)
       rvcy(i,j)=psey+pr1y(i,j)+xrib*0.1*dcos(alpr)

       end do

c      Edges drawing       
       do j=1,120
       call line(lvcx(i,j),lvcy(i,j),lvcx(i,j+1),lvcy(i,j+1),5)
       call line(rvcx(i,j),rvcy(i,j),rvcx(i,j+1),rvcy(i,j+1),5)
       end do

c      Segments drawing

       j=1
       call line(lvcx(i,j),lvcy(i,j),psep+pl1x(i,j),psey+pl1y(i,j),5)
       call line(rvcx(i,j),rvcy(i,j),psep+pr1x(i,j),psey+pr1y(i,j),5)
       j=121
       call line(lvcx(i,j),lvcy(i,j),psep+pl1x(i,j),psey+pl1y(i,j),5)
       call line(rvcx(i,j),rvcy(i,j),psep+pr1x(i,j),psey+pr1y(i,j),5)

c      Calculus of 9-11 length in planar rib i-1
        
       xl911(i)=0.
       do j=1,120
       xl911(i)=xl911(i)+sqrt((pl1x(i,j)-pl1x(i,j+1))**2+
     + (pl1y(i,j)-pl1y(i,j+1))**2)
       end do 

c      Calculus of 2-4 length in planar rib i-1 (rib i)
        
       xc24(i+1)=0.
       do j=1,120
       xc24(i+1)=xc24(i+1)+sqrt((pr1x(i,j)-pr1x(i,j+1))**2+
     + (pr1y(i,j)-pr1y(i,j+1))**2)
       end do 


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      VERIFICATION left     
c       write (*,*) "Rib i-1 ",i,xlle9(i),xl911(i),xlte11(i),rib(i,31),
c     + xlle9(i)+xl911(i)+xlte11(i) !OK
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Naming and marks in V-rib full continous (left-blue)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      V-rib length
       hvr(k,15)=dsqrt((lvcx(i,1)-rvcx(i,1))**2.+
     + (lvcy(i,1)-rvcy(i,1))**2.)

c      Naming ribs with number

       call itxt(psep-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10.,typm3(10),0.0d0,i,7)
       call itxt(psep-xrsep+hvr(k,15)+83.*xkf-120.*(typm3(10)/10.),
     + psey-10.,typm3(10),0.0d0,i+1,7)


c      Mark rib at left (roman number) 

       alpha=-(datan((pl1y(i,1)-pr1y(i,1))/(pl1x(i,1)-pr1x(i,1))))

       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       sl=1.
       
       xpx=pl1x(i,1)*0.8+pr1x(i,1)*0.2-0.2*xrib*dsin(alpha) !double xrib
       xpy=pl1y(i,1)*0.8+pr1y(i,1)*0.2-0.2*xrib*dcos(alpha)
       xpx2=psep+xpx
       xpy2=psey+xpy

       call romano(i,xpx2,xpy2,alpha,typm6(10)*0.1,7)

c      Mark rib at right (roman number) 

       alpha=-(datan((pl1y(i,1)-pr1y(i,1))/(pl1x(i,1)-pr1x(i,1))))

       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       sr=1.
       
       xpx=pl1x(i,1)*0.2+pr1x(i,1)*0.8-0.2*xrib*dsin(alpha)
       xpy=pl1y(i,1)*0.2+pr1y(i,1)*0.8-0.2*xrib*dcos(alpha) 
       xpx2=psep+xpx
       xpy2=psey+xpy

       call romano(i+1,xpx2,xpy2,alpha,typm6(10)*0.1,7)


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Mark equidistant points in left rib (upper surface)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       jcontrol=1

       do jm=1,60 ! Till 60 marks

       xmarkjm=xmark*float(jm)

c      Draw only in rib
       if (xmarkjm.ge.rib(i,105).and.xmarkjm.le.rib(i,105)+xl911(i)) 
     + then

c      Define rib(i,106) only for first mark
       if (jcontrol.eq.1) then
       rib(i,106)=xmarkjm-rib(i,105)
       end if
       jcontrol=0

       xlen=0.
       xlenp=dsqrt((pl1x(i,121)-pl1x(i,120))**2+
     + (pl1y(i,121)-pl1y(i,120))**2)  ! Acumulated length

       do j=121,3,-1
       
c      Detect and draw equidistant point
       if (xmarkjm-rib(i,105).ge.xlen.and.xmarkjm-rib(i,105).lt.xlenp) 
     + then

       rib(i,107)=xmarkjm-xlen-rib(i,105)
       rib(i,108)=dsqrt((pl1x(i,j-1)-pl1x(i,j))**2+
     + (pl1y(i,j-1)-pl1y(i,j))**2)

c      Interpolate
       xequis=pl1x(i,j)-(rib(i,107)*(pl1x(i,j)-pl1x(i,j-1)))/rib(i,108)
       yequis=pl1y(i,j)-(rib(i,107)*(pl1y(i,j)-pl1y(i,j-1)))/rib(i,108)

c      Draw
       alpha=-(datan((pl1y(i,j)-pl1y(i,j-1))/(pl1x(i,j)-pl1x(i,j-1))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xpeq=xequis-1.*xdes*dsin(alpha)
       ypeq=yequis+1.*xdes*dcos(alpha)

       call point (psep+xpeq,psey+ypeq,3)

       end if ! detect point

c      Set xlen, xlenp for next segment
       xlen=xlen+sqrt((pl1x(i,j)-pl1x(i,j-1))**2+
     + (pl1y(i,j)-pl1y(i,j-1))**2)
       xlenp=xlen+sqrt((pl1x(i,j-1)-pl1x(i,j-2))**2+
     + (pl1y(i,j-1)-pl1y(i,j-2))**2)

       end do ! contour V-rib

       end if ! marks zone

       end do ! marks jm

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Mark equidistant points in bottom surface (rib i+1)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Move to rib i+1

       jcontrol=1

       do jm=1,60 ! Till 50 marks

       xmarkjm=xmark*float(jm)

c      Draw only in rib
       if (xmarkjm.ge.rib(i+1,104).and.xmarkjm.le.rib(i+1,104)+
     + xc24(i+1)) then

c      Define rib(i,106) only for first mark
       if (jcontrol.eq.1) then
       rib(i+1,106)=xmarkjm-rib(i+1,104)
       end if
       jcontrol=0

       xlen=0.
       xlenp=dsqrt((pr1x(i,121)-pr1x(i,120))**2+
     + (pr1y(i,121)-pr1y(i,120))**2)

       do j=121,3,-1
       
c      Detect and draw equidistant point
       if (xmarkjm-rib(i+1,104).ge.xlen.and.xmarkjm-rib(i+1,104).lt.
     + xlenp) then

       rib(i+1,107)=xmarkjm-xlen-rib(i+1,104)
       rib(i+1,108)=dsqrt((pr1x(i,j-1)-pr1x(i,j))**2+
     + (pr1y(i,j-1)-pr1y(i,j))**2)

c      Interpolate
       xequis=pr1x(i,j)-(rib(i+1,107)*(pr1x(i,j)-pr1x(i,j-1)))/
     + rib(i+1,108)
       yequis=pr1y(i,j)-(rib(i+1,107)*(pr1y(i,j)-pr1y(i,j-1)))/
     + rib(i+1,108)

c      Draw
       alpha=-(datan((pr1y(i,j)-pr1y(i,j-1))/(pr1x(i,j)-pr1x(i,j-1))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xpeq=xequis+1.*xdes*dsin(alpha)
       ypeq=yequis-1.*xdes*dcos(alpha)

       call point (psep+xpeq,psey+ypeq,3)

       end if ! detect point

       xlen=xlen+sqrt((pr1x(i,j)-pr1x(i,j-1))**2+
     + (pr1y(i,j)-pr1y(i,j-1))**2)
       xlenp=xlen+sqrt((pr1x(i,j-1)-pr1x(i,j-2))**2+
     + (pr1y(i,j-1)-pr1y(i,j-2))**2)

       end do ! contour V-rib

       end if ! marks zone

       end do ! marks jm

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Mark anchor points in left rib
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do klz=1,rib(i+1,15)

       xlen=0.
       xlenp=dsqrt((pr1x(i,121)-pr1x(i,120))**2+
     + (pr1y(i,121)-pr1y(i,120))**2)

       do j=121,3,-1

c      Detect and draw anchor point
       if (rib(i+1,130+klz)-rib(i+1,104).ge.xlen.and.
     + rib(i+1,130+klz)-rib(i+1,104).lt.
     + xlenp) then

    
       rib(i+1,107)=rib(i+1,130+klz)-xlen-rib(i+1,104)
       rib(i+1,108)=dsqrt((pr1x(i,j-1)-pr1x(i,j))**2+
     + (pr1y(i,j-1)-pr1y(i,j))**2)

c      Interpolate
       xequis=pr1x(i,j)-(rib(i+1,107)*(pr1x(i,j)-pr1x(i,j-1)))/
     + rib(i+1,108)
       yequis=pr1y(i,j)-(rib(i+1,107)*(pr1y(i,j)-pr1y(i,j-1)))/
     + rib(i+1,108)

c      Define anchor points in planar V-rib
       xanchor(i+1,klz)=xequis
       yanchor(i+1,klz)=yequis

c      Draw
       alpha=-(datan((pr1y(i,j)-pr1y(i,j-1))/(pr1x(i,j)-pr1x(i,j-1))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xpeq=xequis+1.*xdes*dsin(alpha)
       ypeq=yequis-1.*xdes*dcos(alpha)

c      Girar angle
       call point (psep+xpeq,psey+ypeq,30)
       call point (psep+xpeq-1.,psey+ypeq,30)
       call point (psep+xpeq-2.,psey+ypeq,30)

       end if ! detect point

       xlen=xlen+sqrt((pr1x(i,j)-pr1x(i,j-1))**2+
     + (pr1y(i,j)-pr1y(i,j-1))**2)
       xlenp=xlen+sqrt((pr1x(i,j-1)-pr1x(i,j-2))**2+
     + (pr1y(i,j-1)-pr1y(i,j-2))**2)

       end do ! in contour

       end do ! in anchors

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw parabolic holes in left rib
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


       do klz=1,rib(i+1,15)-1

       xprb(i+1,klz,0)=(xanchor(i+1,klz)+xanchor(i+1,klz+1))/2.
       yprb(i+1,klz,0)=(yanchor(i+1,klz)+yanchor(i+1,klz+1))/2.

       do j=1,120

c      Point 5
       if (pl1y(i,j).le.yprb(i+1,klz,0).and.pl1y(i,j+1).gt.
     + yprb(i+1,klz,0)) then

       xm=(pl1y(i,j+1)-pl1y(i,j))/(pl1x(i,j+1)-pl1x(i,j))
       xb=pl1y(i,j)-xm*pl1x(i,j)

       yprb(i+1,klz,5)=yprb(i+1,klz,0)
       xprb(i+1,klz,5)=(yprb(i+1,klz,5)-xb)/xm
       
c      Point 6
       dist05=xprb(i+1,klz,0)-xprb(i+1,klz,5)
       dist06=dist05*hvr(k,9)/100.
       yprb(i+1,klz,6)=yprb(i+1,klz,0)
       xprb(i+1,klz,6)=xprb(i+1,klz,0)-dist06
       end if

c      Point 1

       if (pr1y(i,j).le.yanchor(i+1,klz)+hvr(k,10).and.pr1y(i,j+1).gt.
     + yanchor(i+1,klz)+hvr(k,10)) then

       xm=(pr1y(i,j+1)-pr1y(i,j))/(pr1x(i,j+1)-pr1x(i,j))
       xb=pr1y(i,j)-xm*pr1x(i,j)

       yprb(i+1,klz,1)=yanchor(i+1,klz)+hvr(k,10)
       xprb(i+1,klz,1)=(yprb(i+1,klz,1)-xb)/xm
       end if

       end do ! end j

       end do ! end klz


       do klz=1,rib(i+1,15)-1

       do j=1,120

c      Point 2 Intersection right side parabola with airfoil contour

       if (pr1y(i,j).ge.yprb(i+1,klz,0).and.pr1y(i,j).lt.
     + yanchor(i+1,klz+1)) then

c      Line "r" (parabola)

       xkprb(klz)=(xprb(i+1,klz,1)-xprb(i+1,klz,6))/
     + ((yprb(i+1,klz,1)-yprb(i+1,klz,6))**2.)

       xru(1)=xkprb(klz)*((pr1y(i,j)-yprb(i+1,klz,6))**2.)+
     + xprb(i+1,klz,6)
       xrv(1)=pr1y(i,j)
       xru(2)=xkprb(klz)*((pr1y(i,j+1)-yprb(i+1,klz,6))**2.)+
     + xprb(i+1,klz,6)
       xrv(2)=pr1y(i,j+1)

c      Line "s" (bottom surface)

       xsu(1)=pr1x(i,j)
       xsv(1)=pr1y(i,j)
       xsu(2)=pr1x(i,j+1)
       xsv(2)=pr1y(i,j+1)

       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)


       if (xsv(1).le.xtv.and.xsv(2).gt.xtv) then  !!REVISAR
       yprb(i+1,klz,2)=xtv
       xprb(i+1,klz,2)=xtu
       end if  


       end if   

       end do ! in j

      
c       call line(psep+xprb(i+1,klz,0),psey+yprb(i+1,klz,0),
c     + psep+xprb(i+1,klz,6),psey+yprb(i+1,klz,6),2)

c       call line(psep+xprb(i+1,klz,1),psey+yprb(i+1,klz,1),
c     + psep+xprb(i+1,klz,6),psey+yprb(i+1,klz,6),3)

c       call line(psep+xprb(i+1,klz,2),psey+yprb(i+1,klz,2),
c     + psep+xprb(i+1,klz,6),psey+yprb(i+1,klz,6),1)

c      Draw parabolas


c      Detect extremal points
       do j=1,120

       if (pr1y(i,j).le.yprb(i+1,klz,1).and.pr1y(i,j+1).gt.
     + yprb(i+1,klz,1)) then
       jconi(klz)=j+1
       end if
       if (pr1y(i,j).le.yprb(i+1,klz,2).and.pr1y(i,j+1).gt.
     + yprb(i+1,klz,2)) then
       jconf(klz)=j
       end if

       end do

c      Draw parabolas

       if (hvr(k,9).le.100.) then

       j=jconi(klz)
       xpa1=xkprb(klz)*((pr1y(i,j)-yprb(i+1,klz,6))**2.)+
     + xprb(i+1,klz,6)
       call line(psep+xprb(i+1,klz,1),psey+yprb(i+1,klz,1),
     + psep+xpa1,psey+pr1y(i,j),5)
       do j=jconi(klz),jconf(klz)-1
       xpa1=xkprb(klz)*((pr1y(i,j)-yprb(i+1,klz,6))**2.)+
     + xprb(i+1,klz,6)
       xpa2=xkprb(klz)*((pr1y(i,j+1)-yprb(i+1,klz,6))**2.)+
     + xprb(i+1,klz,6)
       call line(psep+xpa1,psey+pr1y(i,j),
     + psep+xpa2,psey+pr1y(i,j+1),5)
       end do
       j=jconf(klz)
       xpa1=xkprb(klz)*((pr1y(i,j)-yprb(i+1,klz,6))**2.)+
     + xprb(i+1,klz,6)
       call line(psep+xprb(i+1,klz,2),psey+yprb(i+1,klz,2),
     + psep+xpa1,psey+pr1y(i,j),5)

       end if

       
c      Draw ellipses

       if (hvr(k,9).gt.100) then

       xprb(i+1,klz,7)=(xprb(i+1,klz,0)+xprb(i+1,klz,5))/2.
       yprb(i+1,klz,7)=yprb(i+1,klz,0)
       
       xa=0.5d0*((xprb(i+1,klz,0)-xprb(i+1,klz,5))*
     + (1.0d0-(2.0d0*(hvr(k,9)-100.0d0)/100.0d0)))
       xb=0.5d0*(yprb(i+1,klz,2)-yprb(i+1,klz,1)-2.*hvr(k,10))

       xgir=0.0d0

       do j=1,100-2.*pi/100.

       xsu(1)=xprb(i+1,klz,7)+xa*dcos(xgir)
       xsv(1)=yprb(i+1,klz,7)+xb*dsin(xgir)
       xsu(2)=xprb(i+1,klz,7)+xa*dcos(xgir+2.*pi/100.)
       xsv(2)=yprb(i+1,klz,7)+xb*dsin(xgir+2.*pi/100.)

       call line(psep+xsu(1),psey+xsv(1),psep+xsu(2),psey+xsv(2),5)

       xgir=xgir+2.0d0*pi/100.0d0

       end do

       end if

       end do ! in klz

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw left diagonal in 3D space
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ii.eq.rib(i,15)) then
       
       do j=1,121
       call line3d(rx2(i+1,j,ii),ry2(i+1,j,ii),rz2(i+1,j,ii),
     + rx1(i+1,j,ii),ry1(i+1,j,ii),rz1(i+1,j,ii),5)
       call line3d(-rx2(i+1,j,ii),ry2(i+1,j,ii),rz2(i+1,j,ii),
     + -rx1(i+1,j,ii),ry1(i+1,j,ii),rz1(i+1,j,ii),5)
       end do
       end if

       end if ! Draw left diagonal


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc       
c      16.3.2.5.2 Right rib (red) 2-3
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      i=hvr(k,3)+1 ? NO
       i=hvr(k,3)

c      Call flattening subroutine

       call flatt(i,n2vr,rx,ry,rz,
     + pl1x,pl1y,pl2x,pl2y,pr1x,pr1y,pr2x,pr2y)

c      Rotate ribs in 2D
c      Align using left side
       angle=datan((pr1x(i,121)-pr1x(i,1))/(pr1y(i,121)-pr1y(i,1)))
       angle=angle*180./pi

       xc=dcos(angle*pi/180.)
       xs=dsin(angle*pi/180.)

c      And do displacement using xsegment and angle2 defined in left rib
       xdx=xsegment*dcos(angle2*pi/180)
       xdy=xsegment*dsin(angle2*pi/180)

       do j=1,n2vr
       px9o(j)=xc*pl1x(i,j)-xs*pl1y(i,j)
       py9o(j)=xs*pl1x(i,j)+xc*pl1y(i,j)+xdy
       end do
       do j=1,n2vr
       pl1x(i,j)=px9o(j)
       pl1y(i,j)=py9o(j)
       end do

       do j=1,n2vr
       px9o(j)=xc*pl2x(i,j)-xs*pl2y(i,j)
       py9o(j)=xs*pl2x(i,j)+xc*pl2y(i,j)+xdy
       end do
       do j=1,n2vr
       pl2x(i,j)=px9o(j)
       pl2y(i,j)=py9o(j)
       end do

       do j=1,n2vr
       px9o(j)=xc*pr1x(i,j)-xs*pr1y(i,j)
       py9o(j)=xs*pr1x(i,j)+xc*pr1y(i,j)+xdy
       end do
       do j=1,n2vr
       pr1x(i,j)=px9o(j)
       pr1y(i,j)=py9o(j)
       end do

       do j=1,n2vr
       px9o(j)=xc*pr2x(i,j)-xs*pr2y(i,j)
       py9o(j)=xs*pr2x(i,j)+xc*pr2y(i,j)+xdy
       end do
       do j=1,n2vr
       pr2x(i,j)=px9o(j)
       pr2y(i,j)=py9o(j)
       end do


c      Drawing in 2D model
       
       psep=5820.*xkf+xrsep*1.6*float(i-1)+1.5*xsegment-150
       psey=800.*xkf+yrsep*float(ii)-500.

       if (hvr(k,6).eq.1) then

c      Draw basic contour
       do j=1,120
       call line(psep+pl1x(i,j),psey+pl1y(i,j),
     + psep+pl1x(i,j+1),psey+pl1y(i,j+1),1)
       call line(psep+pr1x(i,j),psey+pr1y(i,j),
     + psep+pr1x(i,j+1),psey+pr1y(i,j+1),1)
       end do

       j=1
       call line(psep+pl1x(i,j),psey+pl1y(i,j),
     + psep+pr1x(i,j),psey+pr1y(i,j),1)
       j=121
       call line(psep+pl1x(i,j),psey+pl1y(i,j),
     + psep+pr1x(i,j),psey+pr1y(i,j),1)


c      External edges calculus and drawing

       do j=1,121

c      Edges left
       alpl=-(datan((pl1y(i,j)-pl2y(i,j))/(pl1x(i,j)-pl2x(i,j))))
       if (alpl.lt.0.) then
       alpl=alpl+pi
       end if

c      Correction in alpl
       if (j.eq.120) then
       alpl120=alpl
       end if
       if (j.eq.121) then
       alpl=alpl120
       end if

       lvcx(i,j)=psep+pl1x(i,j)-xrib*0.1*dsin(alpl)
       lvcy(i,j)=psey+pl1y(i,j)-xrib*0.1*dcos(alpl)

c      Edges right
       alpr=-(datan((pr1y(i,j)-pr2y(i,j))/(pr1x(i,j)-pr2x(i,j))))
       if (alpr.lt.0.) then
       alpr=alpr+pi
       end if
c      Correction in alpr
       if (j.eq.120) then
       alpr120=alpr
       end if
       if (j.eq.121) then
       alpr=alpr120
       end if

       rvcx(i,j)=psep+pr1x(i,j)+xrib*0.1*dsin(alpr)
       rvcy(i,j)=psey+pr1y(i,j)+xrib*0.1*dcos(alpr)

       end do

c      Edges drawing       
       do j=1,120
       call line(lvcx(i,j),lvcy(i,j),lvcx(i,j+1),lvcy(i,j+1),1)
       call line(rvcx(i,j),rvcy(i,j),rvcx(i,j+1),rvcy(i,j+1),1)
       end do

c      Segments drawing
       j=1
       call line(lvcx(i,j),lvcy(i,j),psep+pl1x(i,j),psey+pl1y(i,j),1)
       call line(rvcx(i,j),rvcy(i,j),psep+pr1x(i,j),psey+pr1y(i,j),1)
       j=121
       call line(lvcx(i,j),lvcy(i,j),psep+pl1x(i,j),psey+pl1y(i,j),1)
       call line(rvcx(i,j),rvcy(i,j),psep+pr1x(i,j),psey+pr1y(i,j),1)


c      Calculus of 9-11 length in planar rib i+1
        
       xr911(i+1)=0.
       do j=1,120
       xr911(i+1)=xr911(i+1)+sqrt((pr1x(i,j)-pr1x(i,j+1))**2+
     + (pr1y(i,j)-pr1y(i,j+1))**2)
       end do 

c      Calculus of 2-4 length in planar rib i
        
       xc24i=xc24(i) ! Left side
       xc24(i)=0.
       do j=1,120
       xc24(i)=xc24(i)+sqrt((pl1x(i,j)-pl1x(i,j+1))**2+
     + (pl1y(i,j)-pl1y(i,j+1))**2)
       end do 

c       write (*,*) "xc24(i) ",i,xc24i,xc24(i)
c      Petites diferencies 1 mm a corregir


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      VERIFICATION right     
c       write (*,*) "Rib i+1 ",i+1,xrle9(i+1),xr911(i+1),xrte11(i+1),
c     + rib(i+1,31),xrle9(i+1)+xr911(i+1)+xrte11(i+1) !
c      Hi ha petit error de 1 mm, a revisar (potser calcul r influ)
c      menys exacte r que l? a rutina planar
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Naming and marks in V-rib (right-red)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      V-rib length
       hvr(k,15)=dsqrt((lvcx(i,1)-rvcx(i,1))**2.+
     + (lvcy(i,1)-rvcy(i,1))**2.)

c      Naming ribs with number

       call itxt(psep-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i,7)
       call itxt(psep-xrsep+hvr(k,15)+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i+1,7)

       
c      Mark rib at left (roman number) 

       alpha=-(datan((pl1y(i,1)-pr1y(i,1))/(pl1x(i,1)-pr1x(i,1))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       sl=1.
       
       xpx=pl1x(i,1)*0.8+pr1x(i,1)*0.2+0.2*xrib*dsin(alpha) !double xrib
       xpy=pl1y(i,1)*0.8+pr1y(i,1)*0.2+0.2*xrib*dcos(alpha) 
       xpx2=psep+xpx
       xpy2=psey+xpy

       call romano(i,xpx2,xpy2,alpha,typm6(10)*0.1,7)

c      Mark rib at right (roman number) 

       alpha=-(datan((pl1y(i,1)-pr1y(i,1))/(pl1x(i,1)-pr1x(i,1))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       sr=1.
       
       xpx=pl1x(i,1)*0.2+pr1x(i,1)*0.8+0.2*xrib*dsin(alpha)
       xpy=pl1y(i,1)*0.2+pr1y(i,1)*0.8+0.2*xrib*dcos(alpha)
       xpx2=psep+xpx
       xpy2=psey+xpy

       call romano(i+1,xpx2,xpy2,alpha,typm6(10)*0.1,7)


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Mark equidistant points in right rib (upper surface) rib i+1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       jcontrol=1

       do jm=1,60 ! Till 50 marks

       xmarkjm=xmark*float(jm)

c      Draw only in rib
       if (xmarkjm.ge.rib(i+1,105).and.xmarkjm.le.rib(i+1,105)+
     + xr911(i+1)) then

c      Define rib(i+1,106) only for first mark
       if (jcontrol.eq.1) then
       rib(i+1,106)=xmarkjm-rib(i+1,105)
       end if
       jcontrol=0

       xlen=0.
       xlenp=dsqrt((pr1x(i,121)-pr1x(i,120))**2+
     + (pr1y(i,121)-pr1y(i,120))**2)

       do j=121,3,-1  !!!!! REVISAR !!!!!!!!!!!!!!
c       do j=120,3,-1
       
c      Detect and draw equidistant point
       if (xmarkjm-rib(i+1,105).ge.xlen.and.xmarkjm-rib(i+1,105).lt.
     + xlenp) then

       rib(i+1,107)=xmarkjm-xlen-rib(i+1,105)
       rib(i+1,108)=dsqrt((pr1x(i,j-1)-pr1x(i,j))**2+
     + (pr1y(i,j-1)-pr1y(i,j))**2)

c      Interpolate
       xequis=pr1x(i,j)-(rib(i+1,107)*(pr1x(i,j)-pr1x(i,j-1)))/
     + rib(i+1,108)
       yequis=pr1y(i,j)-(rib(i+1,107)*(pr1y(i,j)-pr1y(i,j-1)))/
     + rib(i+1,108)

c      Draw
       alpha=-(datan((pr1y(i,j)-pr1y(i,j-1))/(pr1x(i,j)-pr1x(i,j-1))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xpeq=xequis+1.*xdes*dsin(alpha)
       ypeq=yequis-1.*xdes*dcos(alpha)

       call point (psep+xpeq,psey+ypeq,3)

       end if ! detect point

       xlen=xlen+sqrt((pr1x(i,j)-pr1x(i,j-1))**2+
     + (pr1y(i,j)-pr1y(i,j-1))**2)
       xlenp=xlen+sqrt((pr1x(i,j-1)-pr1x(i,j-2))**2+
     + (pr1y(i,j-1)-pr1y(i,j-2))**2)

       end do ! contour V-rib

       end if ! marks zone

       end do ! marks jm

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Mark equidistant points in bottom surface (rib i)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Move to rib i

       jcontrol=1

       do jm=1,60 ! Till 50 marks

       xmarkjm=xmark*float(jm)

c      Draw only in rib
       if (xmarkjm.ge.rib(i,104).and.xmarkjm.le.rib(i,104)+
     + xc24(i)) then

c      Define rib(i,106) only for first mark
       if (jcontrol.eq.1) then
       rib(i,106)=xmarkjm-rib(i,104)
       end if
       jcontrol=0

       xlen=0.
       xlenp=dsqrt((pl1x(i,121)-pl1x(i,120))**2+
     + (pl1y(i,121)-pl1y(i,120))**2)

       do j=121,3,-1
       
c      Detect and draw equidistant point
       if (xmarkjm-rib(i,104).ge.xlen.and.xmarkjm-rib(i,104).lt.
     + xlenp) then

       rib(i,107)=xmarkjm-xlen-rib(i,104)
       rib(i,108)=dsqrt((pl1x(i,j-1)-pl1x(i,j))**2+
     + (pl1y(i,j-1)-pl1y(i,j))**2)

c      Interpolate
       xequis=pl1x(i,j)-(rib(i,107)*(pl1x(i,j)-pl1x(i,j-1)))/
     + rib(i,108)
       yequis=pl1y(i,j)-(rib(i,107)*(pl1y(i,j)-pl1y(i,j-1)))/
     + rib(i,108)

c      Draw
       alpha=-(datan((pl1y(i,j)-pl1y(i,j-1))/(pl1x(i,j)-pl1x(i,j-1))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xpeq=xequis-1.*xdes*dsin(alpha)
       ypeq=yequis+1.*xdes*dcos(alpha)

       call point (psep+xpeq,psey+ypeq,3)

       end if ! detect point

       xlen=xlen+sqrt((pl1x(i,j)-pl1x(i,j-1))**2+
     + (pl1y(i,j)-pl1y(i,j-1))**2)
       xlenp=xlen+sqrt((pl1x(i,j-1)-pl1x(i,j-2))**2+
     + (pl1y(i,j-1)-pl1y(i,j-2))**2)

       end do ! contour V-rib

       end if ! marks zone

       end do ! marks jm


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Mark anchor points in right rib
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do klz=1,rib(i,15)

       xlen=0.
       xlenp=dsqrt((pl1x(i,121)-pl1x(i,120))**2+
     + (pl1y(i,121)-pl1y(i,120))**2)

       do j=121,3,-1

c      Detect and draw anchor point
       if (rib(i,130+klz)-rib(i,104).ge.xlen.and.
     + rib(i,130+klz)-rib(i,104).lt.
     + xlenp) then

    
       rib(i,107)=rib(i,130+klz)-xlen-rib(i,104)
       rib(i,108)=dsqrt((pl1x(i,j-1)-pl1x(i,j))**2+
     + (pl1y(i,j-1)-pl1y(i,j))**2)

c      Interpolate
       xequis=pl1x(i,j)-(rib(i,107)*(pl1x(i,j)-pl1x(i,j-1)))/
     + rib(i,108)
       yequis=pl1y(i,j)-(rib(i,107)*(pl1y(i,j)-pl1y(i,j-1)))/
     + rib(i,108)

c      Define anchor points in planar V-rib
       xanchor(i,klz)=xequis
       yanchor(i,klz)=yequis

c      Draw
       alpha=-(datan((pl1y(i,j)-pl1y(i,j-1))/(pl1x(i,j)-pl1x(i,j-1))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xpeq=xequis-1.*xdes*dsin(alpha)
       ypeq=yequis+1.*xdes*dcos(alpha)

c      Girar angle
       call point (psep+xpeq,psey+ypeq,30)
       call point (psep+xpeq+1.,psey+ypeq,30)
       call point (psep+xpeq+2.,psey+ypeq,30)

       end if ! detect point

       xlen=xlen+sqrt((pl1x(i,j)-pl1x(i,j-1))**2+
     + (pl1y(i,j)-pl1y(i,j-1))**2)
       xlenp=xlen+sqrt((pl1x(i,j-1)-pl1x(i,j-2))**2+
     + (pl1y(i,j-1)-pl1y(i,j-2))**2)


       end do ! in contour


       end do ! in anchors



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw parabolic holes in right rib
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


       do klz=1,rib(i,15)-1

       xprb(i,klz,0)=(xanchor(i,klz)+xanchor(i,klz+1))/2.
       yprb(i,klz,0)=(yanchor(i,klz)+yanchor(i,klz+1))/2.

       do j=1,120

c      Point 5
       if (pr1y(i,j).le.yprb(i,klz,0).and.pr1y(i,j+1).gt.
     + yprb(i,klz,0)) then

       xm=(pr1y(i,j+1)-pr1y(i,j))/(pr1x(i,j+1)-pr1x(i,j))
       xb=pr1y(i,j)-xm*pr1x(i,j)

       yprb(i,klz,5)=yprb(i,klz,0)
       xprb(i,klz,5)=(yprb(i,klz,5)-xb)/xm

c       call line(psep+xprb(i,klz,5),psey+yprb(i,klz,5),
c     + psep+xprb(i,klz,5)+30,psey+yprb(i,klz,5),2)

       
c      Point 6
       dist05=-xprb(i,klz,0)+xprb(i,klz,5)
       dist06=dist05*hvr(k,9)/100.
       yprb(i,klz,6)=yprb(i,klz,0)
       xprb(i,klz,6)=xprb(i,klz,0)+dist06
       end if

c      Point 1

       if (pl1y(i,j).le.yanchor(i,klz)+hvr(k,10).and.pl1y(i,j+1).gt.
     + yanchor(i,klz)+hvr(k,10)) then

       xm=(pl1y(i,j+1)-pl1y(i,j))/(pl1x(i,j+1)-pl1x(i,j))
       xb=pl1y(i,j)-xm*pl1x(i,j)

       yprb(i,klz,1)=yanchor(i,klz)+hvr(k,10)
       xprb(i,klz,1)=(yprb(i,klz,1)-xb)/xm
       end if

       end do ! end j

       end do ! end klz


       do klz=1,rib(i+1,15)-1

       do j=1,120

c      Point 2 Intersection right side parabola with airfoil contour

       if (pl1y(i,j).ge.yprb(i,klz,0).and.pl1y(i,j).lt.
     + yanchor(i,klz+1)) then

c      Line "r" (parabola)

       xkprb(klz)=(xprb(i,klz,1)-xprb(i,klz,6))/
     + ((yprb(i,klz,1)-yprb(i,klz,6))**2.)

       xru(1)=xkprb(klz)*((pl1y(i,j)-yprb(i,klz,6))**2.)+
     + xprb(i,klz,6)
       xrv(1)=pl1y(i,j)
       xru(2)=xkprb(klz)*((pl1y(i,j+1)-yprb(i,klz,6))**2.)+
     + xprb(i,klz,6)
       xrv(2)=pl1y(i,j+1)

c      Line "s" (bottom surface)

       xsu(1)=pl1x(i,j)
       xsv(1)=pl1y(i,j)
       xsu(2)=pl1x(i,j+1)
       xsv(2)=pl1y(i,j+1)

       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)


       if (xsv(1).le.xtv.and.xsv(2).gt.xtv) then  !!REVISAR
       yprb(i,klz,2)=xtv
       xprb(i,klz,2)=xtu
       end if  


       end if   

       end do ! in j

      
c       call line(psep+xprb(i,klz,0),psey+yprb(i,klz,0),
c     + psep+xprb(i,klz,6),psey+yprb(i,klz,6),2)

c       call line(psep+xprb(i,klz,1),psey+yprb(i,klz,1),
c     + psep+xprb(i,klz,6),psey+yprb(i,klz,6),3)

c       call line(psep+xprb(i,klz,2),psey+yprb(i,klz,2),
c     + psep+xprb(i,klz,6),psey+yprb(i,klz,6),1)

c      Draw parabolas


c      Detect extremal points
       do j=1,120

       if (pl1y(i,j).le.yprb(i,klz,1).and.pl1y(i,j+1).gt.
     + yprb(i,klz,1)) then
       jconi(klz)=j+1
       end if
       if (pl1y(i,j).le.yprb(i,klz,2).and.pl1y(i,j+1).gt.
     + yprb(i,klz,2)) then
       jconf(klz)=j
       end if

       end do

c      Draw parabolas

       if (hvr(k,9).le.100.) then

       j=jconi(klz)
       xpa1=xkprb(klz)*((pl1y(i,j)-yprb(i,klz,6))**2.)+
     + xprb(i,klz,6)
       call line(psep+xprb(i,klz,1),psey+yprb(i,klz,1),
     + psep+xpa1,psey+pl1y(i,j),1)
       do j=jconi(klz),jconf(klz)-1
       xpa1=xkprb(klz)*((pl1y(i,j)-yprb(i,klz,6))**2.)+
     + xprb(i,klz,6)
       xpa2=xkprb(klz)*((pl1y(i,j+1)-yprb(i,klz,6))**2.)+
     + xprb(i,klz,6)
       call line(psep+xpa1,psey+pl1y(i,j),
     + psep+xpa2,psey+pl1y(i,j+1),1)
       end do
       j=jconf(klz)
       xpa1=xkprb(klz)*((pl1y(i,j)-yprb(i,klz,6))**2.)+
     + xprb(i,klz,6)
       call line(psep+xprb(i,klz,2),psey+yprb(i,klz,2),
     + psep+xpa1,psey+pl1y(i,j),1)

       end if


c      Draw ellipses

       if (hvr(k,9).gt.100) then

       xprb(i,klz,7)=(xprb(i,klz,5)+xprb(i,klz,0))/2.
       yprb(i,klz,7)=yprb(i,klz,0)
       
       xa=0.5*((xprb(i,klz,5)-xprb(i,klz,0))*
     + (1.-(2.*(hvr(k,9)-100.)/100.)))
       xb=0.5*(yprb(i,klz,2)-yprb(i,klz,1)-2.*hvr(k,10))

       xgir=0.

       do j=1,100-2.*pi/100.

       xsu(1)=xprb(i,klz,7)+xa*dcos(xgir)
       xsv(1)=yprb(i,klz,7)+xb*dsin(xgir)
       xsu(2)=xprb(i,klz,7)+xa*dcos(xgir+2.*pi/100.)
       xsv(2)=yprb(i,klz,7)+xb*dsin(xgir+2.*pi/100.)

       call line(psep+xsu(1),psey+xsv(1),psep+xsu(2),psey+xsv(2),1)

       xgir=xgir+2.*pi/100.

       end do

       end if

       end do ! in klz

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw right diagonal in 3D space
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ii.eq.rib(i,15)) then
       do j=1,121
       call line3d(rx2(i,j,ii),ry2(i,j,ii),rz2(i,j,ii),
     + rx3(i,j,ii),ry3(i,j,ii),rz3(i,j,ii),1)
       call line3d(-rx2(i,j,ii),ry2(i,j,ii),rz2(i,j,ii),
     + -rx3(i,j,ii),ry3(i,j,ii),rz3(i,j,ii),1)
       end do
       end if

       end if ! Draw right diagonal

       end if  ! rigth


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.3.2.5.3
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Marks in main ribs (rib i, bottom surface) plott and MC
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       sepxx=700.*xkf
       sepyy=100.*xkf

c      Rib i (center)
       kx=int((float(i-1)/6.))
       ky=i-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

       do klz=1,3
      
       alpha=-datan((xtv9(i-1)-vcnt(i-1,1,2))/(xtu9(i-1)-ucnt(i-1,1,2)))
c       if (rib(i,149).le.0.1d0) then ! Verify if airfoil thicknees = 0
c       alpha=pi/2.0d0
c       end if
       xp22=xtu2(i)+(1-klz+xdes)*dcos(alpha)
       yp22=xtv2(i)-(1-klz+xdes)*dsin(alpha)
       xu=sepx+xp22
       xv=-sepy+yp22
       call pointg(xu,-xv,xcir,6) ! Box (1,2)
       call point(xu+2530.*xkf,-xv,6) ! Box (1,4)

       alpha=datan((xtv11(i-1)-vcnt(i-1,ii,4))/
     + (xtu11(i-1)-ucnt(i-1,ii,4)))
c       if (rib(i,149).le.0.1d0) then ! Verify if airfoil thicknees = 0
c       alpha=pi/2.0d0
c       end if
       xp44=xtu4(i)-(1-klz+xdes)*dcos(alpha)
       yp44=xtv4(i)-(1-klz+xdes)*dsin(alpha)
       xu=sepx+xp44
       xv=-sepy+yp44
       call pointg(xu,-xv,xcir,6) ! Box (1,2)
       call point(xu+2530.*xkf,-xv,6) ! Box (1,4)

       end do

       if (ii.eq.rib(i,15)) then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Full V-ribs marks in ribs plotting and MC
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Box (1,2)

       sepxx=700.*xkf
       sepyy=100.*xkf

c      Rib i-1 Left side
       kx=int((float(i-2)/6.))
       ky=i-1-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)       

       if (hvr(k,5).eq.1) then
       call line(sepx+xtu9(i-1),-xtv9(i-1)+sepy,
     + sepx+ucnt(i-1,1,2),-vcnt(i-1,1,2)+sepy,5)
       call line(sepx+xtu11(i-1),-xtv11(i-1)+sepy,
     + sepx+ucnt(i-1,ii,4),-vcnt(i-1,ii,4)+sepy,5)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Marks 9-10 in V-rib left
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do klz=1,3
      
       alpha=-datan((xtv9(i-1)-vcnt(i-1,1,2))/(xtu9(i-1)-ucnt(i-1,1,2)))
       xp9=xtu9(i-1)-(1-klz+xdes)*dcos(alpha)
       yp9=xtv9(i-1)+(1-klz+xdes)*dsin(alpha)
       xu=sepx+xp9
       xv=-sepy+yp9
       call pointg(xu,-xv,xcir,6) ! Box (1,2)
       call point(xu+2530.*xkf,-xv,6) ! Box (1,4)

       alpha=datan((xtv11(i-1)-vcnt(i-1,ii,4))/
     + (xtu11(i-1)-ucnt(i-1,ii,4)))
       xp11=xtu11(i-1)+(1-klz+xdes)*dcos(alpha)
       yp11=xtv11(i-1)+(1-klz+xdes)*dsin(alpha)
       xu=sepx+xp11
       xv=-sepy+yp11
       call pointg(xu,-xv,xcir,6) ! Box (1,2)
       call point(xu+2530.*xkf,-xv,6) ! Box (1,4)

       end do

       end if  ! Left side


c      Rib i+1 Right side

       kx=int((float(i)/6.))
       ky=i+1-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

       if (hvr(k,6).eq.1) then
       call line(sepx+xtu9(i+1),-xtv9(i+1)+sepy,
     + sepx+ucnt(i+1,1,2),-vcnt(i+1,1,2)+sepy,1)
       call line(sepx+xtu11(i+1),-xtv11(i+1)+sepy,
     + sepx+ucnt(i+1,ii,4),-vcnt(i+1,ii,4)+sepy,1)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Marks 9-11 in V-rib right
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do klz=1,3 ! Tree points
      
       alpha=-datan((xtv9(i+1)-vcnt(i+1,1,2))/(xtu9(i+1)-ucnt(i+1,1,2)))
       xp9=xtu9(i+1)-(1-klz+xdes)*dcos(alpha)
       yp9=xtv9(i+1)+(1-klz+xdes)*dsin(alpha)
       xu=sepx+xp9
       xv=-sepy+yp9
       call pointg(xu,-xv,xcir,6)
       call point(xu+2530.*xkf,-xv,6) ! Box (1,4)

       alpha=datan((xtv11(i+1)-vcnt(i+1,ii,4))/
     + (xtu11(i+1)-ucnt(i+1,ii,4)))
       xp11=xtu11(i+1)+(1-klz+xdes)*dcos(alpha)
       yp11=xtv11(i+1)+(1-klz+xdes)*dsin(alpha)
       xu=sepx+xp11
       xv=-sepy+yp11
       call pointg(xu,-xv,xcir,6)
       call point(xu+2530.*xkf,-xv,6) ! Box (1,4)

       end do

       end if  ! Right side

       end if  ! rib(i,15)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       end if ! ii=rib(i,15)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       end if ! end type 5

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

 



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.4 HV ribs Type 4
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,2).eq.4) then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.4.1 Rib i-1
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)-1
       ii=hvr(k,4) ! row

       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,1)=ucnt(i,ii,3)-hvr(k,8)
       ucnt(i,ii,2)=ucnt(i,ii,3)-(hvr(k,7)+hvr(k,15))
       ucnt(i,ii,4)=ucnt(i,ii,3)+(hvr(k,7)+hvr(k,15))
       ucnt(i,ii,5)=ucnt(i,ii,3)+hvr(k,8)
       ucnt(i,ii,6)=ucnt(i,ii,1)
       ucnt(i,ii,7)=ucnt(i,ii,3)
       ucnt(i,ii,8)=ucnt(i,ii,5)
       ucnt(i,ii,9)=ucnt(i,ii,1)
       ucnt(i,ii,10)=ucnt(i,ii,3)
       ucnt(i,ii,11)=ucnt(i,ii,5)


c      Points 2,3,4 interpolation in rib i-1
       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,2).and.u(i,j+1,3).ge.ucnt(i,ii,2)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,2)=xm*ucnt(i,ii,2)+xb
       jcon(i,ii,2)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       jcon(i,ii,3)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,4).and.u(i,j+1,3).ge.ucnt(i,ii,4)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,4)=xm*ucnt(i,ii,4)+xb
       jcon(i,ii,4)=j
       end if

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat line 2-3-4 in n regular spaces   
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       uinc=0.
       vinc=0.

       do j=1,21
       ucnt2(i,ii,j)=ucnt(i,ii,2)+uinc
       uinc=uinc+(ucnt(i,ii,4)-ucnt(i,ii,2))/20.

c      Between 2 and jcon(i,ii,2)+1
       if (ucnt2(i,ii,j).le.u(i,jcon(i,ii,2)+1,3)) then
       xm=(v(i,jcon(i,ii,2)+1,3)-vcnt(i,ii,2))/(u(i,jcon(i,ii,2)+1,3)-
     + ucnt(i,ii,2))
       xb=vcnt(i,ii,2)-xm*ucnt(i,ii,2)
       vcnt2(i,ii,j)=xm*ucnt2(i,ii,j)+xb
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Between jcon(i,ii,2)+1 and jcon(i,ii,4)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ucnt2(i,ii,j).ge.u(i,jcon(i,ii,2)+1,3).and.ucnt2(i,ii,j)
     + .le.u(i,jcon(i,ii,4),3)) then
c      
       do l=jcon(i,ii,2)+1,jcon(i,ii,4)-1

c      Seleccionar tram d'interpolació

       if (ucnt2(i,ii,j).ge.u(i,l,3).and.ucnt2(i,ii,j).le.u(i,l+1,3)) 
     + then
       xm=(v(i,l+1,3)-v(i,l,3))/(u(i,l+1,3)-u(i,l,3))
       xb=v(i,l,3)-xm*u(i,l,3)
       end if
       end do
c       xm=(v(i,jcon(i,ii,2)+j,3)-v(i,jcon(i,ii,2)+j-1,3))/
c     + (u(i,jcon(i,ii,2)+j,3)-u(i,jcon(i,ii,2)+j-1,3))
c       xb=v(i,jcon(i,ii,2)+j-1,3)-xm*u(i,jcon(i,ii,2)+j-1,3)
       vcnt2(i,ii,j)=xm*ucnt2(i,ii,j)+xb
       end if

c      Between jcon(i,ii,4) and 4       
       if (ucnt2(i,ii,j).gt.u(i,jcon(i,ii,4),3)) then
       xm=(vcnt(i,ii,4)-v(i,jcon(i,ii,4),3))/(ucnt(i,ii,4)-
     + u(i,jcon(i,ii,4),3))
       xb=vcnt(i,ii,4)-xm*ucnt(i,ii,4)
       vcnt2(i,ii,j)=xm*ucnt2(i,ii,j)+xb
       end if

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.4.2 Rib i
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)
       ii=hvr(k,4)

       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,1)=ucnt(i,ii,3)-hvr(k,8)
       ucnt(i,ii,2)=ucnt(i,ii,3)-hvr(k,7)
       ucnt(i,ii,4)=ucnt(i,ii,3)+hvr(k,7)
       ucnt(i,ii,5)=ucnt(i,ii,3)+hvr(k,8)
       ucnt(i,ii,6)=ucnt(i,ii,1)
       ucnt(i,ii,7)=ucnt(i,ii,3)
       ucnt(i,ii,8)=ucnt(i,ii,5)
       ucnt(i,ii,9)=ucnt(i,ii,1)
       ucnt(i,ii,10)=ucnt(i,ii,3)
       ucnt(i,ii,11)=ucnt(i,ii,5)

c      Points 1,3,5 interpolation in rib i
       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,1).and.u(i,j+1,3).ge.ucnt(i,ii,1)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,1)=xm*ucnt(i,ii,1)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,5).and.u(i,j+1,3).ge.ucnt(i,ii,5)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,5)=xm*ucnt(i,ii,5)+xb
       end if

       end do

c      Points 9,10,11 interpolation in rib i
       do j=1,np(i,2)

       if (u(i,j,3).ge.ucnt(i,ii,9).and.u(i,j+1,3).le.ucnt(i,ii,9)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,9)=xm*ucnt(i,ii,9)+xb
       end if

       if (u(i,j,3).ge.ucnt(i,ii,10).and.u(i,j+1,3).le.ucnt(i,ii,10)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,10)=xm*ucnt(i,ii,10)+xb
       end if

       if (u(i,j,3).ge.ucnt(i,ii,11).and.u(i,j+1,3).le.ucnt(i,ii,11)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,11)=xm*ucnt(i,ii,11)+xb
       end if

       end do

c      Calculus of 6,7,8 points in rib i
       vcnt(i,ii,6)=(vcnt(i,ii,9)-vcnt(i,ii,1))*(hvr(k,9)/100.)+
     + vcnt(i,ii,1)
       vcnt(i,ii,7)=(vcnt(i,ii,10)-vcnt(i,ii,3))*(hvr(k,9)/100.)+
     + vcnt(i,ii,3)
       vcnt(i,ii,8)=(vcnt(i,ii,11)-vcnt(i,ii,5))*(hvr(k,9)/100.)+
     + vcnt(i,ii,5)

c      Redefinition of points 6,8 if angle is not 90     
       if (hvr(k,10).ne.90.) then
       ucnt(i,ii,6)=ucnt(i,ii,7)-hvr(k,8)*dcos((pi/180.)*hvr(k,10))
       ucnt(i,ii,8)=ucnt(i,ii,7)+hvr(k,8)*dcos((pi/180.)*hvr(k,10))
       vcnt(i,ii,6)=vcnt(i,ii,7)-hvr(k,8)*dsin((pi/180.)*hvr(k,10))
       vcnt(i,ii,8)=vcnt(i,ii,7)+hvr(k,8)*dsin((pi/180.)*hvr(k,10))
       end if

c      Divide line 6-8 in n segments

       uinc=0.
       vinc=0.
       do j=1,21
       ucnt1(i,ii,j)=ucnt(i,ii,6)+uinc
       uinc=uinc+(ucnt(i,ii,8)-ucnt(i,ii,6))/20.
       vcnt1(i,ii,j)=vcnt(i,ii,6)+vinc
       vinc=vinc+(vcnt(i,ii,8)-vcnt(i,ii,6))/20.
       end do


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.4.3 Rib i+1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)+1
       ii=hvr(k,4)

       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,1)=ucnt(i,ii,3)-hvr(k,8)
       ucnt(i,ii,2)=ucnt(i,ii,3)-hvr(k,7)
       ucnt(i,ii,4)=ucnt(i,ii,3)+hvr(k,7)
       ucnt(i,ii,5)=ucnt(i,ii,3)+hvr(k,8)
       ucnt(i,ii,6)=ucnt(i,ii,1)
       ucnt(i,ii,7)=ucnt(i,ii,3)
       ucnt(i,ii,8)=ucnt(i,ii,5)
       ucnt(i,ii,9)=ucnt(i,ii,1)
       ucnt(i,ii,10)=ucnt(i,ii,3)
       ucnt(i,ii,11)=ucnt(i,ii,5)

c      Points 1,3,5 interpolation in rib i+1
       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,1).and.u(i,j+1,3).ge.ucnt(i,ii,1)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,1)=xm*ucnt(i,ii,1)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       end if

       if (u(i,j,3).le.ucnt(i,ii,5).and.u(i,j+1,3).ge.ucnt(i,ii,5)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,5)=xm*ucnt(i,ii,5)+xb
       end if

       end do

c      Points 9,10,11 interpolation in rib i+1
       do j=1,np(i,2)

       if (u(i,j,3).ge.ucnt(i,ii,9).and.u(i,j+1,3).le.ucnt(i,ii,9)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,9)=xm*ucnt(i,ii,9)+xb
       end if

       if (u(i,j,3).ge.ucnt(i,ii,10).and.u(i,j+1,3).le.ucnt(i,ii,10)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,10)=xm*ucnt(i,ii,10)+xb
       end if

       if (u(i,j,3).ge.ucnt(i,ii,11).and.u(i,j+1,3).le.ucnt(i,ii,11)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,11)=xm*ucnt(i,ii,11)+xb
       end if

       end do

c      Calculus of 6,7,8 points in rib i+1
       vcnt(i,ii,6)=(vcnt(i,ii,9)-vcnt(i,ii,1))*(hvr(k,9)/100.)+
     + vcnt(i,ii,1)
       vcnt(i,ii,7)=(vcnt(i,ii,10)-vcnt(i,ii,3))*(hvr(k,9)/100.)+
     + vcnt(i,ii,3)
       vcnt(i,ii,8)=(vcnt(i,ii,11)-vcnt(i,ii,5))*(hvr(k,9)/100.)+
     + vcnt(i,ii,5)

c      Redefinition of points 7,8 if angle is not 90     
       if (hvr(k,10).ne.90.) then
       ucnt(i,ii,6)=ucnt(i,ii,7)-hvr(k,8)*dcos((pi/180.)*hvr(k,10))
       ucnt(i,ii,8)=ucnt(i,ii,7)+hvr(k,8)*dcos((pi/180.)*hvr(k,10))
       vcnt(i,ii,6)=vcnt(i,ii,7)-hvr(k,8)*dsin((pi/180.)*hvr(k,10))
       vcnt(i,ii,8)=vcnt(i,ii,7)+hvr(k,8)*dsin((pi/180.)*hvr(k,10))
       end if

c      Divide line 6-8 in n segments

       uinc=0.
       vinc=0.
       do j=1,21
       ucnt3(i,ii,j)=ucnt(i,ii,6)+uinc
       uinc=uinc+(ucnt(i,ii,8)-ucnt(i,ii,6))/20.
       vcnt3(i,ii,j)=vcnt(i,ii,6)+vinc
       vinc=vinc+(vcnt(i,ii,8)-vcnt(i,ii,6))/20.
       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.4.4 Rib i+2
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)+2
       ii=hvr(k,4)

       ucnt(i,ii,3)=u(i,ii,6)
       ucnt(i,ii,1)=ucnt(i,ii,3)-hvr(k,8)
       ucnt(i,ii,2)=ucnt(i,ii,3)-(hvr(k,7)+hvr(k,16))
       ucnt(i,ii,4)=ucnt(i,ii,3)+(hvr(k,7)+hvr(k,16))
       ucnt(i,ii,5)=ucnt(i,ii,3)+hvr(k,8)
       ucnt(i,ii,6)=ucnt(i,ii,1)
       ucnt(i,ii,7)=ucnt(i,ii,3)
       ucnt(i,ii,8)=ucnt(i,ii,5)
       ucnt(i,ii,9)=ucnt(i,ii,1)
       ucnt(i,ii,10)=ucnt(i,ii,3)
       ucnt(i,ii,11)=ucnt(i,ii,5)


c      Points 2,3,4 interpolation in rib i+2
       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,2).and.u(i,j+1,3).ge.ucnt(i,ii,2)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,2)=xm*ucnt(i,ii,2)+xb
       jcon(i,ii,2)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       jcon(i,ii,3)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,4).and.u(i,j+1,3).ge.ucnt(i,ii,4)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,4)=xm*ucnt(i,ii,4)+xb
       jcon(i,ii,4)=j
       end if

       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat line 2-3-4 in n regular spaces   
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       uinc=0.
       vinc=0.

       do j=1,21
       ucnt4(i,ii,j)=ucnt(i,ii,2)+uinc
       uinc=uinc+(ucnt(i,ii,4)-ucnt(i,ii,2))/20.

c      Between 2 and jcon(i,ii,2)+1
       if (ucnt4(i,ii,j).le.u(i,jcon(i,ii,2)+1,3)) then
       xm=(v(i,jcon(i,ii,2)+1,3)-vcnt(i,ii,2))/(u(i,jcon(i,ii,2)+1,3)-
     + ucnt(i,ii,2))
       xb=vcnt(i,ii,2)-xm*ucnt(i,ii,2)
       vcnt4(i,ii,j)=xm*ucnt4(i,ii,j)+xb
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Between jcon(i,ii,2)+1 and jcon(i,ii,4)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ucnt4(i,ii,j).ge.u(i,jcon(i,ii,2)+1,3).and.ucnt4(i,ii,j)
     + .le.u(i,jcon(i,ii,4),3)) then
c      
       do l=jcon(i,ii,2)+1,jcon(i,ii,4)-1

c      Seleccionar tram d'interpolació

       if (ucnt4(i,ii,j).ge.u(i,l,3).and.ucnt4(i,ii,j).le.u(i,l+1,3)) 
     + then
       xm=(v(i,l+1,3)-v(i,l,3))/(u(i,l+1,3)-u(i,l,3))
       xb=v(i,l,3)-xm*u(i,l,3)
       end if
       end do
c       xm=(v(i,jcon(i,ii,2)+j,3)-v(i,jcon(i,ii,2)+j-1,3))/
c     + (u(i,jcon(i,ii,2)+j,3)-u(i,jcon(i,ii,2)+j-1,3))
c       xb=v(i,jcon(i,ii,2)+j-1,3)-xm*u(i,jcon(i,ii,2)+j-1,3)
       vcnt4(i,ii,j)=xm*ucnt4(i,ii,j)+xb
       end if

c      Between jcon(i,ii,4) and 4       
       if (ucnt4(i,ii,j).gt.u(i,jcon(i,ii,4),3)) then
       xm=(vcnt(i,ii,4)-v(i,jcon(i,ii,4),3))/(ucnt(i,ii,4)-
     + u(i,jcon(i,ii,4),3))
       xb=vcnt(i,ii,4)-xm*ucnt(i,ii,4)
       vcnt4(i,ii,j)=xm*ucnt4(i,ii,j)+xb
       end if

       end do


c      Rib localisation
       i=hvr(k,3)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.4.4 VH-ribs lines 1 2 3 4 transportation to 3D espace
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Rib i (Line 1)

       i=hvr(k,3)

       tetha=rib(i,8)*pi/180.

       do j=1,21
       ru(i,j,3)=ucnt1(i,ii,j)
       rv(i,j,3)=vcnt1(i,ii,j)-rib(i,50)
       end do

       do j=1,21

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       sx1(i,j,ii)=rx(i,j)
       sy1(i,j,ii)=ry(i,j)
       sz1(i,j,ii)=rz(i,j)

       end do

c      Rib i-1 (Line 2)

       i=hvr(k,3)-1

       tetha=rib(i,8)*pi/180.
       
       do j=1,21
       ru(i,j,3)=ucnt2(i,ii,j)
       rv(i,j,3)=vcnt2(i,ii,j)-rib(i,50)
       end do

       do j=1,21

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       sx2(i,j,ii)=rx(i,j)
       sy2(i,j,ii)=ry(i,j)
       sz2(i,j,ii)=rz(i,j)

       end do

c      Rib i+1 (Line 3)

       i=hvr(k,3)+1

       tetha=rib(i,8)*pi/180.

       do j=1,21
       ru(i,j,3)=ucnt3(i,ii,j)
       rv(i,j,3)=vcnt3(i,ii,j)-rib(i,50)
c      COMPTE AMB el rib(i,50) A ESTUDIAR       
       end do

       do j=1,21

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       sx3(i,j,ii)=rx(i,j)
       sy3(i,j,ii)=ry(i,j)
       sz3(i,j,ii)=rz(i,j)

       end do

c      Rib i+2 (Line 4)

       i=hvr(k,3)+2

       tetha=rib(i,8)*pi/180.
       
       do j=1,21
       ru(i,j,3)=ucnt4(i,ii,j)
       rv(i,j,3)=vcnt4(i,ii,j)-rib(i,50)
       end do

       do j=1,21

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       sx4(i,j,ii)=rx(i,j)
       sy4(i,j,ii)=ry(i,j)
       sz4(i,j,ii)=rz(i,j)

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Drawing VH Type 4 in 3D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


       do j=1,21

c      Rib i-1 to i+2

       i=hvr(k,3)

       if (hvr(k,5).eq.1) then
       call line3d(sx2(i-1,j,ii),sy2(i-1,j,ii),sz2(i-1,j,ii),
     + sx1(i,j,ii),sy1(i,j,ii),sz1(i,j,ii),3)
       call line3d(-sx2(i-1,j,ii),sy2(i-1,j,ii),sz2(i-1,j,ii),
     + -sx1(i,j,ii),sy1(i,j,ii),sz1(i,j,ii),3)
       end if

       call line3d(sx1(i,j,ii),sy1(i,j,ii),sz1(i,j,ii),
     + sx3(i+1,j,ii),sy3(i+1,j,ii),sz3(i+1,j,ii),2)
       call line3d(-sx1(i,j,ii),sy1(i,j,ii),sz1(i,j,ii),
     + -sx3(i+1,j,ii),sy3(i+1,j,ii),sz3(i+1,j,ii),2)

       if (hvr(k,6).eq.1) then
       call line3d(sx3(i+1,j,ii),sy3(i+1,j,ii),sz3(i+1,j,ii),
     + sx4(i+2,j,ii),sy4(i+2,j,ii),sz4(i+2,j,ii),1)
       call line3d(-sx3(i+1,j,ii),sy3(i+1,j,ii),sz3(i+1,j,ii),
     + -sx4(i+2,j,ii),sy4(i+2,j,ii),sz4(i+2,j,ii),1)
       end if

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.4.5 VH-ribs calculus and drawing in 2D and 3D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      VH-rib 1-2 in 2D model
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)-1 ! color green

       px0=0.
       py0=0.
       ptheta=0.

       do j=1,21

c      Distances between points
       pa=dsqrt((rx(i+1,j)-rx(i,j))**2.+(ry(i+1,j)-ry(i,j))**2.+
     + (rz(i+1,j)-rz(i,j))**2.)
       pb=dsqrt((rx(i+1,j+1)-rx(i,j))**2.+(ry(i+1,j+1)-ry(i,j))**2.+
     + (rz(i+1,j+1)-rz(i,j))**2.)
       pc=dsqrt((rx(i+1,j+1)-rx(i+1,j))**2.+(ry(i+1,j+1)-ry(i+1,j))**2.+
     + (rz(i+1,j+1)-rz(i+1,j))**2.)
       pd=dsqrt((rx(i+1,j)-rx(i,j+1))**2.+(ry(i+1,j)-ry(i,j+1))**2.+
     + (rz(i+1,j)-rz(i,j+1))**2.)
       pe=dsqrt((rx(i,j+1)-rx(i,j))**2.+(ry(i,j+1)-ry(i,j))**2.+
     + (rz(i,j+1)-rz(i,j))**2.)
       pf=dsqrt((rx(i+1,j+1)-rx(i,j+1))**2.+(ry(i+1,j+1)-ry(i,j+1))**2.+
     + (rz(i+1,j+1)-rz(i,j+1))**2.)
       
       pa2r=(pa*pa-pb*pb+pc*pc)/(2.*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

       pb2t=(pb*pb-pe*pe+pf*pf)/(2.*pb)
       pb1t=pb-pb2t
       pht=dsqrt(pf*pf-pb2t*pb2t)
       
       pw1=datan(phr/pa1r)
       phu=pb1t*dtan(pw1)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0
       
       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

c      Iteration
       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))
       
       end do

c      Drawing in 2D model
       
       psep=3300.*xkf+xrsep*float(i)
       psey=800.*xkf+yrsep*float(ii)

       if (hvr(k,5).eq.1) then

       j=1

       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),3)

       j=21

       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),3)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Marca punts MC a l'esquerra
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       alpha=-(datan((pl1y(i,1)-pl2y(i,20))/(pl1x(i,1)-pl2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp6=pl1x(i,1)-xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp6=pl1y(i,1)-xdes*dcos(alpha)+2.*xdes*dsin(alpha)
       xp8=pl1x(i,21)-xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp8=pl1y(i,21)-xdes*dcos(alpha)-2.*xdes*dsin(alpha)
c       xp7=0.5*(pl1x(i,1)+pl1x(i,21))-xdes*dsin(alpha)
c       yp7=0.5*(pl1y(i,1)+pl1y(i,21))-xdes*dcos(alpha)

       call point(psep+xp6,psey+yp6,1)
       call point(psep+xp8,psey+yp8,1)

c      Romano costat esquerra
       sl=1.
       
       xpx=(pl1x(i,1)+pl2x(i,20))/2.-sl*xdes*dsin(alpha)
       xpy=(pl1y(i,1)+pl2y(i,20))/2.-sl*xdes*dcos(alpha)

       xpx2=psep+xpx+0.3*hvr(k,7)*dcos(alpha)-0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy-0.3*hvr(k,7)*dsin(alpha)-0.3*xvrib*dcos(alpha) 

       call romano(i,xpx2,xpy2,alpha,typm6(10)*0.1,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Marca punts MC a la dreta
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       alpha=-(datan((pr1y(i,1)-pr2y(i,20))/(pr1x(i,1)
     + -pr2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp6=pr1x(i,1)+xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp6=pr1y(i,1)+xdes*dcos(alpha)+2.*xdes*dsin(alpha)
       xp8=pr1x(i,21)+xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp8=pr1y(i,21)+xdes*dcos(alpha)-2.*xdes*dsin(alpha)
       xp7=0.5*(xp6+xp8)
       yp7=0.5*(yp6+yp8)

       call point(psep+xp6,psey+yp6,1)
       call point(psep+xp8,psey+yp8,1)

c      Romano costat dret
       sr=1.
       
       xpx=(pr1x(i,1)+pr2x(i,20))/2.+xdes*dsin(alpha)
       xpy=(pr1y(i,1)+pr2y(i,20))/2.+xdes*dcos(alpha)

       xpx2=psep+xpx+0.5*hvr(k,8)*dcos(alpha)+0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy-0.5*hvr(k,8)*dsin(alpha)+0.3*xvrib*dcos(alpha) 

       call romano(i+1,xpx2,xpy2,alpha,typm6(10)*0.1,7)

       xpx2=psep+xpx-0.5*hvr(k,8)*dcos(alpha)+0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy+0.5*hvr(k,8)*dsin(alpha)+0.3*xvrib*dcos(alpha) 

       call romano(int(hvr(k,4)),xpx2,xpy2,alpha,typm6(10)*0.1,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Vores de costura
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do j=1,21-1

c       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pl2x(i,j),
c     + psey+pl2y(i,j),30)

c       call line(psep+pr1x(i,j),psey+pr1y(i,j),psep+pr2x(i,j),
c     + psey+pr2y(i,j),2)

c      Vores de costura esquerra
       alpl=abs(datan((pl2y(i,j)-pl1y(i,j))/(pl2x(i,j)-pl1x(i,j))))

       call line(psep+pl1x(i,j)-xvrib*dsin(alpl),psey+pl1y(i,j)
     + +xvrib*dcos(alpl),psep+pl2x(i,j)-xvrib*dsin(alpl),
     + psey+pl2y(i,j)+xvrib*dcos(alpl),3)

c      Vores de costura dreta
       alpr=abs(datan((pr2y(i,j)-pr1y(i,j))/(pr2x(i,j)-pr1x(i,j))))
c       alpr=-(datan((pr1y(i,j)-pr2y(i,j))/(pr1x(i,j)-pr2x(i,j))))
       if (alpr.lt.0.) then ! Revisar cases atčs que hi ha qualque no OK!!!!!!!!!!!!!
       alpr=alpr+pi
       end if

       call line(psep+pr1x(i,j)+xvrib*dsin(alpr),psey+pr1y(i,j)
     + -xvrib*dcos(alpr),psep+pr2x(i,j)+xvrib*dsin(alpr),
     + psey+pr2y(i,j)-xvrib*dcos(alpr),3)

c      Tancament lateral inici
       if (j.eq.1) then
       call line(psep+pl1x(i,j)-xvrib*dsin(alpl),psey+pl1y(i,j)
     + +xvrib*dcos(alpl),psep+pl1x(i,j),psey+pl1y(i,j),3)
       call line(psep+pr1x(i,j)+xvrib*dsin(alpr),psey+pr1y(i,j)
     + -xvrib*dcos(alpr),psep+pr1x(i,j),psey+pr1y(i,j),3)
       end if

c      Tancament lateral fi
       if (j.eq.20) then
       call line(psep+pl2x(i,j)-xvrib*dsin(alpl),psey+pl2y(i,j)
     + +xvrib*dcos(alpl),psep+pl2x(i,j),psey+pl2y(i,j),3)
       call line(psep+pr2x(i,j)+xvrib*dsin(alpr),psey+pr2y(i,j)
     + -xvrib*dcos(alpr),psep+pr2x(i,j),psey+pr2y(i,j),3)

       lvcx(i,j+1)=psep+pl2x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j+1)=psey+pl2y(i,j)-xvrib*dcos(alpl)

       rvcx(i,j+1)=psep+pr2x(i,j)+xvrib*dsin(alpr)
       rvcy(i,j+1)=psey+pr2y(i,j)+xvrib*dcos(alpr)

       end if

       
       end do ! J

c      V-rib length
       hvr(k,15)=dsqrt((lvcx(i,21)-rvcx(i,21))**2.+
     + (lvcy(i,21)-rvcy(i,21))**2.)

c      Numera cintes Type 4 V (i to i-1)
       call itxt(psep-0.-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i,7)
       call itxt(psep+hvr(k,15)-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i+1,7)


       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      VH-rib 3-4 in 2D model
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)+1 ! color red

       px0=0.0d0
       py0=0.0d0
       ptheta=0.0d0

       do j=1,21

c      Distances between points
       pa=dsqrt((rx(i+1,j)-rx(i,j))**2.+(ry(i+1,j)-ry(i,j))**2.+
     + (rz(i+1,j)-rz(i,j))**2.)
       pb=dsqrt((rx(i+1,j+1)-rx(i,j))**2.+(ry(i+1,j+1)-ry(i,j))**2.+
     + (rz(i+1,j+1)-rz(i,j))**2.)
       pc=dsqrt((rx(i+1,j+1)-rx(i+1,j))**2.+(ry(i+1,j+1)-ry(i+1,j))**2.+
     + (rz(i+1,j+1)-rz(i+1,j))**2.)
       pd=dsqrt((rx(i+1,j)-rx(i,j+1))**2.+(ry(i+1,j)-ry(i,j+1))**2.+
     + (rz(i+1,j)-rz(i,j+1))**2.)
       pe=dsqrt((rx(i,j+1)-rx(i,j))**2.+(ry(i,j+1)-ry(i,j))**2.+
     + (rz(i,j+1)-rz(i,j))**2.)
       pf=dsqrt((rx(i+1,j+1)-rx(i,j+1))**2.+(ry(i+1,j+1)-ry(i,j+1))**2.+
     + (rz(i+1,j+1)-rz(i,j+1))**2.)
       
       pa2r=(pa*pa-pb*pb+pc*pc)/(2.*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

       pb2t=(pb*pb-pe*pe+pf*pf)/(2.*pb)
       pb1t=pb-pb2t
       pht=dsqrt(pf*pf-pb2t*pb2t)
       
       pw1=datan(phr/pa1r)
       phu=pb1t*dtan(pw1)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0
       
       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

c      Iteration
       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))
       
       
       end do

c      Drawing in 2D model
       
       psep=3300.*xkf+xrsep*float(i)
       psey=800.*xkf+yrsep*float(ii)

       if (hvr(k,6).eq.1) then

       j=1

       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),1)

       j=21

       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),1)


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Marca punts MC a l'esquerra
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       alpha=-(datan((pl1y(i,1)-pl2y(i,20))/(pl1x(i,1)-pl2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp6=pl1x(i,1)-xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp6=pl1y(i,1)-xdes*dcos(alpha)+2.*xdes*dsin(alpha)
       xp8=pl1x(i,21)-xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp8=pl1y(i,21)-xdes*dcos(alpha)-2.*xdes*dsin(alpha)
c       xp7=0.5*(pl1x(i,1)+pl1x(i,21))-xdes*dsin(alpha)
c       yp7=0.5*(pl1y(i,1)+pl1y(i,21))-xdes*dcos(alpha)

       call point(psep+xp6,psey+yp6,1)
       call point(psep+xp8,psey+yp8,1)

c      Romano costat esquerra
       sl=1.
       
       xpx=(pl1x(i,1)+pl2x(i,20))/2.-sl*xdes*dsin(alpha)
       xpy=(pl1y(i,1)+pl2y(i,20))/2.-sl*xdes*dcos(alpha)

       xpx2=psep+xpx+0.3*hvr(k,7)*dcos(alpha)-0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy-0.3*hvr(k,7)*dsin(alpha)-0.3*xvrib*dcos(alpha) 

       call romano(i,xpx2,xpy2,alpha,typm6(10)*0.1,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Marca punts MC a la dreta
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       alpha=-(datan((pr1y(i,1)-pr2y(i,20))/(pr1x(i,1)
     + -pr2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp6=pr1x(i,1)+xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp6=pr1y(i,1)+xdes*dcos(alpha)+2.*xdes*dsin(alpha)
       xp8=pr1x(i,21)+xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp8=pr1y(i,21)+xdes*dcos(alpha)-2.*xdes*dsin(alpha)
       xp7=0.5*(xp6+xp8)
       yp7=0.5*(yp6+yp8)

       call point(psep+xp6,psey+yp6,1)
       call point(psep+xp8,psey+yp8,1)

c      Romano costat dret
       sr=1.
       
       xpx=(pr1x(i,1)+pr2x(i,20))/2.+xdes*dsin(alpha)
       xpy=(pr1y(i,1)+pr2y(i,20))/2.+xdes*dcos(alpha)

       xpx2=psep+xpx+0.2*hvr(k,8)*dcos(alpha)+0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy-0.2*hvr(k,8)*dsin(alpha)+0.3*xvrib*dcos(alpha) 

       call romano(i+1,xpx2,xpy2,alpha,typm6(10)*0.1,7)

       xpx2=psep+xpx-0.2*hvr(k,8)*dcos(alpha)+0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy+0.2*hvr(k,8)*dsin(alpha)+0.3*xvrib*dcos(alpha) 

       call romano(int(hvr(k,4)),xpx2,xpy2,alpha,typm6(10)*0.1,7)


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Vores de costura
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do j=1,21-1

c       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pl2x(i,j),
c     + psey+pl2y(i,j),1)

c       call line(psep+pr1x(i,j),psey+pr1y(i,j),psep+pr2x(i,j),
c     + psey+pr2y(i,j),1)

c      Vores de costura esquerra
       alpl=abs(datan((pl2y(i,j)-pl1y(i,j))/(pl2x(i,j)-pl1x(i,j))))

       call line(psep+pl1x(i,j)-xvrib*dsin(alpl),psey+pl1y(i,j)
     + +xvrib*dcos(alpl),psep+pl2x(i,j)-xvrib*dsin(alpl),
     + psey+pl2y(i,j)+xvrib*dcos(alpl),1)

c      Vores de costura dreta
       alpr=abs(datan((pr2y(i,j)-pr1y(i,j))/(pr2x(i,j)-pr1x(i,j))))

       call line(psep+pr1x(i,j)+xvrib*dsin(alpr),psey+pr1y(i,j)
     + -xvrib*dcos(alpr),psep+pr2x(i,j)+xvrib*dsin(alpr),
     + psey+pr2y(i,j)-xvrib*dcos(alpr),1)

c      Tancament lateral inici
       if (j.eq.1) then
       call line(psep+pl1x(i,j)-xvrib*dsin(alpl),psey+pl1y(i,j)
     + +xvrib*dcos(alpl),psep+pl1x(i,j),psey+pl1y(i,j),1)
       call line(psep+pr1x(i,j)+xvrib*dsin(alpr),psey+pr1y(i,j)
     + -xvrib*dcos(alpr),psep+pr1x(i,j),psey+pr1y(i,j),1)
       end if

c      Tancament lateral fi
       if (j.eq.20) then
       call line(psep+pl2x(i,j)-xvrib*dsin(alpl),psey+pl2y(i,j)
     + +xvrib*dcos(alpl),psep+pl2x(i,j),psey+pl2y(i,j),1)
       call line(psep+pr2x(i,j)+xvrib*dsin(alpr),psey+pr2y(i,j)
     + -xvrib*dcos(alpr),psep+pr2x(i,j),psey+pr2y(i,j),1)

       lvcx(i,j+1)=psep+pl2x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j+1)=psey+pl2y(i,j)-xvrib*dcos(alpl)

       rvcx(i,j+1)=psep+pr2x(i,j)+xvrib*dsin(alpr)
       rvcy(i,j+1)=psey+pr2y(i,j)+xvrib*dcos(alpr)

       end if


       end do ! j

c      V-rib length
       hvr(k,15)=dsqrt((lvcx(i,21)-rvcx(i,21))**2.+
     + (lvcy(i,21)-rvcy(i,21))**2.)

c      REVISAR PRESENTACIO

c      Numera cintes V TYpe 4 i+1 to i+2
       call itxt(psep-0.-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i,7)
       call itxt(psep+hvr(k,15)-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i+1,7)

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      VH-rib 1-3 in 2D model
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3) ! color yellow

       px0=0.
       py0=0.
       ptheta=0.

       do j=1,21

c      Distances between points
       pa=dsqrt((rx(i+1,j)-rx(i,j))**2.+(ry(i+1,j)-ry(i,j))**2.+
     + (rz(i+1,j)-rz(i,j))**2.)
       pb=dsqrt((rx(i+1,j+1)-rx(i,j))**2.+(ry(i+1,j+1)-ry(i,j))**2.+
     + (rz(i+1,j+1)-rz(i,j))**2.)
       pc=dsqrt((rx(i+1,j+1)-rx(i+1,j))**2.+(ry(i+1,j+1)-ry(i+1,j))**2.+
     + (rz(i+1,j+1)-rz(i+1,j))**2.)
       pd=dsqrt((rx(i+1,j)-rx(i,j+1))**2.+(ry(i+1,j)-ry(i,j+1))**2.+
     + (rz(i+1,j)-rz(i,j+1))**2.)
       pe=dsqrt((rx(i,j+1)-rx(i,j))**2.+(ry(i,j+1)-ry(i,j))**2.+
     + (rz(i,j+1)-rz(i,j))**2.)
       pf=dsqrt((rx(i+1,j+1)-rx(i,j+1))**2.+(ry(i+1,j+1)-ry(i,j+1))**2.+
     + (rz(i+1,j+1)-rz(i,j+1))**2.0d0)
       
       pa2r=(pa*pa-pb*pb+pc*pc)/(2.0d0*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.0d0*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

       pb2t=(pb*pb-pe*pe+pf*pf)/(2.0d0*pb)
       pb1t=pb-pb2t
       pht=dsqrt(pf*pf-pb2t*pb2t)
       
       pw1=datan(phr/pa1r)
       phu=pb1t*dtan(pw1)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0
       
       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

c      Iteration
       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))
       
       
       end do

c      Drawing in 2D model
       
       psep=3300.*xkf+xrsep*float(i)
       psey=800.*xkf+yrsep*float(ii)

       j=1

       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),30)

       j=21

       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),30)


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Marca punts MC a l'esquerra
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       alpha=-(datan((pl1y(i,1)-pl2y(i,20))/(pl1x(i,1)-pl2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp6=pl1x(i,1)-xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp6=pl1y(i,1)-xdes*dcos(alpha)+2.*xdes*dsin(alpha)
       xp8=pl1x(i,21)-xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp8=pl1y(i,21)-xdes*dcos(alpha)-2.*xdes*dsin(alpha)
c       xp7=0.5*(pl1x(i,1)+pl1x(i,21))-xdes*dsin(alpha)
c       yp7=0.5*(pl1y(i,1)+pl1y(i,21))-xdes*dcos(alpha)

       call point(psep+xp6,psey+yp6,1)
       call point(psep+xp8,psey+yp8,1)

c      Romano costat esquerra
       sl=1.
       
       xpx=(pl1x(i,1)+pl2x(i,20))/2.-sl*xdes*dsin(alpha)
       xpy=(pl1y(i,1)+pl2y(i,20))/2.-sl*xdes*dcos(alpha)

       xpx2=psep+xpx+0.3*hvr(k,7)*dcos(alpha)-0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy-0.3*hvr(k,7)*dsin(alpha)-0.3*xvrib*dcos(alpha) 

       call romano(i,xpx2,xpy2,alpha,typm6(10)*0.1,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Marca punts MC a la dreta
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       alpha=-(datan((pr1y(i,1)-pr2y(i,20))/(pr1x(i,1)
     + -pr2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp6=pr1x(i,1)+xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp6=pr1y(i,1)+xdes*dcos(alpha)+2.*xdes*dsin(alpha)
       xp8=pr1x(i,21)+xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp8=pr1y(i,21)+xdes*dcos(alpha)-2.*xdes*dsin(alpha)
       xp7=0.5*(xp6+xp8)
       yp7=0.5*(yp6+yp8)

       call point(psep+xp6,psey+yp6,1)
       call point(psep+xp8,psey+yp8,1)

c      Romano costat dret
       sr=1.
       
       xpx=(pr1x(i,1)+pr2x(i,20))/2.+xdes*dsin(alpha)
       xpy=(pr1y(i,1)+pr2y(i,20))/2.+xdes*dcos(alpha)

       xpx2=psep+xpx+0.5*hvr(k,8)*dcos(alpha)+0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy-0.5*hvr(k,8)*dsin(alpha)+0.3*xvrib*dcos(alpha) 

       call romano(i+1,xpx2,xpy2,alpha,typm6(10)*0.1,7)

       xpx2=psep+xpx-0.5*hvr(k,8)*dcos(alpha)+0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy+0.5*hvr(k,8)*dsin(alpha)+0.3*xvrib*dcos(alpha) 

       call romano(int(hvr(k,4)),xpx2,xpy2,alpha,typm6(10)*0.1,7)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Vores de costura
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do j=1,21-1

c       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pl2x(i,j),
c     + psey+pl2y(i,j),1)

c       call line(psep+pr1x(i,j),psey+pr1y(i,j),psep+pr2x(i,j),
c     + psey+pr2y(i,j),1)


c      Vores de costura esquerra
       alpl=abs(datan((pl2y(i,j)-pl1y(i,j))/(pl2x(i,j)-pl1x(i,j))))

       call line(psep+pl1x(i,j)-xvrib*dsin(alpl),psey+pl1y(i,j)
     + +xvrib*dcos(alpl),psep+pl2x(i,j)-xvrib*dsin(alpl),
     + psey+pl2y(i,j)+xvrib*dcos(alpl),30)

c      Vores de costura dreta
       alpr=abs(datan((pr2y(i,j)-pr1y(i,j))/(pr2x(i,j)-pr1x(i,j))))

       call line(psep+pr1x(i,j)+xvrib*dsin(alpr),psey+pr1y(i,j)
     + -xvrib*dcos(alpr),psep+pr2x(i,j)+xvrib*dsin(alpr),
     + psey+pr2y(i,j)-xvrib*dcos(alpr),30)

c      Tancament lateral inici
       if (j.eq.1) then
       call line(psep+pl1x(i,j)-xvrib*dsin(alpl),psey+pl1y(i,j)
     + +xvrib*dcos(alpl),psep+pl1x(i,j),psey+pl1y(i,j),30)
       call line(psep+pr1x(i,j)+xvrib*dsin(alpr),psey+pr1y(i,j)
     + -xvrib*dcos(alpr),psep+pr1x(i,j),psey+pr1y(i,j),30)
       end if

c      Tancament lateral fi
       if (j.eq.20) then
       call line(psep+pl2x(i,j)-xvrib*dsin(alpl),psey+pl2y(i,j)
     + +xvrib*dcos(alpl),psep+pl2x(i,j),psey+pl2y(i,j),30)
       call line(psep+pr2x(i,j)+xvrib*dsin(alpr),psey+pr2y(i,j)
     + -xvrib*dcos(alpr),psep+pr2x(i,j),psey+pr2y(i,j),30)

       lvcx(i,j+1)=psep+pl2x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j+1)=psey+pl2y(i,j)-xvrib*dcos(alpl)

       rvcx(i,j+1)=psep+pr2x(i,j)+xvrib*dsin(alpr)
       rvcy(i,j+1)=psey+pr2y(i,j)+xvrib*dcos(alpr)

       end if

       end do

c      V-rib length
       hvr(k,15)=dsqrt((lvcx(i,21)-rvcx(i,21))**2.+
     + (lvcy(i,21)-rvcy(i,21))**2.)

c      Numera cintes H Type 4 i to i+1
       call itxt(psep-0.-xrsep+83.*xkf-120.*(typm3(10)/10.),psey-10,
     + typm3(10),0.0d0,i,7)
       call itxt(psep+hvr(k,15)-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i+1,7)


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Drawing VH-ribs in 2D ribs
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Box (1,2)

       sepxx=700.*xkf
       sepyy=100.*xkf

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Rib i-1
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       kx=int((float(i-2)/6.))
       ky=i-1-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

c       write (*,*) "i,kx,ky ",i,kx,ky,sepx,sepy

       if (hvr(k,5).eq.1) then

c      Segment
       call line(sepx+ucnt(i-1,ii,2),-vcnt(i-1,ii,2)+sepy,
     + sepx+ucnt(i-1,ii,4),-vcnt(i-1,ii,4)+sepy,3)
       call line(sepx+2530.*xkf+ucnt(i-1,ii,2),-vcnt(i-1,ii,2)+sepy,
     + sepx+2530.*xkf+ucnt(i-1,ii,4),-vcnt(i-1,ii,4)+sepy,3)

c      Points in 2
       alpha=(datan((v(i-1,jcon(i-1,ii,2)-1,3)-v(i-1,jcon(i-1,ii,2)+1,
     + 3))/(u(i-1,jcon(i-1,ii,2)-1,3)-u(i-1,jcon(i-1,ii,2)+1,3))))
       xpeq=ucnt(i-1,ii,2)+1.*xdes*dsin(alpha)
       ypeq=vcnt(i-1,ii,2)-1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,3)
       call point(sepx+xpeq-1*dsin(alpha),sepy-ypeq-1*dcos(alpha),1)
       call point(sepx+xpeq-2*dsin(alpha),sepy-ypeq-2*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,3)
       call point(2530.*xkf+sepx+xpeq-1*dsin(alpha),sepy-ypeq-
     + 1*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq-2*dsin(alpha),sepy-ypeq-
     + 2*dcos(alpha),1)

c      Points in 4
       alpha=(datan((v(i-1,jcon(i-1,ii,4)-1,3)-v(i-1,jcon(i-1,ii,4)+1,
     + 3))/(u(i-1,jcon(i-1,ii,4)-1,3)-u(i-1,jcon(i-1,ii,4)+1,3))))
       xpeq=ucnt(i-1,ii,4)+1.*xdes*dsin(alpha)
       ypeq=vcnt(i-1,ii,4)-1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,3)
       call point(sepx+xpeq-1*dsin(alpha),sepy-ypeq-1*dcos(alpha),1)
       call point(sepx+xpeq-2*dsin(alpha),sepy-ypeq-2*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,3)
       call point(2530.*xkf+sepx+xpeq-1*dsin(alpha),sepy-ypeq-
     + 1*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq-2*dsin(alpha),sepy-ypeq-
     + 2*dcos(alpha),1)

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Rib i (center)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       kx=int((float(i-1)/6.))
       ky=i-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

c      Segment
       call line(sepx+ucnt(i,ii,6),-vcnt(i,ii,6)+sepy,
     + sepx+ucnt(i,ii,8),-vcnt(i,ii,8)+sepy,30)
       call line(sepx+2530.*xkf+ucnt(i,ii,6),-vcnt(i,ii,6)+sepy,
     + sepx+2530.*xkf+ucnt(i,ii,8),-vcnt(i,ii,8)+sepy,30)

c      Points in 6
       alpha=(datan((v(i,jcon(i,ii,6)-1,3)-v(i,jcon(i,ii,6)+1,
     + 3))/(u(i,jcon(i,ii,6)-1,3)-u(i,jcon(i,ii,6)+1,3))))
       xpeq=ucnt(i,ii,6)-1.*xdes*dsin(alpha)
       ypeq=vcnt(i,ii,6)+1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,1)
c       call point(sepx+xpeq+1*dsin(alpha),sepy-ypeq+1*dcos(alpha),1)
c       call point(sepx+xpeq+2*dsin(alpha),sepy-ypeq+2*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,1)
c       call point(2530.*xkf+sepx+xpeq+1*dsin(alpha),sepy-ypeq+
c     + 1*dcos(alpha),1)
c       call point(2530.*xkf+sepx+xpeq+2*dsin(alpha),sepy-ypeq+
c     + 2*dcos(alpha),1)

c      Points in 8
       alpha=(datan((v(i,jcon(i,ii,8)-1,3)-v(i,jcon(i,ii,8)+1,
     + 3))/(u(i,jcon(i,ii,8)-1,3)-u(i,jcon(i,ii,8)+1,3))))
       xpeq=ucnt(i,ii,8)-1.*xdes*dsin(alpha)
       ypeq=vcnt(i,ii,8)+1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,30)
c       call point(sepx+xpeq+1*dsin(alpha),sepy-ypeq+1*dcos(alpha),1)
c       call point(sepx+xpeq+2*dsin(alpha),sepy-ypeq+2*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,30)
c       call point(2530.*xkf+sepx+xpeq+1*dsin(alpha),sepy-ypeq+
c     + 1*dcos(alpha),1)
c       call point(2530.*xkf+sepx+xpeq+2*dsin(alpha),sepy-ypeq+
c     + 2*dcos(alpha),1)


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Rib i+1
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       kx=int((float(i)/6.))
       ky=i+1-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

       if (hvr(k,6).eq.1) then
       
c      Segment
       call line(sepx+ucnt(i+1,ii,6),-vcnt(i+1,ii,6)+sepy,
     + sepx+ucnt(i+1,ii,8),-vcnt(i+1,ii,8)+sepy,30)
       call line(sepx+2530.*xkf+ucnt(i+1,ii,6),-vcnt(i+1,ii,6)+sepy,
     + sepx+2530.*xkf+ucnt(i+1,ii,8),-vcnt(i+1,ii,8)+sepy,30)

c      Points in 6
       alpha=(datan((v(i+1,jcon(i+1,ii,6)-1,3)-v(i+1,jcon(i+1,ii,6)+1,
     + 3))/(u(i+1,jcon(i+1,ii,6)-1,3)-u(i+1,jcon(i+1,ii,6)+1,3))))
       xpeq=ucnt(i+1,ii,6)-1.*xdes*dsin(alpha)
       ypeq=vcnt(i+1,ii,6)+1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,30)
c       call point(sepx+xpeq+1*dsin(alpha),sepy-ypeq+1*dcos(alpha),1)
c       call point(sepx+xpeq+2*dsin(alpha),sepy-ypeq+2*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,30)
c       call point(2530.*xkf+sepx+xpeq+1*dsin(alpha),sepy-ypeq+
c     + 1*dcos(alpha),1)
c       call point(2530.*xkf+sepx+xpeq+2*dsin(alpha),sepy-ypeq+
c     + 2*dcos(alpha),1)

c      Points in 8
       alpha=(datan((v(i+1,jcon(i+1,ii,8)-1,3)-v(i+1,jcon(i+1,ii,8)+1,
     + 3))/(u(i+1,jcon(i+1,ii,8)-1,3)-u(i+1,jcon(i+1,ii,8)+1,3))))
       xpeq=ucnt(i+1,ii,8)-1.*xdes*dsin(alpha)
       ypeq=vcnt(i+1,ii,8)+1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,1)
c       call point(sepx+xpeq+1*dsin(alpha),sepy-ypeq+1*dcos(alpha),1)
c       call point(sepx+xpeq+2*dsin(alpha),sepy-ypeq+2*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,1)
c       call point(2530.*xkf+sepx+xpeq+1*dsin(alpha),sepy-ypeq+
c     + 1*dcos(alpha),1)
c       call point(2530.*xkf+sepx+xpeq+2*dsin(alpha),sepy-ypeq+
c     + 2*dcos(alpha),1)

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Rib i+2
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       kx=int((float(i+1)/6.))
       ky=i+2-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

       if (hvr(k,6).eq.1) then

c      Segment
       call line(sepx+ucnt(i+2,ii,2),-vcnt(i+2,ii,2)+sepy,
     + sepx+ucnt(i+2,ii,4),-vcnt(i+2,ii,4)+sepy,1)
       call line(sepx+2530.*xkf+ucnt(i+2,ii,2),-vcnt(i+2,ii,2)+sepy,
     + sepx+2530.*xkf+ucnt(i+2,ii,4),-vcnt(i+2,ii,4)+sepy,1)

c      Points in 2
       alpha=(datan((v(i+2,jcon(i+2,ii,2)-1,3)-v(i+2,jcon(i+2,ii,2)+1,
     + 3))/(u(i+2,jcon(i+2,ii,2)-1,3)-u(i+2,jcon(i+2,ii,2)+1,3))))
       xpeq=ucnt(i+2,ii,2)+1.*xdes*dsin(alpha)
       ypeq=vcnt(i+2,ii,2)-1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,3)
       call point(sepx+xpeq-1*dsin(alpha),sepy-ypeq-1*dcos(alpha),1)
       call point(sepx+xpeq-2*dsin(alpha),sepy-ypeq-2*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,3)
       call point(2530.*xkf+sepx+xpeq-1*dsin(alpha),sepy-ypeq-
     + 1*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq-2*dsin(alpha),sepy-ypeq-
     + 2*dcos(alpha),1)

c      Points in 4
       alpha=(datan((v(i+2,jcon(i+2,ii,4)-1,3)-v(i+2,jcon(i+2,ii,4)+1,
     + 3))/(u(i+2,jcon(i+2,ii,4)-1,3)-u(i+2,jcon(i+2,ii,4)+1,3))))
       xpeq=ucnt(i+2,ii,4)+1.*xdes*dsin(alpha)
       ypeq=vcnt(i+2,ii,4)-1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,3)
       call point(sepx+xpeq-1*dsin(alpha),sepy-ypeq-1*dcos(alpha),1)
       call point(sepx+xpeq-2*dsin(alpha),sepy-ypeq-2*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,3)
       call point(2530.*xkf+sepx+xpeq-1*dsin(alpha),sepy-ypeq-
     + 1*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq-2*dsin(alpha),sepy-ypeq-
     + 2*dcos(alpha),1)

       end if

       end if   ! end type VH



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.6 V-rib Type 6 GENERAL TYPE
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.6.1 Rib i
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Now ii is virtual row, assigned automatically for each rib
       iii=1

       if (hvr(k,2).eq.6) then

c      Define types 6 along rib
       if (k.ge.2.and.hvr(k-1,2).eq.6.and.hvr(k-1,3).eq.hvr(k,3)) then
       iii=iii+1
       end if

c      Define main points 2,3,4,9,10,11

       i=hvr(k,3)    ! rib i
       ii=iii       ! virtual row ii, in rib i

       ucnt(i,ii,3)=rib(i,5)*hvr(k,4)/100.0d0
       ucnt(i,ii,2)=ucnt(i,ii,3)-hvr(k,6)
       ucnt(i,ii,4)=ucnt(i,ii,3)+hvr(k,7)
       ucnt(i,ii,6)=ucnt(i,ii,2)
       ucnt(i,ii,7)=ucnt(i,ii,3)
       ucnt(i,ii,8)=ucnt(i,ii,4)
       ucnt(i,ii,9)=ucnt(i,ii,2)
       ucnt(i,ii,10)=ucnt(i,ii,3)
       ucnt(i,ii,11)=ucnt(i,ii,4)

c      Points 2,3,4 interpolation in rib i

       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,2).and.u(i,j+1,3).ge.ucnt(i,ii,2)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,2)=xm*ucnt(i,ii,2)+xb
       jcon(i,ii,2)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       jcon(i,ii,3)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,4).and.u(i,j+1,3).ge.ucnt(i,ii,4)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,4)=xm*ucnt(i,ii,4)+xb
       jcon(i,ii,4)=j
       end if

       end do

c      Points 9,10,11 interpolation in rib i

       do j=1,np(i,2)

       if (u(i,j,3).gt.ucnt(i,ii,9).and.u(i,j+1,3).le.ucnt(i,ii,9)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,9)=xm*ucnt(i,ii,9)+xb
       jcon(i,ii,9)=j+1
       end if

       if (u(i,j,3).gt.ucnt(i,ii,10).and.u(i,j+1,3).le.ucnt(i,ii,10)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,10)=xm*ucnt(i,ii,10)+xb
       jcon(i,ii,10)=j+1
       end if

       if (u(i,j,3).gt.ucnt(i,ii,11).and.u(i,j+1,3).le.ucnt(i,ii,11)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,11)=xm*ucnt(i,ii,11)+xb
       jcon(i,ii,11)=j+1
       end if

       end do

c      Points 6,8 interpolation in rib i

       vcnt(i,ii,6)=(vcnt(i,ii,9)-vcnt(i,ii,2))*(hvr(k,5)/100.)+
     + vcnt(i,ii,2)
       vcnt(i,ii,8)=(vcnt(i,ii,11)-vcnt(i,ii,4))*(hvr(k,5)/100.)+
     + vcnt(i,ii,4)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case h1=0.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (hvr(k,5).eq.0.) then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat line 2-3-4 in n regular spaces   
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Experimental version     
c      Reformat in 20 spaces

       n1vr=jcon(i,ii,4)-jcon(i,ii,2)+1
       n2vr=20+1

c      Load data polyline
       xlin1(1)=ucnt(i,ii,2)
       ylin1(1)=vcnt(i,ii,2)
       do j=2,n1vr-1
       xlin1(j)=u(i,jcon(i,ii,2)+j-1,3)
       ylin1(j)=v(i,jcon(i,ii,2)+j-1,3)
c      MIRAR SI CAL +-1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       end do
       xlin1(n1vr)=ucnt(i,ii,4)
       ylin1(n1vr)=vcnt(i,ii,4)

c      Call subroutine vector redistribution

       call vredis(xlin1,ylin1,xlin3,ylin3,n1vr,n2vr)

c      Load result polyline

       do j=1,n2vr
       ucnt2(i,ii,j)=xlin3(j)
       vcnt2(i,ii,j)=ylin3(j)
       end do

       end if ! case h1=0.

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case 0. < h1 < 100.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Redefine line 2: ucnt2(i,ii,j) - vcnt2(i,ii,j)
c      Divide line 6-8 in n segments

       uinc=0.
       vinc=0.
       do j=1,21
       ucnt2(i,ii,j)=ucnt(i,ii,6)+uinc
       uinc=uinc+(ucnt(i,ii,8)-ucnt(i,ii,6))/20.
       vcnt2(i,ii,j)=vcnt(i,ii,6)+vinc
       vinc=vinc+(vcnt(i,ii,8)-vcnt(i,ii,6))/20.
       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case h1=100.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,5).eq.100.) then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat 9-10-11 in n spaces (rib i)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
   
c      Reformat in 20 spaces

       n1vr=jcon(i,ii,9)-jcon(i,ii,11)+1    
       n2vr=20+1

c      Load data polyline
       xlin1(1)=ucnt(i,ii,9)
       ylin1(1)=vcnt(i,ii,9)
       do j=2,n1vr-1
       xlin1(j)=u(i,jcon(i,ii,9)-j+1,3)
       ylin1(j)=v(i,jcon(i,ii,9)-j+1,3)
c      MIRAR SI CAL +-1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       end do
       xlin1(n1vr)=ucnt(i,ii,11)
       ylin1(n1vr)=vcnt(i,ii,11)

c      Call subroutine vector redistribution

       call vredis(xlin1,ylin1,xlin3,ylin3,n1vr,n2vr)

c      Load result polyline

       do j=1,n2vr
       ucnt2(i,ii,j)=xlin3(j)
       vcnt2(i,ii,j)=ylin3(j)
       end do
 
       end if ! Case h1=100.


cccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.6.2 Rib i+1
cccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,8)   ! rib i+1
c      ii use virtial row 

       ucnt(i,ii,3)=rib(i,5)*hvr(k,9)/100.0d0

c       ucnt(i,ii,1)=ucnt(i,ii,3)-hvr(k,8)

       ucnt(i,ii,2)=ucnt(i,ii,3)-hvr(k,11)
       ucnt(i,ii,4)=ucnt(i,ii,3)+hvr(k,12)
       ucnt(i,ii,6)=ucnt(i,ii,2)
       ucnt(i,ii,8)=ucnt(i,ii,4)
       ucnt(i,ii,9)=ucnt(i,ii,2)
       ucnt(i,ii,11)=ucnt(i,ii,4)

c      Points 2,3,4 interpolation in rib i+1

       do j=np(i,2),np(i,1)

       if (u(i,j,3).le.ucnt(i,ii,2).and.u(i,j+1,3).ge.ucnt(i,ii,2)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,2)=xm*ucnt(i,ii,2)+xb
       jcon(i,ii,2)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,3).and.u(i,j+1,3).ge.ucnt(i,ii,3)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,3)=xm*ucnt(i,ii,3)+xb
       jcon(i,ii,3)=j
       end if

       if (u(i,j,3).le.ucnt(i,ii,4).and.u(i,j+1,3).ge.ucnt(i,ii,4)) then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,4)=xm*ucnt(i,ii,4)+xb
       jcon(i,ii,4)=j
       end if

       end do

c      Points 9,10,11 interpolation in rib i+1

       do j=1,np(i,2)

       if (u(i,j,3).gt.ucnt(i,ii,9).and.u(i,j+1,3).le.ucnt(i,ii,9)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,9)=xm*ucnt(i,ii,9)+xb
       jcon(i,ii,9)=j+1
       end if

       if (u(i,j,3).gt.ucnt(i,ii,10).and.u(i,j+1,3).le.ucnt(i,ii,10)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,10)=xm*ucnt(i,ii,10)+xb
       jcon(i,ii,10)=j+1
       end if

       if (u(i,j,3).gt.ucnt(i,ii,11).and.u(i,j+1,3).le.ucnt(i,ii,11)) 
     + then
       xm=(v(i,j+1,3)-v(i,j,3))/(u(i,j+1,3)-u(i,j,3))
       xb=v(i,j,3)-xm*u(i,j,3)
       vcnt(i,ii,11)=xm*ucnt(i,ii,11)+xb
       jcon(i,ii,11)=j+1
       end if

       end do

c      Points 6,8 interpolation in rib i+1

       vcnt(i,ii,6)=(vcnt(i,ii,9)-vcnt(i,ii,2))*(hvr(k,10)/100.)+
     + vcnt(i,ii,2)
       vcnt(i,ii,8)=(vcnt(i,ii,11)-vcnt(i,ii,4))*(hvr(k,10)/100.)+
     + vcnt(i,ii,4)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case h2=0.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,10).eq.0.) then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat line 2-3-4 in n regular spaces   
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Experimental version     
c      Reformat in 20 spaces

       n1vr=jcon(i,ii,4)-jcon(i,ii,2)+1
       n2vr=20+1

c      Load data polyline
       xlin1(1)=ucnt(i,ii,2)
       ylin1(1)=vcnt(i,ii,2)
       do j=2,n1vr-1
       xlin1(j)=u(i,jcon(i,ii,2)+j-1,3)
       ylin1(j)=v(i,jcon(i,ii,2)+j-1,3)
c      MIRAR SI CAL +-1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       end do
       xlin1(n1vr)=ucnt(i,ii,4)
       ylin1(n1vr)=vcnt(i,ii,4)

c      Call subroutine vector redistribution

       call vredis(xlin1,ylin1,xlin3,ylin3,n1vr,n2vr)

c      Load result polyline

       do j=1,n2vr
       ucnt3(i,ii,j)=xlin3(j)
       vcnt3(i,ii,j)=ylin3(j)
       end do

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case 0. < h2 < 100.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Redefine line 2: ucnt3(i,ii,j) - vcnt3(i,ii,j)
c      Divide line 6-8 in n segments

       uinc=0.
       vinc=0.
       do j=1,21
       ucnt3(i,ii,j)=ucnt(i,ii,6)+uinc
       uinc=uinc+(ucnt(i,ii,8)-ucnt(i,ii,6))/20.
       vcnt3(i,ii,j)=vcnt(i,ii,6)+vinc
       vinc=vinc+(vcnt(i,ii,8)-vcnt(i,ii,6))/20.
       end do

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case h2=100.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,10).eq.100.) then

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Reformat 9-10-11 in n spaces (rib i+1)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Experimental version     
c      Reformat in 20 spaces

       n1vr=jcon(i,ii,9)-jcon(i,ii,11)+1
       n2vr=20+1

c      Load data polyline
       xlin1(1)=ucnt(i,ii,9)
       ylin1(1)=vcnt(i,ii,9)
       do j=2,n1vr-1
       xlin1(j)=u(i,jcon(i,ii,9)-j+1,3)
       ylin1(j)=v(i,jcon(i,ii,9)-j+1,3)
c      MIRAR SI CAL +-1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       end do
       xlin1(n1vr)=ucnt(i,ii,11)
       ylin1(n1vr)=vcnt(i,ii,11)

c      Call subroutine vector redistribution

       call vredis(xlin1,ylin1,xlin3,ylin3,n1vr,n2vr)

c      Load result polyline

       do j=1,n2vr
       ucnt3(i,ii,j)=xlin3(j)
       vcnt3(i,ii,j)=ylin3(j)
       end do

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Rib localisation
       i=hvr(k,3)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.6.3 V-ribs lines 2 3 transportation to 3D espace
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Rib i (Line 2)

       i=hvr(k,3)

       tetha=rib(i,8)*pi/180.
       
       do j=1,21
       ru(i,j,3)=ucnt2(i,ii,j)
       rv(i,j,3)=vcnt2(i,ii,j)-rib(i,50)
       end do

       do j=1,21

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       rx2(i,j,ii)=rx(i,j)
       ry2(i,j,ii)=ry(i,j)
       rz2(i,j,ii)=rz(i,j)

       end do

c      Rib i+1 (Line 3)

       i=hvr(k,8)

       tetha=rib(i,8)*pi/180.

       do j=1,21
       ru(i,j,3)=ucnt3(i,ii,j)
       rv(i,j,3)=vcnt3(i,ii,j)-rib(i,50)      
       end do

       do j=1,21

       u_aux(i,j,1)=ru(i,j,3)
       v_aux(i,j,1)=rv(i,j,3)
       w_aux(i,j,1)=0.0d0
       call xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)
       rx(i,j)=w_aux(i,j,5)
       ry(i,j)=u_aux(i,j,5)
       rz(i,j)=v_aux(i,j,5)

       rx3(i-1,j,ii)=rx(i,j)
       ry3(i-1,j,ii)=ry(i,j)
       rz3(i-1,j,ii)=rz(i,j)

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.6.4 V-ribs calculus and drawing in 3D and 2D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.6.4 V-rib 2-3 in 2D model (red)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       i=hvr(k,3)

       px0=0.
       py0=0.
       ptheta=0.

       do j=1,21

c      Distances between points
       pa=dsqrt((rx(i+1,j)-rx(i,j))**2.+(ry(i+1,j)-ry(i,j))**2.+
     + (rz(i+1,j)-rz(i,j))**2.)
       pb=dsqrt((rx(i+1,j+1)-rx(i,j))**2.+(ry(i+1,j+1)-ry(i,j))**2.+
     + (rz(i+1,j+1)-rz(i,j))**2.)
       pc=dsqrt((rx(i+1,j+1)-rx(i+1,j))**2.+(ry(i+1,j+1)-ry(i+1,j))**2.+
     + (rz(i+1,j+1)-rz(i+1,j))**2.)
       pd=dsqrt((rx(i+1,j)-rx(i,j+1))**2.+(ry(i+1,j)-ry(i,j+1))**2.+
     + (rz(i+1,j)-rz(i,j+1))**2.)
       pe=dsqrt((rx(i,j+1)-rx(i,j))**2.+(ry(i,j+1)-ry(i,j))**2.+
     + (rz(i,j+1)-rz(i,j))**2.)
       pf=dsqrt((rx(i+1,j+1)-rx(i,j+1))**2.+(ry(i+1,j+1)-ry(i,j+1))**2.+
     + (rz(i+1,j+1)-rz(i,j+1))**2.)
       
       pa2r=(pa*pa-pb*pb+pc*pc)/(2.0d0*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.0d0*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

       pb2t=(pb*pb-pe*pe+pf*pf)/(2.0d0*pb)
       pb1t=pb-pb2t
       pht=dsqrt(pf*pf-pb2t*pb2t)
       
       pw1=datan(phr/pa1r)
       phu=pb1t*dtan(pw1)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0
       
       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

c      Iteration
       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))
       
       
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Drawing Type-6 in 2D model
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       

c      Draw in BOX(2,6)

       psep=(3300.+1260.+1260.)*xkf+xrsep*float(i)
       psey=(800.+890.85+100.)*xkf+(hvr(k,4)+hvr(k,9))*0.5*
     + rib(int(hvr(k,3)),5)*3.0/100.

c       write (*,*) "i,ii ",i,ii

       j=1

c      Costat vora d'atac
       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),1)

       j=21
c      Costat fuga
       call line(psep+pl1x(i,j),psey+pl1y(i,j),psep+pr1x(i,j),
     + psey+pr1y(i,j),1)


c      Marca punts MC a l'esquerra

       alpha=-(datan((pl1y(i,1)-pl2y(i,20))/(pl1x(i,1)-pl2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp6=pl1x(i,1)-xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp6=pl1y(i,1)-xdes*dcos(alpha)+2.*xdes*dsin(alpha)
       xp8=pl1x(i,21)-xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp8=pl1y(i,21)-xdes*dcos(alpha)-2.*xdes*dsin(alpha)
c       xp7=0.5*(pl1x(i,1)+pl1x(i,21))-xdes*dsin(alpha)
c       yp7=0.5*(pl1y(i,1)+pl1y(i,21))-xdes*dcos(alpha)

c       call point(psep+xp7,psey+yp7,2)

       call point(psep+xp6,psey+yp6,1)
c       call point(psep+xp7,psey+yp7,1)
       call point(psep+xp8,psey+yp8,1)


c      Romano costat esquerra

       sl=1.
       
       xpx=(pl1x(i,1)+pl2x(i,20))/2.-sl*xdes*dsin(alpha)
       xpy=(pl1y(i,1)+pl2y(i,20))/2.-sl*xdes*dcos(alpha)

       xpx2=psep+xpx+0.3*hvr(k,7)*dcos(alpha)-0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy-0.3*hvr(k,7)*dsin(alpha)-0.3*xvrib*dcos(alpha) 

       call romano(i,xpx2,xpy2,alpha,typm6(10)*0.1,7)

c      Marca punts MC a la dreta

       alpha=-(datan((pr1y(i,1)-pr2y(i,20))/(pr1x(i,1)
     + -pr2x(i,20))))
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

       xp6=pr1x(i,1)+xdes*dsin(alpha)-2.*xdes*dcos(alpha)
       yp6=pr1y(i,1)+xdes*dcos(alpha)+2.*xdes*dsin(alpha)
       xp8=pr1x(i,21)+xdes*dsin(alpha)+2.*xdes*dcos(alpha)
       yp8=pr1y(i,21)+xdes*dcos(alpha)-2.*xdes*dsin(alpha)
       xp7=0.5*(xp6+xp8)
       yp7=0.5*(yp6+yp8)

       call point(psep+xp6,psey+yp6,1)
c       call point(psep+xp7,psey+yp7,1)
       call point(psep+xp8,psey+yp8,1)

c      Romano costat dret

       sr=1.
       
       xpx=(pr1x(i,1)+pr2x(i,20))/2.+xdes*dsin(alpha)
       xpy=(pr1y(i,1)+pr2y(i,20))/2.+xdes*dcos(alpha)

       xpx2=psep+xpx+0.2*hvr(k,8)*dcos(alpha)+0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy-0.2*hvr(k,8)*dsin(alpha)+0.3*xvrib*dcos(alpha) 

       call romano(i+1,xpx2,xpy2,alpha,typm6(10)*0.1,7)

       xpx2=psep+xpx-0.2*hvr(k,8)*dcos(alpha)+0.3*xvrib*dsin(alpha)
       xpy2=psey+xpy+0.2*hvr(k,8)*dsin(alpha)+0.3*xvrib*dcos(alpha) 

c      Numbering of Type 6 pieces now fron 0 t 10 according the %
       call romano(int(hvr(k,4)*0.1),xpx2,xpy2,alpha,typm6(10)*0.1,7)

c      Vores de costura

       do j=1,21-1

c      Vores de costura esquerra
       alpl=-(datan((pl1y(i,j)-pl2y(i,j))/(pl1x(i,j)-pl2x(i,j))))
       if (alpl.lt.0.) then
       alpl=alpl+pi
       end if

       lvcx(i,j)=psep+pl1x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j)=psey+pl1y(i,j)-xvrib*dcos(alpl)

c      Vores de costura dreta
       alpr=-(datan((pr1y(i,j)-pr2y(i,j))/(pr1x(i,j)-pr2x(i,j))))
       if (alpr.lt.0.) then
       alpr=alpr+pi
       end if

       rvcx(i,j)=psep+pr1x(i,j)+xvrib*dsin(alpr)
       rvcy(i,j)=psey+pr1y(i,j)+xvrib*dcos(alpr)

c      Tancament lateral inici
       if (j.eq.1) then
       call line(psep+pl1x(i,j)-xvrib*dsin(alpl),psey+pl1y(i,j)
     + -xvrib*dcos(alpl),psep+pl1x(i,j),psey+pl1y(i,j),1)
       call line(psep+pr1x(i,j)+xvrib*dsin(alpr),psey+pr1y(i,j)
     + +xvrib*dcos(alpr),psep+pr1x(i,j),psey+pr1y(i,j),1)
       end if

c      Tancament lateral fi
       if (j.eq.20) then
       call line(psep+pl2x(i,j)-xvrib*dsin(alpl),psey+pl2y(i,j)
     + -xvrib*dcos(alpl),psep+pl2x(i,j),psey+pl2y(i,j),1)
       call line(psep+pr2x(i,j)+xvrib*dsin(alpr),psey+pr2y(i,j)
     + +xvrib*dcos(alpr),psep+pr2x(i,j),psey+pr2y(i,j),1)

       lvcx(i,j+1)=psep+pl2x(i,j)-xvrib*dsin(alpl)
       lvcy(i,j+1)=psey+pl2y(i,j)-xvrib*dcos(alpl)

       rvcx(i,j+1)=psep+pr2x(i,j)+xvrib*dsin(alpr)
       rvcy(i,j+1)=psey+pr2y(i,j)+xvrib*dcos(alpr)

       end if

       end do ! j

c      V-rib length
       hvr(k,15)=dsqrt((lvcx(i,1)-rvcx(i,1))**2.0d0+
     + (lvcy(i,1)-rvcy(i,1))**2.0d0)

c      Numera cintes V Type 6
       call itxt(psep-xrsep+83.*xkf-120.*(typm3(10)/10.),psey-10,
     + typm3(10),0.0d0,i,7)
       call itxt(psep+hvr(k,15)-xrsep+83.*xkf-120.*(typm3(10)/10.),
     + psey-10,typm3(10),0.0d0,i+1,7)

c      Dibuixa vores amb segments completament enllaçats       
       do j=1,20

       call line(lvcx(i,j),lvcy(i,j),lvcx(i,j+1),lvcy(i,j+1),1)
       call line(rvcx(i,j),rvcy(i,j),rvcx(i,j+1),rvcy(i,j+1),1)

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.6.5 Drawing V-ribs marks in 2D ribs
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Drawing in 2D ribs printing and MC (+2530.xkf)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Box (1,2)

       sepxx=700.*xkf
       sepyy=100.*xkf

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Rib i (center)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       kx=int((float(i-1)/6.))
       ky=i-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case h1=0.
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,5).eq.0.) then

c      Segment
       call line(sepx+ucnt(i,ii,2),-vcnt(i,ii,2)+sepy,
     + sepx+ucnt(i,ii,4),-vcnt(i,ii,4)+sepy,1)
       call line(sepx+2530.*xkf+ucnt(i,ii,2),-vcnt(i,ii,2)+sepy,
     + sepx+2530.*xkf+ucnt(i,ii,4),-vcnt(i,ii,4)+sepy,1)

c      Points in 2 and 4 (Experimental)

c      Points in 2
       alpha=(datan((v(i,jcon(i,ii,2)-1,3)-v(i,jcon(i,ii,2)+1,
     + 3))/(u(i,jcon(i,ii,2)-1,3)-u(i,jcon(i,ii,2)+1,3))))
       xpeq=ucnt(i,ii,2)+1.*xdes*dsin(alpha)
       ypeq=vcnt(i,ii,2)-1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,1)
       call point(sepx+xpeq-1*dsin(alpha),sepy-ypeq-1*dcos(alpha),1)
       call point(sepx+xpeq-2*dsin(alpha),sepy-ypeq-2*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,1)
       call point(2530.*xkf+sepx+xpeq-1*dsin(alpha),sepy-ypeq-
     + 1*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq-2*dsin(alpha),sepy-ypeq-
     + 2*dcos(alpha),1)

c      Points in 4
       alpha=(datan((v(i,jcon(i,ii,4)-1,3)-v(i,jcon(i,ii,4)+1,
     + 3))/(u(i,jcon(i,ii,4)-1,3)-u(i,jcon(i,ii,4)+1,3))))
       xpeq=ucnt(i,ii,4)+1.*xdes*dsin(alpha)
       ypeq=vcnt(i,ii,4)-1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,1)
       call point(sepx+xpeq-1*dsin(alpha),sepy-ypeq-1*dcos(alpha),1)
       call point(sepx+xpeq-2*dsin(alpha),sepy-ypeq-2*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,1)
       call point(2530.*xkf+sepx+xpeq-1*dsin(alpha),sepy-ypeq-
     + 1*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq-2*dsin(alpha),sepy-ypeq-
     + 2*dcos(alpha),1)

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case 0. < h1 < 100.
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,5).gt.0.and.hvr(k,5).lt.100.) then

c      Segment
       call line(sepx+ucnt(i,ii,6),-vcnt(i,ii,6)+sepy,
     + sepx+ucnt(i,ii,8),-vcnt(i,ii,8)+sepy,1)
       call line(sepx+2530.*xkf+ucnt(i,ii,6),-vcnt(i,ii,6)+sepy,
     + sepx+2530.*xkf+ucnt(i,ii,8),-vcnt(i,ii,8)+sepy,1)

c      Punts marcatge V-rib
       alpha=datan((vcnt(i,ii,8)-vcnt(i,ii,6))/
     + (ucnt(i,ii,8)-ucnt(i,ii,6)))
       xp6=ucnt(i,ii,6)-xdes*dsin(alpha)
       yp6=vcnt(i,ii,6)+xdes*dcos(alpha)
       xp8=ucnt(i,ii,8)-xdes*dsin(alpha)
       yp8=vcnt(i,ii,8)+xdes*dcos(alpha)
       xp7=0.5*(xp6+xp8)
       yp7=0.5*(yp6+yp8)
       call point(sepx+xp6,sepy-yp6,1)
       call point(sepx+xp7,sepy-yp7,1)
       call point(sepx+xp8,sepy-yp8,1)
       call point(sepx+2530.*xkf+xp6,sepy-yp6,1)
       call point(sepx+2530.*xkf+xp7,sepy-yp7,1)
       call point(sepx+2530.*xkf+xp8,sepy-yp8,1)

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case h1=100.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,5).eq.100.) then

c      Segment
       call line(sepx+ucnt(i,ii,9),-vcnt(i,ii,9)+sepy,
     + sepx+ucnt(i,ii,11),-vcnt(i,ii,11)+sepy,1)
       call line(sepx+2530.*xkf+ucnt(i,ii,9),-vcnt(i,ii,9)+sepy,
     + sepx+2530.*xkf+ucnt(i,ii,11),-vcnt(i,ii,11)+sepy,1)

c      Points in 9
       alpha=(datan((v(i,jcon(i,ii,9)-1,3)-v(i,jcon(i,ii,9)+1,
     + 3))/(u(i,jcon(i,ii,9)-1,3)-u(i,jcon(i,ii,9)+1,3))))
       xpeq=ucnt(i,ii,9)-1.*xdes*dsin(alpha)
       ypeq=vcnt(i,ii,9)+1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,1)
       call point(sepx+xpeq+1*dsin(alpha),sepy-ypeq+1*dcos(alpha),1)
       call point(sepx+xpeq+2*dsin(alpha),sepy-ypeq+2*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,1)
       call point(2530.*xkf+sepx+xpeq+1*dsin(alpha),sepy-ypeq+
     + 1*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq+2*dsin(alpha),sepy-ypeq+
     + 2*dcos(alpha),1)

c      Points in 11
       alpha=(datan((v(i,jcon(i,ii,11)-1,3)-v(i,jcon(i,ii,11)+1,
     + 3))/(u(i,jcon(i,ii,11)-1,3)-u(i,jcon(i,ii,11)+1,3))))
       xpeq=ucnt(i,ii,11)-1.*xdes*dsin(alpha)
       ypeq=vcnt(i,ii,11)+1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,1)
       call point(sepx+xpeq+1*dsin(alpha),sepy-ypeq+1*dcos(alpha),1)
       call point(sepx+xpeq+2*dsin(alpha),sepy-ypeq+2*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,1)
       call point(2530.*xkf+sepx+xpeq+1*dsin(alpha),sepy-ypeq+
     + 1*dcos(alpha),1)
       call point(2530.*xkf+sepx+xpeq+2*dsin(alpha),sepy-ypeq+
     + 2*dcos(alpha),1)

       end if


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Rib i+1
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       kx=int((float(i)/6.))
       ky=i+1-kx*6

       sepx=sepxx+seprix*float(kx)
       sepy=sepyy+sepriy*float(ky-1)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case h2=0.
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,10).eq.0.) then

c      Segments
       call line(sepx+ucnt(i+1,ii,2),-vcnt(i+1,ii,2)+sepy,
     + sepx+ucnt(i+1,ii,4),-vcnt(i+1,ii,4)+sepy,4)
       call line(sepx+2530.*xkf+ucnt(i+1,ii,2),-vcnt(i+1,ii,2)+sepy,
     + sepx+2530.*xkf+ucnt(i+1,ii,4),-vcnt(i+1,ii,4)+sepy,4)

c      Draw 3 point in 2 and 4

c      Points in 2 and 4 (Experimental)

c      Points in 2
       alpha=(datan((v(i+1,jcon(i+1,ii,2)-1,3)-v(i+1,jcon(i+1,ii,2)+1,
     + 3))/(u(i+1,jcon(i+1,ii,2)-1,3)-u(i+1,jcon(i+1,ii,2)+1,3))))
       xpeq=ucnt(i+1,ii,2)+1.*xdes*dsin(alpha)
       ypeq=vcnt(i+1,ii,2)-1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,4)
       call point(sepx+xpeq-1*dsin(alpha),sepy-ypeq-1*dcos(alpha),4)
       call point(sepx+xpeq-2*dsin(alpha),sepy-ypeq-2*dcos(alpha),4)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,4)
       call point(2530.*xkf+sepx+xpeq-1*dsin(alpha),sepy-ypeq-
     + 1*dcos(alpha),4)
       call point(2530.*xkf+sepx+xpeq-2*dsin(alpha),sepy-ypeq-
     + 2*dcos(alpha),4)

c      Points in 4
       alpha=(datan((v(i+1,jcon(i+1,ii,4)-1,3)-v(i+1,jcon(i+1,ii,4)+1,
     + 3))/(u(i+1,jcon(i+1,ii,4)-1,3)-u(i+1,jcon(i+1,ii,4)+1,3))))
       xpeq=ucnt(i+1,ii,4)+1.*xdes*dsin(alpha)
       ypeq=vcnt(i+1,ii,4)-1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,4)
       call point(sepx+xpeq-1*dsin(alpha),sepy-ypeq-1*dcos(alpha),4)
       call point(sepx+xpeq-2*dsin(alpha),sepy-ypeq-2*dcos(alpha),4)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,4)
       call point(2530.*xkf+sepx+xpeq-1*dsin(alpha),sepy-ypeq-
     + 1*dcos(alpha),4)
       call point(2530.*xkf+sepx+xpeq-2*dsin(alpha),sepy-ypeq-
     + 2*dcos(alpha),4)

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case 0. < h2 < 100.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,10).gt.0.and.hvr(k,10).lt.100.) then

c      Segments
       call line(sepx+ucnt(i+1,ii,6),-vcnt(i+1,ii,6)+sepy,
     + sepx+ucnt(i+1,ii,8),-vcnt(i+1,ii,8)+sepy,4)
       call line(sepx+2530.*xkf+ucnt(i+1,ii,6),-vcnt(i+1,ii,6)+sepy,
     + sepx+2530.*xkf+ucnt(i+1,ii,8),-vcnt(i+1,ii,8)+sepy,4)

c      Punts marcatge V-rib
       alpha=datan((vcnt(i+1,ii,8)-vcnt(i+1,ii,6))/
     + (ucnt(i+1,ii,8)-ucnt(i+1,ii,6)))
       xp6=ucnt(i+1,ii,6)-xdes*dsin(alpha)
       yp6=vcnt(i+1,ii,6)+xdes*dcos(alpha)
       xp8=ucnt(i+1,ii,8)-xdes*dsin(alpha)
       yp8=vcnt(i+1,ii,8)+xdes*dcos(alpha)
       xp7=0.5*(xp6+xp8)
       yp7=0.5*(yp6+yp8)
       call point(sepx+xp6,sepy-yp6,4)
       call point(sepx+xp7,sepy-yp7,4)
       call point(sepx+xp8,sepy-yp8,4)
       call point(sepx+2530.*xkf+xp6,sepy-yp6,4)
       call point(sepx+2530.*xkf+xp7,sepy-yp7,4)
       call point(sepx+2530.*xkf+xp8,sepy-yp8,4)

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case h2=100.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,10).eq.100.) then

c      Segements
       call line(sepx+ucnt(i+1,ii,9),-vcnt(i+1,ii,9)+sepy,
     + sepx+ucnt(i+1,ii,11),-vcnt(i+1,ii,11)+sepy,4)
       call line(sepx+2530.*xkf+ucnt(i+1,ii,9),-vcnt(i+1,ii,9)+sepy,
     + sepx+2530.*xkf+ucnt(i+1,ii,11),-vcnt(i+1,ii,11)+sepy,4)

c      Draw 3 point in 9 and 11

c      Points in 9
       alpha=(datan((v(i+1,jcon(i+1,ii,9)-1,3)-v(i+1,jcon(i+1,ii,9)+1,
     + 3))/(u(i+1,jcon(i+1,ii,9)-1,3)-u(i+1,jcon(i+1,ii,9)+1,3))))
       xpeq=ucnt(i+1,ii,9)-1.*xdes*dsin(alpha)
       ypeq=vcnt(i+1,ii,9)+1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,4)
       call point(sepx+xpeq+1*dsin(alpha),sepy-ypeq+1*dcos(alpha),4)
       call point(sepx+xpeq+2*dsin(alpha),sepy-ypeq+2*dcos(alpha),4)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,4)
       call point(2530.*xkf+sepx+xpeq+1*dsin(alpha),sepy-ypeq+
     + 1*dcos(alpha),4)
       call point(2530.*xkf+sepx+xpeq+2*dsin(alpha),sepy-ypeq+
     + 2*dcos(alpha),4)

c      Points in 11
       alpha=(datan((v(i+1,jcon(i+1,ii,11)-1,3)-v(i+1,jcon(i+1,ii,11)+1,
     + 3))/(u(i+1,jcon(i+1,ii,11)-1,3)-u(i+1,jcon(i+1,ii,11)+1,3))))
       xpeq=ucnt(i+1,ii,11)-1.*xdes*dsin(alpha)
       ypeq=vcnt(i+1,ii,11)+1.*xdes*dcos(alpha)
       call point(sepx+xpeq,sepy-ypeq,4)
       call point(sepx+xpeq+1*dsin(alpha),sepy-ypeq+1*dcos(alpha),4)
       call point(sepx+xpeq+2*dsin(alpha),sepy-ypeq+2*dcos(alpha),4)
       call point(2530.*xkf+sepx+xpeq,sepy-ypeq,4)
       call point(2530.*xkf+sepx+xpeq+1*dsin(alpha),sepy-ypeq+
     + 1*dcos(alpha),4)
       call point(2530.*xkf+sepx+xpeq+2*dsin(alpha),sepy-ypeq+
     + 2*dcos(alpha),4)

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      16.6.6 Draw V-rib type 6 in 3D model
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Colors definition if even or odd
       control=((hvr(k,3))/2.)-float(int((hvr(k,3))/2.))
       if (control.ne.0) then
       icolor=4
       else
       icolor=30
       end if

c      Draw in 3D model
       do j=1,21
       call line3d(rx2(i,j,ii),ry2(i,j,ii),rz2(i,j,ii),
     + rx3(i,j,ii),ry3(i,j,ii),rz3(i,j,ii),icolor)
       call line3d(-rx2(i,j,ii),ry2(i,j,ii),rz2(i,j,ii),
     + -rx3(i,j,ii),ry3(i,j,ii),rz3(i,j,ii),icolor)
       end do

c      end if V-rib type 6
       end if


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c   End type 6
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


c      Seguent dispositiu

       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     17. CALAGE CALCULUS (SOLVE EQUILIBRIUM)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (k35d.eq.1) then ! only if section 35 active

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     17.0 Initial calculus
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Quick links mass (maillons)
       xlimog(16)=x35qlmass*dfloat(nrisers)*2./1000. ! kg

c      Lines drag
c      Drag in each line or riser xlimo(i,22) (N)
       x35linesd=0.0
       do i=1,cordat
       xlimo(i,22)=xlimo(i,21)*0.5*x35ro*x35v*x35v*(xlimo(i,3)*1e-6)
       x35linesd=x35linesd+xlimo(i,22)
       end do
       x35linesd=x35linesd*2. ! total N

c       write (*,*) "Ep1:",x35linesd
c       write (*,*) x35dlcoef
c       write (*,*) "Ep2:",0.5*x35ro*x35v*x35v*x35dlcoef*xlimog(3)

c      Total lines drag center of application, ponderation by line drag
c      xlimo(1,11) and xlimo(i,12) are (y,z) coordinates of line center
c      xlimo(i,22) is line drag (N)
       x35dly=0.0d0
       x35dlz=0.0d0
       do i=1,cordat
       x35dly=x35dly+xlimo(i,11)*xlimo(i,22)  
       x35dlz=x35dlz+xlimo(i,12)*xlimo(i,22)
       end do
       x35dly=(x35dly/100.)/(x35linesd*0.5)
       x35dlz=(x35dlz/100.)/(x35linesd*0.5)

c      Pilot drag (N)
       x35pilotd=x35dpcoef*0.5*x35ro*x35v*x35v*x35spilot

c      Flat area used as reference for aerodynamic forces
       farea=acit*2./10000. ! Flat area m2

c      Area. Select farea or parea
       farea=(rib(1,4)-rib(1,3))*rib(1,2)
       parea=(rib(1,4)-rib(1,3))*rib(1,6)
       do i=1,nribss-1
       farea=farea+(rib(i,4)-rib(i,3)+rib(i+1,4)-rib(i+1,3))*0.5*
     + (rib(i+1,2)-rib(i,2))
       parea=parea+(rib(i,4)-rib(i,3)+rib(i+1,4)-rib(i+1,3))*0.5*
     + (rib(i+1,6)-rib(i,6))
       end do
       farea=farea*2./10000.
       parea=parea*2./10000.

c      Select flat or projected area (default is flat)
       if (i37fparea.eq.1) then
       fparea=farea
       else
       fparea=parea
       end if

c      Wing lift (N) previous
       x35wlp=x35cl*x35cle*0.5*x35ro*x35v*x35v*fparea

c      Wing drag (N) previous
       x35wdp=x35cd*x35cde*0.5*x35ro*x35v*x35v*fparea

c      Solve equilibrium equations
c      Simplified notations
c      Uniformice forces to Newtons (!)
       x35_a=x35wlp  ! Lift_p (previous)
       x35_b=x35wdp  ! Drag_p (previous)
       x35_c=(x35wingmass+xlimog(2)+xlimog(16)+x35pilotmass)*x35grav ! Weight (N)
       xlimog(17)=x35_c ! Total Weight (N)
       xlimog(18)=xlimog(17)/x35grav ! kg total mass
       x35_d=x35linesd ! Lines drag
       x35_e=x35pilotd ! Pilot drag

c      Set instrumental glide angle (no used)
       x35finesse=2.*x35lambda-2.     ! Set finesse proportional to AR!!!
       x35gammai=datan(1./x35finesse) ! Set instrumental glide angle

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Solve for gamma and K (vertical and horizontal equilibrium) (I+II)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      17.1 Method 1 (i37solve=1) Solve gamma and K simultaneous
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (i37solve.eq.1) then

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Solve in first aproximate
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       x35zeroprev=100.
       do x35gamma=0.01,0.8,0.005 ! explore 1 to 45 deg aprox
c      Vertical equilibrium
       x35_k1=(x35_c-(x35_d+x35_e)*dsin(x35gamma))/
     + (x35_a*dcos(x35gamma)+x35_b*dsin(x35gamma))
c      Horizontal equilibrium
       x35_k2=-((x35_d+x35_e)*dcos(x35gamma))/
     + (-x35_a*dsin(x35gamma)+x35_b*dcos(x35gamma))
       x35zero=dabs(x35_k1-x35_k2)
c      Solve zero by brute force
       if (x35zero.le.x35zeroprev.and.dabs(x35_k2).le.2.0d0) then
       x35gammafi=x35gamma
       x35zeroprev=x35zero
       x35_k1fi=x35_k1
       x35_k2fi=x35_k2
       end if
       end do ! gamma

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Solve again, with increased precision
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       x35zeroprev=100.
       do x35gamma=x35gammafi-0.08,x35gammafi+0.08,0.0016 ! 100 iterations +-5 deg
c      Vertical equilibrium
       x35_k1=(x35_c-(x35_d+x35_e)*dsin(x35gamma))/
     + (x35_a*dcos(x35gamma)+x35_b*dsin(x35gamma))
c      Horizontal equilibrium
       x35_k2=-((x35_d+x35_e)*dcos(x35gamma))/
     + (-x35_a*dsin(x35gamma)+x35_b*dcos(x35gamma))
       x35zero=dabs(x35_k1-x35_k2)
c      Solve zero by brute force
       if (x35zero.le.x35zeroprev.and.dabs(x35_k2).le.2.0d0) then
       x35gammafi=x35gamma
       x35zeroprev=x35zero
       x35_k1fi=x35_k1
       x35_k2fi=x35_k2
       end if
c       write (*,*) "Ep ",x35gamma*180./pi,x35gammafi*180./pi,
c     + x35_k1,x35_k2,x35zero
       end do ! gamma

c      k and gamma
       x35_k1=x35_k1fi
       x35_k2=x35_k2fi
       x35gamma=x35gammafi
       x35theta=x35gamma-x35alpha
       x35_k=(x35_k1+x35_k2)/2.
       x35finesse=1./dtan(x35gamma)

c      Initial flight speed
       x35vi=dsqrt((xlimog(17)*dcos(x35gamma))/
     + (0.5*x35ro*fparea*x35cl*x35cle*x35_k))

c      x35_a = "Lift"
       x35wl=x35cl*x35_k*0.5*x35ro*x35vi*x35vi*fparea
c      Lift extra
       x35liftextra=x35cl*x35_k*(x35cle-1.)*0.5*x35ro*x35vi*x35vi*fparea
c      x35_b = "Drag"
       x35wd=x35cd*x35_k*0.5*x35ro*x35vi*x35vi*fparea
c      Drag extra
       x35dragextra=x35cd*x35_k*(x35cde-1.)*0.5*x35ro*x35vi*x35vi*fparea

c      Put warnings and hints if no convergence (!!!)
c      If weight is excessive, there may be no angle that achieves vertical balance
c      If the lift at angle 0 is greater than the weight, there is no balance

c      Verify convergence
       i35m1contr=0
       x35m1contr=0.0d0

       end if ! End method 1

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      17.2 Method 2 (i37solve=2) solve for gamma i dragextra
c      WARNING! Is not logical! Do not use!
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (i37solve.eq.2) then

       x35_k=1.0
       x35_k1=1.0
       x35_k2=1.0

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Solve dragextra in first aproximate
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       x35zeroprev=100.
       do x35gamma=0.01,0.8,0.005 ! explore 1 to 45 deg aprox
c      Vertical equilibrium
       x35_k1d=(x35_c-x35_a*dcos(x35gamma)-(x35_b+x35_d+x35_e)*
     + dsin(x35gamma))/dsin(x35gamma)
c      Horizontal equilibrium
       x35_k2d=(x35_a*dsin(x35gamma)-(x35_b+x35_d+x35_e)*
     + dcos(x35gamma))/dcos(x35gamma)
c      Zero
       x35zero=dabs(x35_k1d-x35_k2d)
c      Solve zero by brute force
       if (x35zero.le.x35zeroprev) then
       x35gammafi=x35gamma
       x35zeroprev=x35zero
       x35_k1fi=x35_k1d
       x35_k2fi=x35_k2d
       end if
c       write (*,*) "Ep ",x35gamma*180./pi,x35gammafi*180./pi,
c     + x35_k1d,x35_k2d,x35zero
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Solve again, with increased precision
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       x35zeroprev=100.
       do x35gamma=x35gammafi-0.08,x35gammafi+0.08,0.0016 ! 100 iterations +-5 deg
c      Vertical equilibrium
       x35_k1d=(x35_c-x35_a*dcos(x35gamma)-(x35_b+x35_d+x35_e)*
     + dsin(x35gamma))/dsin(x35gamma)
c      Horizontal equilibrium
       x35_k2d=(x35_a*dsin(x35gamma)-(x35_b+x35_d+x35_e)*
     + dcos(x35gamma))/dcos(x35gamma)
c      Zero
       x35zero=dabs(x35_k1d-x35_k2d)
c      Solve zero by brute force
       if (x35zero.le.x35zeroprev) then
       x35gammafi=x35gamma
       x35zeroprev=x35zero
       x35_k1fi=x35_k1d
       x35_k2fi=x35_k2d
       end if
c       write (*,*) "Ep ",x35gamma*180./pi,x35gammafi*180./pi,
c     + x35_k1d,x35_k2d,x35zero
       end do

       x35_k1d=x35_k1fi
       x35_k2d=x35_k2fi
       x35gamma=x35gammafi
       x35theta=x35gamma-x35alpha
       x35dragextra=(x35_k1d+x35_k2d)/2.
       x35finesse=1./dtan(x35gamma)
       x35_k1=1.0
       x35_k2=1.0
       x35_k=1.0
       x35wl=x35wlp*x35_k            ! set Lift final regularized
       x35wd=x35wdp*x35_k            ! set Drag final regularized
c      Put warnings and hints if no convergence (!!!)
c      If weight is excessive, there may be no angle that achieves vertical balance
c      If the lift at angle 0 is greater than the weight, there is no balance

c       x35_k=1.0
c       x35_k1=1.0
c       x35_k2=1.0

c      Verify convergence WARNING Improve criteria !!!!
       i35m2contr=0        ! 0 = converges
       x35m2contr=0.0d0
       x35m2contr=dabs((x35_k1fi-x35_k2fi)/x35_k1fi)*100.
       if (x35m2contr.gt.15.or.x35_k1fi.eq.0.0d0) then
       i35m2contr=1 ! Does not converge (!)
       end if
c       write (*,*) 
c       write (*,*) i35m2contr,x35m2contr

       end if ! End method 2


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      17.3 Method 3 (i37solve=2) solve for (gamma, K) and then (gamma dragextra)
c      WARNING! Is not logical! Do not use!
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (i37solve.eq.3) then

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     Uniformize Lift and Drag using first method 1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       x35zeroprev=100.
       do x35gamma=0.01,0.8,0.005 ! explore 1 to 45 deg aprox
c      Vertical equilibrium
       x35_k1=(x35_c-(x35_d+x35_e)*dsin(x35gamma))/
     + (x35_a*dcos(x35gamma)+x35_b*dsin(x35gamma))
c      Horizontal equilibrium
       x35_k2=-((x35_d+x35_e)*dcos(x35gamma))/
     + (-x35_a*dsin(x35gamma)+x35_b*dcos(x35gamma))
       x35zero=dabs(x35_k1-x35_k2)
c      Solve zero by brute force
       if (x35zero.le.x35zeroprev.and.dabs(x35_k2).le.2.0d0) then
       x35gammafi=x35gamma
       x35zeroprev=x35zero
       x35_k1fi=x35_k1
       x35_k2fi=x35_k2
       end if
c       write (*,*) "Ep ",x35gamma*180./pi,x35gammafi*180./pi,
c     + x35_k1,x35_k2,x35zero
       end do
       x35_k1=x35_k1fi
       x35_k2=x35_k2fi
       x35gamma=x35gammafi
       x35theta=x35gamma-x35alpha
       x35_k=(x35_k1+x35_k2)/2.
       x35finesse=1./dtan(x35gamma)
       x35wl=x35wlp*x35_k ! Lift unifomized
       x35wd=x35wdp*x35_k ! Drag uniformized
       x35_a=x35wl
       x35_b=x35wd

c       x35gamma=10.125*pi/180.
c       write (*,*) "gamma ",x35gamma*180./pi
c       write (*,*) "VERTICAL FORCES:"
c       write (*,*) "Lift_v ",x35_a*dcos(x35gamma)
c       write (*,*) "Drag_v ",x35_b*dsin(x35gamma)
c       write (*,*) "Drage_v ",x35dragextra*dsin(x35gamma)
c       write (*,*) "Dragl_v ",x35_d*dsin(x35gamma)
c       write (*,*) "Dragp_v ",x35_e*dsin(x35gamma)
c       write (*,*) "Total_v ",x35_a*dcos(x35gamma)+(x35_b+
c     + x35dragextra+x35_d+x35_e)*dsin(x35gamma)
c       write (*,*) "Weight_v ",x35_c

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Solve dragextra in first aproximate
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       x35zeroprev=100.
       do x35gamma=0.01,0.8,0.005 ! explore 1 to 45 deg aprox
c      Vertical equilibrium
       x35_k1d=(x35_c-x35_a*dcos(x35gamma)-(x35_b+x35_d+x35_e)*
     + dsin(x35gamma))/dsin(x35gamma)
c      Horizontal equilibrium
       x35_k2d=(x35_a*dsin(x35gamma)-(x35_b+x35_d+x35_e)*
     + dcos(x35gamma))/dcos(x35gamma)
c      Zero
       x35zero=dabs(x35_k1d-x35_k2d)
c      Solve zero by brute force
       if (x35zero.le.x35zeroprev) then
       x35gammafi=x35gamma
       x35zeroprev=x35zero
       x35_k1fi=x35_k1d
       x35_k2fi=x35_k2d
       end if
c       write (*,*) "Ep ",x35gamma*180./pi,x35gammafi*180./pi,
c     + x35_k1d,x35_k2d,x35zero
       end do
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Solve again, with increased precision
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       x35zeroprev=100.
       do x35gamma=x35gammafi-0.08,x35gammafi+0.08,0.0016 ! 100 iterations +-5 deg
c      Vertical equilibrium
       x35_k1d=(x35_c-x35_a*dcos(x35gamma)-(x35_b+x35_d+x35_e)*
     + dsin(x35gamma))/dsin(x35gamma)
c      Horizontal equilibrium
       x35_k2d=(x35_a*dsin(x35gamma)-(x35_b+x35_d+x35_e)*
     + dcos(x35gamma))/dcos(x35gamma)
c      Zero
       x35zero=dabs(x35_k1d-x35_k2d)
c      Solve zero by brute force
       if (x35zero.le.x35zeroprev) then
       x35gammafi=x35gamma
       x35zeroprev=x35zero
       x35_k1fi=x35_k1d
       x35_k2fi=x35_k2d
       end if
c       write (*,*) "Ep ",x35gamma*180./pi,x35gammafi*180./pi,
c     + x35_k1d,x35_k2d,x35zero
       end do

       x35_k1d=x35_k1fi
       x35_k2d=x35_k2fi
       x35gamma=x35gammafi
       x35theta=x35gamma-x35alpha
       x35dragextra=(x35_k1d+x35_k2d)/2.
       x35finesse=1./dtan(x35gamma)
c      Put warnings and hints if no convergence (!!!)
c      If weight is excessive, there may be no angle that achieves vertical balance
c      If the lift at angle 0 is greater than the weight, there is no balance

c       x35_k=1.0
c       x35_k1=1.0
c       x35_k2=1.0

c      Verify convergence
       i35m3contr=0
       x35m3contr=0.0d0

       end if ! End method 3

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      17.4 Method 4 (i37solve=4) solve for gamma and Cde
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (i37solve.eq.4) then

c      De Villiers method 4, solving glide angle directly:
c      gamma --> Analytical solution from horizontal equilibrium
       x35gamma=2.*datan((2.*(dsqrt(x35_a*x35_a+x35_b*x35_b+
     + 2.*x35_b*(x35_d+x35_e)+x35_d*x35_d+2.*x35_d*x35_e+x35_e*x35_e))
     + -2.*x35_a)/(2.*(x35_b+x35_d+x35_e)))

       x35theta=x35gamma-x35alpha
       x35finesse=1./dtan(x35gamma)

c      Do not regularize
       x35_k=1.0
       x35_k1=1.0
       x35_k2=1.0

c      Initial flight speed
       x35vi=dsqrt((xlimog(17)*dcos(x35gamma))/
     + (0.5*x35ro*fparea*x35cl*x35cle*x35_k))

c      x35_a = "Lift"
       x35wl=x35cl*x35_k*0.5*x35ro*x35vi*x35vi*fparea
c      Lift extra
       x35liftextra=x35cl*x35_k*(x35cle-1.)*0.5*x35ro*x35vi*x35vi*fparea
c      x35_b = "Drag"
       x35wd=x35cd*x35_k*0.5*x35ro*x35vi*x35vi*fparea
c      Drag extra
       x35dragextra=x35cd*x35_k*(x35cde-1.)*0.5*x35ro*x35vi*x35vi*fparea

c      Verify convergence, not used because method is analitycal
       i35m4contr=0
       x35m4contr=0.0d0

       end if ! End method 4


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      17.5 Method 5 (i37solve=5) solve for gamma and V
c      OK, but excessive loops
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (i37solve.eq.5) then

c      Set drag extra, attention to Kd coefficient, initially camouflaged in Cde (!)
c      Cde transports Kd and then returns to 1.0 like Cle
       x35kd=x35cde   ! Set kd
       x35cde=1.0     ! Restore cde

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      17.5.1 Do the first RUN loop using a rought interval (steeps 0.5 m/s)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Loop in V from 5 to 15 m/s
       x35zero=0.0d0          ! Zero
       x35zeroprev=1000.0d0   ! First value close to zero
       x35linesdf=0.0d0       ! Final drag lines
       do x35v=5.,15.,0.5 ! Do only 20 steps in first run

c      x35_a = "Lift"
       x35_a=x35cl*x35cle*0.5*x35ro*x35v*x35v*fparea
c      x35_b = "Drag"
       x35_b=x35cd*x35cde*0.5*x35ro*x35v*x35v*fparea
c      x35_f = "Drag+Drag extra"
       x35_f=x35cd*x35cde*x35kd*0.5*x35ro*x35v*x35v*fparea

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      x35_d= "Lines drag" ! --> necessary calc all lines drag again (!!!)
c      x35ro = air mass density 1.225 kg/m3
c      x35v  = speed m/s
c      x35mu = air dynamic viscosity 18.46 x 1e-6 Pascalsˇs
c      Reynolds numbers by types tyline(k,20)
       do k=1,k34n
       tyline(k,20)=(x35ro*x35v*tyline(k,2)*1e-3)/(x35mu*1e-6)
       end do
c      Reynolds number operating in each line xlimo(1,20)
       do i=1,cordat
       xlimo(i,20)=tyline(corda(i,40),20)
       end do
c      Drag coefficient in each line xlimo(1,21)
c      Weisener and its simple equation for a cylinder
c      Source: De Villiers, HEGALA v6 report
       do i=1,cordat
       xlimo(i,21)=(10.*xlimo(i,20)**(-2./3.))+1.0d0
c      Correction for rectangular risers, increment Cd
       if (corda(i,2).eq.1.and.tylinea(corda(i,40),1).eq."r") then
       xlimo(i,21)=1.98
       end if
       end do
c      Drag in each line or riser xlimo(i,22) (N)
       x35linesd=0.0
       do i=1,cordat
       xlimo(i,22)=xlimo(i,21)*0.5*x35ro*x35v*x35v*(xlimo(i,3)*1e-6)
       x35linesd=x35linesd+xlimo(i,22)
       end do
       x35linesd=x35linesd*2. ! total N
       x35_d=x35linesd        ! lines drag
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      x35_e= "Pilot drag"
       x35_e=x35dpcoef*0.5*x35ro*x35v*x35v*x35spilot

c      De Villiers method 5, solving glide angle directly:
c      x35_a Lift
c      x35_b Drag
c      x35_c Total weight (N)
c      x35_d Lines drag
c      x35_e Pilot drag
c      x35_f Drag+Dragextra
c      gamma --> Analytical solution from horizontal equilibrium
       x35gamma=2.*datan((2.*(dsqrt(x35_a*x35_a+x35_f*x35_f+
     + 2.*x35_f*(x35_d+x35_e)+x35_d*x35_d+2.*x35_d*x35_e+x35_e*x35_e))
     + -2.*x35_a)/(2.*(x35_f+x35_d+x35_e)))

c      Calc f(V)=0. Auxiliar notations
       x355_1=x35_d*dsin(x35gamma)    
       x355_2=x35_e*dsin(x35gamma)
       x355_3=x35_a*dcos(x35gamma)
       x355_4=x35_f*dsin(x35gamma)

c      Vertical equilibrium equation f(speed)=0
       x35zero=x355_1+x355_2+x355_3+x355_4-x35_c

c      Find root, using condition "detect the minimun value"
       if (dabs(x35zero).le.x35zeroprev) then
       x35zeroprev=dabs(x35zero)
       x35vi=x35v        ! final speed
       x35linesdf=x35_d  ! final lines drag
       end if
c      Convergence verification
       if (x35vi.gt.5.0d0.and.x35vi.lt.15.0d0) then ! Solution was found
       i35m5contr=0 ! method converges
       else
       i35m5contr=1 ! Not found
       end if

c       write (*,*) "Here1: ",x35v,x35zero

       end do ! Close loop in V
c       write (*,*) x35vi,x35zeroprev
c       write (*,*)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      17.5.2 Do a second RUN loop using a fine interval (steeps 0.01 m/s)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Loop in V
       x35zero=0.0d0
       x35zeroprev=1000.0d0
       x35linesdf=0.0d0
       do x35v=x35vi-0.5,x35vi+0.5,0.01 ! Using 100 steps in 1 m/2

c      x35_a = "Lift"
       x35_a=x35cl*x35cle*0.5*x35ro*x35v*x35v*fparea
c      x35_b = "Drag"
       x35_b=x35cd*x35cde*0.5*x35ro*x35v*x35v*fparea
c      x35_f = "Drag+Drag extra"
       x35_f=x35cd*x35cde*x35kd*0.5*x35ro*x35v*x35v*fparea

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      x35_d= "Lines drag" ! --> necessary calc all lines drag again (!!!)
c      x35ro = air mass density 1.225 kg/m3
c      x35v  = speed m/s
c      x35mu = air dynamic viscosity 18.46 x 1e-6 Pascalsˇs
c      Reynolds numbers by types tyline(k,20)
       do k=1,k34n
       tyline(k,20)=(x35ro*x35v*tyline(k,2)*1e-3)/(x35mu*1e-6)
       end do
c      Reynolds number operating in each line xlimo(1,20)
       do i=1,cordat
       xlimo(i,20)=tyline(corda(i,40),20)
       end do
c      Drag coefficient in each line xlimo(1,21)
c      Weisener and its simple equation for a cylinder
c      Source: De Villiers, HEGALA v6 report
       do i=1,cordat
       xlimo(i,21)=(10.*xlimo(i,20)**(-2./3.))+1.0d0
c      Correction for rectangular risers, increment Cd
       if (corda(i,2).eq.1.and.tylinea(corda(i,40),1).eq."r") then
       xlimo(i,21)=1.98
       end if
       end do
c      Drag in each line or riser xlimo(i,22) (N)
       x35linesd=0.0
       do i=1,cordat
       xlimo(i,22)=xlimo(i,21)*0.5*x35ro*x35v*x35v*(xlimo(i,3)*1e-6)
       x35linesd=x35linesd+xlimo(i,22)
       end do
       x35linesd=x35linesd*2. ! total N
       x35_d=x35linesd        ! lines drag
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      x35_e= "Pilot drag"
       x35_e=x35dpcoef*0.5*x35ro*x35v*x35v*x35spilot

c      De Villiers method 5, solving glide angle directly:
c      x35_a Lift
c      x35_b Drag
c      x35_c Total weight (N)
c      x35_d Lines drag
c      x35_e Pilot drag
c      x35_f Drag+Dragextra
c      gamma --> Analytical solution from horizontal equilibrium
       x35gamma=2.*datan((2.*(dsqrt(x35_a*x35_a+x35_f*x35_f+
     + 2.*x35_f*(x35_d+x35_e)+x35_d*x35_d+2.*x35_d*x35_e+x35_e*x35_e))
     + -2.*x35_a)/(2.*(x35_f+x35_d+x35_e)))

c      Calc f(V)=0. Auxiliar notations
       x355_1=x35_d*dsin(x35gamma)    
       x355_2=x35_e*dsin(x35gamma)
       x355_3=x35_a*dcos(x35gamma)
       x355_4=x35_f*dsin(x35gamma)

c      Vertical equilibrium equation f(speed)=0
       x35zero=x355_1+x355_2+x355_3+x355_4-x35_c

c      Find root, using condition "detect the minimun value"
       if (dabs(x35zero).le.x35zeroprev) then
       x35zeroprev=dabs(x35zero)
       x35vi=x35v        ! final speed
       x35linesdf=x35_d  ! final lines drag
       end if

c       write (*,*) "Here2: ",x35v,x35zero

       end do ! Close loop in V
c       write (*,*) x35vi,x35zeroprev
c       write (*,*)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      17.5.3 Now we have V :) calcule values again
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c       x35v=x35vi ! Speed

c      Calc main values again
c      x35_a = "Lift"
       x35_a=x35cl*x35cle*0.5*x35ro*x35vi*x35vi*fparea
c      x35_b = "Drag"
       x35_b=x35cd*x35cde*0.5*x35ro*x35vi*x35vi*fparea
c      x35_f = "Drag+Drag extra"
       x35_f=x35cd*x35cde*x35kd*0.5*x35ro*x35vi*x35vi*fparea
c      Drag extra again
       x35dragextra=x35_b*(x35kd-1.0d0)
c      Calc gamma again
       x35gamma=2.*datan((2.*(dsqrt(x35_a*x35_a+x35_f*x35_f+
     + 2.*x35_f*(x35_d+x35_e)+x35_d*x35_d+2.*x35_d*x35_e+x35_e*x35_e))
     + -2.*x35_a)/(2.*(x35_f+x35_d+x35_e)))

c      Derived values theta="assiette" and GR="finesse"
       x35theta=x35gamma-x35alpha
       x35finesse=1./dtan(x35gamma)

c      Set final lift and drag
       x35wl=x35_a
       x35wd=x35_b

c      Set final lines drag
       x35linesd=x35linesdf

c      Set final pilot drag
       x35pilotd=x35dpcoef*0.5*x35ro*x35vi*x35vi*x35spilot

c      Set default k values (not used in this method)
       x35_k=1.0
       x35_k1=1.0
       x35_k2=1.0

c      Restore cde
       x35cde=x35kd

c      x35_a = "Lift"
       x35wl=x35cl*x35_k*0.5*x35ro*x35vi*x35vi*fparea
c      Lift extra
       x35liftextra=x35cl*x35_k*(x35cle-1.)*0.5*x35ro*x35vi*x35vi*fparea
c      x35_b = "Drag"
       x35wd=x35cd*x35_k*0.5*x35ro*x35vi*x35vi*fparea
c      Drag extra
       x35dragextra=x35cd*x35_k*(x35cde-1.)*0.5*x35ro*x35vi*x35vi*fparea

       end if ! End method 5

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      17.6 Method 6
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Find gamma explicity and V independent
c      Find V explicity
c      Use cle and cde values

       if (i37solve.eq.6) then

c      Solve gamma from horizontal equilibrium equation
c      Define values
       x35var(1)=fparea*fparea*x35cd*x35cde*x35cd*x35cde
       x35var(2)=fparea*fparea*x35cl*x35cle*x35cl*x35cle
       x35var(3)=2.*fparea*x35spilot*x35dpcoef*x35cd*x35cde
       x35var(4)=2.*fparea*xlimog(3)*x35dlcoef*x35cd*x35cde
       x35var(5)=x35spilot*x35spilot*x35dpcoef*x35dpcoef
       x35var(6)=2.*x35spilot*xlimog(3)*x35dlcoef*x35dpcoef
       x35var(7)=xlimog(3)*xlimog(3)*x35dlcoef*x35dlcoef
       x35var(8)=fparea*x35cl*x35cle
       x35var(9)=x35spilot*x35dpcoef
       x35var(10)=xlimog(3)*x35dlcoef
       x35var(11)=fparea*x35cd*x35cde

c      Glide angle is not function of V (!)
       x35gamma=2.*datan((dsqrt(x35var(1)+x35var(2)+x35var(3)+x35var(4)+
     + x35var(5)+x35var(6)+x35var(7))-x35var(8))/
     + (x35var(9)+x35var(10)+x35var(11)))

c       write (*,*) "xlimog(3)",xlimog(3)
c       write (*,*) "x35dlcoef",x35dlcoef
c       write (*,*) "x35dpcoef",x35dpcoef
c       write (*,*) "x35spilot",x35spilot
c       do k=1,11
c       write (*,*) k,x35var(k)
c       end do
c       write (*,*) "Ep gamma",x35gamma*180./pi

c      Solve V from vertical equilibrium equation
c      Define values
       x35var(14)=x35wingmass+xlimog(2)+xlimog(16)+x35pilotmass
       x35var(15)=x35spilot*x35dpcoef*dsin(x35gamma)
       x35var(16)=xlimog(3)*x35dlcoef*dsin(x35gamma)
       x35var(17)=fparea*x35cl*x35cle*dcos(x35gamma)
       x35var(18)=fparea*x35cd*x35cde*dsin(x35gamma)
       x35var(19)=x35spilot*x35dpcoef*dsin(x35gamma)
       x35var(20)=xlimog(3)*x35dlcoef*dsin(x35gamma)
       x35var(21)=fparea*x35cl*x35cle*dcos(x35gamma)
       x35var(22)=fparea*x35cd*x35cde*dsin(x35gamma)

c      Speed of flight
       x35vi=dsqrt(2.0d0)*dsqrt(x35ro*x35grav*x35var(14)*(x35var(15)+
     + x35var(16)+x35var(17)+x35var(18)))/(x35ro*(x35var(19)+
     + x35var(20)+x35var(21)+x35var(22)))

c      Calcule values Lift and Drag using new speed
c      x35_a = "Lift"
       x35_a=x35cl*0.5*x35ro*x35vi*x35vi*fparea
c      Lift extra
       x35liftextra=x35cl*(x35cle-1.)*0.5*x35ro*x35vi*x35vi*fparea
c      x35_b = "Drag"
       x35_b=x35cd*0.5*x35ro*x35vi*x35vi*fparea
c      Drag extra
       x35dragextra=x35cd*(x35cde-1.)*0.5*x35ro*x35vi*x35vi*fparea

c      Derived values theta="assiette" and GR="finesse"
       x35theta=x35gamma-x35alpha
       x35finesse=1./dtan(x35gamma)

c      Set final lift and drag
       x35wl=x35_a
       x35wd=x35_b

c      Set final lines drag
       x35linesd=x35dlcoef*0.5*x35ro*x35vi*x35vi*xlimog(3)

c      Set final pilot drag
       x35pilotd=x35dpcoef*0.5*x35ro*x35vi*x35vi*x35spilot

c      Set default k values (not used in this method)
       x35_k=1.0
       x35_k1=1.0
       x35_k2=1.0

       end if ! method 6

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      17.7 Common for all methods
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Other derived parameters
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Total drag
       x35totald=x35wd+x35dragextra+x35linesd+x35pilotd

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Initial flight speed x35vi m/s used in methods 1,2,3,4
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (i37solve.ne.5.and.i37solve.ne.6) then
       x35vi=dsqrt((xlimog(17)*dcos(x35gamma))/
     + (0.5*x35ro*fparea*x35cl*x35cle*x35_k))
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Solve for moments equilibrium (III)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 
       x35_a=-dcos(x35theta)*x35wingmass*x35grav*(x35ycp-wcdgy3d/100.)
     + -(x35zcp-wcdgz3d/100.)*dsin(x35theta)*x35wingmass*x35grav

       x35_b=-dcos(x35theta)*xlimog(2)*x35grav*(x35ycp-xlimog(11)/100.)
     + -(x35zcp-xlimog(12)/100.)*dsin(x35theta)*xlimog(2)*x35grav

       x35_c=-dcos(x35theta)*x35pilotmass*x35grav*x35ycp
     + -(x35zcp-((hcp/100.)+x35pmc*dcos(x35theta)))*dsin(x35theta)*
     + x35pilotmass*x35grav

       x35_d=(x35ycp-x35dly)*x35linesd*dsin(x35alpha)
     + +(x35zcp-x35dlz)*x35linesd*dcos(x35alpha)

       x35_e= x35ycp*x35pilotd*dsin(x35alpha)
     + +(x35zcp-((hcp/100.)+x35pmc*dcos(x35theta)))*x35pilotd*
     + dcos(x35alpha)

c      Calage (m):
       x35py=((x35_a+x35_b+x35_c+x35_d+x35_e)/
     + (x35pilotd*dsin(x35alpha)-x35pilotmass*x35grav*dcos(x35theta)))+
     + x35pmc*dsin(x35theta)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Pilot plumb point
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       x35ypp=x35py+((hcp/100.)+x35pmc)*dtan(x35theta)

c      Induced drag estimation (N)
c      MODELISATION D'UN PARAPENTE - JEROME SARTHE - SEPTEMBRE 1999, page 22
       fspan=2.*rib(nribss,2)/100.
       x35lambda=fspan*fspan/farea
       x35oswald=0.9
       x35xi=x35cl*x35cl*x35cle*x35cle/(pi*x35lambda*x35oswald)  ! Cd induced drag
       x35inducedd=x35xi*0.5*x35ro*x35vi*x35vi*farea*x35_k ! Induced drag (N)
c      WARNING: Induced drag seems excessibe using these formula (!)
c       write (*,*) "Ep... ",pi,x35lambda,x35xi,x35inducedd

c      Pilot+harness mass center (not in main carabiners P)
       x35pmcx=0.0d0
       x35pmcy=x35py-x35pmc*dsin(x35theta)
       x35pmcz=hcp/100.+x35pmc*dcos(x35theta)

c      Quicklinks mass center
       x35qlmcx=0.0d0
       x35qlmcy=0.0d0
       x35qlmcz=0.0d0
       do i=1,cordam
       if (corda(i,2).eq.1) then
       x35qlmcy=x35qlmcy+ycorda(i,2)
       x35qlmcz=x35qlmcz+zcorda(i,2)
c       write (*,*) "Ep...",i,ycorda(i,2),zcorda(i,2)
       end if
       end do
       x35qlmcy=x35qlmcy/(100.*dfloat(nrisers))
       x35qlmcz=x35qlmcz/(100.*dfloat(nrisers))
c       write (*,*) x35qlmcy,x35qlmcz

c      Total mass center (wing + lines+risers + ql + pilot+harness)
       x35totmcx=0.0d0
       x35totmcy=((wcdgy3d/100.)*x35wingmass+  ! wing
     + (xlimog(11)/100.)*xlimog(2)+            ! lines
     + x35qlmcy*xlimog(16)+                    ! ql
     + x35pmcy*x35pilotmass)/xlimog(18)        ! pilot
       x35totmcz=((wcdgz3d/100.)*x35wingmass+  ! wing
     + (xlimog(12)/100.)*xlimog(2)+            ! lines
     + x35qlmcz*xlimog(16)+                    ! ql
     + x35pmcz*x35pilotmass)/xlimog(18)        ! pilot

c      Distance(wingcg(y,z),wingcp(y,z)
       x35distwcp=1000.*dsqrt(((wcdgy3d/100.)-x35ycp)**2.+
     + ((wcdgz3d/100.)-x35zcp)**2.)            ! mm

       end if ! case 35 active


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     18. TXT OUTPUT lep-out.txt
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     18.1 Main output
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write (23,'(A31,1x,A6,1x,A7,1x,A50)') 
     + " LABORATORI D'ENVOL PARAGLIDING",lepv,"version",lepc
       write (23,*) "by Pere Casellas 2010-2026"
       write (23,*) "http://www.laboratoridenvol.com"
       write (23,*) "General Public License GNU/GPL 3.0"
c      Customized header
       if (ich.eq.1) then
       write (23,*) 
       write (23,*) "**************************************************"
       write (23,*) "Special version for:"
       write (23,'(1x,A72)') lepuser
       write (23,*) "**************************************************"
       else
       end if
       write (23,*)
       write (23,'(A6,x,A)') "Brand:", bname
       if (atp.eq."pc") then
       write (23,'(A6,x,A)') "Model:", wname
       else
       write (23,'(A6,x,A)') "Model:", wname
       end if
       
       if(iflag2000.eq.1) then
       write (23,'(A13,x,A)') "Edition date:", a37date
       end if

       write (23,'(A6,x,F7.5)') "Scale:", xwf
       if (atp.eq."ds") then
       write (23,'(A,x,A,x,A)') "Wing type is:", atp,"(double surface)"
       end if
       if (atp.eq."sk") then
       write (23,'(A,x,A,x,A)') "Wing type is:", atp,"(single skin)"
       end if
       if (atp.eq."pc") then
       write (23,'(A,x,A,x,A)') "Wing type is:", atp,"(parachute)"
       end if

c      Area

       farea=(rib(1,4)-rib(1,3))*rib(1,2)
       parea=(rib(1,4)-rib(1,3))*rib(1,6)
       do i=1,nribss-1
       farea=farea+(rib(i,4)-rib(i,3)+rib(i+1,4)-rib(i+1,3))*0.5*
     + (rib(i+1,2)-rib(i,2))
       parea=parea+(rib(i,4)-rib(i,3)+rib(i+1,4)-rib(i+1,3))*0.5*
     + (rib(i+1,6)-rib(i,6))
       end do
       farea=farea*2./10000.
       parea=parea*2./10000.

c      Span

       fspan=2.*rib(nribss,2)/100.
       pspan=2.*rib(nribss,6)/100.

c      A/R Aspect Ratio

       faratio=fspan*fspan/farea
       paratio=pspan*pspan/parea

       write (23,*)
       write (23,*) "1. MAIN PARAMETERS:"
       write (23,*) "-------------------------------------------------"
       write (23,'(A,1x,F5.2,A,F6.1,A)') "Flat area = ", farea, " m2 ",
     + farea*10.7639," ft2"
       write (23,'(A,1x,F5.2,A,F6.1,A)') "Flat span = ",fspan, " m  ",
     + fspan/0.3048," ft" 
       write (23,'(A,3x,F4.2)') "Flat A/R = ", faratio
       write (23,*)
       write (23,'(A,1x,F5.2,A,F6.1,A)') "Projected area = ", parea, 
     + " m2 ",parea*10.7639," ft2"
       write (23,'(A,1x,F5.2,A,F6.1,A)') "Projected span = ",pspan, 
     + " m  ",pspan/0.3048," ft" 
       write (23,'(A,1x,F4.2)') "Projected A/R =   ", paratio
       write (23,'(A,5x,F5.2)') "Flattening = ", ((farea-parea)/farea)*100.

c      More geometric parameters
       write (23,*)
       write (23,'(A)') "More geometric parameters:"
       varrow=(rib(nribss,7)-rib(1,7))*xwf/100
       write (23,'(A,1x,F5.2,A)') "Vault arrow = ", varrow, " m"
       write (23,'(A,1x,F5.2)') "Proj_span/arrow = ", pspan/varrow
       write (23,'(A,1x,F5.2,A)') "Line heigth (included risers) = ", 
     + (clengr+clengl)/100, " m"
       write (23,'(A,1x,F5.2)') "Proj_span/Line_heigth = ", 
     + pspan*100/(clengl)
       clli=(dsqrt((clengl-rib(nribss,7)*xwf)*(clengl-rib(nribss,7)*
     + xwf)+(pspan*0.50d0*100.0d0)*(pspan*0.5d0*100.0d0)))/100.0d0
       write (23,'(A,2x,F5.2,A)') "Karabiners - wingtip = ", clli, " m"
       write (23,'(A,1x,F5.2)') "Proj_span/(Karabiners - wingtip) = ",
     + pspan/clli

c      Center of gravity
       write (23,*)
       write (23,'(A,F5.2,A)') 
     + "Planform geometric center of gravity at ", cdg, 
     + " % from leading edge"
c      Wing 3d mass center
       write (23,'(A)') "Wing 3d estimated mass center:"
       write (23,'(A3,F7.2,x,A2)') "x= ",wcdgx3d,"cm"
       write (23,'(A3,F7.2,x,A2)') "y= ",wcdgy3d,"cm"
       write (23,'(A3,F7.2,x,A2)') "z= ",wcdgz3d,"cm"

c      Calage properties     

       write (23,*)
       write (23,*) "2. CALAGE PROPERTIES:"
       write (23,*) "-------------------------------------------------"
       write (23,'(A,1x,F5.2)') "Finesse GR  ", planeig
       write (23,'(A,1x,F5.2,x,A3)') "Glide angle ", afinesse,"deg"
       write (23,'(A,9x,F5.2,x,A3)') "AoA ", aoa,"deg"
       write (23,'(A,4x,F5.2,x,A3)') "Assiette ", assiette,"deg"
       write (23,'(A,1x,F6.0,A)') "Total height hcp (inc risers)", 
     + hcpp, " cm"
       write (23,'(A,1x,F6.0,A)') "Risers", clengr, " cm"
       write (23,'(A,1x,F6.2,x,A,x,F6.2,x,A2)') 
     + "calage, pilot centering ", calage,"%", calag,"cm"
       write (23,'(A,1x,F6.2,x,A,x,F6.2,x,A2)') 
     + "plumb point (estimation)", cpress,"%", cple,"cm"
       write (23,'(A,3(2x,F7.2))') "karabiners (x,y,z)    ",
     + xkar,ykar,zkar
       write (23,*)

c      Rib properties

       write (23,*) "3. RIB PROPERTIES:"
       write (23,*) "-------------------------------------------------"
       write (23,*) "Ribs number  = ", nribss*2
       write (23,*) "Cells number = ", nribss*2-1
       if (rib(1,2).lt.0.01) then
       write (23,*) "Zero-thickness central cell"
       end if
       write (23,*)

       write (23,*) "Rib - Chord - washin - beta - Rot_z"
       write (23,*) "-------------------------------------------------"

       do i=1,nribss

       write (23,'(I2,5x,F6.2,2x,F6.3,2x,F5.2,2x,F5.2)') i,rib(i,5), 
     + rib(i,8),rib(i,9),rib(i,250)

       end do

c      Cell properties

       write(23,*)

       write (23,*) "Cell   width (cm)"
      
       write (23,'(I2,7x,F5.2)') 0, 2.*rib(1,2)
       
       do i=1,nribss-1

       write (23,'(I2,5x,F5.2)') i, rib(i+1,2)-rib(i,2)

       end do

c      Anchor points

c      Lines

       xlength=0.

       write (23,*)
       write (23,*) "4. LINE MATRIX, LINE LENGTHS,AND LINE LOADS:"
       write (23,*) "Line-plan- level- order- ap  - r - row - rib -  L  
     +  -   length -length_e - load (Kg) - Type"
       write (23,*) "------------------------------------------------",
     + "----------------------------------------------"

       do i=1,cordat

       write (23,'(8(I3,3x),A,3x,2(F6.2,3x),F7.2,7x,I2)') i,corda(i,1),
     + corda(i,2),corda(i,3),corda(i,4),corda(i,5),corda(i,6),
     + corda(i,7)," L = ",xline(i), xlifi(i), xload(i), 
     + corda(i,30+corda(i,2))

c      Exclude risers and loops
       if (corda(i,2).ne.1) then
       xlength=xlength+xline(i)
       end if
       end do

c      Include brakes
       xlength=xlength+xline(cordam+1)

c      Note: xlength no longuer used. Calculus in section 14.8

       write (23,*)
       write (23,'(A,A,x,F8.2,x,A)') "Total line lengths ",
     + "(without loops) = ", xlength2,"m"
       write (23,'(A,A,x,F8.2,x,A)') "Total line lengths ",
     + "(with loops) = ", xlength1,"m"
       write (23,*) "(loops lengths according section 34 ",
     + "or internal predefined values)"
       write (23,*)

c      Print lengths by types
       write (23,*) "Minimal lengths by types, including loops:"
       do k=1,k34n
       if (lentype(k).ge.1.0d0) then
       write (23,'(A5,x,I2,x,F7.2,x,A,x,A15,x,A15,x,F6.2,x,A2,x,A4,x,
     + F6.2,x,A2)')  "Type ",jltype(k),lentype(k)/50.,"m",
     + tylinea(k,4),tylinea(k,6),tyline(k,2),"mm",
     + "loop",tyline(k,9),"cm"
       end if
       end do

c      Additional detailed lines properties
       write (23,*)
       write (23,*) "Additional detailed lines properties:"
       write (23,*)
       write (23,*) "Line - Lenght - LenghtL - Weight(g) - Area(mm2)",
     + " -  x   -   y   -   z" 
       do i=1,cordat
       write (23,'(I3,7(x,F9.2))') 
     + i, xlimo(i,0), xlimo(i,1), xlimo(i,2), xlimo(i,3), 
     + xlimo(i,10),xlimo(i,11),xlimo(i,12)
       end do

       write (23,*)
       write (23,'(A,x,F8.3,x,A2)') 
     + "Total lines weight included risers:",xlimog(2),"kg"
       write (23,'(A,x,F8.3,x,A2)') 
     + "Total lines area included risers:",xlimog(3),"m2"
       write (23,'(A,x,F8.3,x,A2)') 
     + "Lines x-coordinate mass center:",xlimog(10),"cm"
       write (23,'(A,x,F8.3,x,A2)') 
     + "Lines y-coordinate mass center:",xlimog(11),"cm"
       write (23,'(A,x,F8.3,x,A2)') 
     + "Lines z-coordinate mass center:",xlimog(12),"cm"

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     18.2 ADJUSTEMENT SEAM PARAMETERS
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  
c      Ajust de costura

       write (23,*)
       write (23,*) "5. Adjustment seam parameters on the inner side" 
       write (23,*) "of extrados panels (fig. 10 of the manual)"
       write (23,*) "-------------------------------------------------"

       if (ndif.eq.1000) then
       write (23,*) "Not used ( ndif=1000 )"
       else
       write (23,*) "Points number= ", ndif, "  scale= ",xndif
       do i=1,nribss-1
       write (23,*) "Rib= ", i, " dif= ", rib(i,81)
       end do
       end if

       write (23,*)

c      Panels and rib differences report

       write (23,*)
       write (23,*) "6. VERIFICATION Panels and rib differences (mm):"
       write (23,*) "-------------------------------------------------"
       write (23,*) "NOTE: Maximal accuracy ",
     + "<< 0.02 mm in extrados and intrados panels"
       write (23,*)
       write (23,*) "Number - Panel at left - Rib - Panel at right -", 
     + " max dif (mm)"

       if (atp.eq."ss") then
       do i=1,nribss-1
       xmax=max(abs(rib(i,30)-rib(i,31)),abs(rib(i,32)-rib(i,31)))
       write(23,'(I2,3x,F10.2,F10.2,F10.2,F10.2,F10.2)') 
     + i,10.*rib(i,30)+10.*rib(i,26),10.*rib(i,31)+10.*rib(i,26),
     + 10.*rib(i,32)+10.*rib(i,26),10.*xmax
       end do
       end if

       if (atp.ne."ss") then

c      Ribs 1 to nribss-1
       do i=1,nribss-1
       xmaxe=max(abs(rib(i,30)-rib(i,31)),abs(rib(i,32)-rib(i,31)))
       xmaxi=max(abs(rib(i,33)-rib(i,34)),abs(rib(i,35)-rib(i,34)))
       write (23,*)
       write (23,'(I2,2x,F10.2,F10.2,F10.2,F10.3,A6)') 
     + i,10*rib(i,30),10*rib(i,31),10*rib(i,32),10.*xmaxe," extra"
       write (23,'(I2,2x,F10.2,F10.2,F10.2,F10.3,A6)') 
     + i,10*rib(i,33),10*rib(i,34),10*rib(i,35),10.*xmaxi," intra"
       end do

c      Last rib
       i=nribss
       xmaxe=abs(rib(i,30)-rib(i,31))
       xmaxi=abs(rib(i,33)-rib(i,34))
       write (23,*)
       write (23,'(I2,2x,F10.2,F10.2,A10,F10.3,A6)') 
     + i,10*rib(i,30),10*rib(i,31),"   -    ",10.*xmaxe," extra"
       write (23,'(I2,2x,F10.2,F10.2,A10,F10.3,A6)') 
     + i,10*rib(i,33),10*rib(i,34),"   -    ",10.*xmaxi," intra"

       end if

       write (23,*)

c      Print distorsions

       write (23,*) "Panel distorsions in the leading edge (mm):"
       write (23,*) "-------------------------------------------"
       write (23,*) "Panel   D. extra   D. intra"
       do i=0,nribss-1
       write (23,'(I3,2x,F10.4,F10.4)')
     + i,(rib(i,97)-rib(i,96))*10.,(rib(i,99)-rib(i,98))*10.
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.3 Speed system amb trim calculus
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (k28d.eq.1) then
       
       write(23,*)
       write(23,*) "7. CALAGE AND RISERS VARIATIONS WITH ANGLE"

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.3.1 a) Speed system pivot in last riser
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       a1281=a128/dfloat(n128)

       do j=1,n128+1 ! itera en angles

       alpha28(j)=a1281*dfloat(j-1) 

c      Initial and final lengths
       
       do k=1,nriser28

       x1=p28(k)*rib(1,5)/100.0d0
       y1=0.0d0
       x2=calage*rib(1,5)/100.0d0
       y2=clengl+clengr
       lini28(j,k)=dsqrt(((x2-x1)*(x2-x1))+((y2-y1)*(y2-y1)))

       hhh=(p28(nriser28)-p28(k))*rib(1,5)/100.0d0
       xxx=hhh*dcos(alpha28(j)*pi/180.0d0)
       yyy=hhh*dsin(alpha28(j)*pi/180.0d0)
       x3=x1+hhh-xxx
       y3=yyy
       lfin28(j,k)=dsqrt(((x2-x3)*(x2-x3))+((y2-y3)*(y2-y3)))

       end do

c      New calage, use values k=nriser28

       xru(1)=p28(nriser28)*rib(1,5)/100.0d0
       xrv(1)=0.0d0
       hhh=(p28(nriser28)-p28(1))*rib(1,5)/100.0d0
       xxx=hhh*dcos(alpha28(j)*pi/180.0d0)
       yyy=hhh*dsin(alpha28(j)*pi/180.0d0)
       xru(2)=(p28(1)*rib(1,5)/100.0d0)+hhh-xxx
       xrv(2)=-yyy

       xsu(1)=calage*rib(1,5)/100.0d0
       xsv(1)=clengl+clengr
       xsu(2)=xsu(1)+100.0d0*dtan(alpha28(j)*pi/180.0d0)
       xsv(2)=xsv(1)-100.0d0

       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       if (alpha28(j).eq.0.0d0) then
       xtu=calage*rib(1,5)/100.0d0
       xtv=0.0d0
       end if
       
       p28max=(p28(nriser28))*rib(i,5)/100.0d0
       xru(3)=p28max*(1.0d0-dcos(alpha28(j)*pi/180.0d0))
       xrv(3)=-p28max*sin(alpha28(j)*pi/180.0d0)

       calagnew(j)=(dsqrt(((xtu-xru(3))*(xtu-xru(3)))+
     + ((xtv-xrv(3))*(xtv-xrv(3)))))*100.0d0/rib(1,5)

       cnewtps(j)=calagnew(j)
       cnewcms(j)=lini28(j,1)-lfin28(j,1)

       end do

c      Print case 2 risers
       if (nriser28.eq.2) then
       write(23,*)
       write(23,*) "a) Speed system pivot in last riser:"
       write (23,*) "-------------------------------------------"
       write(23,'(A2,2x,A6,2x,A6,2x,A6)') "i","alpha",
     + "A","B","Calage"
       do j=1,n128+1
       write(*,'(I2,2x,F6.2,2x,F6.2,2x,F6.2,2x,A6)') 
     + j,alpha28(j),lini28(j,1)-lfin28(j,1),
     + lini28(j,2)-lfin28(j,2), calagnew(j)
       end do
       end if

c      Print case 3 risers
       if (nriser28.eq.3) then
       write(23,*)
       write(23,*) "a) Speed system pivot in last riser:"
       write (23,*) "-------------------------------------------"
       write(23,'(A2,2x,A6,2x,A6,2x,A6,2x,A6,2x,A6)') "i","alpha",
     + "A","B","C","Calage"
       do j=1,n128+1
       write(23,'(I2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,A6)') 
     + j,alpha28(j),lini28(j,1)-lfin28(j,1),
     + lini28(j,2)-lfin28(j,2),lini28(j,3)-lfin28(j,3), calagnew(j)
       end do
       end if

c      Print case 4 risers
       if (nriser28.eq.4) then
       write(23,*)
       write(23,*) "a) Speed system pivot in last riser:"
       write (23,*) "-------------------------------------------"
       write(23,'(A2,2x,A6,2x,A6,2x,A6,2x,A6,2x,A6,2x,A6)') "i","alpha",
     + "A","B","C","D","Calage"
       do j=1,n128+1
       write(23,'(I2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F5.2,2x,
     + A6)') j,alpha28(j),lini28(j,1)-lfin28(j,1),lini28(j,2)-lfin28
     + (j,2),lini28(j,3)-lfin28(j,3),lini28(j,4)-lfin28(j,4),calagnew(j)
       end do
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.3.2 b) Speed system pivot in first riser
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       a1281=a128/dfloat(n128)

       do j=1,n128+1 ! itera en angles

       alpha28(j)=a1281*dfloat(j-1) 

c      Initial and final lengths
       
       do k=1,nriser28

       x1=p28(k)*rib(1,5)/100.0d0
       y1=0.0d0
       x2=calage*rib(1,5)/100.0d0
       y2=clengl+clengr
       lini28(j,k)=dsqrt(((x2-x1)*(x2-x1))+((y2-y1)*(y2-y1)))

       hhh=(p28(k)-p28(1))*rib(1,5)/100.0d0
       xxx=hhh*dcos(alpha28(j)*pi/180.0d0)
       yyy=hhh*dsin(alpha28(j)*pi/180.0d0)
       x3=(p28(1)*rib(1,5)/100.0d0)+xxx
       y3=yyy
       lfin28(j,k)=dsqrt(((x2-x3)*(x2-x3))+((y2-y3)*(y2-y3)))

       end do

c      New calage, use values k=nriser28

       xru(1)=p28(1)*rib(1,5)/100.0d0
       xrv(1)=0.0d0
       hhh=(p28(nriser28)-p28(1))*rib(1,5)/100.0d0
       xxx=hhh*dcos(alpha28(j)*pi/180.0d0)
       yyy=hhh*dsin(alpha28(j)*pi/180.0d0)
       xru(2)=xru(1)+xxx
       xrv(2)=yyy

       xsu(1)=calage*rib(1,5)/100.0d0
       xsv(1)=clengl+clengr
       xsu(2)=xsu(1)+100.0d0*dtan(alpha28(j)*pi/180.0d0)
       xsv(2)=xsv(1)-100.0d0

       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       if (alpha28(j).eq.0.0d0) then
       xtu=calage*rib(1,5)/100.0d0
       xtv=0.0d0
       end if

       xru(3)=xru(1)*(1.0d0-dcos(alpha28(j)*pi/180.0d0))
       xrv(3)=-xru(1)*dsin(alpha28(j)*pi/180.0d0)

       calagnew(j)=(dsqrt(((xtu-xru(3))*(xtu-xru(3)))+
     + ((xtv-xrv(3))*(xtv-xrv(3)))))*100.0d0/rib(1,5)

       end do

c      Print case 2 risers
       if (nriser28.eq.2) then
       write(23,*)
       write(23,*) "b) Speed system pivot in first riser:"
       write (23,*) "-------------------------------------------"
       write(23,'(A2,2x,A6,2x,A6,2x,A6)') "i","alpha",
     + "A","B","Calage"
       do j=1,n128+1
       write(*,'(I2,2x,F6.2,2x,F6.2,2x,F6.2,2x,A6)') 
     + j,alpha28(j),lfin28(j,1)-lini28(j,1),
     + lfin28(j,2)-lini28(j,2), calagnew(j)
       end do
       end if

c      Print case 3 risers
       if (nriser28.eq.3) then
       write(23,*)
       write(23,*) "b) Speed system pivot in first riser:"
       write (23,*) "-------------------------------------------"
       write(23,'(A2,2x,A6,2x,A6,2x,A6,2x,A6,2x,A6)') "i","alpha",
     + "A","B","C","Calage"
       do j=1,n128+1
       write(23,'(I2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,A6)') 
     + j,alpha28(j),lfin28(j,1)-lini28(j,1),
     + lfin28(j,2)-lini28(j,2),lfin28(j,3)-lini28(j,3), calagnew(j)
       end do
       end if

c      Print case 4 risers
       if (nriser28.eq.4) then
       write(23,*)
       write(23,*) "b) Speed system pivot in first riser:"
       write (23,*) "-------------------------------------------"
       write(23,'(A2,2x,A6,2x,A6,2x,A6,2x,A6,2x,A6,2x,A6)') "i","alpha",
     + "A","B","C","D","Calage"
       do j=1,n128+1
       write(23,'(I2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,
     + A6)') j,alpha28(j),lfin28(j,1)-lini28(j,1),lfin28(j,2)-lini28
     + (j,2),lfin28(j,3)-lini28(j,3),lfin28(j,4)-lini28(j,4),calagnew(j)
       end do
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.3.3 c) Trimer system pivot in first riser
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       a2282=a228/dfloat(n228)

       do j=1,n228+1 ! itera en angles

       alpha28(j)=a2282*dfloat(j-1) 

c      Initial and final lengths
       
       do k=1,nriser28

       x1=p28(k)*rib(1,5)/100.0d0
       y1=0.0d0
       x2=calage*rib(1,5)/100.0d0
       y2=clengl+clengr
       lini28(j,k)=dsqrt(((x2-x1)*(x2-x1))+((y2-y1)*(y2-y1)))

       hhh=(p28(k)-p28(1))*rib(1,5)/100.0d0
       xxx=hhh*dcos(alpha28(j)*pi/180.0d0)
       yyy=hhh*dsin(alpha28(j)*pi/180.0d0)
       x3=(p28(1)*rib(1,5)/100.0d0)+xxx
       y3=yyy
       lfin28(j,k)=dsqrt(((x2-x3)*(x2-x3))+((y2-y3)*(y2-y3)))

       end do

c      New calage, use values k=nriser28

       xru(1)=p28(1)*rib(1,5)/100.0d0
       xrv(1)=0.0d0
       hhh=(p28(nriser28)-p28(1))*rib(1,5)/100.0d0
       xxx=hhh*dcos(alpha28(j)*pi/180.0d0)
       yyy=hhh*dsin(alpha28(j)*pi/180.0d0)
       xru(2)=xru(1)+xxx
       xrv(2)=yyy

       xsu(1)=calage*rib(1,5)/100.0d0
       xsv(1)=clengl+clengr
       xsu(2)=xsu(1)+100.0d0*dtan(alpha28(j)*pi/180.0d0)
       xsv(2)=xsv(1)-100.0d0

       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       if (alpha28(j).eq.0.0d0) then
       xtu=calage*rib(1,5)/100.0d0
       xtv=0.0d0
       end if

       xru(3)=xru(1)*(1.0d0-dcos(alpha28(j)*pi/180.0d0))
       xrv(3)=-xru(1)*dsin(alpha28(j)*pi/180.0d0)

       calagnew(j)=(dsqrt(((xtu-xru(3))*(xtu-xru(3)))+
     + ((xtv-xrv(3))*(xtv-xrv(3)))))*100.0d0/rib(1,5)

       cnewtpt(j)=calagnew(j)
       cnewcmt(j)=lini28(j,nriser28)-lfin28(j,nriser28)

       end do

c      Print case 2 risers
       if (nriser28.eq.2) then
       write(23,*)
       write(23,*) "c) Trimer system pivot in first riser:"
       write (23,*) "-------------------------------------------"
       write(23,'(A2,2x,A6,2x,A6,2x,A6)') "i","alpha",
     + "A","B","Calage"
       do j=1,n228+1
       write(*,'(I2,2x,F6.2,2x,F6.2,2x,F6.2,2x,A6)') 
     + j,alpha28(j),lfin28(j,1)-lini28(j,1),
     + lfin28(j,2)-lini28(j,2), calagnew(j)
       end do
       end if

c      Print case 3 risers
       if (nriser28.eq.3) then
       write(23,*)
       write(23,*) "c) Trimer system pivot in first riser:"
       write (23,*) "-------------------------------------------"
       write(23,'(A2,2x,A6,2x,A6,2x,A6,2x,A6,2x,A6)') "i","alpha",
     + "A","B","C","Calage"
       do j=1,n228+1
       write(23,'(I2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,A6)') 
     + j,alpha28(j),lfin28(j,1)-lini28(j,1),
     + lfin28(j,2)-lini28(j,2),lfin28(j,3)-lini28(j,3), calagnew(j)
       end do
       end if

c      Print case 4 risers
       if (nriser28.eq.4) then
       write(23,*)
       write(23,*) "c) Trimer system pivot in first riser:"
       write (23,*) "-------------------------------------------"
       write(23,'(A2,2x,A6,2x,A6,2x,A6,2x,A6,2x,A6,2x,A6)') "i","alpha",
     + "A","B","C","D","Calage"
       do j=1,n228+1
       write(23,'(I2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,
     + A6)') j,alpha28(j),lfin28(j,1)-lini28(j,1),lfin28(j,2)-lini28
     + (j,2),lfin28(j,3)-lini28(j,3),lfin28(j,4)-lini28(j,4),calagnew(j)
       end do
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.3.4 d) Trimer system pivot in last riser
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

    
       a2282=a228/dfloat(n228)

       do j=1,n228+1 ! itera en angles

       alpha28(j)=a2282*dfloat(j-1) 

c      Initial and final lengths
       
       do k=1,nriser28

       x1=p28(k)*rib(1,5)/100.0d0
       y1=0.0d0
       x2=calage*rib(1,5)/100.0d0
       y2=clengl+clengr
       lini28(j,k)=dsqrt(((x2-x1)*(x2-x1))+((y2-y1)*(y2-y1)))

       hhh=(p28(nriser28)-p28(k))*rib(1,5)/100.0d0
       xxx=hhh*dcos(alpha28(j)*pi/180.0d0)
       yyy=hhh*dsin(alpha28(j)*pi/180.0d0)
       x3=x1+hhh-xxx
       y3=yyy
       lfin28(j,k)=dsqrt(((x2-x3)*(x2-x3))+((y2-y3)*(y2-y3)))

       end do

c      New calage, use values k=nriser28

       xru(1)=p28(nriser28)*rib(1,5)/100.0d0
       xrv(1)=0.0d0
       hhh=(p28(nriser28)-p28(1))*rib(1,5)/100.0d0
       xxx=hhh*dcos(alpha28(j)*pi/180.0d0)
       yyy=hhh*dsin(alpha28(j)*pi/180.0d0)
       xru(2)=(p28(1)*rib(1,5)/100.0d0)+hhh-xxx
       xrv(2)=-yyy

       xsu(1)=calage*rib(1,5)/100.0d0
       xsv(1)=clengl+clengr
       xsu(2)=xsu(1)+100.0d0*dtan(alpha28(j)*pi/180.0d0)
       xsv(2)=xsv(1)-100.0d0

       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       if (alpha28(j).eq.0.0d0) then
       xtu=calage*rib(1,5)/100.0d0
       xtv=0.0d0
       end if

       p28max=(p28(nriser28))*rib(i,5)/100.0d0
       xru(3)=p28max*(1.0d0-dcos(alpha28(j)*pi/180.0d0))
       xrv(3)=-p28max*dsin(alpha28(j)*pi/180.0d0)

       calagnew(j)=(dsqrt(((xtu-xru(3))*(xtu-xru(3)))+
     + ((xtv-xrv(3))*(xtv-xrv(3)))))*100.0d0/rib(1,5)

       end do

c      Print case 2 risers
       if (nriser28.eq.2) then
       write(23,*)
       write(23,*) "d) Trimer system pivost in last riser:"
       write (23,*) "-------------------------------------------"
       write(23,'(A2,2x,A6,2x,A6,2x,A6)') "i","alpha",
     + "A","B","Calage"
       do j=1,n228+1
       write(*,'(I2,2x,F6.2,2x,F6.2,2x,F6.2,2x,A6)') 
     + j,alpha28(j),lini28(j,1)-lfin28(j,1),
     + lini28(j,2)-lfin28(j,2), calagnew(j)
       end do
       end if

c      Print case 3 risers
       if (nriser28.eq.3) then
       write(23,*)
       write(23,*) "d) Trimer system pivot in last riser:"
       write (23,*) "-------------------------------------------"
       write(23,'(A2,2x,A6,2x,A6,2x,A6,2x,A6,2x,A6)') "i","alpha",
     + "A","B","C","Calage"
       do j=1,n228+1
       write(23,'(I2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,A6)') 
     + j,alpha28(j),lini28(j,1)-lfin28(j,1),
     + lini28(j,2)-lfin28(j,2),lini28(j,3)-lfin28(j,3), calagnew(j)
       end do
       end if

c      Print case 4 risers
       if (nriser28.eq.4) then
       write(23,*)
       write(23,*) "d) Trimer system pivot in last riser:"
       write (23,*) "-------------------------------------------"
       write(23,'(A2,2x,A6,2x,A6,2x,A6,2x,A6,2x,A6,2x,A6)') "i","alpha",
     + "A","B","C","D","Calage"
       do j=1,n228+1
       write(23,'(I2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,F6.2,2x,
     + A6)') j,alpha28(j),lini28(j,1)-lfin28(j,1),lini28(j,2)-lfin28
     + (j,2),lini28(j,3)-lfin28(j,3),lini28(j,4)-lfin28(j,4),calagnew(j)
       end do
       end if






cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.3.5 Draw calage variations
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


c     Box (2,1)

       x0=0.-400.0*xkf
       y0=900.*xkf+600.*xkf

c      Draw box

       xakk=2.*xkf
       yakk=2.*xkf
       xa=100.*xakk
       ya=100.*yakk

       call line(x0,y0,x0+xa,y0,7)
       call line(x0,y0,x0,y0-ya,7)
       call line(x0+xa,y0,x0+xa,y0-ya,7)
       call line(x0,y0-ya,x0+xa,y0-ya,7)

       do j=1,9
       call line(x0+10.*float(j)*xakk,y0,x0+10.*float(j)*xakk,y0-ya,8)
       end do

       do j=1,19
       call line(x0,y0-5.*float(j)*yakk,x0+xa,y0-5.*float(j)*yakk,9)
       end do

       xtext="Calage %"
       call txt(x0+xa/2.0d0-10.0d0,y0+25.0d0,8.0d0,0.0d0,xtext,7)
       xtext="0 %"
       call txt(x0-10.,y0+12.,8.0d0,0.0d0,xtext,7)
       write (xtext,'(F5.2)') calage
       call txt(x0+calage*xakk-10.,y0+12.,8.0d0,0.0d0,xtext,7)
       xtext="100 %"
       call txt(x0+xa,y0+12.,8.0d0,0.0d0,xtext,7)

       xtext="Speed system (cm)"
       call txt(x0-20.,y0-20,8.0d0,90.0d0,xtext,1)
       xtext="0"
       call txt(x0-10.,y0,8.0d0,0.0d0,xtext,1)
       xtext="20"
       call txt(x0-10.,y0-ya,8.0d0,0.0d0,xtext,1)

       xtext="Trimer system (cm)"
       call txt(x0+xa+20.,y0-20,8.0d0,90.0d0,xtext,5)
       xtext="0"
       call txt(x0+xa+10.,y0,8.0d0,0.0d0,xtext,5)
       xtext="20"
       call txt(x0+xa+10.,y0-ya,8.0d0,0.0d0,xtext,5)

       do j=1,n128

       call line(x0+cnewtps(j)*xakk,y0+cnewcms(j)*5.*yakk,
     + x0+cnewtps(j+1)*xakk,y0+cnewcms(j+1)*5.*yakk,1)

       end do

       do j=1,n228

       call line(x0+cnewtpt(j)*xakk,y0-cnewcmt(j)*5.*yakk,
     + x0+cnewtpt(j+1)*xakk,y0-cnewcmt(j+1)*5.*yakk,5)

       end do

       end if ! Case k28p=1


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.4 Print joncs
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (k21d.ge.1) then
       x1=0.
       write (23,*)
       write (23,*) "8. NYLON RODS (JONCS)"
       write (23,*) "-------------------------------------------"
       do m=1,k21blocs
       write (23,'(A5,I3,A8,I2)') "BLOC ",m,"   TYPE ",k21blocf(m,2) 
       write (23,*) "-------------------------------------------"
       do ng=1,k21blocf(m,3)
       write (23,'(A5,I3)') "Group",ng
       write (23,*) "----------------------------"
       do i=ngoo(m,ng,2),ngoo(m,ng,3)
       x1=x1+joncf(i,m,ng,2)
       write (23,'(A5,I3,2x,F7.1)') "Jonc ",i,joncf(i,m,ng,2)
       end do
       write (23,*) "----------------------------"

       end do
       end do
       write (23,'(A,F8.2)') "Joncs total length m (both sides) ",
     + x1*2./100.
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.5 Print 3D-shaping details
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

 
c      Case k29d=0     
       if (k29d.eq.0) then
       write (23,*)
       write (23,*) "9. 3D-SHAPING DETAILS"
       write (23,*) "-------------------------------------------"
       write (23,*) 
       end if

c      Case k29d=1
       if (k29d.eq.1) then
       write (23,*)
       write (23,*) "9. 3D-SHAPING DETAILS"
       write (23,*) "-------------------------------------------"
       write (23,*) 

       ng=rib(i,169)

       do i=1,nribss

       if (uppcuts(ng).ge.1.or.lowcuts(ng).ge.1) then
       write (23,*) "-------------------------------------"
       write (23,*) "zone   rib      d1       d2    d2-d1 "
       write (23,*) "-------------------------------------"
       end if

       if (uppcuts(ng).eq.1) then
       write (23,'(A4,3x,I3,3x,F6.2,3x,F6.2,3x,F6.2)') 
     + "z1 ",i,zinf(i,1,1),zinf(i,2,1),zinf(i,5,1)
       write (23,'(A4,3x,I3,3x,F6.2,3x,F6.2,3x,F6.2)') 
     + "z3 ",i,zinf(i,1,3),zinf(i,2,3),zinf(i,5,3)
       write (23,'(A4,3x,I3,3x,F6.2)') "f13 ",i,zinf(i,6,1)
       end if

       if (uppcuts(ng).eq.2) then
       write (23,'(A4,3x,I3,3x,F6.2,3x,F6.2,3x,F6.2)') 
     + "z1 ",i,zinf(i,1,1),zinf(i,2,1),zinf(i,5,1)
       write (23,'(A4,3x,I3,3x,F6.2,3x,F6.2,3x,F6.2)') 
     + "z2 ",i,zinf(i,1,2),zinf(i,2,2),zinf(i,5,2)
       write (23,'(A4,3x,I3,3x,F6.2,3x,F6.2,3x,F6.2)') 
     + "z3 ",i,zinf(i,1,3),zinf(i,2,3),zinf(i,5,3)
       write (23,'(A4,3x,I3,3x,F6.2)') "f12 ",i,zinf(i,6,1)
       write (23,'(A4,3x,I3,3x,F6.2)') "f23 ",i,zinf(i,6,2)
       end if

       if (uppcuts(ng).ge.1) then
       write (23,'(A4,3x,I3,3x,F6.2,3x,F6.2,3x,F6.2)') 
     + "z4 ",i,zinf(i,1,4),zinf(i,2,4),zinf(i,5,4)
       end if

       if (lowcuts(ng).eq.1) then
       write (23,'(A4,3x,I3,3x,F6.2,3x,F6.2,3x,F6.2)') 
     + "z5 ",i,zinf(i,1,5),zinf(i,2,5),zinf(i,5,5)
       write (23,'(A4,3x,I3,3x,F6.2,3x,F6.2,3x,F6.2)') 
     + "z6 ",i,zinf(i,1,6),zinf(i,2,6),zinf(i,5,6)
       write (23,'(A4,3x,I3,3x,F6.2)') "f56 ",i,zinf(i,6,4)
       end if
       end do

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.6 Print informative extrados and intrados coeeficents
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 
       write (23,*)
       write (23,*) "10. INFORMATIVE EXTRADOS AND INTRADOS COEFFICIENTS"
       write (23,*) "-------------------------------------------"
c       write (23,*) 

       write (23,*) "Rib             panel/rib (left) panel/rib (right)"
       do i=0,nribss-1
       write (23,'(I3,3x,A11,5x,F7.5,9x,F7.5)') i,"extrados ",
     + rib(i,194),rib(i,195)
       end do
       write (23,*) 
       do i=0,nribss-1
       write (23,'(I3,3x,A11,5x,F7.5,9x,F7.5)') i,"intrados ",
     + rib(i,200),rib(i,201)
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.7 Print information about profil points
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 
       write (23,*)
       write (23,*) "11. INFORMATION ABOUT AIRFOIL POINTS"
       write (23,*) "-------------------------------------------"
c       write (23,*) 

       write (23,*) "Rib  Total Extra Vents Intra"
       do i=0,nribss
       write (23,'(I3,3x,I3,3x,I3,3x,I3,3x,I3)') i,np(i,1),np(i,2),
     + np(i,3),np(i,4)
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.8 Print angles between airfoil plane and glidepath
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write (23,*)
       write (23,*) "12. ANGLES BETWEEN AIRFOIL PLANE AND GLIDEPATH LINE
     +  (phi) and local AoA (chi)"
       write (23,*) "-------------------------------------------------",
     + "---------------------------"
c       write (23,*) 
       write (23,*) "Informative angles. Change rotation values"
       write (23,*) "in column 10 of SECTION 1, using phi to improve the 
     + results"
       write (23,*) "phi=angle between airfoil plane and glidepath line"
       write (23,*) 'chi=angle between chord line and glidepath line (lo
     +cal AoA)'
       write (23,*)
       write (23,'(A,F6.2)') "glide angle (deg) = ",afinesse
       write (23,'(A,F6.2)') "central AoA (deg) = ",aoa
       write (23,'(A,F6.2)') "assiette (deg) = ",assiette
       if (iflag_assiette.eq.1) then
       write (23,'(A,F6.2)') "forced assiette (deg) = ",assiette2003
       end if
       write (23,*)

       write (23,*) "Rib    phi      chi"
       do i=1,nribss
       write (23,'(I3,3x,F6.2,3x,F6.2)') i,-phii(i)*180.0d0/pi,
     + chii(i)*180.0d0/pi
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.9 Risers information
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write (23,*)
       write (23,*) "14. RISERS INFORMATION"
       write (23,*) "-------------------------------------------------",
     + "---------------------------"

c      Case 0 Standard risers, equal length
       if (k33d.eq.0) then
       write (23,*) "Standard risers, equal length"
       write (23,'(A,x,I2)') " Risers number: ", nrisers
       if (slp.ge.1) then
       write (23,'(A,2x,F7.2,x,A)') " Riser A: ",  x33(1), "cm"
       if (slp.ge.2) then
       write (23,'(A,2x,F7.2,x,A)') " Riser B: ",  x33(2), "cm"
       if (slp.ge.3) then
       write (23,'(A,2x,F7.2,x,A)') " Riser C: ",  x33(3), "cm"
       if (slp.ge.4) then
       write (23,'(A,2x,F7.2,x,A)') " Riser D: ",  x33(4), "cm"
       if (slp.ge.5) then
       write (23,'(A,2x,F7.2,x,A)') " Riser E: ",  x33(5), "cm"
       end if
       end if
       end if
       end if
       end if
       end if

c      Case 1 Standard risers, different length
       if (k33d.eq.1) then
       write (23,*) "Standard risers, different length"
       write (23,'(A,x,I2)') " Risers number: ", nrisers
       if (slp.ge.1) then
       write (23,'(A,2x,F7.2,x,A)') " Riser A: ",  x33(1), "cm"
       if (slp.ge.2) then
       write (23,'(A,2x,F7.2,x,A)') " Riser B: ",  x33(2), "cm"
       if (slp.ge.3) then
       write (23,'(A,2x,F7.2,x,A)') " Riser C: ",  x33(3), "cm"
       if (slp.ge.4) then
       write (23,'(A,2x,F7.2,x,A)') " Riser D: ",  x33(4), "cm"
       if (slp.ge.5) then
       write (23,'(A,2x,F7.2,x,A)') " Riser E: ",  x33(5), "cm"
       end if
       end if
       end if
       end if
       end if
       end if

c      Case 2 Vario seat two points

c      Case 3 Vario seat three points

c      Case 4 Vario seat four points


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.10 Lines characteristics table
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write (23,*)
       write (23,*) "16. LINES CHARACTERISTICS TABLE"
       write (23,*) "-------------------------------------------------",
     + "----------------------------------"
       if (k34d.eq.0) then
       write (23,*) "Used default types table"
       end if
       if (k34d.eq.1) then
       write (23,*) "Used custom types table"
       end if
       write (23,'(A20,x,I2)') " Total types number: ",k34n

       write (23,'(A2,x,A1,x,A6,x,A6,x,A13,x,A8,x,A3,x,A15,x,
     + A6,x,A3,x,A1,x,A6,x,A2)')
     + " T","s","a","b","Label        ","Strength","daN",
     + "Material       ",
     + "Weight","g","l","Length","cm"
       write (23,*) "-------------------------------------------------",
     + "----------------------------------"

       do i=1,k34n
       if (tylinea(i,1).eq."r") then
       write (23,'(I2,x,A1,x,F6.2,x,F6.2,x,A15,x,F6.1,x,A3,x,A15,x,
     + F6.2,x,A3,x,A1,x,F6.2,x,A2)')
     + i,tylinea(i,1),tyline(i,2),tyline(i,3),tylinea(i,4),tyline(i,5)
     + ,"daN",tylinea(i,6),tyline(i,7),"g",
     + tylinea(i,8),tyline(i,9),"cm"
       end if
       if (tylinea(i,1).eq."c") then
       write (23,'(I2,x,A1,x,F6.2,x,A6,x,A15,x,F6.1,x,A3,x,A15,x,
     + F6.2,x,A3,x,A1,x,F6.2,x,A2)')
     + i,tylinea(i,1),tyline(i,2),"",tylinea(i,4),tyline(i,5)
     + ,"daN",tylinea(i,6),tyline(i,7),"g",
     + tylinea(i,8),tyline(i,9),"cm"
       end if
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.11 Solve equilibrium equations
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write (23,*)
       write (23,*) "17. LONGITUDINAL EQUILIBRIUM (informative)"
       write (23,*) "-------------------------------------------------",
     + "---------------------------"

       if (k35d.eq.0) then
       write (23,*) "Don't try to solve equilibrium equacions"
       end if

       if (k35d.eq.1) then ! write output case 35

       write (23,*) "An attempt to solve the paraglider longitudinal",
     + " equilibrium. ", 
     + "Use interactively until you get convincing results."
       write (23,*) "It is necessary to use external programs such as",
     + " XFLR5 and or CFD to obtain the aerodynamic coefficients",
     + " and the center of pressure"
       write (23,*) "Remember that the axes used in LEparagliding are:"
       write (23,*) "Origin (0,0,0)= at the nose of the central ",
     + "profile section."
       write (23,*) "X-axis horizontal and in the span direction"
       write (23,*) "Y-axis along the central chord"
       write (23,*) "Z-axis perpendicular to the XY plane and pointing",
     + " down (not coincides with gravity axis)"


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Print normal output (regular users)
c      i37output=0
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (i37output.eq.0) then 

       write (23,*)
       write (23,*) "Section 35 data and initial parameters:"
       write (23,*) "-----------------------------------------------"
       write (23,'(A16,x,F10.4,x,A)') "g=",x35grav,
     + "m/s2 gravity of Eart"
       write (23,'(A16,x,F10.4,x,A)') "ro=",x35ro,
     + "kg/m3 air mass density"
       write (23,'(A16,x,F10.4,x,A)') "mu=",x35mu,
     + "microPascals x s air dynamic viscosity"
       write (23,'(A16,x,F10.4,x,A)') "V=",x35v,
     + "m/s estimated initial flow speed"
       write (23,'(A16,x,F10.4,x,A)') "Alpha=",x35alpha*180./pi,
     + "deg estimated wing angle of attack AOA"
       write (23,'(A16,x,F10.4,x,A)') "Cl=",x35cl,
     + "wing lift coefficient"
       write (23,'(A16,x,F10.4,x,A)') "Cle=",x35cle,
     + "wing lift adjustment coefficient"
       write (23,'(A16,x,F10.4,x,A)') "Cd=",x35cd,
     + "wing drag coefficient"
       write (23,'(A16,x,F10.4,x,A)') "Cde=",x35cde,
     + "wing drag adjustment coefficient"
       write (23,'(A16,x,F10.4,x,A)') "Cm=",x35cm,
     + "wing moment coefficient"
       write (23,'(A16,x,F10.4,x,A,x,A,F8.3,x,A)') "Cdp=",x35dpcoef,
     + "pilot drag coefficient"
       write (23,'(A16,x,F10.4,x,A2)') "Spilot=",x35spilot,"m2" 
       write (23,'(A16,x,F10.3,x,A2)') "Wing mass=",x35wingmass,"kg"
       write (23,'(A16,x,F10.3,x,A2,x,A39)') "Pilot mass=",x35pilotmass
     + ,"kg","included harness, instruments, water..."
       write (23,'(A16,x,F10.3,x,A)') "Pilot mass desp=",x35pmc,
     + "m  below main karabiners"
       write (23,'(A16,x,F10.3,x,A)') "x-coordinate Cp=",0.0d0,"m"
       write (23,'(A16,x,F10.3,x,A)') "y-coordinate Cp=",x35ycp,"m"
       write (23,'(A16,x,F10.3,x,A)') "z-coordinate Cp=",x35zcp,"m"

c      Results
       write (23,*)
       write (23,*) "Results:"
       write (23,*) "-----------------------------------------------"
c      Print method
       write (23,'(A16,7x,I1)') "Solve method=",i37solve
c      Convergence control
       if (i35m1contr.eq.1) then
       write (23,*) "WARNING!!! Method does not converge! Review data!"
       end if
       if (i35m2contr.eq.1) then
       write (23,*) "WARNING!!! Method does not converge! Review data!"
       end if
       if (i35m3contr.eq.1) then
       write (23,*) "WARNING!!! Method does not converge! Review data!"
       end if
       if (i35m4contr.eq.1) then
       write (23,*) "WARNING!!! Method does not converge! Review data!"
       end if
       if (i35m5contr.eq.1) then
       write (23,*) "WARNING!!! Method does not converge! Review data!"
       end if
c      Masses
       write (23,*)
       write (23,*) "Masses and wingload:"
       write (23,'(A16,x,F10.3,x,A2,x,A)') "Lines mass=",xlimog(2),
     + "kg","(risers included)"
       write (23,'(A16,x,F10.3,x,A2)') "Risers mass=",xlimog(14),
     + "kg"
       write (23,'(A16,x,F10.3,x,A2,3x,I2,x,A)') 
     + "Quickli mass=",xlimog(16),"kg",nrisers*2,"units"
       write (23,'(A16,x,F10.3,x,A2)') "Total mass=",xlimog(16)+
     + xlimog(2)+x35wingmass+x35pilotmass,"kg"
c      Surfaces
       write (23,'(A16,x,F10.4,x,A2)') "Wing flatS=",farea,"m2"
       write (23,'(A16,x,F10.4,x,A2)') "Wing projS=",parea,"m2"
c      Wing load
       write (23,'(A16,x,F10.3,x,A5,x,A)') "Wingload=",xlimog(18)/farea,
     + "kg/m2","(using flat wing area)"
       write (23,'(A16,x,F10.3,x,A5,x,A)') "Wingload=",xlimog(18)/parea,
     + "kg/m2","(using projected wing area)"
c      Lines calculus
       write (23,*)
       write (23,*) "Lines calculus:"
       write (23,'(A16,x,F10.4,x,A,x,A)') "Lines surf=",xlimog(3),
     + "m2 (risers included)" 
       write (23,'(A16,x,F10.4,x,A2)') "Risers surf=",xlimog(15),
     + "m2"
       write (23,'(A16,x,F10.4,x,A)') "y-Lines drag=",x35dly,"m"
       write (23,'(A16,x,F10.4,x,A)') "z-Lines drag=",x35dlz,"m"
       write (23,'(A16,x,F10.4)') "Global Cdlines=",x35dlcoef

c      Aero forces
       write (23,*)
       write (23,*) "Aerodynamic forces:"
       write (23,'(A16,x,F10.4,x,F10.4,x,F10.4)') "k1,k2,k=",
     + x35_k1,x35_k2,x35_k
       write (23,'(A16,x,F10.4,x,A)') "Wing lift=",x35wl,"N"
       write (23,'(A16,x,F10.4,x,A)') "Wing lift ex=",x35liftextra,"N"
       write (23,'(A16,x,F10.4,x,A)') "Wing drag=",x35wd,"N"
       write (23,'(A16,x,F10.4,x,A)') "Wing drag ex=",x35dragextra,"N"
       write (23,'(A16,x,F10.4,x,A)') "Lines drag=",x35linesd,
     + "N (risers included)" 
       write (23,'(A16,x,F10.4,x,A)') "Pilot drag=",x35pilotd,"N"
       write (23,'(A16,x,F10.4,x,A)') "Total drag=",x35totald,"N"  

c      Speed
       write (23,*)
       write (23,'(A16,x,F10.3,x,A3,x,F10.2,x,A4)') "Theoric speed=",
     + x35vi,"m/s",x35vi*3.6,"km/h"
       write (23,'(A16,x,F10.3,x,A3,x,F10.2,x,A4)') "Horiz speed=",
     + x35vi*dcos(x35gamma),"m/s",x35vi*dcos(x35gamma)*3.6,"km/h"
       write (23,'(A16,x,F10.3,x,A3,x,F10.2,x,A4)') "Vert speed=",
     + x35vi*dsin(x35gamma),"m/s",x35vi*dsin(x35gamma)*3.6,"km/h"

c      Wing 3d mass center (repeat above
       write (23,*)
       write (23,*) "Mass centers:"
       write (23,'(A16)') "Wing mc:"
c       write (23,'(A16,x,F10.3,x,A2)') "x=",wcdgx3d/100.,"m"
       write (23,'(A16,x,F10.3,x,A)') "y=",wcdgy3d/100.,"m"
       write (23,'(A16,x,F10.3,x,A)') "z=",wcdgz3d/100.,"m"
       write (23,'(A16)') "Lines+risers mc:"
c       write (23,'(A16,x,F10.3,x,A2)') "x=",0.0d0,"m"
       write (23,'(A16,x,F10.3,x,A)') "y=",xlimog(11)/100.,"m"
       write (23,'(A16,x,F10.3,x,A)') "z=",xlimog(12)/100.,"m"
       write (23,'(A16)') "Quicklinks mc:"
c       write (23,'(A16,x,F10.3,x,A)') "x=",x35qlmcx,"m"
       write (23,'(A16,x,F10.3,x,A)') "y=",x35qlmcy,"m"
       write (23,'(A16,x,F10.3,x,A)') "z=",x35qlmcz,"m"
       write (23,'(A16)') "Pilot+harnes mc:"
c       write (23,'(A16,x,F10.3,x,A)') "x=",x35pmcx,"m"
       write (23,'(A16,x,F10.3,x,A)') "y=",x35pmcy,"m"
       write (23,'(A16,x,F10.3,x,A)') "z=",x35pmcz,"m"
       write (23,'(A16)') "Total mc:"
c       write (23,'(A16,x,F10.3,x,A)') "x=",x35totmcx,"m"
       write (23,'(A16,x,F10.3,x,A)') "y=",x35totmcy,"m"
       write (23,'(A16,x,F10.3,x,A)') "z=",x35totmcz,"m"

c      Angles and calage
       write (23,*)
       write (23,'(A)') "Angles and calage:"
       write (23,'(A,A)') "WARNING: ",
     + "Iterate initial values until convergence!"
       write (23,'(A,A)') "These results are ",
     + "for informational purposes only!"
       write (23,'(A,A)') "The REAL design parameters ",
     + "must be entered manually in section 8 of leparagliding.txt"
       write (23,'(A16,x,F10.3,x,A3)') "Theta=",x35theta*180./pi,"deg"
       write (23,'(A16,x,F10.3,x,A3)') "Gamma=",x35gamma*180./pi,"deg"
       write (23,'(A16,x,F10.3)') "Glide ratio=",x35finesse
       write (23,'(A16,x,F10.3,x,A)') "Main-K x-coord=",clengk/200.,"m"
       write (23,'(A16,x,F10.3,x,A)') "Main-K y-coord=",x35py,"m"
       write (23,'(A16,x,F10.3,x,A)') "Main-K z-coord=",hcp/100.,"m"
       write (23,'(A16,x,F10.2,x,A,x,I5,x,A2)') "Cp %=",
     + x35ycp*1e4/rib(1,5),"%",int(x35ycp*1000.),"mm"
       write (23,'(A16,x,F10.2,x,A,x,I5,x,A2)') "Pp %=",
     + x35ypp*1e4/rib(1,5),"%",int(x35ypp*1000.),"mm"
       write (23,'(A16,x,F10.2,x,A,x,I5,x,A7)') "Calage %="
     + ,x35py*1e4/rib(1,5),"%",int(x35py*1000.),"mm (Py)"

       end if ! i37output=0 normal users
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Print detailed output (advanced and research users)
c      i37output=1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (i37output.eq.1.or.i37output.eq.2) then 

       if (i37output.eq.2) then  ! Add only by De Villiers request :)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Basic data
       write (23,*)
       write (23,*) "Basic project data:"
       write (23,*) "-----------------------------------------------"
       write (23,'(A16,1x,F6.2,A,F6.1,A)') "Flat area= ", farea, 
     + " m2 ",farea*10.7639," ft2"
       write (23,'(A16,1x,F6.2,A,F6.1,A)') "Flat span= ",fspan, " m  ",
     + fspan/0.3048," ft" 
       write (23,'(A16,1x,F6.2)') "Flat A/R= ", faratio
       write (23,'(A16,1x,F6.2,A,F6.1,A)') "Projected area= ", parea, 
     + " m2 ",parea*10.7639," ft2"
       write (23,'(A16,1x,F6.2,A,F6.1,A)') "Projected span= ",pspan, 
     + " m  ",pspan/0.3048," ft" 
       write (23,'(A16,1x,F6.2)') "Projected A/R= ", paratio
       write (23,'(A16,1x,F6.2)') "Flattening= ", 
     + ((farea-parea)/farea)*100.
c      More geometric parameters
       varrow=(rib(nribss,7)-rib(1,7))*xwf/100
       write (23,'(A16,1x,F6.2,A)') "Vault arrow= ", varrow, " m"
       write (23,'(A16,1x,F6.2)') "Proj_span/arrow= ", pspan/varrow
       write (23,'(A16,1x,F6.2,A)') "Line heigth= ", 
     + (clengr+clengl)/100, " m included risers"
       write (23,'(A,1x,F6.2)') "Proj_span/Line_heigth= ", 
     + pspan*100/(clengl)
       clli=(dsqrt((clengl-rib(nribss,7)*xwf)*(clengl-rib(nribss,7)*
     + xwf)+(pspan*0.50d0*100.0d0)*(pspan*0.5d0*100.0d0)))/100.0d0
       write (23,'(A,1x,F6.2,A)') "Karabiners - wingtip= ", 
     + clli, " m"
       write (23,'(A,1x,F6.2)') "Proj_span/(Karabiners - wingtip)= ",
     + pspan/clli
c      Wing type
       write (23,'(A16,A)') "Wing type is= ", atp
c      Center of gravity
       write (23,'(A,F6.2,A,x,I4,x,A2)') 
     + "Planform geometric center of gravity at ", cdg, 
     + " % from leading edge",int((cdg/100.)*rib(1,5)*10.),"mm"
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       end if

       write (23,*)
       write (23,*) "Section 35 data and initial parameters:"
       write (23,*) "-----------------------------------------------"
       write (23,'(A16,x,F10.4,x,A)') "g=",x35grav,
     + "m/s2 gravity of Eart"
       write (23,'(A16,x,F10.4,x,A)') "ro=",x35ro,
     + "kg/m3 air mass density"
       write (23,'(A16,x,F10.4,x,A)') "mu=",x35mu,
     + "microPascals x s air dynamic viscosity"
       write (23,'(A16,x,F10.4,x,A)') "V=",x35v,
     + "m/s estimated initial flow speed"
       write (23,'(A16,x,F10.4,x,A)') "Alpha=",x35alpha*180./pi,
     + "deg estimated wing angle of attack AOA"
       write (23,'(A16,x,F10.4,x,A)') "Cl=",x35cl,
     + "wing lift coefficient"
       write (23,'(A16,x,F10.4,x,A)') "Cle=",x35cle,
     + "wing lift adjustment coefficient"
       write (23,'(A16,x,F10.4,x,A)') "Cd=",x35cd,
     + "wing drag coefficient"
       write (23,'(A16,x,F10.4,x,A)') "Cde=",x35cde,
     + "wing drag adjustment coefficient"
       write (23,'(A16,x,F10.4,x,A)') "Cm=",x35cm,
     + "wing moment coefficient"
       write (23,'(A16,x,F10.4,x,A,x,A,F8.3,x,A)') "Cdp=",x35dpcoef,
     + "pilot drag coefficient"
       write (23,'(A16,x,F10.4,x,A2)') "Spilot=",x35spilot,"m2" 
       write (23,'(A16,x,F10.3,x,A2)') "Wing mass=",x35wingmass,"kg"
       write (23,'(A16,x,F10.3,x,A2,x,A39)') "Pilot mass=",x35pilotmass
     + ,"kg","included harness, instruments, water..."
       write (23,'(A16,x,F10.3,x,A)') "Pilot mass desp=",x35pmc,
     + "m  below main karabiners"
       write (23,'(A16,x,F10.3,x,A)') "x-coordinate Cp=",0.0d0,"m"
       write (23,'(A16,x,F10.3,x,A)') "y-coordinate Cp=",x35ycp,"m"
       write (23,'(A16,x,F10.3,x,A)') "z-coordinate Cp=",x35zcp,"m"

c      Results
       write (23,*)
       write (23,*) "Results:"
       write (23,*) "-----------------------------------------------"
c      Print method
       write (23,'(A16,7x,I1)') "Solve method=",i37solve
c      Convergence control
       if (i35m1contr.eq.1) then
       write (23,*) "WARNING!!! Method does not converge! Review data!"
       end if
       if (i35m2contr.eq.1) then
       write (23,*) "WARNING!!! Method does not converge! Review data!"
       end if
       if (i35m3contr.eq.1) then
       write (23,*) "WARNING!!! Method does not converge! Review data!"
       end if
       if (i35m4contr.eq.1) then
       write (23,*) "WARNING!!! Method does not converge! Review data!"
       end if
       if (i35m5contr.eq.1) then
       write (23,*) "WARNING!!! Method does not converge! Review data!"
       end if
c      Masses
       write (23,*)
       write (23,*) "Masses and wingload:"
       write (23,'(A16,x,F10.3,x,A2,x,A)') "Lines mass=",xlimog(2),
     + "kg","(risers included)"
       write (23,'(A16,x,F10.3,x,A2)') "Risers mass=",xlimog(14),
     + "kg"
       write (23,'(A16,x,F10.3,x,A2,3x,I2,x,A)') 
     + "Quickli mass=",xlimog(16),"kg",nrisers*2,"units"
       write (23,'(A16,x,F10.3,x,A2)') "Total mass=",xlimog(16)+
     + xlimog(2)+x35wingmass+x35pilotmass,"kg"
c      Surfaces
       write (23,'(A16,x,F10.4,x,A2)') "Wing flatS=",farea,"m2"
       write (23,'(A16,x,F10.4,x,A2)') "Wing projS=",parea,"m2"
c      Wing load
       write (23,'(A16,x,F10.3,x,A5,x,A)') "Wingload=",xlimog(18)/farea,
     + "kg/m2","(using flat wing area)"
       write (23,'(A16,x,F10.3,x,A5,x,A)') "Wingload=",xlimog(18)/parea,
     + "kg/m2","(using projected wing area)"
c      Lines calculus
       write (23,*)
       write (23,*) "Lines calculus:"
       write (23,'(A16,x,F10.4,x,A,x,A)') "Lines surf=",xlimog(3),
     + "m2 (risers included)" 
       write (23,'(A16,x,F10.4,x,A2)') "Risers surf=",xlimog(15),
     + "m2"
       write (23,'(A16,x,F10.4,x,A)') "y-Lines drag=",x35dly,"m"
       write (23,'(A16,x,F10.4,x,A)') "z-Lines drag=",x35dlz,"m"
       write (23,'(A16,x,F10.4)') "Global Cdlines=",x35dlcoef

c      Aero forces
       write (23,*)
       write (23,*) "Aerodynamic forces:"
       write (23,'(A16,x,F10.4,x,F10.4,x,F10.4)') "k1,k2,k=",
     + x35_k1,x35_k2,x35_k
       write (23,'(A16,x,F10.4,x,A)') "Wing lift=",x35wl,"N"
       write (23,'(A16,x,F10.4,x,A)') "Wing lift ex=",x35liftextra,"N"
       write (23,'(A16,x,F10.4,x,A)') "Wing lift tot=",
     + x35wl+x35liftextra,"N"
       write (23,'(A16,x,F10.4,x,A)') "Wing drag=",x35wd,"N"
       write (23,'(A16,x,F10.4,x,A)') "Wing drag ex=",x35dragextra,"N"
       write (23,'(A16,x,F10.4,x,A)') "Wing drag tot=",
     + x35wd+x35dragextra,"N"
       write (23,'(A16,x,F10.4,x,A)') "Lines drag=",x35linesd,
     + "N (risers included)" 
       write (23,'(A16,x,F10.4,x,A)') "Pilot drag=",x35pilotd,"N"
       write (23,'(A16,x,F10.4,x,A)') "Total drag=",x35totald,"N"  
       write (23,'(A16,x,F10.4,x,A)') "Induced drag=",
     + x35inducedd,"N (theoretical by AR, and included in wing drag)"

c      Lift/Drag ratios
       write (23,*)
       write (23,*) "Lift to Drag ratios:"
       write (23,'(A16,x,F10.4,x,A)') "Wing Cl/Cd=",x35cl/x35cd
       write (23,'(A16,x,F10.4,x,A)') "Cl*Cle/(Cd*Cde)=",
     + x35cl*x35cle/(x35cd*x35cde)
       write (23,'(A16,x,F10.4,x,A)') "L/(D+Dextra)=",
     + x35wl/(x35wd+x35dragextra)
       write (23,'(A16,x,F10.4,x,A)') "L/(Drag total)=",
     + x35wl/x35totald

c      Speed
       write (23,*)
       write (23,'(A16,x,F10.3,x,A3,x,F10.2,x,A4)') "Theoric speed=",
     + x35vi,"m/s",x35vi*3.6,"km/h"
       write (23,'(A16,x,F10.3,x,A3,x,F10.2,x,A4)') "Horiz speed=",
     + x35vi*dcos(x35gamma),"m/s",x35vi*dcos(x35gamma)*3.6,"km/h"
       write (23,'(A16,x,F10.3,x,A3,x,F10.2,x,A4)') "Vert speed=",
     + x35vi*dsin(x35gamma),"m/s",x35vi*dsin(x35gamma)*3.6,"km/h"

c      Wing 3d mass center (repeat above
       write (23,*)
       write (23,*) "Mass centers:"
       write (23,'(A16)') "Wing mc:"
c       write (23,'(A16,x,F10.3,x,A2)') "x=",wcdgx3d/100.,"m"
       write (23,'(A16,x,F10.3,x,A)') "y=",wcdgy3d/100.,"m"
       write (23,'(A16,x,F10.3,x,A)') "z=",wcdgz3d/100.,"m"
       write (23,'(A16)') "Lines+risers mc:"
c       write (23,'(A16,x,F10.3,x,A2)') "x=",0.0d0,"m"
       write (23,'(A16,x,F10.3,x,A)') "y=",xlimog(11)/100.,"m"
       write (23,'(A16,x,F10.3,x,A)') "z=",xlimog(12)/100.,"m"
       write (23,'(A16)') "Quicklinks mc:"
c       write (23,'(A16,x,F10.3,x,A)') "x=",x35qlmcx,"m"
       write (23,'(A16,x,F10.3,x,A)') "y=",x35qlmcy,"m"
       write (23,'(A16,x,F10.3,x,A)') "z=",x35qlmcz,"m"
       write (23,'(A16)') "Pilot+harnes mc:"
c       write (23,'(A16,x,F10.3,x,A)') "x=",x35pmcx,"m"
       write (23,'(A16,x,F10.3,x,A)') "y=",x35pmcy,"m"
       write (23,'(A16,x,F10.3,x,A)') "z=",x35pmcz,"m"
       write (23,'(A16)') "Total mc:"
c       write (23,'(A16,x,F10.3,x,A)') "x=",x35totmcx,"m"
       write (23,'(A16,x,F10.3,x,A)') "y=",x35totmcy,"m"
       write (23,'(A16,x,F10.3,x,A)') "z=",x35totmcz,"m"

c      Angles and calage
       write (23,*)
       write (23,'(A)') "Angles and calage:"
       write (23,'(A,A)') "WARNING: ",
     + "Iterate initial values until convergence!"
       write (23,'(A,A)') "These results are ",
     + "for informational purposes only!"
       write (23,'(A,A)') "The REAL design parameters ",
     + "must be entered manually in section 8 of leparagliding.txt"
       write (23,'(A16,x,F10.3,x,A3)') "Theta=",x35theta*180./pi,"deg"
       write (23,'(A16,x,F10.3,x,A3)') "Gamma=",x35gamma*180./pi,"deg"
       write (23,'(A16,x,F10.3)') "Glide ratio=",x35finesse
       write (23,'(A16,x,F10.3,x,A)') "Main-K x-coord=",clengk/200.,"m"
       write (23,'(A16,x,F10.3,x,A)') "Main-K y-coord=",x35py,"m"
       write (23,'(A16,x,F10.3,x,A)') "Main-K z-coord=",hcp/100.,"m"
       write (23,'(A16,x,F10.2,x,A,x,I5,x,A2)') "Cp %=",
     + x35ycp*1e4/rib(1,5),"%",int(x35ycp*1000.),"mm"
       write (23,'(A16,x,F10.2,x,A,x,I5,x,A2)') "Pp %=",
     + x35ypp*1e4/rib(1,5),"%",int(x35ypp*1000.),"mm"
       write (23,'(A16,x,F10.2,x,A,x,I5,x,A7)') "Calage %="
     + ,x35py*1e4/rib(1,5),"%",int(x35py*1000.),"mm (Py)"
c      Complements
       write (23,*)
       write (23,*) "Complements:"
       write (23,'(A16,x,F10.2,x,A,x,I5,x,A2)') "Pp-Py %=",
     + (x35ypp-x35py)*1e4/rib(i,5),"%",int((x35ypp-x35py)*1e3),"mm"
       write (23,'(A16,x,F10.2,x,A,x,I5,x,A2)') "Py-Cp %=",
     + (x35py-x35ycp)*1e4/rib(i,5),"%",int((x35py-x35ycp)*1e3),"mm"
       write (23,'(A16,x,F10.2,x,A,x,I5,x,A2)') "Pp-Cp %=",
     + (x35ypp-x35ycp)*1e4/rib(i,5),"%",int((x35ypp-x35ycp)*1e3),"mm"
       write (23,'(A16,x,I4,x,A)') "wcg-wcp=",
     + int(x35distwcp),"mm Distance(wingcg(y,z),wingcp(y,z))"
       write (23,'(A16,x,I4,x,A)') "wcg_y-wcp_y=",
     + int((wcdgy3d*0.01-x35ycp)*1000.),"mm"
       write (23,'(A16,x,I4,x,A)') "wcg_z-wcp_z=",
     + int((wcdgz3d*0.01-x35zcp)*1000.),"mm"

       end if ! i37output=1 for advanced and research users
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Debug informations
c       write (23,*)
c       write (23,*) "Debug informations:"
c       write (23,*) "-----------------------------------------------"
c       write (23,'(A16,x,F8.2,x,A)') "Lift at gamma=0 is",x35_up,"N"
c       write (23,'(A16,x,F8.2,x,A)') "Total weight is",x35_down,"N"
c       if (x35_up.gt.x35_down) then
c       write (23,*) "Warning! Wing lift is excessive or pilot",
c     + " too light for the initial estimated speed"
c       end if

c      Speeds V,Vh,Vv

c      Write detailed lines drag information
       write (23,*)
       write (23,*) "Detailed lines drag information:"
       write (23,*) "-----------------------------------------------"
       write (23,*) "Line - Surf (mm2) - Reynolds -  Cdline  ",
     + "-  Line drag (N) "
       do i=1,cordat
       write (23,'(I4,3x,F9.0,3x,F9.0,3x,F8.3,3x,F8.2)') 
     + i,xlimo(i,3),xlimo(i,20),xlimo(i,21),xlimo(i,22) 
       end do

       end if ! case 35 active

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.12 Some parameters used in XFLR5 analysis
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write (23,*)
       write (23,*) "18. SOME PANEL PARAMETERS FOR XFLR5 ANALYSIS"
       write (23,*) "-------------------------------------------------",
     + "---------------------------"

       if (k36d.eq.0) then
       write (23,*) "No files for XFLR5"
       end if

       if (k36d.eq.1) then
       write (23,*) "Read files inside xfl5 folder"
       end if


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      18.14 Some special parameters
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write (23,*)
       write (23,*) "19. SOME SPECIAL PARAMETERS"
       write (23,*) "-------------------------------------------------",
     + "---------------------------"

       if (k37d.eq.0) then
       write (23,*) "No special parameters used in section 37"
       end if

       if (k37d.eq.1) then
       write (23,'(I3,x,A)') k37n, "special codes used"
       end if


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      19. lines.txt List of lines - labels in human readable format
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write (30,*) "LEparagliding"
       write (30,*) "List of lines, human readable format"
       write (30,*) "Ready also to import in .ods or .xls formats"
       write (30,*)
       write (30,*) "Line number - Label - Lenght (cm) - Type"
       write (30,*) 

       do i=1, cordat

c      Select letter as final row of the line
       write (ln1,'(I1)') corda (i,2)

       if (corda(i,6).eq.1) ln2="A"
       if (corda(i,6).eq.2) ln2="B"
       if (corda(i,6).eq.3) ln2="C"
       if (corda(i,6).eq.4) ln2="D"
       if (corda(i,6).eq.5) ln2="E"
       if (corda(i,6).eq.6) ln2="F"

c      If only two levels
c      Is OK

c      If tree levels
c      1 and 2 level will be named acording lineplan

c      Renames letters if levels 1 or 2

       if (corda(i,2).le.2.and.corda(i,5).ge.3) then

       if (corda(i,1).eq.1) ln2="A"
       if (corda(i,1).eq.2) ln2="B"
       if (corda(i,1).eq.3) ln2="C"
       if (corda(i,1).eq.4) ln2="D"
       if (corda(i,1).eq.5) ln2="E"
       if (corda(i,1).eq.6) ln2="F"

       end if

       if (corda(i,2).eq.1.and.corda(i,5).eq.2) then

       if (corda(i,1).eq.1) ln2="A"
       if (corda(i,1).eq.2) ln2="B"
       if (corda(i,1).eq.3) ln2="C"
       if (corda(i,1).eq.4) ln2="D"
       if (corda(i,1).eq.5) ln2="E"
       if (corda(i,1).eq.6) ln2="F"

       end if

c      Adjust brake letter to F

       if (i.gt.cordam) ln2="F"

c      Put 2 characters
       
c       if (corda(i,3).le.9)  write (ln3,'(I,I)') 0,corda(i,3)
c       if (corda(i,3).gt.9)  write (ln3,'(I2)') corda(i,3)

c       write (ln3,'(I2)') corda(i,3)

       if (corda(i,3).ge.10) then
       write (ln3,'(I2)') corda(i,3)
       end if

       if (corda(i,3).lt.10) then
       write (ln3,'(I1)') corda(i,3)
       end if


c      Change line order by final rib if upper line

       if (corda(i,2).eq.corda(i,5)) then

c       if (corda(i,7).le.9)  write (ln3,'(I,I)') 0,corda(i,7)
c       if (corda(i,7).gt.9)  write (ln3,'(I2)') corda(i,7)

       if (corda(i,7).ge.10) then
       write (ln3,'(I2)') corda(i,7)
       end if

       if (corda(i,7).lt.10) then
       write (ln3,'(I1)') corda(i,7)
       end if


       end if

c      Write line labels

       write (ln4(i),'(A1,A1,A2)') ln1,ln2,ln3
c       write (*,*) i , ln4(i)
c       write (ln4(i),'(A1,A1)') ln1,ln2


       if (corda(i,6).eq.6) xlifi(i)=xline(i)

c      Row plan A

       if (i.eq.1) then 
       slpi(1)=i
       write (30,*)
       write (30,*) "Plan A"
       write (30,*) 
       end if

c      Rows plan B,C,D,E,F

       if(i.ge.2.and.corda(i-1,1).lt.corda(i,1)) then

       if (corda(i,1).eq.2) then
       slpi(2)=i
       write (30,*)
       write (30,*) "Plan B"
       write (30,*) 
       end if

       if (corda(i,1).eq.3) then
       slpi(3)=i
       write (30,*)
       write (30,*) "Plan C"
       write (30,*) 
       end if

       if (corda(i,1).eq.4.and.i.le.cordam) then
       slpi(4)=i
       write (30,*)
       write (30,*) "Plan D"
       write (30,*) 
       end if

       if (corda(i,1).eq.5.and.i.le.cordam) then
       slpi(5)=i
       write (30,*)
       write (30,*) "Plan E"
       write (30,*) 
       end if

       end if

c      Plan F

       if (i.eq.cordam+1) then
       slpi(6)=i
       write (30,*)
       write (30,*) "Brake lines"
       write (30,*) 
       end if

       itype=corda(i,30+corda(i,2))
c       corda(i,40)=itype
       write (30,'(I3,3x,A4,3x,F5.1,A,x,I2,x,A15,x,F6.2,x,A2)')  
     + i, ln4(i), xlifi(i), 
     + " cm  -  type", itype, tylinea(itype,4), tyline(itype,2), "mm"

       end do

       write (30,*)
       write (30,'(A,A,x,F8.2,x,A)') "Total line lengths ",
     + "(without loops) = ", xlength2,"m"
       write (30,'(A,A,x,F8.2,x,A)') "Total line lengths ",
     + "(with loops) = ", xlength1,"m"
       write (30,*) "(loops lengths according section 34 ",
     + "or internal predefined values)"
       write (30,*)

c      Print lengths by types
       write (30,*) "Minimal lengths by types, including loops:"
       do k=1,k34n
       if (lentype(k).ge.1.0d0) then
       write (30,'(A5,x,I2,x,F7.2,x,A,x,A15,x,A15,x,F6.2,x,A2,x,A4,x,
     + F6.2,x,A2)')  "Type ",jltype(k),lentype(k)/50.,"m",
     + tylinea(k,4),tylinea(k,6),tyline(k,2),"mm",
     + "loop",tyline(k,9),"cm"
       end if
       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     20. Draw labels in 2D (in tree of lines)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Labels in lines
       corda1=cordam

       do i=1,corda1

       x0=(1260.-160.)*xkf
       y0=1800.*xkf

       x00=1260.*xkf*float(corda(i,1)-1)

       xxk=0.7 ! controls label positions

       xlabel=x1line(corda(i,1),corda(i,2),corda(i,3))+
     + (x2line(corda(i,1),corda(i,2),corda(i,3))-
     + x1line(corda(i,1),corda(i,2),corda(i,3)))*xxk+x0+x00

       zlabel=z1line(corda(i,1),corda(i,2),corda(i,3))+
     + (z2line(corda(i,1),corda(i,2),corda(i,3))-
     + z1line(corda(i,1),corda(i,2),corda(i,3)))*xxk+y0

c       xlabel=((x1line(corda(i,1),corda(i,2),corda(i,3))+x0+x00)+
c     + (x2line(corda(i,1),corda(i,2),corda(i,3))+x0+x00))*0.5d0

c       zlabel=((z1line(corda(i,1),corda(i,2),corda(i,3))+y0)+
c     + (z2line(corda(i,1),corda(i,2),corda(i,3))+y0))*0.5d0

c      Text size = typm3(9)
       xtext=ln4(i)
       call txt(xlabel,zlabel,typm3(9),0.0d0,xtext,7)

       end do
   
c      Labels in brakes
       do i=cordam+1,cordat

       x0=(1260.-160.)*xkf
       y0=(1800.+890.95)*xkf

       x00=1260.*xkf*float(corda(i,1)-1)

       xlabel=((x1line(corda(i,1),corda(i,2),corda(i,3))+x0+x00)+
     + (x2line(corda(i,1),corda(i,2),corda(i,3))+x0+x00))*0.5d0

       zlabel=((z1line(corda(i,1),corda(i,2),corda(i,3))+y0)+
     + (z2line(corda(i,1),corda(i,2),corda(i,3))+y0))*0.5d0

c      Text size = typm3(9)   
       xtext=ln4(i)
       call txt(xlabel,zlabel,typm3(9),0.0d0,xtext,7)

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      21. 3D model DXF drawing
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c       call dxfinit(25)

       do i=1,nribss

c      21.1 Extrados airfoil blue

       do j=1,np(i,2)-1

       p1x=x(i,j)
       p1y=y(i,j)
       p1z=z(i,j)
       p2x=x(i,j+1)
       p2y=y(i,j+1)
       p2z=z(i,j+1)

       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(11))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,ele3dc(11))

       end do

c      Draw extrados, straight line

       if (i.le.nribss.and.ele3d(11).eq.1) then

       do j=1,np(i,2)-1
       p1x=x(i-1,j)
       p1y=y(i-1,j)
       p1z=z(i-1,j)
       p2x=x(i,j)
       p2y=y(i,j)
       p2z=z(i,j)
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(11))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,ele3dc(11))
       end do

       end if

c      21.2 Vents

c      Case "ds" or "ss"
       if (atp.eq."ds".or.atp.eq."ss") then

       do j=np(i,2),np(i,2)+np(i,3)-2

       p1x=x(i,j)
       p1y=y(i,j)
       p1z=z(i,j)
       p2x=x(i,j+1)
       p2y=y(i,j+1)
       p2z=z(i,j+1)

       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(12))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,ele3dc(12))

       end do

c      Draw vents, straight line

       if (i.le.nribss.and.ele3d(12).eq.1) then

       do j=np(i,2),np(i,2)+np(i,3)-2
       p1x=x(i-1,j)
       p1y=y(i-1,j)
       p1z=z(i-1,j)
       p2x=x(i,j)
       p2y=y(i,j)
       p2z=z(i,j)
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(12))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,ele3dc(12))
       end do

       end if

       end if ! ds or ss

c      Case "pc"
       if (atp.eq."pc") then

       j1=np(i,2)
       j2=np(i,2)+np(i,3)-1

       p1x=x(i,j1)
       p1y=y(i,j1)
       p1z=z(i,j1)
       p2x=x(i,j2)
       p2y=y(i,j2)
       p2z=z(i,j2)

       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(12))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,ele3d(12))

       end if

c      21.3 Intrados 

       do j=np(i,2)+np(i,3)-1,np(i,1)-1

       p1x=x(i,j)
       p1y=y(i,j)
       p1z=z(i,j)
       p2x=x(i,j+1)
       p2y=y(i,j+1)
       p2z=z(i,j+1)

       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(13))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,ele3dc(13))

       end do

c      Draw intrados, straight line

       if (i.le.nribss.and.ele3d(13).eq.1) then

       do j=np(i,2)+np(i,3)-1,np(i,1)-1
       p1x=x(i-1,j)
       p1y=y(i-1,j)
       p1z=z(i-1,j)
       p2x=x(i,j)
       p2y=y(i,j)
       p2z=z(i,j)
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(13))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,ele3dc(13))
       end do

       end if


       end do

c      21.4 Trailing edge

       do i=1,nribss-1

       p1x=x(i,1)
       p1y=y(i,1)
       p1z=z(i,1)
       p2x=x(i+1,1)
       p2y=y(i+1,1)
       p2z=z(i+1,1)

       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(11))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,ele3dc(11))

       end do

       p1x=x(1,1)
       p1y=y(1,1)
       p1z=z(1,1)
       p2x=-x(1,1)
       p2y=y(1,1)
       p2z=z(1,1)

       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(11))

c      21.5 Leading edge

c      Case classic
       if (k26d.eq.0) then

c      Vent in

       do i=1,nribss

       p1x=x(i-1,np(i,2))
       p1y=y(i-1,np(i,2))
       p1z=z(i-1,np(i,2))
       p2x=x(i,np(i,2))
       p2y=y(i,np(i,2))
       p2z=z(i,np(i,2))

       if (rib(i,14).eq.1) then
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(12))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,ele3dc(12))
       end if
       if (rib(i,14).eq.0) then
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,9)
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,9)
       end if


       end do

c       p1x=x(1,np(i,2))
c       p1y=y(1,np(i,2))
c       p1z=z(1,np(i,2))
c       p2x=-x(1,np(i,2))
c       p2y=y(1,np(i,2))
c       p2z=z(1,np(i,2))

c       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,1)

c      Vent out

       do i=1,nribss

       j=np(i,2)+np(i,3)-1

       p1x=x(i-1,j)
       p1y=y(i-1,j)
       p1z=z(i-1,j)
       p2x=x(i,j)
       p2y=y(i,j)
       p2z=z(i,j)

       if (rib(i,14).eq.1) then
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(12))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,ele3dc(12))
       end if
       if (rib(i,14).eq.4) then
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,9)
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,9)
       end if

       end do

       end if ! k26d=0


c      Case new vents
       if (k26d.eq.1) then

c      Vent in

       do i=1,nribss

       p1x=x(i-1,np(i,2))
       p1y=y(i-1,np(i,2))
       p1z=z(i-1,np(i,2))
       p2x=x(i,np(i,2))
       p2y=y(i,np(i,2))
       p2z=z(i,np(i,2))

       j=np(i,2)+np(i,3)-1

       p3x=x(i-1,j)
       p3y=y(i-1,j)
       p3z=z(i-1,j)
       p4x=x(i,j)
       p4y=y(i,j)
       p4z=z(i,j)

       if (rib(i,165).eq.0) then
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(12))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,ele3dc(12))
       call line3d(p3x,p3y,p3z,p4x,p4y,p4z,ele3dc(12))
       call line3d(-p3x,p3y,p3z,-p4x,p4y,p4z,ele3dc(12))
       end if

       if (rib(i,165).eq.1.or.rib(i,165).eq.6) then
       call line3d(p3x,p3y,p3z,p4x,p4y,p4z,ele3dc(12))
       call line3d(-p3x,p3y,p3z,-p4x,p4y,p4z,ele3dc(12))
       end if

       if (rib(i,165).eq.-1.or.rib(i,165).eq.-6) then
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(12))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,ele3dc(12))
       end if

       if (rib(i,165).eq.-2) then
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(12))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,ele3dc(12))
       call line3d(p3x,p3y,p3z,p2x,p2y,p2z,ele3dc(12))
       call line3d(-p3x,p3y,p3z,-p2x,p2y,p2z,ele3dc(12))
       end if

       if (rib(i,165).eq.-3) then
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,ele3dc(12))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,ele3dc(12))
       call line3d(p1x,p1y,p1z,p4x,p4y,p4z,ele3dc(12))
       call line3d(-p1x,p1y,p1z,-p4x,p4y,p4z,ele3dc(12))
       end if


c      Vents type 4,-4,-5
       if (rib(i,165).eq.4.or.rib(i,165).eq.-4.or.rib(i,165).eq.-5) then

c      Interpolate new vent init

c      Load vent polyline
c      Left side
       do j=np(i,2),np(i,2)+np(i,3)-1
       xpoly(j)=x(i-1,j)
       ypoly(j)=y(i-1,j)
       zpoly(j)=z(i-1,j)
       end do
       npo=np(i,3)

c      Length vent left
       xlenl=0.0d0
       do j=np(i,2),np(i,2)+np(i,3)-2
       xlenl=xlenl+dsqrt((xpoly(j+1)-xpoly(j))*(xpoly(j+1)-xpoly(j))+
     + (ypoly(j+1)-ypoly(j))*(ypoly(j+1)-ypoly(j))+
     + (zpoly(j+1)-zpoly(j))*(zpoly(j+1)-zpoly(j)))  
       end do
       xlenlr=xlenl*(1.-csi(i,19)/100.)

c      Interpole point
       call interpoly3d(xpoly,ypoly,zpoly,x_poly,y_poly,z_poly,
     + xlenlr,np(i,2),np(i,2)+np(i,3)-1,npolyl,distrel)
       x_poly1=x_poly
       y_poly1=y_poly
       z_poly1=z_poly
       distrel1=distrel

c      Right side
       do j=np(i,2),np(i,2)+np(i,3)-1
       xpoly(j)=x(i,j)
       ypoly(j)=y(i,j)
       zpoly(j)=z(i,j)
       end do
       npo=np(i,3)

c      Length vent right
       xlenr=0.0d0
       do j=np(i,2),np(i,2)+np(i,3)-2
       xlenr=xlenr+dsqrt((xpoly(j+1)-xpoly(j))*(xpoly(j+1)-xpoly(j))+
     + (ypoly(j+1)-ypoly(j))*(ypoly(j+1)-ypoly(j))+
     + (zpoly(j+1)-zpoly(j))*(zpoly(j+1)-zpoly(j)))  
       end do
       xlenrr=xlenr*(1.-csi(i,20)/100.)

c      Interpole point
       call interpoly3d(xpoly,ypoly,zpoly,x_poly,y_poly,z_poly,
     + xlenrr,np(i,2),np(i,2)+np(i,3)-1,npolyl,distrel)
       x_poly2=x_poly
       y_poly2=y_poly
       z_poly2=z_poly
       distrel2=distrel

c      Case 4,-4,-5
c      Draw line vent
       call line3d(x_poly1,y_poly1,z_poly1,x_poly2,y_poly2,z_poly2,
     + ele3dc(12))
       call line3d(-x_poly1,y_poly1,z_poly1,-x_poly2,y_poly2,z_poly2,
     + ele3dc(12))

c      Case -5 still not drawn

c      Draw line extrados
       if (rib(i,165).eq.-4.or.rib(i,165).eq.-5) then
       j=np(i,2)
       call line3d(x(i-1,j),y(i-1,j),z(i-1,j),x(i,j),y(i,j),z(i,j),
     + ele3dc(12))
       call line3d(-x(i-1,j),y(i-1,j),z(i-1,j),-x(i,j),y(i,j),z(i,j),
     + ele3dc(12))
       end if

c      Draw line intrados
       if (rib(i,165).eq.4.or.rib(i,165).eq.5) then
       j=np(i,2)+np(i,3)-1
       call line3d(x(i-1,j),y(i-1,j),z(i-1,j),x(i,j),y(i,j),z(i,j),
     + ele3dc(12))
       call line3d(-x(i-1,j),y(i-1,j),z(i-1,j),-x(i,j),y(i,j),z(i,j),
     + ele3dc(12))
       end if

       end if ! vents 4,-4,-5

       end do ! i


       end if ! k26d=1


c      21.6 lines 3D

c      Lines A,B,C,D,...

       do i=1,cordam

       p2x=x2line(corda(i,1),corda(i,2),corda(i,3))
       p1x=x1line(corda(i,1),corda(i,2),corda(i,3))
       p2y=y2line(corda(i,1),corda(i,2),corda(i,3))
       p1y=y1line(corda(i,1),corda(i,2),corda(i,3))
       p2z=z2line(corda(i,1),corda(i,2),corda(i,3))
       p1z=z1line(corda(i,1),corda(i,2),corda(i,3))

       if (i37c.eq.0) then ! colors by risers
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,iccolor(10+corda(i,1)))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,iccolor(10+corda(i,1)))
       end if

       if (i37c.eq.1) then ! colors by table 34
       iccolor34(i)=int(tyline(corda(i,40),10))
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,iccolor34(i))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,iccolor34(i))
       end if

       end do

c      21.7 Brakes

       do i=cordam+1,cordat

       p2x=x2line(corda(i,1),corda(i,2),corda(i,3))
       p1x=x1line(corda(i,1),corda(i,2),corda(i,3))
       p2y=y2line(corda(i,1),corda(i,2),corda(i,3))
       p1y=y1line(corda(i,1),corda(i,2),corda(i,3))
       p2z=z2line(corda(i,1),corda(i,2),corda(i,3))
       p1z=z1line(corda(i,1),corda(i,2),corda(i,3))

       if (i37c.eq.0) then ! colors by risers
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,iccolor(16))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,iccolor(16))
       end if

       if (i37c.eq.1) then ! colors by table 34
       iccolor34(i)=int(tyline(corda(i,40),10))
       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,iccolor34(i))
       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,iccolor34(i))
       end if

       end do


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      21.8 H-V-ribs 3D drawing
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do k=1,nhvr

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      21.8.1 H-ribs
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (hvr(k,2).eq.1) then
       i=hvr(k,3)
c      warning
       ii=hvr(k,4)

       do j=1,21

       p1x=hx3(i,j,ii)
       p1y=hy3(i,j,ii)
       p1z=hz3(i,j,ii)
       p2x=hx2(i,j,ii)
       p2y=hy2(i,j,ii)
       p2z=hz2(i,j,ii)

       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,2)

       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,2)

       if (j.lt.21) then

       call line3d(-hx2(i,j,ii),hy2(i,j,ii),hz2(i,j,ii),
     + -hx2(i,j+1,ii),hy2(i,j+1,ii),hz2(i,j+1,ii),2)
       call line3d(-hx3(i,j,ii),hy3(i,j,ii),hz3(i,j,ii),
     + -hx3(i,j+1,ii),hy3(i,j,ii),hz3(i,j+1,ii),2)

       call line3d(hx2(i,j,ii),hy2(i,j,ii),hz2(i,j,ii),
     + hx2(i,j+1,ii),hy2(i,j+1,ii),hz2(i,j+1,ii),2)
       call line3d(hx3(i,j,ii),hy3(i,j,ii),hz3(i,j,ii),
     + hx3(i,j+1,ii),hy3(i,j,ii),hz3(i,j+1,ii),2)

       end if

       end do

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      21.8.2 V-ribs partial
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Obsolete, erased

       if (hvr(k,2).eq.2) then
       i=hvr(k,3)
       ii=hvr(k,4)

       do j=1,21

       p1x=rx1(i,j,ii)
       p1y=ry1(i,j,ii)
       p1z=rz1(i,j,ii)
       p2x=rx2(i,j,ii)
       p2y=ry2(i,j,ii)
       p2z=rz2(i,j,ii)

c      Diagonal i-1 to i
       if (hvr(k,5).eq.1) then
c       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,5)
c       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,5)
       end if

       if (j.lt.21) then
       if (hvr(k,5).eq.1) then
c       call line3d(rx1(i,j,ii),ry1(i,j,ii),rz1(i,j,ii),
c     + rx1(i,j+1,ii),ry1(i,j+1,ii),rz1(i,j+1,ii),5)
c       call line3d(-rx1(i,j,ii),ry1(i,j,ii),rz1(i,j,ii),
c     + -rx1(i,j+1,ii),ry1(i,j+1,ii),rz1(i,j+1,ii),5)
       end if
       end if

       p1x=rx3(i,j,ii)
       p1y=ry3(i,j,ii)
       p1z=rz3(i,j,ii)
       p2x=rx2(i,j,ii)
       p2y=ry2(i,j,ii)
       p2z=rz2(i,j,ii)

c      Diagonal i to i+1
       if (hvr(k,6).eq.1) then
c       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,1)
c       call line3d(-p1x,p1y,p1z,-p2x,p2y,p2z,1)
       end if

       if (j.lt.21) then
       if (hvr(k,6).eq.1) then
c       call line3d(rx3(i,j,ii),ry3(i,j,ii),rz3(i,j,ii),
c     + rx3(i,j+1,ii),ry3(i,j+1,ii),rz3(i,j+1,ii),1)
c       call line3d(-rx3(i,j,ii),ry3(i,j,ii),rz3(i,j,ii),
c     + -rx3(i,j+1,ii),ry3(i,j+1,ii),rz3(i,j+1,ii),1)
       end if
       end if

       end do

       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      21.8.4 VH-ribs
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      OBSOLETE, draw before. ERASE

       if (hvr(k,2).eq.4) then
       i=hvr(k,3)-1
       ii=hvr(k,4)

       do j=1,21

c      Diagonal i-1 to i

       p1x=sx1(i,j,ii)
       p1y=sy1(i,j,ii)
       p1z=sz1(i,j,ii)
       p2x=sx2(i,j,ii)
       p2y=sy2(i,j,ii)
       p2z=sz2(i,j,ii)

       if (hvr(k,5).eq.1) then
c       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,4)
       end if

       if (j.lt.21) then
       if (hvr(k,5).eq.1) then
c       call line3d(rx1(i,j,ii),ry1(i,j,ii),rz1(i,j,ii),
c     + rx1(i,j+1,ii),ry1(i,j+1,ii),rz1(i,j+1,ii),4)
       end if
       end if

c      Horizontal i to i+1

       p1x=sx1(i,j,ii)
       p1y=sy1(i,j,ii)
       p1z=sz1(i,j,ii)
       p2x=sx3(i,j,ii)
       p2y=sy3(i,j,ii)
       p2z=sz3(i,j,ii)

       if (hvr(k,5).eq.1.or.hvr(k,6).eq.1) then
c       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,4)
       end if

       if (j.lt.21) then
       if (hvr(k,5).eq.1) then
c       call line3d(rx1(i,j,ii),ry1(i,j,ii),rz1(i,j,ii),
c     + rx1(i,j+1,ii),ry1(i,j+1,ii),rz1(i,j+1,ii),4)
       end if
       end if

c      Diagonal i+1 to i+2

       p1x=sx3(i,j,ii)
       p1y=sy3(i,j,ii)
       p1z=sz3(i,j,ii)
       p2x=sx4(i,j,ii)
       p2y=sy4(i,j,ii)
       p2z=sz4(i,j,ii)

       if (hvr(k,6).eq.1) then
c       call line3d(p1x,p1y,p1z,p2x,p2y,p2z,4)
       end if

       if (j.lt.21) then
       if (hvr(k,6).eq.1) then
c       call line3d(rx3(i,j,ii),ry3(i,j,ii),rz3(i,j,ii),
c     + rx3(i,j+1,ii),ry3(i,j+1,ii),rz3(i,j+1,ii),4)
       end if
       end if

       end do

       end if

       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      21.9 Draw the intermediate and ovalized airfoil in 3D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do i=1,nribss

c      All airfoil points
       if (atp.ne."ss") then
       jfin=np(i,1)-1
       end if

c      Limite the number of points in single skin
       if (atp.eq."ss") then
       jfin=np(i,2)+np(i,3)-2
       end if

c      Intermediate airfoil (48)
       if (pp29(1,1).eq.1) then
       if (i.ge.pp29(1,2).and.i.le.pp29(1,3)) then
       do j=1,jfin
       call line3d(u(i,j,48),v(i,j,48),w(i,j,48),
     + u(i,j+1,48),v(i,j+1,48),w(i,j+1,48),7)
       if (pp29(1,4).eq.0) then
       call line3d(-u(i,j,48),v(i,j,48),w(i,j,48),
     + -u(i,j+1,48),v(i,j+1,48),w(i,j+1,48),7)
       end if
       end do
       end if
       end if

c      Ovalized airfoil (49)
       if (pp29(2,1).eq.1) then
       if (i.ge.pp29(2,2).and.i.le.pp29(2,3)) then
       do j=1,jfin
       call line3d(u(i,j,49),v(i,j,49),w(i,j,49),u(i,j+1,49),v(i,j+1,49)
     + ,w(i,j+1,49),4)
       if (pp29(2,4).eq.0) then
       call line3d(-u(i,j,49),v(i,j,49),w(i,j,49),-u(i,j+1,49),
     + v(i,j+1,49),w(i,j+1,49),4)
       end if
       end do
       end if
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      21.10 Draw tessellation in 3D model
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
       if (pp29(3,1).eq.1) then
       if (i.ge.pp29(3,2).and.i.le.pp29(3,3)) then

c      21.10.1 Extrados
c      Extrados transverse line
       do k=1,nsegments
       do j=1,np(i,2)
       call line3d(tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + tesse3d(1,i,j,k+1),tesse3d(2,i,j,k+1),tesse3d(3,i,j,k+1),
     + ele3dc(11))
       if (pp29(3,4).eq.1) then ! draw symetric part
       call line3d(-tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + -tesse3d(1,i,j,k+1),tesse3d(2,i,j,k+1),tesse3d(3,i,j,k+1),
     + ele3dc(11))
       end if
       end do ! j
       end do ! k

c      Extrados longitudinal lines
       do k=1,nsegments+1
       do j=1,np(i,2)-1       
       call line3d(tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + tesse3d(1,i,j+1,k),tesse3d(2,i,j+1,k),tesse3d(3,i,j+1,k),
     + ele3dc(11))
       if (pp29(3,4).eq.1) then ! draw symetric part
       call line3d(-tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + -tesse3d(1,i,j+1,k),tesse3d(2,i,j+1,k),tesse3d(3,i,j+1,k),
     + ele3dc(11))
       end if
       end do ! j
       end do ! k

c      21.10.2 Vents
c      Draw vents only if closed
c      Still not draw special cases
       if (rib(i,165).eq.1.or.rib(i,165).eq.-1.or.
     + rib(i,14).eq.0) then
c      Vents transverse line
       do k=1,nsegments
       do j=np(i,2),np(i,2)+np(i,3)-1
       call line3d(tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + tesse3d(1,i,j,k+1),tesse3d(2,i,j,k+1),tesse3d(3,i,j,k+1),
     + ele3dc(12))
       if (pp29(3,4).eq.1) then ! draw symetric part
       call line3d(-tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + -tesse3d(1,i,j,k+1),tesse3d(2,i,j,k+1),tesse3d(3,i,j,k+1),
     + ele3dc(12))
       end if
       end do ! j
       end do ! k

c      Vents longitudinal lines
       do k=1,nsegments+1
       do j=np(i,2),np(i,2)+np(i,3)-1   
       call line3d(tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + tesse3d(1,i,j+1,k),tesse3d(2,i,j+1,k),tesse3d(3,i,j+1,k),
     + ele3dc(12))
       if (pp29(3,4).eq.1) then ! draw symetric part
       call line3d(-tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + -tesse3d(1,i,j+1,k),tesse3d(2,i,j+1,k),tesse3d(3,i,j+1,k),
     + ele3dc(12))
       end if
       end do ! j
       end do ! k
       end if ! Vents only if closed rib


c      21.10.3 Intrados
       if (atp.ne."ss") then
c      Intrados transverse line
       do k=1,nsegments
       do j=np(i,2)+np(i,3)-1,np(i,1)
       call line3d(tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + tesse3d(1,i,j,k+1),tesse3d(2,i,j,k+1),tesse3d(3,i,j,k+1),
     + ele3dc(13))
       if (pp29(3,4).eq.1) then ! draw symetric part
       call line3d(-tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + -tesse3d(1,i,j,k+1),tesse3d(2,i,j,k+1),tesse3d(3,i,j,k+1),
     + ele3dc(13))
       end if
       end do ! j
       end do ! k

c      Intrados longitudinal lines
       do k=1,nsegments+1
       do j=np(i,2)+np(i,3)-1,np(i,1)-1   
       call line3d(tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + tesse3d(1,i,j+1,k),tesse3d(2,i,j+1,k),tesse3d(3,i,j+1,k),
     + ele3dc(13))
       if (pp29(3,4).eq.1) then ! draw symetric part
       call line3d(-tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + -tesse3d(1,i,j+1,k),tesse3d(2,i,j+1,k),tesse3d(3,i,j+1,k),
     + ele3dc(13))
       end if
       end do ! j
       end do ! k
       end if ! wing type is not "ss"


       end if ! i included
       end if ! case DXF in model


       end do ! i main loop

       call dxfend(25)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      21.11 Draw external 3D DXF tessellation
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (pp29(4,1).eq.1) then ! Draw external DXF

       do i=1,nribss

       if (pp29(4,1).eq.1) then
       if (i.ge.pp29(4,2).and.i.le.pp29(4,3)) then

c      Write new DXF file (file 26)

c      Extrados transverse line
       do k=1,nsegments
       do j=1,np(i,2)
       call line3dn(tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + tesse3d(1,i,j,k+1),tesse3d(2,i,j,k+1),tesse3d(3,i,j,k+1),
     + ele3dc(11))
       if (pp29(4,4).eq.1) then ! draw symetric part
       call line3dn(-tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + -tesse3d(1,i,j,k+1),tesse3d(2,i,j,k+1),tesse3d(3,i,j,k+1),
     + ele3dc(11))
       end if
       end do ! j
       end do ! k

c      Extrados longitudinal lines
       do k=1,nsegments+1
       do j=1,np(i,2)-1       
       call line3dn(tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + tesse3d(1,i,j+1,k),tesse3d(2,i,j+1,k),tesse3d(3,i,j+1,k),
     + ele3dc(11))
       if (pp29(4,4).eq.1) then ! draw symetric part
       call line3dn(-tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + -tesse3d(1,i,j+1,k),tesse3d(2,i,j+1,k),tesse3d(3,i,j+1,k),
     + ele3dc(11))
       end if
       end do ! j
       end do ! k

c      Draw vents only if closed
c      Still not draw special cases
       if (rib(i,165).eq.1.or.rib(i,165).eq.-1.or.
     + rib(i,14).eq.0) then
c      Vents transverse line
       do k=1,nsegments
       do j=np(i,2),np(i,2)+np(i,3)-1
       call line3dn(tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + tesse3d(1,i,j,k+1),tesse3d(2,i,j,k+1),tesse3d(3,i,j,k+1),
     + ele3dc(12))
       if (pp29(4,4).eq.1) then ! draw symetric part
       call line3dn(-tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + -tesse3d(1,i,j,k+1),tesse3d(2,i,j,k+1),tesse3d(3,i,j,k+1),
     + ele3dc(12))
       end if
       end do ! j
       end do ! k

c      Vents longitudinal lines
       do k=1,nsegments+1
       do j=np(i,2),np(i,2)+np(i,3)-1   
       call line3dn(tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + tesse3d(1,i,j+1,k),tesse3d(2,i,j+1,k),tesse3d(3,i,j+1,k),
     + ele3dc(12))
       if (pp29(4,4).eq.1) then ! draw symetric part
       call line3dn(-tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + -tesse3d(1,i,j+1,k),tesse3d(2,i,j+1,k),tesse3d(3,i,j+1,k),
     + ele3dc(12))
       end if
       end do ! j
       end do ! k
       end if ! Vents only if closed rib

       if (atp.ne."ss") then
c      Intrados transverse line
       do k=1,nsegments
       do j=np(i,2)+np(i,3)-1,np(i,1)
       call line3dn(tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + tesse3d(1,i,j,k+1),tesse3d(2,i,j,k+1),tesse3d(3,i,j,k+1),
     + ele3dc(13))
       if (pp29(4,4).eq.1) then ! draw symetric part
       call line3dn(-tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + -tesse3d(1,i,j,k+1),tesse3d(2,i,j,k+1),tesse3d(3,i,j,k+1),
     + ele3dc(13))
       end if
       end do ! j
       end do ! k

c      Intrados longitudinal lines
       do k=1,nsegments+1
       do j=np(i,2)+np(i,3)-1,np(i,1)-1   
       call line3dn(tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + tesse3d(1,i,j+1,k),tesse3d(2,i,j+1,k),tesse3d(3,i,j+1,k),
     + ele3dc(13))
       if (pp29(4,4).eq.1) then ! draw symetric part
       call line3dn(-tesse3d(1,i,j,k),tesse3d(2,i,j,k),tesse3d(3,i,j,k),
     + -tesse3d(1,i,j+1,k),tesse3d(2,i,j+1,k),tesse3d(3,i,j+1,k),
     + ele3dc(13))
       end if
       end do ! j
       end do ! k
       end if ! wing type is not "ss"

       end if
       end if

       end do

       call dxfend(26)

       end if ! Close external dxf

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      21.12 Draw tessellation in 3D model (OpenSCAD view)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (pp29(5,1).eq.1) then ! Case SCAD and STL

c      Constructing OpenSCAD file
       write(27,*) "// http://www.laboratoridenvol.com"
       write(27,*) "// OpenSCAD file generated by LEparagliding version"
     + ," ",lepv
       write(27,*)

c      Avoid zero width centrall cell
       if (pp29(5,2).eq.1.and.rib(1,2).lt.0.10d0) then
       pp29(5,2)=2
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      22.12.1 Extrados surface
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Define points
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write(27,*) "PolPoints_Ext = [ "
       
       do i=pp29(5,2),pp29(5,3) ! Iterate in panels
       npoints=np(i,2)
       nlpanels=pp29(5,3)-pp29(5,2)+1 ! number of local panels

       do k=nsegments+1,1,-1 ! Iterate in segments

       write (27,*)
       write (27,*) "// Cell ",i," Line ",k,"from ",nsegments+1
       write (27,*)

       do j=1,np(i,2) 

       write (27,'(A3,1x,F12.3,A3,F12.3,A3,F12.3,A4,A9,1x,I6)') "[ ",
     + tesse3d(1,i,j,k)," , ",tesse3d(2,i,j,k)," , ",-tesse3d(3,i,j,k),
     + " ], ","// Point ",j+npoints*(nsegments+1-k)+
     + npoints*(nsegments+1)*(i-pp29(5,2))-1

       end do ! j
       end do ! k
       end do ! i

c      Add one point only to close the list, not used
       write (27,'(A3,1x,F12.3,A3,F12.3,A3,F12.3,A5,A9,1x,I6)') "[ ",
     + 0.0d0," , ",0.0d0," , ",0.0d0,
     + " ]]; ","// End ",(nsegments+1)*npoints*nlpanels

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Define faces
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write(27,*)
       write(27,*) "PolFaces_Ext = [ "
       write(27,*)

       iini=1 ! control
       k0=0
       
       do k=1,(nsegments+1)*nlpanels-1

       k0=k0+1

c      Count cells
       if (k0.eq.nsegments+1) then
       iini=iini+1
       k0=0
       end if

       write (27,*)
       write (27,'(A9,1x,I2,A9,1x,I2,1x,A6,1x,I2)') 
     + "// Panel ",(iini-1)+pp29(5,2),
     + " Segment ",k0," from ",+ nsegments
       write (27,*)

c      if (nflag.ne.1) then ! Don't draw zero face

       do j=1,npoints-1

       write (27,'(A3,1x,I6,A3,I6,A3,I6,A3,I6,A19,I3,A12,I2,A7,I2)') 
     + "[ ",
     + j-1+(npoints)*(k-1)," , ",
     + j+(npoints)*(k-1)," , ",
     + j+(npoints)*(k)," , ",
     + j-1+(npoints)*(k),
     + " ], // Face number ",j," in segment ",k0,
     + " panel ",(iini-1)+pp29(5,2)
    
       end do ! j

       end do ! k
 
       write(27,*) " [ 0,0,0,0 ]]; // Close faces"

       write(27,*)
       write(27,*) "// Draw extrados surfaces"
       write(27,*) "color ([1,0,0])"
       write(27,*) "polyhedron ( PolPoints_Ext, PolFaces_Ext );"

       if (pp29(5,4).eq.1) then ! mirror
       write(27,*) "color ([1,0,0])"
       write(27,*) "mirror ([1,0,0])"
       write(27,*) "polyhedron ( PolPoints_Ext, PolFaces_Ext );"
       end if



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      22.12.1 Vents surface
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Define points
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write(27,*) "PolPoints_Ven = [ "
       
       do i=pp29(5,2),pp29(5,3) ! Iterate in panels
       npoints=np(i,3)
       nlpanels=pp29(5,3)-pp29(5,2)+1 ! number of local panels

       do k=nsegments+1,1,-1 ! Iterate in segments

       write (27,*)
       write (27,*) "// Cell ",i," Line ",k,"from ",nsegments+1
       write (27,*)

       do j=np(i,2),np(i,2)+np(i,3)-1

       write (27,'(A3,1x,F12.3,A3,F12.3,A3,F12.3,A4,A9,1x,I6)') "[ ",
     + tesse3d(1,i,j,k)," , ",tesse3d(2,i,j,k)," , ",-tesse3d(3,i,j,k),
     + " ], ","// Point ",j+npoints*(nsegments+1-k)+
     + npoints*(nsegments+1)*(i-pp29(5,2))-1-np(i,2)

       end do ! j
       end do ! k
       end do ! i

c      Add one point only to close the list, not used
       write (27,'(A3,1x,F12.3,A3,F12.3,A3,F12.3,A5,A9,1x,I6)') "[ ",
     + 0.0d0," , ",0.0d0," , ",0.0d0,
     + " ]]; ","// End ",(nsegments+1)*npoints*nlpanels

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Define faces
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write(27,*)
       write(27,*) "PolFaces_Ven = [ "
       write(27,*)

       iini=1 ! control
       k0=0
       
       do k=1,(nsegments+1)*nlpanels-1

       k0=k0+1

c      Count cells
       if (k0.eq.nsegments+1) then
       iini=iini+1
       k0=0
       end if

       write (27,*)
       write (27,'(A9,1x,I2,A9,1x,I2,1x,A6,1x,I2)') 
     + "// Panel ",(iini-1)+pp29(5,2),
     + " Segment ",k0," from ",+ nsegments
       write (27,*)

c      if (nflag.ne.1) then ! Don't draw zero face

       if (rib(iini-1+pp29(5,2),14).eq.0.or.atp.eq."ss") then

       do j=1,npoints-1

       write (27,'(A3,1x,I6,A3,I6,A3,I6,A3,I6,A19,I3,A12,I2,A7,I2)') 
     + "[ ",
     + j-1+(npoints)*(k-1)," , ",
     + j+(npoints)*(k-1)," , ",
     + j+(npoints)*(k)," , ",
     + j-1+(npoints)*(k),
     + " ], // Face number ",j," in segment ",k0,
     + " panel ",(iini-1)+pp29(5,2)
    
       end do ! j

       end if

       end do ! k
 
       write(27,*) " [ 0,0,0,0 ]]; // Close faces"

       write(27,*)
       write(27,*) "// Draw extrados surfaces"
       write(27,*) "color ([0,0,1])"
       write(27,*) "polyhedron ( PolPoints_Ven, PolFaces_Ven );"

       if (pp29(5,4).eq.1) then ! mirror
       write(27,*) "color ([0,0,1])"
       write(27,*) "mirror ([1,0,0])"
       write(27,*) "polyhedron ( PolPoints_Ven, PolFaces_Ven );"
       end if


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      22.12.3 Intrados surface
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Define points
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write(27,*) "PolPoints_Int = [ "
       
       do i=pp29(5,2),pp29(5,3) ! Iterate in panels
       npoints=np(i,4)
       nlpanels=pp29(5,3)-pp29(5,2)+1 ! number of local panels

       do k=nsegments+1,1,-1 ! Iterate in segments

       write (27,*)
       write (27,*) "// Cell ",i," Line ",k,"from ",nsegments+1
       write (27,*)

       do j=np(i,2)+np(i,3)-1,np(i,1)

       write (27,'(A3,1x,F12.3,A3,F12.3,A3,F12.3,A4,A9,1x,I6)') "[ ",
     + tesse3d(1,i,j,k)," , ",tesse3d(2,i,j,k)," , ",-tesse3d(3,i,j,k),
     + " ], ","// Point ",j+npoints*(nsegments+1-k)+
     + npoints*(nsegments+1)*(i-pp29(5,2))-1-(np(i,2)+np(i,3)-1)

       end do ! j
       end do ! k
       end do ! i

c      Add one point only to close the list, not used
       write (27,'(A3,1x,F12.3,A3,F12.3,A3,F12.3,A5,A9,1x,I6)') "[ ",
     + 0.0d0," , ",0.0d0," , ",0.0d0,
     + " ]]; ","// End ",(nsegments+1)*npoints*nlpanels

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Define faces
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write(27,*)
       write(27,*) "PolFaces_Int = [ "
       write(27,*)

       iini=1 ! control
       k0=0
       
       do k=1,(nsegments+1)*nlpanels-1

       k0=k0+1

c      Count cells
       if (k0.eq.nsegments+1) then
       iini=iini+1
       k0=0
       end if

       write (27,*)
       write (27,'(A9,1x,I2,A9,1x,I2,1x,A6,1x,I2)') 
     + "// Panel ",(iini-1)+pp29(5,2),
     + " Segment ",k0," from ",+ nsegments
       write (27,*)

c      if (nflag.ne.1) then ! Don't draw zero face

       do j=1,npoints-1

       write (27,'(A3,1x,I6,A3,I6,A3,I6,A3,I6,A19,I3,A12,I2,A7,I2)') 
     + "[ ",
     + j-1+(npoints)*(k-1)," , ",
     + j+(npoints)*(k-1)," , ",
     + j+(npoints)*(k)," , ",
     + j-1+(npoints)*(k),
     + " ], // Face number ",j," in segment ",k0,
     + " panel ",(iini-1)+pp29(5,2)
    
       end do ! j

       end do ! k
 
       write(27,*) " [ 0,0,0,0 ]]; // Close faces"

       write(27,*)
       write(27,*) "// Draw extrados surfaces"
       write(27,*) "color ([0,1,0])"
       write(27,*) "polyhedron ( PolPoints_Int, PolFaces_Int );"

       if (pp29(5,4).eq.1) then ! mirror
       write(27,*) "color ([0,1,0])"
       write(27,*) "mirror ([1,0,0])"
       write(27,*) "polyhedron ( PolPoints_Int, PolFaces_Int );"
       end if

c      End case OpenSCAD
       end if ! Case SCAD


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      21.13 Draw external STL file (CFD analysis)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (pp29(5,1).eq.1) then ! Draw external STL

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      21.13.1 Extrados surfaces
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       write (28,'(A14)') "solid extrados"
       write (28,*)

       write (29,'(A14)') "solid extrados"
       write (29,*)


       do i=pp29(5,2),pp29(5,3) ! Iterate in panels

       npoints=np(i,2)

       nlpanels=pp29(5,3)-pp29(5,2)+1 ! number of local panels

       do k=1,nsegments ! Iterate in segments

       do j=1,np(i,2)-1

c      Define points
       punt1(1)=tesse3d(1,i,j,k)
       punt1(2)=tesse3d(2,i,j,k)
       punt1(3)=-tesse3d(3,i,j,k)
       punt2(1)=tesse3d(1,i,j+1,k)
       punt2(2)=tesse3d(2,i,j+1,k)
       punt2(3)=-tesse3d(3,i,j+1,k)
       punt3(1)=tesse3d(1,i,j+1,k+1)
       punt3(2)=tesse3d(2,i,j+1,k+1)
       punt3(3)=-tesse3d(3,i,j+1,k+1)
       punt4(1)=tesse3d(1,i,j,k+1)
       punt4(2)=tesse3d(2,i,j,k+1)
       punt4(3)=-tesse3d(3,i,j,k+1)

       call planeby123(punt1,punt2,punt3,aplane,bplane,
     + cplane,dplane)
       call unitaryto123(unitv,aplane,bplane,cplane)

       write (28,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (28,*) "    outer loop"
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt1(1),punt1(2),punt1(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt2(1),punt2(2),punt2(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt3(1),punt3(2),punt3(3)
       write (28,*) "    endloop"
       write (28,'(A8)') "endfacet"
       write (28,*)

       write (29,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (29,*) "    outer loop"
       write (29,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt1(1),punt1(2),punt1(3)
       write (29,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt2(1),punt2(2),punt2(3)
       write (29,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt3(1),punt3(2),punt3(3)
       write (29,*) "    endloop"
       write (29,'(A8)') "endfacet"
       write (29,*)


c      Symmetry
       if (pp29(5,4).eq.1.and.i.ne.1) then
       write (28,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (28,*) "    outer loop"
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt1(1),punt1(2),punt1(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt2(1),punt2(2),punt2(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt3(1),punt3(2),punt3(3)
       write (28,*) "    endloop"
       write (28,'(A8)') "endfacet"
       write (28,*)
       end if

c      Symmetry
       if (pp29(5,4).eq.1.and.i.ne.1) then
       write (29,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (29,*) "    outer loop"
       write (29,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt1(1),punt1(2),punt1(3)
       write (29,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt2(1),punt2(2),punt2(3)
       write (29,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt3(1),punt3(2),punt3(3)
       write (29,*) "    endloop"
       write (29,'(A8)') "endfacet"
       write (29,*)
       end if


       call planeby123(punt3,punt4,punt1,aplane,bplane,
     + cplane,dplane)
       call unitaryto123(unitv,aplane,bplane,cplane)

       write (28,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (28,*) "    outer loop"
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt3(1),punt3(2),punt3(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt4(1),punt4(2),punt4(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt1(1),punt1(2),punt1(3)
       write (28,*) "    endloop"
       write (28,*) "endfacet"
       write (28,*)


       write (29,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (29,*) "    outer loop"
       write (29,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt3(1),punt3(2),punt3(3)
       write (29,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt4(1),punt4(2),punt4(3)
       write (29,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt1(1),punt1(2),punt1(3)
       write (29,*) "    endloop"
       write (29,*) "endfacet"
       write (29,*)


c      Symmetry
       if (pp29(5,4).eq.1.and.i.ne.1) then
       write (28,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (28,*) "    outer loop"
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt3(1),punt3(2),punt3(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt4(1),punt4(2),punt4(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt1(1),punt1(2),punt1(3)
       write (28,*) "    endloop"
       write (28,*) "endfacet"
       write (28,*)
       end if

c      Symmetry
       if (pp29(5,4).eq.1.and.i.ne.1) then
       write (29,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (29,*) "    outer loop"
       write (29,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt3(1),punt3(2),punt3(3)
       write (29,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt4(1),punt4(2),punt4(3)
       write (29,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt1(1),punt1(2),punt1(3)
       write (29,*) "    endloop"
       write (29,*) "endfacet"
       write (29,*)
       end if


       end do ! j
       end do ! k
       end do ! i

       write (28,'(A17)') "endsolid extrados"
       write (28,*)

       write (29,'(A17)') "endsolid extrados"
       write (29,*)


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      21.13.2 Vents surfaces
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


       write (28,'(A14)') "solid vents   "
       write (28,*)

       write (32,'(A14)') "solid vents   "
       write (32,*)


       do i=pp29(5,2),pp29(5,3) ! Iterate in panels

       if (rib(i,14).eq.0.or.atp.eq."ss".or.rib(i,14).eq.1) then ! Vents cases

       npoints=np(i,3)

       nlpanels=pp29(5,3)-pp29(5,2)+1 ! number of local panels

       do k=1,nsegments ! Iterate in segments

       do j=np(i,2),np(i,2)+np(i,3)-2

c      Define points
       punt1(1)=tesse3d(1,i,j,k)
       punt1(2)=tesse3d(2,i,j,k)
       punt1(3)=-tesse3d(3,i,j,k)
       punt2(1)=tesse3d(1,i,j+1,k)
       punt2(2)=tesse3d(2,i,j+1,k)
       punt2(3)=-tesse3d(3,i,j+1,k)
       punt3(1)=tesse3d(1,i,j+1,k+1)
       punt3(2)=tesse3d(2,i,j+1,k+1)
       punt3(3)=-tesse3d(3,i,j+1,k+1)
       punt4(1)=tesse3d(1,i,j,k+1)
       punt4(2)=tesse3d(2,i,j,k+1)
       punt4(3)=-tesse3d(3,i,j,k+1)

       call planeby123(punt1,punt2,punt3,aplane,bplane,
     + cplane,dplane)
       call unitaryto123(unitv,aplane,bplane,cplane)

       write (28,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (28,*) "    outer loop"
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt1(1),punt1(2),punt1(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt2(1),punt2(2),punt2(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt3(1),punt3(2),punt3(3)
       write (28,*) "    endloop"
       write (28,'(A8)') "endfacet"
       write (28,*)

       write (32,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (32,*) "    outer loop"
       write (32,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt1(1),punt1(2),punt1(3)
       write (32,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt2(1),punt2(2),punt2(3)
       write (32,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt3(1),punt3(2),punt3(3)
       write (32,*) "    endloop"
       write (32,'(A8)') "endfacet"
       write (32,*)


c      Symmetry
       if (pp29(5,4).eq.1.and.i.ne.1) then
       write (28,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (28,*) "    outer loop"
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt1(1),punt1(2),punt1(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt2(1),punt2(2),punt2(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt3(1),punt3(2),punt3(3)
       write (28,*) "    endloop"
       write (28,'(A8)') "endfacet"
       write (28,*)
       end if

c      Symmetry
       if (pp29(5,4).eq.1.and.i.ne.1) then
       write (32,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (32,*) "    outer loop"
       write (32,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt1(1),punt1(2),punt1(3)
       write (32,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt2(1),punt2(2),punt2(3)
       write (32,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt3(1),punt3(2),punt3(3)
       write (32,*) "    endloop"
       write (32,'(A8)') "endfacet"
       write (32,*)
       end if


       call planeby123(punt3,punt4,punt1,aplane,bplane,
     + cplane,dplane)
       call unitaryto123(unitv,aplane,bplane,cplane)

       write (28,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (28,*) "    outer loop"
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt3(1),punt3(2),punt3(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt4(1),punt4(2),punt4(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt1(1),punt1(2),punt1(3)
       write (28,*) "    endloop"
       write (28,*) "endfacet"
       write (28,*)

       write (32,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (32,*) "    outer loop"
       write (32,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt3(1),punt3(2),punt3(3)
       write (32,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt4(1),punt4(2),punt4(3)
       write (32,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt1(1),punt1(2),punt1(3)
       write (32,*) "    endloop"
       write (32,*) "endfacet"
       write (32,*)


c      Symmetry
       if (pp29(5,4).eq.1.and.i.ne.1) then
       write (28,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (28,*) "    outer loop"
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt3(1),punt3(2),punt3(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt4(1),punt4(2),punt4(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt1(1),punt1(2),punt1(3)
       write (28,*) "    endloop"
       write (28,*) "endfacet"
       write (28,*)
       end if

c      Symmetry
       if (pp29(5,4).eq.1.and.i.ne.1) then
       write (32,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (32,*) "    outer loop"
       write (32,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt3(1),punt3(2),punt3(3)
       write (32,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt4(1),punt4(2),punt4(3)
       write (32,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt1(1),punt1(2),punt1(3)
       write (32,*) "    endloop"
       write (32,*) "endfacet"
       write (32,*)
       end if


       end do ! j
       end do ! k
       end if ! Vents case
       end do ! i

       write (28,'(A17)') "endsolid vents   "
       write (28,*)

       write (32,'(A17)') "endsolid vents   "
       write (32,*)


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      21.13.1 Intrados surfaces
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (atp.ne."ss") then ! Not single skin

       write (28,'(A14)') "solid intrados"
       write (28,*)

       write (31,'(A14)') "solid intrados"
       write (31,*)


       do i=pp29(5,2),pp29(5,3) ! Iterate in panels

       npoints=np(i,4)

       nlpanels=pp29(5,3)-pp29(5,2)+1 ! number of local panels

       do k=1,nsegments ! Iterate in segments

       do j=np(i,2)+np(i,3)-1,np(i,1)-1

c      Define points
       punt1(1)=tesse3d(1,i,j,k)
       punt1(2)=tesse3d(2,i,j,k)
       punt1(3)=-tesse3d(3,i,j,k)
       punt2(1)=tesse3d(1,i,j+1,k)
       punt2(2)=tesse3d(2,i,j+1,k)
       punt2(3)=-tesse3d(3,i,j+1,k)
       punt3(1)=tesse3d(1,i,j+1,k+1)
       punt3(2)=tesse3d(2,i,j+1,k+1)
       punt3(3)=-tesse3d(3,i,j+1,k+1)
       punt4(1)=tesse3d(1,i,j,k+1)
       punt4(2)=tesse3d(2,i,j,k+1)
       punt4(3)=-tesse3d(3,i,j,k+1)

       call planeby123(punt1,punt2,punt3,aplane,bplane,
     + cplane,dplane)
       call unitaryto123(unitv,aplane,bplane,cplane)

       write (28,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (28,*) "    outer loop"
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt1(1),punt1(2),punt1(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt2(1),punt2(2),punt2(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt3(1),punt3(2),punt3(3)
       write (28,*) "    endloop"
       write (28,'(A8)') "endfacet"
       write (28,*)

       write (31,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (31,*) "    outer loop"
       write (31,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt1(1),punt1(2),punt1(3)
       write (31,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt2(1),punt2(2),punt2(3)
       write (31,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt3(1),punt3(2),punt3(3)
       write (31,*) "    endloop"
       write (31,'(A8)') "endfacet"
       write (31,*)


c      Symmetry
       if (pp29(5,4).eq.1.and.i.ne.1) then
       write (28,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (28,*) "    outer loop"
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt1(1),punt1(2),punt1(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt2(1),punt2(2),punt2(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt3(1),punt3(2),punt3(3)
       write (28,*) "    endloop"
       write (28,'(A8)') "endfacet"
       write (28,*)
       end if


c      Symmetry
       if (pp29(5,4).eq.1.and.i.ne.1) then
       write (31,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (31,*) "    outer loop"
       write (31,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt1(1),punt1(2),punt1(3)
       write (31,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt2(1),punt2(2),punt2(3)
       write (31,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt3(1),punt3(2),punt3(3)
       write (31,*) "    endloop"
       write (31,'(A8)') "endfacet"
       write (31,*)
       end if


       call planeby123(punt3,punt4,punt1,aplane,bplane,
     + cplane,dplane)
       call unitaryto123(unitv,aplane,bplane,cplane)

       write (28,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (28,*) "    outer loop"
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt3(1),punt3(2),punt3(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt4(1),punt4(2),punt4(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt1(1),punt1(2),punt1(3)
       write (28,*) "    endloop"
       write (28,*) "endfacet"
       write (28,*)

       write (31,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (31,*) "    outer loop"
       write (31,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt3(1),punt3(2),punt3(3)
       write (31,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt4(1),punt4(2),punt4(3)
       write (31,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",punt1(1),punt1(2),punt1(3)
       write (31,*) "    endloop"
       write (31,*) "endfacet"
       write (31,*)


c      Symmetry
       if (pp29(5,4).eq.1.and.i.ne.1) then
       write (28,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (28,*) "    outer loop"
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt3(1),punt3(2),punt3(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt4(1),punt4(2),punt4(3)
       write (28,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt1(1),punt1(2),punt1(3)
       write (28,*) "    endloop"
       write (28,*) "endfacet"
       write (28,*)
       end if

c      Symmetry
       if (pp29(5,4).eq.1.and.i.ne.1) then
       write (31,'(A13,x,F12.6,x,F12.6,x,F12.6)') 
     + "facet normal ",unitv(1),unitv(2),unitv(3)
       write (31,*) "    outer loop"
       write (31,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt3(1),punt3(2),punt3(3)
       write (31,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt4(1),punt4(2),punt4(3)
       write (31,'(A15,x,F12.3,x,F12.3,x,F12.3)') 
     + "        vertex ",-punt1(1),punt1(2),punt1(3)
       write (31,*) "    endloop"
       write (31,*) "endfacet"
       write (31,*)
       end if


       end do ! j
       end do ! k
       end do ! i

       write (28,'(A17)') "endsolid intrados"
       write (28,*)

       write (31,'(A17)') "endsolid intrados"
       write (31,*)


       end if ! atp not "ss"

       end if ! case STL


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      22. TEXT NOTES
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      22.1 Text in boxes

       xtext=bname
       call txt(-630.*xkf,-100.*xkf,50.0d0,0.0d0,xtext,3)
   
       xtext=wname
       call txt(600.*xkf,-100.*xkf,50.0d0,0.0d0,xtext,1)

       xtext=lepv
       call txt(1400.*xkf,-100.*xkf,50.0d0,0.0d0,xtext,3)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (n1draw.eq.1) then
c      Row -1

       xpos=1260.*2*xkf
       ypos=-(91.+891.)*xkf
       xtext="-1-3 EXTRADOS PANELS WITH 3D-PARTS (PRINTER)"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=1260.*4*xkf
       ypos=-(91.+891.)*xkf
       xtext="-1-5 EXTRADOS PANELS WITH 3D-PARTS (LASER)"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

c      Row 0

       xpos=1260.*2*xkf
       ypos=-91.*xkf
       xtext="0-3 INTRADOS PANELS WITH 3D-PARTS (PRINTER)"
       call txt(xpos,ypos,10.0d0,0.0d0,xtext,7)

       xpos=1260.*4*xkf
       ypos=-91.*xkf
       xtext="0-5 INTRADOS PANELS WITH 3D-PARTS (LASER)"
       call txt(xpos,ypos,10.0d0,0.0d0,xtext,7)
       end if ! n1draw
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Row 1

       xpos=0.*xkf
       ypos=800.*xkf
       xtext="1-1 PLANFORM AND VAULT"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)
       xtext=bname
       call txt(xpos,ypos-300.*xkf,10.0d0,0.0d0,xtext,7)
       xtext=wname
       call txt(xpos+190.,ypos-300.*xkf,10.0d0,0.0d0,xtext,7)
       xtext="Flat area (m2) : "
       call txt(xpos,ypos-280.*xkf,10.0d0,0.0d0,xtext,7)
       write (xtext, '(F5.2)') farea
       call txt(xpos+170.,ypos-280.*xkf,10.0d0,0.0d0,xtext,7)
       xtext="Flat span (m) : "
       call txt(xpos,ypos-260.*xkf,10.0d0,0.0d0,xtext,7)
       write (xtext, '(F5.2)') fspan
       call txt(xpos+170.,ypos-260.*xkf,10.0d0,0.0d0,xtext,7)
       xtext="Flat aspect ratio : "
       call txt(xpos,ypos-240.*xkf,10.0d0,0.0d0,xtext,7)
       write (xtext, '(F5.2)') faratio
       call txt(xpos+170.,ypos-240.*xkf,10.0d0,0.0d0,xtext,7)
       xtext="Cells number : "
       call txt(xpos,ypos-220.*xkf,10.0d0,0.0d0,xtext,7)
       write (xtext, '(I3)') nribss*2-1
       if (rib(1,2).le.0.01) then
       write (xtext, '(I3)') nribss*2-2
       end if
       call txt(xpos+170.,ypos-220.*xkf,10.0d0,0.0d0,xtext,7)
       if (iflag2000.eq.1) then
       write (xtext,'(A13,x,A)') "Edition date:", a37date
       call txt(xpos,ypos-200.*xkf,10.0d0,0.0d0,xtext,7)
       end if


       xpos=xpos+1260.*xkf
       xtext="1-2 RIBS"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="1-3 EXTRADOS PANELS"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)
       xtext="Leading edge"
       call txt(xpos,ypos-810.*xkf,10.0d0,0.0d0,xtext,7)
       xtext="Trailing edge"
       call txt(xpos,ypos-160.*xkf,10.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="1-4 RIBS (FOR CUTTING TABLE)"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="1-5 EXTRADOS PANELS (FOR CUTTING TABLE)"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)
       xtext="Leading edge"
       call txt(xpos,ypos-810.*xkf,10.0d0,0.0d0,xtext,7)
       xtext="Trailing edge"
       call txt(xpos,ypos-160.*xkf,10.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="1-6 MIDDLE UNLOADED RIBS"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="1-7 NYLON RODS POCKETS, NOSE MYLARS"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

c      Print joncs in BOX(1,7)
c      ACTUALITZAR BLOCS m !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
c      Print blocs separate
c      Define jonc lenghts in each bloc
       if (k21d.ge.1) then
       xqw=0.

       do m=1,k21blocs

       y1=40.*float(m-1) ! Desplacement in Y for each bloc

       write (xtext,'(A25,I2,A1)') "List of nylon rods (bloc ",
     + m,")"

       ng21=k21blocf(m,3)
       call txt(xpos+400.*xkf,ypos+y1+(-700.+xqw)*
     + xkf,xmida1,0.0d0,xtext,7)
       do ng=1,ng21
       xqw=xqw+15.
       write (xtext,'(A5,I3)') "Group ",ng
       call txt(xpos+400*xkf,ypos+y1+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       ngo(ng,2)=ngoo(m,ng,2)
       ngo(ng,3)=ngoo(m,ng,3)
       do i=ngo(ng,2),ngo(ng,3)
       xqw=xqw+15.
       write (xtext,'(A5,I3,2x,F7.1)') "Jonc ",i,joncf(i,m,ng,2)
       call txt(xpos+400*xkf,ypos+y1+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       end do ! ngo
       end do ! ng

       end do ! m
       end if

       xpos=xpos+1260.*xkf
       xtext="1-8 MIDDLE AND MIDDLE OVALIZED AIRFOILS"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

c      Row 2

       xpos=0.*xkf
       ypos=ypos+890.95*xkf
       xtext="2-1 CALAGE ESTIMATION"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="2-2 RIBS WASHIN ANGLE"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="2-3 INTRADOS PANELS"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)
       xtext="Trailing edge"
       call txt(xpos,ypos-810.*xkf,10.0d0,0.0d0,xtext,7)
       xtext="Leading edge"
       call txt(xpos,ypos-160.*xkf,10.0d0,0.0d0,xtext,7)


       xpos=xpos+1260.*xkf
       xtext="2-4 MINI-RIBS"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="2-5 INTRADOS PANELS (FOR CUTTING TABLE)"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)
       xtext="Trailing edge"
       call txt(xpos,ypos-810.*xkf,10.0d0,0.0d0,xtext,7)
       xtext="Leading edge"
       call txt(xpos,ypos-160.*xkf,10.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="2-6 FULL DIAGONAL RIBS"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="2-7"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="2-8"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

c      Row 3

       xpos=0.*xkf
       ypos=ypos+890.95*xkf
       xtext="3-1 UPPER VIEW"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="3-2 LINES A"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Write lines in plan A,B,C,D,E,F
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      write lines in plan A
       if (slp.ge.1) then
       xqw=0.
       xtext="Line - Label - Length"
       call txt(xpos-500.*xkf,ypos+(-718.+xqw)*
     + xkf,typm3(9),0.0d0,xtext,7)
       do i=1,slpi(2)-1
       xqw=xqw+18.
       write (xtext,'(I3,3x,A4,3x,F5.1)') i,ln4(i),xlifi(i)
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,typm3(9),0.0d0,xtext,7)
       end do
       end if

       xpos=xpos+1260.*xkf
       xtext="3-3 LINES B"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

c      write lines in plan B
       if (slp.ge.2) then
       if (slp.eq.2) slpi(3)=cordam+1
       xqw=0.
       xtext="Line - Label - Length"
       call txt(xpos-500.*xkf,ypos+(-718.+xqw)*
     + xkf,typm3(9),0.0d0,xtext,7)
       do i=slpi(2),slpi(3)-1
       xqw=xqw+18.
       write (xtext,'(I3,3x,A4,3x,F5.1)') i,ln4(i),xlifi(i)
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,typm3(9),0.0d0,xtext,7)
       end do
       end if

       xpos=xpos+1260.*xkf
       xtext="3-4 LINES C"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

c      write lines in plan C
       if (slp.ge.3) then
       if (slp.eq.3) slpi(4)=cordam+1
       xqw=0.
       xtext="Line - Label - Length"
       call txt(xpos-500.*xkf,ypos+(-718.+xqw)*
     + xkf,typm3(9),0.0d0,xtext,7)
       do i=slpi(3),slpi(4)-1
       xqw=xqw+18.
       write (xtext,'(I3,3x,A4,3x,F5.1)') i,ln4(i),xlifi(i)
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,typm3(9),0.0d0,xtext,7)
       end do
       end if

       xpos=xpos+1260.*xkf
       xtext="3-5 LINES D"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

c      write lines in plan D
       if (slp.ge.4) then
       if (slp.eq.4) slpi(5)=cordam+1
       xqw=0.
       xtext="Line - Label - Length"
       call txt(xpos-500.*xkf,ypos+(-718.+xqw)*
     + xkf,typm3(9),0.0d0,xtext,7)
       do i=slpi(4),slpi(5)-1
       xqw=xqw+18.
       write (xtext,'(I3,3x,A4,3x,F5.1)') i,ln4(i),xlifi(i)
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,typm3(9),0.0d0,xtext,7)
       end do
       end if

c      Box for V-rib Type-6

       xpos=xpos+1260.*xkf
       xtext="3-6 V-rib Type-6"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

c      Box(3,7)

       xpos=xpos+1260.*xkf
       xtext="3-7"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="3-8"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

c      Row 4

       xpos=0.*xkf
       ypos=ypos+890.95*xkf
       xtext="4-1 VAULT VIEW"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="4-2 LATERAL VIEW"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="4-3 BRAKE DISTRIBUTION"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="4-4"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="4-5 BRAKES"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

c      write lines in brakes
       xqw=0.
       xtext="Line - Label - Length"
       call txt(xpos-500.*xkf,ypos+(-718.+xqw)*
     + xkf,typm3(9),0.0d0,xtext,7)
       do i=cordam+1,cordat
       xqw=xqw+18.
       write (xtext,'(I3,3x,A4,3x,F5.1)') i,ln4(i),xlifi(i)
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,typm3(9),0.0d0,xtext,7)
       end do

       xpos=xpos+1260.*xkf
       xtext="4-6"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

       xpos=xpos+1260.*xkf
       xtext="4-7 GENERAL NOTES"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

c      Print general notes BOX(4,7)

c      Notes about plans, first column

       xqw=0.
       xtext="1-1: 111111111111111111111111111111111111111111111"  

       xtext="PLANS GENERAL NOTES"
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida1,0.0d0,xtext,7)
       xqw=xqw+30.

       xtext="1-1: Planform and vault view (informative)"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="1-2: Ribs for plotter, one side"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="1-3: Extrados panels for plotter, one side"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="1-4: Ribs for laser cutting, one side. Units cm"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="1-5: Extrados for laser cutting, one side.Units cm"  
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="1-6: Middle unloaded ribs for laser cutting, "
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="     one side Units cm"  
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="1-7: Rods pockets and nylons lengths, mylars"  
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="1-8: Intermediate and ovalized airfoils"  
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)

       xqw=xqw+30.
       xtext="2-1: Calage estimation, speed and trim systems"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="2-2: Ribs printed with washin angle (informative)"
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="2-3: Intrados panels for plotter, one side"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="2-4: Mini-ribs horizontal and diagonal"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="2-5: Intrados for laser cutting, one side"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="2-6: Full diagonal ribs laser, one side"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="2-7: Free"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)

       xqw=xqw+30.
       xtext="3-1: Upper view 3D (informative)"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="3-2: Lines A"
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="3-3: Lines B"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="3-4: Lines C"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="3-5: Lines D"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="3-6: V-rib type-6"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="3-7: Free"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)

       xqw=xqw+30.
       xtext="4-1: Vault view (informative)"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="4-2: Lateral view (informative)"
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="4-3: Brake distribution (informative)"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="4-4: Free"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="4-5: Brake lines"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="4-6: Free"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext="4-7: General notes"       
       call txt(xpos-500.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)

c      Notes, second column

       xqw=0.
       xtext="1-1: 111111111111111111111111111111111111111111111"    

       xtext="UNITS"
       call txt(xpos-100.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida1,0.0d0,xtext,7)
       xqw=xqw+30.

       xtext="Main units are centimeters. Scale x10 to use in mm"
       call txt(xpos-100.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+30.

       xtext="WIDTHS FOR SEWING AND OFFSETS "
       call txt(xpos-100.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida1,0.0d0,xtext,7)
       xqw=xqw+30.

       write (xtext,'(A32,F6.2)') "Lateral width in extrados (mm): ",
     + xupp
       call txt(xpos-100.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       write (xtext,'(A31,F6.2)') "Width in leading edge ex (mm): ",
     + xupple
       call txt(xpos-100.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       write (xtext,'(A32,F6.2)') "Width in trailing edge ex (mm): ",
     + xuppte
       call txt(xpos-100.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       write (xtext,'(A32,F6.2)') "Lateral width in intrados (mm): ",
     + xlow
       call txt(xpos-100.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       write (xtext,'(A31,F6.2)') "Width in leading edge in (mm): ",
     + xlowle
       call txt(xpos-100.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       write (xtext,'(A32,F6.2)') "Width in trailing edge in (mm): ",
     + xlowte
       call txt(xpos-100.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       write (xtext,'(A28,F6.2)') "Lateral width in ribs (mm): ",
     + xrib
       call txt(xpos-100.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       write (xtext,'(A30,F6.2)') "Lateral width in V-ribs (mm): ",
     + xvrib*10.
       call txt(xpos-100.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.
       
       write(xtext,'(A35,F6.2)') "General offset lateral points (mm): ",
     + typm6(1)
       call txt(xpos-100.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+30.

       write(xtext,'(A28,A14,F6.2)') "Distance between equidistant",
     + " points (cm): ",xmark
       call txt(xpos-100.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       xqw=xqw+15.


c      Notes, third column

       xqw=0.
       xtext="1-1: 111111111111111111111111111111111111111111111"    

       xtext='"ROMAN" NUMBERS CODIFICATION'
       call txt(xpos+300.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida1,0.0d0,xtext,7)
       xqw=xqw+15.
       xtext='Numbering panels, ribs, mini-ribs, V-ribs'
       call txt(xpos+300.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida1,0.0d0,xtext,7)
       xqw=xqw+30.

       do i=1,nribss
       write (xtext,'(A7,I3,A3)') "Number ",i," = "
       call txt(xpos+300.*xkf,ypos+(-700.+xqw)*
     + xkf,xmida2,0.0d0,xtext,7)
       call romano(i,xpos+400.*xkf,ypos+(-700.+xqw)*xkf,0.0d0,3.0d0,7)
       xqw=xqw+15.
       end do

       xpos=xpos+1260.*xkf
       xtext="4-8"
       call txt(xpos,ypos,12.0d0,0.0d0,xtext,7)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      23. END OF MAIN PROGRAM
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc   

       call dxfend(20)

       write (*,*)

       if (atp.eq."pc") then
       write (*,'(A,1x,F6.2,A,F7.1,A)') " Total line length = ",
     + xlength2," m ",(xlength2)/0.3048," ft"
       write (*,*)
       else
       write (*,'(A,1x,F6.2,A)') " Total line length = ",
     + xlength2," m"
       write (*,*)
       end if

       if (atp.eq."ds".or.atp.eq."ss") then
       write (*,*) "OK, paraglider calculated!"
       end if
       if (atp.eq."pc") then
       write (*,*) "OK, parachute calculated!"
       end if
       write (*,*)
       write (*,*) "Please open the following files:" 
       write (*,*)
       write (*,*) "   leparagliding.dxf"
       write (*,*) "   lep-3d.dxf"
       if (pp29(4,1).eq.1) then ! External DXF
       write (*,*) "   lep-3d-surfaces.dxf"
       end if
       write (*,*) "   lep-out.txt"
       write (*,*) "   lines.txt"
       if (pp29(5,1).eq.1) then ! External STL SCAD
       write (*,*) "   ../stl/lep-3d-surfaces.stl"
       write (*,*) "   ../stl/lep-3d-surfaces.scad"
       end if
       if (k36d.eq.1) then ! External XFLR5 files
       write (*,*) "   ../xflr5/ *.xwimp"
       write (*,*) "   ../xflr5/ *.dat"
       end if

       write (*,*)


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc       
c      Verificació de subrutines
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       punt1(1)=0.0
       punt1(2)=0.0
       punt1(3)=0.0
       punt2(1)=1.0
       punt2(2)=0.0
       punt2(3)=0.0
       punt3(1)=0.0
       punt3(2)=2.0
       punt3(3)=0.0

c       call planeby123(punt1,punt2,punt3,aplane,bplane,cplane,
c     + dplane)

c       write (*,*) "A B C D"
c       write (*,*) aplane,bplane,cplane,dplane

       dp0=-20.0
       punt0(1)=1.0
       punt0(2)=2.0
       punt0(3)=1.0

c       call pointp(punt0,aplane,bplane,cplane,dp0,punt4)

c       write (*,*) punt4(1),punt4(2),punt4(3)






cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Perform second RUN !
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (irun.eq.1) then
       write (*,*) "Attention! Doing second RUN...!"
       irun=0
       goto 1
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Call noNaN subroutine
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 

c       write (*,*) "Cleaning dxf (noNaN)..."
c       call test_read("leparagliding.dxf")
c       call fix_dxf_nan("leparagliding.dxf")


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      END MAIN PROGRAM
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 

       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      24. GRAPHICAL SUBROUTINES
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE pointg (radius xcir)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE pointg(xu,xv,xcir,pointcolor)

       integer pointcolor

       real*8 pi,angle1,angle2,xu,xv,xcir

       integer typm1(50),typm4(50)
       real*8 typm2(50),typm3(50),typm5(50),typm6(50)
       common /markstypes/ typm1,typm2,typm3,typm4,typm5,typm6

       pi=4.0d0*datan(1.0d0)
       xcir=0.1*typm2(1)

c      Case 1: Draw constructed points
       if (typm1(1).eq.1) then
       xv=-xv
c      Draw cross
       call line(xu-xcir,-(xv),xu+xcir,-(xv),pointcolor)
       call line(xu,-(xv-xcir),xu,-(xv+xcir),pointcolor)

c      Draw circle
       do l=1,8

       angle1=float(l-1)*2.*pi/8.
       xlu1=xcir*dcos(angle1)
       xlv1=xcir*dsin(angle1)
       angle2=float(l)*2.*pi/8.
       xlu2=xcir*dcos(angle2)
       xlv2=xcir*dsin(angle2)

       call line(xu+xlu1,-(xv+xlv1),xu+xlu2,-(xv+xlv2),pointcolor)

       end do
       end if

c      Case 2: Draw minicircles
       if (typm1(1).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,xu,20,-xv
       write(20,'(I2,/,F12.3,/,I2,/,I3,/,I2)') 40,0.1*typm2(1),62,
     + pointcolor,0
       end if

       return

       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE POINT 2D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       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
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE POINTLAYER 2D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE poinc(x1,y1,xrad,gname,pointcolor)
c      Point as minicicle radius xrad in layer gname

       character*50 gname
       real*8 x1,y1,xrad
       integer pointcolor

c      Point defined as circle radius xrad (0.2 mm)
       write(20,'(A,/,I1,/,A)') "CIRCLE",8,gname
       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,xrad,62,pointcolor,0

       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE POINTLAYER 2D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE poinl(x1,y1,gname,pointcolor)
c      Euclidean point in layer gname

       character*50 gname
       real*8 x1,y1
       integer pointcolor

       write(20,'(A,/,I1,/,A)') "POINT",8,gname
       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

       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE CIRCLE
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE circle(x1,y1,radc,gname,pointcolor)
c      Circle radius radc in layer gname

       character*50 gname
       real*8 x1,y1,radc
       integer pointcolor

       write(20,'(A,/,I1,/,A)') "CIRCLE",8,gname
       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,radc,62,pointcolor,0

       return
       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE MTRIANGLE
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE mtriangle(p1x,p1y,xh,xrot,linecolor)
c      line P1-P2

       real*8 p1x,p1y

       real*8 xh,xrot,pi

       pi=4.0d0*datan(1.0d0)

c       write (*,*) i,xrot

       x1=p1x
       y1=p1y
       xx2=xh*dtan((pi/6.))
       yy2=xh
       xx3=-xh*dtan((pi/6.))
       yy3=xh

c      Rotation matrix in xrot
       x2=p1x+xx2*dcos(xrot)+yy2*sin(xrot)
       y2=p1y-xx2*dsin(xrot)+yy2*cos(xrot)
       x3=p1x+xx3*dcos(xrot)+yy3*sin(xrot)
       y3=p1y-xx3*dsin(xrot)+yy3*cos(xrot)

       write(20,'(A,/,I1,/,A)') "LINE",8,"triangles"
       write(20,'(I1,/,A)') 6,"CONTINUOUS"
       write(20,'(I2,/,F14.4,/,I2,/,F14.4)') 10,x1,20,-y1
       write(20,'(I2,/,F14.4,/,I2,/,F14.4)') 11,x2,21,-y2
       write(20,'(I2,/,I2,/,I2,/,I2,/,I2)') 39,0,62,linecolor,0

       write(20,'(A,/,I1,/,A)') "LINE",8,"triangles"
       write(20,'(I1,/,A)') 6,"CONTINUOUS"
       write(20,'(I2,/,F14.4,/,I2,/,F14.4)') 10,x2,20,-y2
       write(20,'(I2,/,F14.4,/,I2,/,F14.4)') 11,x3,21,-y3
       write(20,'(I2,/,I2,/,I2,/,I2,/,I2)') 39,0,62,linecolor,0
       
       write(20,'(A,/,I1,/,A)') "LINE",8,"triangles"
       write(20,'(I1,/,A)') 6,"CONTINUOUS"
       write(20,'(I2,/,F14.4,/,I2,/,F14.4)') 10,x3,20,-y3
       write(20,'(I2,/,F14.4,/,I2,/,F14.4)') 11,x1,21,-y1
       write(20,'(I2,/,I2,/,I2,/,I2,/,I2)') 39,0,62,linecolor,0

       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE LINEVENT
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE linevent(p1x,p1y,p2x,p2y,linecolor)
c      line P1-P2

       real*8 p1x,p1y,p2x,p2y

       write(20,'(A,/,I1,/,A)') "LINE",8,"vents"
       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,/,I2,/,I2)') 39,0,62,linecolor,0
       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE SEGMENT101
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE segment101(p1x,p1y,p2x,p2y,linecolor)
c      line P1-P2

       real*8 p1x,p1y,p2x,p2y

       x3=p1x+(p2x-p1x)/3.
       y3=p1y+(p2y-p1y)/3.
       x4=p1x+(p2x-p1x)*(2./3.)
       y4=p1y+(p2y-p1y)*(2./3.)

       write(20,'(A,/,I1,/,A)') "LINE",8,"segment101"
       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,x3,21,-y3
       write(20,'(I2,/,I2,/,I2,/,I2,/,I2)') 39,0,62,linecolor,0

       write(20,'(A,/,I1,/,A)') "LINE",8,"segment101"
       write(20,'(I1,/,A)') 6,"CONTINUOUS"
       write(20,'(I2,/,F14.4,/,I2,/,F14.4)') 10,x4,20,-y4
       write(20,'(I2,/,F14.4,/,I2,/,F14.4)') 11,p2x,21,-p2y
       write(20,'(I2,/,I2,/,I2,/,I2,/,I2)') 39,0,62,linecolor,0

       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE LINE 2D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       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

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc        
c     SUBROUTINE LINE 3D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE line3d(p1x,p1y,p1z,p2x,p2y,p2z,linecolor)
c      line P1-P2

       real*8 p1x,p1y,p1z,p2x,p2y,p2z

       write(25,'(A,/,I1,/,A)') "LINE",8,"default"
c       write(25,'(I3,/,A)') 100,"AcDbLine"
       write(25,'(I1,/,A)') 6,"CONTINUOUS"
       write(25,'(I2,/,F8.3,/,I2,/,F8.3,/,I2,/,F8.3)') 
     + 10,p1x,20,p1y,30,p1z
       write(25,'(I2,/,F8.3,/,I2,/,F8.3,/,I2,/,F8.3)') 
     + 11,p2x,21,p2y,31,p2z
       write(25,'(I2,/,I2,/,I2,/,I3,/,I2)') 39,0,62,linecolor,0
       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc        
c     SUBROUTINE LINE 3D IN FILE NUMBER 26
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE line3dn(p1x,p1y,p1z,p2x,p2y,p2z,linecolor)
c      line P1-P2

       real*8 p1x,p1y,p1z,p2x,p2y,p2z

       write(26,'(A,/,I1,/,A)') "LINE",8,"default"
c       write(25,'(I3,/,A)') 100,"AcDbLine"
       write(26,'(I1,/,A)') 6,"CONTINUOUS"
       write(26,'(I2,/,F8.3,/,I2,/,F8.3,/,I2,/,F8.3)') 
     + 10,p1x,20,p1y,30,p1z
       write(26,'(I2,/,F8.3,/,I2,/,F8.3,/,I2,/,F8.3)') 
     + 11,p2x,21,p2y,31,p2z
       write(26,'(I2,/,I2,/,I2,/,I3,/,I2)') 39,0,62,linecolor,0
       return
       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      POLYLINE 2D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE poly2d(plx,ply,nvertex,linecolor)

       real*8 plx(500),ply(500)

       write (20,'(A,/,I1,/,I1,/,I2)') "POLYLINE",8,0,62
       write (20,'(I3,/,I2,/,I1)') linecolor,66,1
       write (20,'(I2,/,F3.1,/,I2,/,F3.1,/,I2,/,F3.1,/,I1)') 
     + 10,0.0,20,0.0,30,0.0,0
       
       do k=1,nvertex

       write (20,'(A,/,I1,/,I1,/,I2)') "VERTEX",8,0,62
       write (20,'(I3,/,I2,/,I1)') linecolor,66,1 
       write (20,'(I2,/,F9.3,/,I2,/,F9.3,/,I2,/,F9.3,/,I1)') 
     + 10,plx(k),20,ply(k),30,0.0,0

       end do
       
       write (20,'(A,/,I1,/,I1,/,I2)') "SEQEND",8,0,62
       write (20,'(I3,/,I1)') linecolor,0 

c       write (*,'(A,/,I1,/,I1,/,I2)') "POLYLINE",8,0,62
c       write (*,'(I3,/,I2,/,I1)') linecolor,66,1
c       write (*,'(I2,/,F3.1,/,I2,/,F3.1,/,I2,/,F3.1,/,I1)') 
c     + 10,0.0,20,0.0,30,0.0,0
       
c       do k=1,nvertex

c       write (*,'(A,/,I1,/,I1,/,I2)') "VERTEX",8,0,62
c       write (*,'(I3,/,I2,/,I1)') linecolor,66,1 
c       write (*,'(I2,/,F9.3,/,I2,/,F9.3,/,I2,/,F9.3,/,I1)') 
c     + 10,plx(k),20,ply(k),30,0.0,0

c       end do

c       write (*,'(A,/,I1,/,I1,/,I2)') "SEQEND",8,0,62
c       write (*,'(I3,/,I1)') linecolor,0 

       return

       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      ELLIPSE
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE ellipse(u0,v0,a,b,tet0,linecolor)

       real*8 xe(500),ye(500)

       real*8 pi,u0,v0,a,b,tet,tet0

       real*8 p1x,p1y,p2x,p2y

       pi=4.0d0*datan(1.0d0)

       do ll=1,40

       tet=2.*pi*((float(ll)-1.)/39.)

c      write (*,*) ll,float(ll),tet," ",pi,"---"

       xe(ll)=u0+a*dcos(tet)*dcos(tet0)-b*dsin(tet)*dsin(tet0)
       ye(ll)=v0+a*dcos(tet)*dsin(tet0)+b*dsin(tet)*dcos(tet0)

       end do

       do ll=1,39

       p1x=xe(ll)
       p2x=xe(ll+1)
       p1y=ye(ll)
       p2y=ye(ll+1)

       call line(p1x,p1y,p2x,p2y,linecolor)

c       write (*,*) ll,tet*180./pi,xe(ll),ye(ll)

       end do

       return

       end

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE ROMANO
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE romano(rn,rx0,ry0,ralp,requi,rcolor)

       integer rn, rn1, rn2, rn3, rcolor
       real*8 rx0, ry0, ralp, requi, dx
        
c      AQUI ES EL PROBLEMA!!!!!!!!!!!!!!!!!!!!!!!!!!!
c      Points separation in romano

c      requi=0.350d0

       dx=0.0d0

       rn1=int(float(rn)/10)
       rn2=int((float(rn)-10*float(rn1))/5)
       rn3=rn-10*rn1-5*rn2

c      write (*,*) "rn1= ", rn, rn1, rn2, rn3

       do i=1,rn1

       call point(rx0+dx*dcos(ralp),ry0-dx*dsin(ralp),rcolor)
       call point(rx0+dx*dcos(ralp)+requi*dsin(ralp),
     + ry0-dx*dsin(ralp)+requi*dcos(ralp),rcolor)
       dx=dx+requi
       call point(rx0+dx*dcos(ralp),ry0-dx*dsin(ralp),rcolor)
       call point(rx0+dx*dcos(ralp)+requi*dsin(ralp),
     + ry0-dx*dsin(ralp)+requi*dcos(ralp),rcolor)
       dx=dx+requi

       end do

       do i=1,rn2

       call point(rx0+dx*dcos(ralp),ry0-dx*dsin(ralp),rcolor)
       call point(rx0+(dx+0.5d0*requi)*dcos(ralp)+requi*dsin(ralp),
     + ry0-(dx+0.5d0*requi)*dsin(ralp)+requi*dcos(ralp),rcolor)
       dx=dx+requi
       call point(rx0+dx*dcos(ralp),ry0-dx*dsin(ralp),rcolor)
       dx=dx+requi

       end do

       do i=1,rn3

       call point(rx0+dx*dcos(ralp),ry0-dx*dsin(ralp),rcolor)
       dx=dx+requi

       end do

       return

       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE TEXT
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       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

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE ITEXT
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       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

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE ITEXT2
c      Only format two digits
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE itxt2(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,/,I2)') 1, itext
       write(20,'(I2,/,F12.2,/I1)') 50, atext,0

       return
       end

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      DXF init
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
       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

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      DXF end
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE dxfend(nunit)

       write(nunit,'(A,/,I1,/,A)') "ENDSEC",0,"EOF"
       return
       end

 
cccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE vectors redistribution             c
c                                                    c
c      Read polyline (xlin1,ylin1) in n1vr points    c
c      and redistribute in polyline                  c
c      (xlin3,ylin3) in n2vr points                  c
cccccccccccccccccccccccccccccccccccccccccccccccccccccc

       subroutine vredis(xlin1,ylin1,xlin3,ylin3,n1vr,n2vr)  

       real*8 xlin1(5000),ylin1(5000)
       real*8 xlin2(50000),ylin2(50000)
       real*8 xlin3(5000),ylin3(5000)
   

c      Case n1vr > 3

c      j2vr counter in x10 multiplied vector
       j2vr=0

c      Define local vector
       do j1vr=1,n1vr-1

       xj=xlin1(j1vr)
       yj=ylin1(j1vr)
       xjm1=xlin1(j1vr+1)
       yjm1=ylin1(j1vr+1)

       do kvr=0,10
       stvr=float(kvr)/10.
       j2vr=j2vr+1
c      Parametric equation in each segment
       xlin2(j2vr)=xj+stvr*(xjm1-xj)
       ylin2(j2vr)=yj+stvr*(yjm1-yj)
       end do
       j2vr=j2vr-1

       end do

       j2max=j2vr+1
      
       icount=int(float((10*n1vr-1)/(n2vr-1)))
       iespai=icount*(n2vr-1)
       isobra=10*(n1vr-1)-iespai

       itotes=10*(n1vr-1)

c      Assign vector 3

c      j3 counter in final vector
       j3vr=1
       j2vr=1
       do j22vr=1,j2max

       xlin3(j3vr)=xlin2(j2vr)
       ylin3(j3vr)=ylin2(j2vr)

c      Ajust exactly the final point
       if (j3vr.eq.n2vr) then
       xlin3(j3vr)=xlin1(n1vr)
       ylin3(j3vr)=ylin1(n1vr)
       end if

c      Assign excess of spaces
       iplus=0
       if (j3vr.le.isobra) then
       iplus=1
       end if

c      Count
       do ijkvr=1,icount+iplus
       j2vr=j2vr+1
       end do
      
       j3vr=j3vr+1

       end do

c      Special case n1vr=2
       if (n1vr.eq.2) then 
             
       disx=(xlin1(2)-xlin1(1))/float(n2vr-1)
       disy=(ylin1(2)-ylin1(1))/float(n2vr-1)

       do j=1,n2vr
       xlin3(j)=xlin1(1)+disx*float(j-1)
       ylin3(j)=ylin1(1)+disy*float(j-1)
       end do

       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)

      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

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     SUBROUTINE  flattening
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE flatt(ni,npunts,rx,ry,rz,
     + pl1x,pl1y,pl2x,pl2y,pr1x,pr1y,pr2x,pr2y)

       real*8 rx(0:100,500),ry(0:100,500),rz(0:100,500)

       real*8 pl1x(0:100,500),pl1y(0:100,500),pl2x(0:100,500),
     + pl2y(0:100,500)
       real*8 pr1x(0:100,500),pr1y(0:100,500),pr2x(0:100,500),
     + pr2y(0:100,500)

       real*8 phr,pa1r,pa2r,phl,pa1l,pa2l,px0,py0,ptheta,pw1
       real*8 pa,pb,pc,pd,pe,pf

       i=ni

       px0=0.0d0
       py0=0.0d0
       ptheta=0.0d0

       do j=1,npunts

c       write (*,*) "rx ry rx ", j, rx(i,j),ry(i,j),rz(i,j)

c      Distances between points
       pa=dsqrt((rx(i+1,j)-rx(i,j))**2.0d0+(ry(i+1,j)-ry(i,j))**2.0d0+
     + (rz(i+1,j)-rz(i,j))**2.0d0)
       pb=dsqrt((rx(i+1,j+1)-rx(i,j))**2.0d0+(ry(i+1,j+1)-ry(i,j))**
     + 2.0d0+(rz(i+1,j+1)-rz(i,j))**2.0d0)
       pc=dsqrt((rx(i+1,j+1)-rx(i+1,j))**2.0d0+(ry(i+1,j+1)-ry(i+1,j))
     + **2.+(rz(i+1,j+1)-rz(i+1,j))**2.0d0)
       pd=dsqrt((rx(i+1,j)-rx(i,j+1))**2.0d0+(ry(i+1,j)-ry(i,j+1))**
     + 2.0d0+(rz(i+1,j)-rz(i,j+1))**2.0d0)
       pe=dsqrt((rx(i,j+1)-rx(i,j))**2.0d0+(ry(i,j+1)-ry(i,j))**2.0d0+
     + (rz(i,j+1)-rz(i,j))**2.0d0)
       pf=dsqrt((rx(i+1,j+1)-rx(i,j+1))**2.0d0+(ry(i+1,j+1)-ry(i,j+1))
     + **2.0d0+(rz(i+1,j+1)-rz(i,j+1))**2.0d0)
       
       pa2r=(pa*pa-pb*pb+pc*pc)/(2.0d0*pa)
       pa1r=pa-pa2r
       phr=dsqrt(pc*pc-pa2r*pa2r)

       pa2l=(pa*pa-pe*pe+pd*pd)/(2.0d0*pa)
       pa1l=pa-pa2l
       phl=dsqrt(pd*pd-pa2l*pa2l)

       pb2t=(pb*pb-pe*pe+pf*pf)/(2.0d0*pb)
       pb1t=pb-pb2t
       pht=dsqrt(pf*pf-pb2t*pb2t)
       
       pw1=datan(phr/pa1r)
       phu=pb1t*dtan(pw1)

c      Quadrilater coordinates
       pl1x(i,j)=px0
       pl1y(i,j)=py0

       pr1x(i,j)=pa*dcos(ptheta)+px0
       pr1y(i,j)=pa*dsin(ptheta)+py0

       pl2x(i,j)=pa1l*dcos(ptheta)-phl*dsin(ptheta)+px0
       pl2y(i,j)=pa1l*dsin(ptheta)+phl*dcos(ptheta)+py0
       
       pr2x(i,j)=pa1r*dcos(ptheta)-phr*dsin(ptheta)+px0
       pr2y(i,j)=pa1r*dsin(ptheta)+phr*dcos(ptheta)+py0

c      Iteration
       px0=pl2x(i,j)
       py0=pl2y(i,j)
       ptheta=datan((pr2y(i,j)-pl2y(i,j))/(pr2x(i,j)-pl2x(i,j)))
       
       end do

       return

       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     SUBROUTINE  axisch
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE axisch(npunts,angle,px9i,py9i,px9o,py9o)

       real*8 px9i(500),py9i(500)
       real*8 px9o(500),py9o(500)

       real*8 angle,xc,xs,pi

       pi=4.0d0*datan(1.0d0)
       angle=0.0d0

       do j=1,npunts

       xc=dcos(angle*pi/180.0d0)
       xs=dsin(angle*pi/180.0d0)

       px9o(j)=xc*px9i(j)-xs*py9i(j)
       py9o(j)=xs*px9i(j)+xc*py9i(j)

       end do

       return

       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE angdis1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE angdis2
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      ES FA SERVIR??????????????
c      REVISAR el double precision:
c
c      gfortran-8 -g -fbacktrace -fdefault-real-8 
c      -falign-commons -fno-automatic -finit-local-zero 
c      -mcmodel=medium leparagliding.f 
c 

       SUBROUTINE angdis2(p1u,p1v,p2u,p2v,p3u,p3v,angl,dist)

       real*8 du,dv,angl

       real*8 p1u,p1v,p2u,p2v,p3u,p3v,dist

       du=p2u-p1u
       dv=p2v-p1v

c       write (*,*) "sub ",p1u,p1v,p2u,p2v
      
       if (du.ne.0.) then 
c       angl=dabs(datan(dv/du))
       end if
ccccccccccccccccc       if (du.eq.0.) then angl=2.0d0*datan(1.0d0)
c       write (*,*) "sub dv du",dv,du,angl

c      Case 1
       if (du.ge.0.and.dv.ge.0) then
c       p3u=p1u-dist*dsin(angl)
c       p3v=p1v+dist*dcos(angl)
       end if

c      Case 2
       if (du.lt.0.and.dv.ge.0) then
c       p3u=p1u-dist*dsin(angl)
c       p3v=p1v-dist*dcos(angl)
       end if

c      Case 3
       if (du.ge.0.and.dv.le.0) then
c       p3u=p1u+dist*dsin(angl)
c       p3v=p1v+dist*dcos(angl)
       end if

c      Case 4
       if (du.lt.0.and.dv.le.0) then
c       p3u=p1u+dist*dsin(angl)
c       p3v=p1v-dist*dcos(angl)
       end if

c       write(*,*) "4444 ",angl,p3u,p3v

      
       return

       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE angdis3
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE d3p
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE EXTERNAL POINTS IN A PANEL
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Computes external points 11-24-14 and 12-25-15
c      in a panel from 1 to npo
c      but draws nothing
c
c      WARNING IN REDEFINITION VARIABLES u, v !!!
c      ISOLATE THEM!

       SUBROUTINE extpoints(i,uf,vf,npo,xpal,xpale,xpate,icase)

       real*8 uf(0:100,500,50),vf(0:100,500,50)
       real*8 xupp,xupple,xpale,xpate,xpal,xuppte,alple,alpte
       real*8 xru(2),xrv(2),xsu(2),xsv(2)
c       integer icase

       xupple=xpale
       xuppte=xpate
       xupp=xpal
c      WARNING!!! xupp NOT USED

c       icase=1 ! Tangent
c       icase=2 ! Orthogonal

c       icase=1

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case tangent
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Points LE 14,15,24,25

       if (icase.eq.1) then

       alple=-(datan((vf(i,npo,10)-vf(i,npo,9))/
     + (uf(i,npo,10)-uf(i,npo,9))))

       uf(i,npo,14)=uf(i,npo,9)+xupple*0.1*dsin(alple)
       vf(i,npo,14)=vf(i,npo,9)+xupple*0.1*dcos(alple)

       uf(i,npo,15)=uf(i,npo,10)+xupple*0.1*dsin(alple)
       vf(i,npo,15)=vf(i,npo,10)+xupple*0.1*dcos(alple)

c      recta r (14-15)

       xru(1)=uf(i,npo,14)
       xrv(1)=vf(i,npo,14)
       xru(2)=uf(i,npo,15)
       xrv(2)=vf(i,npo,15)

c      recta s left (11)

       xsu(1)=uf(i,npo-1,11)
       xsv(1)=vf(i,npo-1,11)
       xsu(2)=uf(i,npo,11)
       xsv(2)=vf(i,npo,11)

c      Intersection 24
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       uf(i,npo,24)=xtu
       vf(i,npo,24)=xtv

c      recta s right (11)

       xsu(1)=uf(i,npo-1,12)
       xsv(1)=vf(i,npo-1,12)
       xsu(2)=uf(i,npo,12)
       xsv(2)=vf(i,npo,12)

c      Intersection 24
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       uf(i,npo,25)=xtu
       vf(i,npo,25)=xtv

c      Points TE 14,15,24,25

       alpte=-(datan((vf(i,1,10)-vf(i,1,9))/
     + (uf(i,1,10)-uf(i,1,9))))

       uf(i,1,14)=uf(i,1,9)-xuppte*0.1*dsin(alpte)
       vf(i,1,14)=vf(i,1,9)-xuppte*0.1*dcos(alpte)

       uf(i,1,15)=uf(i,1,10)-xuppte*0.1*dsin(alpte)
       vf(i,1,15)=vf(i,1,10)-xuppte*0.1*dcos(alpte)

c      recta r (14-15)

       xru(1)=uf(i,1,14)
       xrv(1)=vf(i,1,14)
       xru(2)=uf(i,1,15)
       xrv(2)=vf(i,1,15)

c      recta s left (11)

       xsu(1)=uf(i,1,11)
       xsv(1)=vf(i,1,11)
       xsu(2)=uf(i,2,11)
       xsv(2)=vf(i,2,11)

c      Intersection 24
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       uf(i,1,24)=xtu
       vf(i,1,24)=xtv

c      recta s right (11)

       xsu(1)=uf(i,1,12)
       xsv(1)=vf(i,1,12)
       xsu(2)=uf(i,2,12)
       xsv(2)=vf(i,2,12)

c      Intersection 25
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       uf(i,1,25)=xtu
       vf(i,1,25)=xtv

       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case orthogonal
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (icase.eq.2) then

       alple=-(datan((vf(i,npo,10)-vf(i,npo,9))/
     + (uf(i,npo,10)-uf(i,npo,9))))

       uf(i,npo,14)=uf(i,npo,9)+xupple*0.1*dsin(alple)
       vf(i,npo,14)=vf(i,npo,9)+xupple*0.1*dcos(alple)

       uf(i,npo,15)=uf(i,npo,10)+xupple*0.1*dsin(alple)
       vf(i,npo,15)=vf(i,npo,10)+xupple*0.1*dcos(alple)

       uf(i,npo,24)=uf(i,npo,14)-xupp*0.1*dcos(alple)
       vf(i,npo,24)=vf(i,npo,14)+xupp*0.1*dsin(alple)

       uf(i,npo,25)=uf(i,npo,15)+xupp*0.1*dcos(alple)
       vf(i,npo,25)=vf(i,npo,15)-xupp*0.1*dsin(alple)

c      Points TE 14,15,24,25,26,27
c      TE case orthogonal

       alpte=-(datan((vf(i,1,10)-vf(i,1,9))/(uf(i,1,10)-uf(i,1,9))))

       uf(i,1,14)=uf(i,1,9)-xuppte*0.1*dsin(alpte)
       vf(i,1,14)=vf(i,1,9)-xuppte*0.1*dcos(alpte)

       uf(i,1,15)=uf(i,1,10)-xuppte*0.1*dsin(alpte)
       vf(i,1,15)=vf(i,1,10)-xuppte*0.1*dcos(alpte)

       uf(i,1,24)=uf(i,1,14)-xupp*0.1*dcos(alpte)
       vf(i,1,24)=vf(i,1,14)+xupp*0.1*dsin(alpte)
 
       uf(i,1,25)=uf(i,1,15)+xupp*0.1*dcos(alpte)
       vf(i,1,25)=vf(i,1,15)-xupp*0.1*dsin(alpte)

       end if

       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE DRAW PANEL COMPLETE
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE dpanelc(i,uf,vf,npo,psep,psey)

       real*8 uf(0:100,500,50),vf(0:100,500,50)
       real*8 psep,psey

       do j=1,npo-1
c      Sobreamples esquerra

       call line(psep+uf(i,j,9),psey-vf(i,j,9),psep+uf(i,j+1,9),
     + psey-vf(i,j+1,9),1)

c      Sobreamples dreta

       call line(psep+uf(i,j,10),psey-vf(i,j,10),psep+uf(i,j+1,10),
     + psey-vf(i,j+1,10),1)

c      Vores de costura esquerra

       call line(psep+uf(i,j,11),psey-vf(i,j,11),psep+uf(i,j+1,11),
     + psey-vf(i,j+1,11),3)

c      Vores de costura dreta

       call line(psep+uf(i,j,12),psey-vf(i,j,12),psep+uf(i,j+1,12),
     + psey-vf(i,j+1,12),3)

       end do

c      Four horizontal segments 11-9, 10-12

       call line(psep+uf(i,npo,11),psey-vf(i,npo,11),
     + psep+uf(i,npo,9),psey-vf(i,npo,9),3)

       call line(psep+uf(i,npo,10),psey-vf(i,npo,10),
     + psep+uf(i,npo,12),psey-vf(i,npo,12),3)

       call line(psep+uf(i,1,11),psey-vf(i,1,11),
     + psep+uf(i,1,9),psey-vf(i,1,9),3)

       call line(psep+uf(i,1,10),psey-vf(i,1,10),
     + psep+uf(i,1,12),psey-vf(i,1,12),3)

c      Four vertical segments 10-15, 9-14

       call line(psep+uf(i,1,10),psey-vf(i,1,10),
     + psep+uf(i,1,15),psey-vf(i,1,15),3)

       call line(psep+uf(i,npo,10),psey-vf(i,npo,10),
     + psep+uf(i,npo,15),psey-vf(i,npo,15),3)
       
       call line(psep+uf(i,1,9),psey-vf(i,1,9),
     + psep+uf(i,1,14),psey-vf(i,1,14),3)

       call line(psep+uf(i,npo,9),psey-vf(i,npo,9),
     + psep+uf(i,npo,14),psey-vf(i,npo,14),3)

c      Two horizontal lines 14-15

       call line(psep+uf(i,1,14),psey-vf(i,1,14),
     + psep+uf(i,1,15),psey-vf(i,1,15),3)

       call line(psep+uf(i,npo,14),psey-vf(i,npo,14),
     + psep+uf(i,npo,15),psey-vf(i,npo,15),3)

c      Draw eight corner segments

       call line(psep+uf(i,1,14),psey-vf(i,1,14),
     + psep+uf(i,1,24),psey-vf(i,1,24),3)

       call line(psep+uf(i,1,11),psey-vf(i,1,11),
     + psep+uf(i,1,24),psey-vf(i,1,24),3)

       call line(psep+uf(i,1,15),psey-vf(i,1,15),
     + psep+uf(i,1,25),psey-vf(i,1,25),3)
     
       call line(psep+uf(i,1,12),psey-vf(i,1,12),
     + psep+uf(i,1,25),psey-vf(i,1,25),3)

       call line(psep+uf(i,npo,14),psey-vf(i,npo,14),
     + psep+uf(i,npo,24),psey-vf(i,npo,24),3)

       call line(psep+uf(i,npo,11),psey-vf(i,npo,11),
     + psep+uf(i,npo,24),psey-vf(i,npo,24),3)

       call line(psep+uf(i,npo,15),psey-vf(i,npo,15),
     + psep+uf(i,npo,25),psey-vf(i,npo,25),3)
     
       call line(psep+uf(i,npo,12),psey-vf(i,npo,12),
     + psep+uf(i,npo,25),psey-vf(i,npo,25),3)

c      Trailing edge extrados
       call line(psep+uf(i,1,9),psey-vf(i,1,9),
     + psep+uf(i,1,10),psey-vf(i,1,10),1)
       
c      Init extrados
       call line(psep+uf(i,npo,9),psey-vf(i,npo,9),
     + psep+uf(i,npo,10),psey-vf(i,npo,10),1)
            
       return
       end



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE DRAW PANEL COMPLETE WITH CONTROL (ic)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE dpanelcc(i,uf,vf,npo,psep,psey,ic)

       real*8 uf(0:100,500,50),vf(0:100,500,50)
       real*8 psep,psey
       integer icont(10),ic

       do k=1,8
       icont(k)=0
       end do

c      case ic=1
       if (ic.eq.1) then ! Vores laterals exteriors
       icont(1)=1
       icont(4)=1
       end if

c      case ic=2
       if (ic.eq.2) then ! Vores laterals exteriors sense LE
       icont(1)=1
       icont(2)=1
       icont(4)=1
       icont(5)=1
       icont(7)=1
       end if

c      case ic=3
       if (ic.eq.3) then ! Vores laterals exteriors tot
       icont(1)=1
       icont(2)=1
       icont(3)=1
       icont(4)=1
       icont(5)=1
       icont(6)=1
       icont(7)=1
       icont(8)=1
       end if

c      case ic=4
       if (ic.eq.4) then ! Vores laterals exteriors sense TE
       icont(1)=1
       icont(3)=1
       icont(4)=1
       icont(6)=1
       icont(8)=1
       end if

c      case ic=5
       if (ic.eq.5) then ! Vores laterals exteriors
       icont(1)=1
       end if

c      case ic=6
       if (ic.eq.6) then ! Vores laterals exteriors sense TE
       icont(1)=1
       icont(2)=1
       end if

c      case ic=7
       if (ic.eq.7) then ! Vores laterals exteriors sense TE
       icont(1)=1
       icont(2)=1
       icont(3)=1
       end if

c      case ic=8
       if (ic.eq.8) then ! Vores laterals exteriors sense TE
       icont(1)=1
       icont(3)=1
       end if

       do j=1,npo-1

       if (icont(4).eq.1) then
c      Sobreamples esquerra
       call line(psep+uf(i,j,9),psey-vf(i,j,9),psep+uf(i,j+1,9),
     + psey-vf(i,j+1,9),1)
c      Sobreamples dreta
       call line(psep+uf(i,j,10),psey-vf(i,j,10),psep+uf(i,j+1,10),
     + psey-vf(i,j+1,10),1)
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      MULTIBAT
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (icont(1).eq.1) then
c      Vores de costura esquerra
       call line(psep+uf(i,j,11),psey-vf(i,j,11),psep+uf(i,j+1,11),
     + psey-vf(i,j+1,11),3)
c      Vores de costura dreta
       call line(psep+uf(i,j,12),psey-vf(i,j,12),psep+uf(i,j+1,12),
     + psey-vf(i,j+1,12),3)
       end if

       end do

       if (icont(8).eq.1) then
c      Corners fin 11-9-14 and 12-10-15
       call line(psep+uf(i,npo,11),psey-vf(i,npo,11),
     + psep+uf(i,npo,9),psey-vf(i,npo,9),3)
       call line(psep+uf(i,npo,9),psey-vf(i,npo,9),
     + psep+uf(i,npo,14),psey-vf(i,npo,14),3)
       call line(psep+uf(i,npo,10),psey-vf(i,npo,10),
     + psep+uf(i,npo,12),psey-vf(i,npo,12),3)
       call line(psep+uf(i,npo,10),psey-vf(i,npo,10),
     + psep+uf(i,npo,15),psey-vf(i,npo,15),3)
       end if

       if (icont(7).eq.1) then
c      Corners init 11-9-14 and 12-10-15
       call line(psep+uf(i,1,11),psey-vf(i,1,11),
     + psep+uf(i,1,9),psey-vf(i,1,9),3)
       call line(psep+uf(i,1,10),psey-vf(i,1,10),
     + psep+uf(i,1,12),psey-vf(i,1,12),3)
       call line(psep+uf(i,1,10),psey-vf(i,1,10),
     + psep+uf(i,1,15),psey-vf(i,1,15),3)     
       call line(psep+uf(i,1,9),psey-vf(i,1,9),
     + psep+uf(i,1,14),psey-vf(i,1,14),3)
       end if

       if (icont(2).eq.1) then
c      Init bracket
c      Lines 14-15
       call line(psep+uf(i,1,14),psey-vf(i,1,14),
     + psep+uf(i,1,15),psey-vf(i,1,15),3)
c      Segments 14-24-11 and 15-25-12
       call line(psep+uf(i,1,14),psey-vf(i,1,14),
     + psep+uf(i,1,24),psey-vf(i,1,24),3)
       call line(psep+uf(i,1,11),psey-vf(i,1,11),
     + psep+uf(i,1,24),psey-vf(i,1,24),3)
       call line(psep+uf(i,1,15),psey-vf(i,1,15),
     + psep+uf(i,1,25),psey-vf(i,1,25),3)
       call line(psep+uf(i,1,12),psey-vf(i,1,12),
     + psep+uf(i,1,25),psey-vf(i,1,25),3)
       end if

       if (icont(3).eq.1) then
c      Final bracket
c      Lines 14-15
       call line(psep+uf(i,npo,14),psey-vf(i,npo,14),
     + psep+uf(i,npo,15),psey-vf(i,npo,15),3)
c      Segments 14-24-11 and 15-25-12
       call line(psep+uf(i,npo,14),psey-vf(i,npo,14),
     + psep+uf(i,npo,24),psey-vf(i,npo,24),3)
       call line(psep+uf(i,npo,11),psey-vf(i,npo,11),
     + psep+uf(i,npo,24),psey-vf(i,npo,24),3)
       call line(psep+uf(i,npo,15),psey-vf(i,npo,15),
     + psep+uf(i,npo,25),psey-vf(i,npo,25),3)
       call line(psep+uf(i,npo,12),psey-vf(i,npo,12),
     + psep+uf(i,npo,25),psey-vf(i,npo,25),3)
       end if

       if (icont(5).eq.1) then
c      Initial segment
       call line(psep+uf(i,1,9),psey-vf(i,1,9),
     + psep+uf(i,1,10),psey-vf(i,1,10),1)
       end if

       if (icont(6).eq.1) then
c      Final segment
       call line(psep+uf(i,npo,9),psey-vf(i,npo,9),
     + psep+uf(i,npo,10),psey-vf(i,npo,10),1)
       end if
            
       return

       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE DRAW ARC BY 3 POINTS WITH CONTROL (ic)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE arc3p(i,npunt,uf,vf,dfle,is,psep,psey,ic,xupp)

       real*8 uf(0:100,500,50),vf(0:100,500,50)
       real*8 psep,psey,dfle,sfle,tetha,omega,puntu(0:10),puntv(0:10)
       real*8 a,b,c,d,e,f,ep,eps,ep1,ep3,radi,epinc,bv,cv,xupp
       real*8 g,mu,xi,parcu(0:21),parcv(0:21),parcul(0:21),parcvl(0:21)
       real*8 parcve(0:21),parcue(0:21)
       real*8 xru(2),xrv(2),xsu(2),xsv(2)
       integer npunt,ic,is

c      is = convexitat (1) o concavitat (-1) de l'arc

       j=npunt

c      Evita radi infinit
       if (dabs(dfle).lt.0.000001d0) then
       dfle=0.00001d0 ! :)
       end if

c      Sign control (use negative 3D shaping)
       ii=1
       if (dfle.lt.0.) then
       ii=-1
       end if
       is=is*ii

c      ic=1 draw complete borders
c      ic=2 draw only external borders

c      Set basic points 1-2-3-4

       puntu(1)=uf(i,j,9)
       puntv(1)=vf(i,j,9)
       puntu(3)=uf(i,j,10)
       puntv(3)=vf(i,j,10)
       puntu(4)=0.5d0*(puntu(1)+puntu(3))
       puntv(4)=0.5d0*(puntv(1)+puntv(3))
       puntu(9)=puntu(3)
       puntv(9)=puntv(3)

       sfle=0.5d0*dsqrt((puntu(1)-puntu(3))**2.+(puntv(1)-puntv(3))**2.)
       tetha=datan(dfle/sfle)
       omega=datan((puntv(1)-puntv(3))/(puntu(3)-puntu(1)))
       if (is.eq.1) then
       puntu(2)=puntu(4)+dfle*dsin(omega)
       puntv(2)=puntv(4)+dfle*dcos(omega)
       end if
       if (is.eq.-1) then
       puntu(2)=puntu(4)-dfle*dsin(omega)
       puntv(2)=puntv(4)-dfle*dcos(omega)
       end if

c      Draw two segments
c       call line(psep+puntu(1),psey-puntv(1),
c     + psep+puntu(2),psey-puntv(2),1)
c       call line(psep+puntu(3),psey-puntv(3),
c     + psep+puntu(2),psey-puntv(2),1)

c      Circle by 1-2-3 analytical solution

       a=2.0d0*(puntu(2)-puntu(1))
       b=2.0d0*(puntv(2)-puntv(1))
       c=puntu(1)*puntu(1)-puntu(2)*puntu(2)+
     + puntv(1)*puntv(1)-puntv(2)*puntv(2)
       d=2.0d0*(puntu(3)-puntu(2))
       e=2.0d0*(puntv(3)-puntv(2))
       f=puntu(2)*puntu(2)-puntu(3)*puntu(3)+
     + puntv(2)*puntv(2)-puntv(3)*puntv(3)
       puntv(0)=((c*d/a)-f)/(e-(b*d/a))
       puntu(0)=-(puntv(0)*b+c)/a
       radi=dsqrt((puntu(1)-puntu(0))**2.+(puntv(1)-puntv(0))**2.)

c      Draw basic radius
c       call line(psep+puntu(1),psey-puntv(1),
c     + psep+puntu(0),psey-puntv(0),7)
c       call line(psep+puntu(3),psey-puntv(3),
c     + psep+puntu(0),psey-puntv(0),7)

c      Consider points in an horizontal segment 1-3

       if (dabs(puntu(3)-puntu(1)).ge.0.01d0) then
       xi=datan((puntv(1)-puntv(3))/(puntu(1)-puntu(3)))
       end if

       g=dsqrt(radi*radi-sfle*sfle)
       mu=datan(sfle/g)

       puntu(3)=puntu(1)+2.0d0*sfle
       puntv(3)=puntv(1)
       puntu(0)=puntu(1)+sfle
       puntv(0)=puntv(1)-g

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Arc internal
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Arc global coordinates (u,v) using 21 points
       do k=1,21
       ep=mu-(2.0d0*mu/20.0d0)*dfloat(k-1)
       parcu(k-1)=puntu(0)-radi*dsin(ep)
       parcv(k-1)=puntv(0)+radi*dcos(ep)
       end do

c      Arc local coordinates (u',v')
       do k=0,20
       parcul(k)=parcu(k)-puntu(1)
       parcvl(k)=dfloat(is)*(parcv(k)-puntv(1))
       end do

c      Rotate local coordinates around punt 1
       do k=0,20
       parcu(k)=parcul(k)*dcos(xi)-parcvl(k)*dsin(xi)+puntu(1)
       parcv(k)=parcul(k)*dsin(xi)+parcvl(k)*dcos(xi)+puntv(1)
       end do

c      Draw rotated arc
       if (ic.ne.2) then
       do k=1,20
       call line(psep+parcu(k-1),psey-parcv(k-1),
     + psep+parcu(k),psey-parcv(k),1)
       end do
       end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Arc external
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Arc global coordinates (u,v) using 21 points
       do k=1,21
       ep=mu-(2.0d0*mu/20.0d0)*dfloat(k-1)
       parcu(k-1)=puntu(0)-(radi+dfloat(ii)*xupp*0.1d0)*dsin(ep)
       parcv(k-1)=puntv(0)+(radi+dfloat(ii)*xupp*0.1d0)*dcos(ep)
       end do

c      Arc local coordinates (u',v')
       do k=0,20
       parcul(k)=parcu(k)-puntu(1)
       parcvl(k)=dfloat(is)*(parcv(k)-puntv(1))
       end do

c      Rotate local coocrdinates around punt 1
       do k=0,20
       parcue(k)=parcul(k)*dcos(xi)-parcvl(k)*dsin(xi)+puntu(1)
       parcve(k)=parcul(k)*dsin(xi)+parcvl(k)*dcos(xi)+puntv(1)
       end do

c      Draw rotated arc
       do k=1,20
       call line(psep+parcue(k-1),psey-parcve(k-1),
     + psep+parcue(k),psey-parcve(k),3)
       end do

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Intersection points
c      Points of intersection of arcs with external borders
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Intersection left
       xru(1)=parcue(0)
       xrv(1)=parcve(0)
       xru(2)=parcue(1)
       xrv(2)=parcve(1)

       if (is*ii.eq.1) then
       xsu(1)=uf(i,j,11)
       xsv(1)=vf(i,j,11)
       xsu(2)=uf(i,j-1,11)
       xsv(2)=vf(i,j-1,11)
       end if

       if (is*ii.eq.-1) then 
       xsu(1)=uf(i,j,11)
       xsv(1)=vf(i,j,11)
       xsu(2)=uf(i,j+1,11)
       xsv(2)=vf(i,j+1,11)
       end if

       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       call line(psep+xsu(1),psey-xsv(1),psep+xtu,psey-xtv,3)
       call line(psep+xru(1),psey-xrv(1),psep+xtu,psey-xtv,3)
       if (ic.ne.2) then
       call line(psep+puntu(1),psey-puntv(1),psep+xtu,psey-xtv,3)
       call line(psep+puntu(1),psey-puntv(1),psep+xsu(1),psey-xsv(1),3)
       call line(psep+puntu(1),psey-puntv(1),psep+xru(1),psey-xrv(1),3)
       end if

c      Intersection right
       xru(1)=parcue(20)
       xrv(1)=parcve(20)
       xru(2)=parcue(19)
       xrv(2)=parcve(19)

       if (is*ii.eq.1) then
       xsu(1)=uf(i,j,12)
       xsv(1)=vf(i,j,12)
       xsu(2)=uf(i,j-1,12)
       xsv(2)=vf(i,j-1,12)
       end if

       if (is*ii.eq.-1) then
       xsu(1)=uf(i,j,12)
       xsv(1)=vf(i,j,12)
       xsu(2)=uf(i,j+1,12)
       xsv(2)=vf(i,j+1,12)
       end if

       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)

       call line(psep+xsu(1),psey-xsv(1),psep+xtu,psey-xtv,3)
       call line(psep+xru(1),psey-xrv(1),psep+xtu,psey-xtv,3)
       if (ic.ne.2) then
       call line(psep+puntu(9),psey-puntv(9),psep+xtu,psey-xtv,3)
       call line(psep+puntu(9),psey-puntv(9),psep+xsu(1),psey-xsv(1),3)
       call line(psep+puntu(9),psey-puntv(9),psep+xru(1),psey-xrv(1),3)
       end if

       return
       end



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE DRAW ARC BY 3 POINTS WITH CONTROL (ic) 
c      SPECIAL!!!!!
c      USED ONLY FOR OBTAINIG SOME POINTS FOR ROMAN PRINTING....
c      INTEGRAR DINS romanoparc
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE arc3parc(i,npunt,uf,vf,dfle,is,psep,psey,ic,xupp)

       real*8 uf(0:100,500,50),vf(0:100,500,50)
       real*8 psep,psey,dfle,sfle,tetha,omega,puntu(0:10),puntv(0:10)
       real*8 a,b,c,d,e,f,ep,eps,ep1,ep3,radi,epinc,bv,cv,xupp
       real*8 g,mu,xi,parcu(0:21),parcv(0:21),parcul(0:21),parcvl(0:21)
       real*8 parcve(0:21),parcue(0:21)
       real*8 xru(2),xrv(2),xsu(2),xsv(2)
       real*8 uu1,vv1,uu2,vv2,xlen1,xlen2
       integer npunt,ic,is,kini,kfin

       j=npunt

c      Evita radi infinit
       if (dfle.lt.0.000001d0) then
       dfle=0.00001d0 ! :)
       end if

c      ic=1 draw complete borders
c      ic=2 draw only external borders

c      Set basic points 1-2-3-4

       puntu(1)=uf(i,j,9)
       puntv(1)=vf(i,j,9)
       puntu(3)=uf(i,j,10)
       puntv(3)=vf(i,j,10)
       puntu(4)=0.5d0*(puntu(1)+puntu(3))
       puntv(4)=0.5d0*(puntv(1)+puntv(3))
       puntu(9)=puntu(3)
       puntv(9)=puntv(3)

       sfle=0.5d0*dsqrt((puntu(1)-puntu(3))**2.+(puntv(1)-puntv(3))**2.)
       tetha=datan(dfle/sfle)
       omega=datan((puntv(1)-puntv(3))/(puntu(3)-puntu(1)))
       if (is.eq.1) then
       puntu(2)=puntu(4)+dfle*dsin(omega)
       puntv(2)=puntv(4)+dfle*dcos(omega)
       end if
       if (is.eq.-1) then
       puntu(2)=puntu(4)-dfle*dsin(omega)
       puntv(2)=puntv(4)-dfle*dcos(omega)
       end if

c      Circle by 1-2-3 analytical solution
       a=2.0d0*(puntu(2)-puntu(1))
       b=2.0d0*(puntv(2)-puntv(1))
       c=puntu(1)*puntu(1)-puntu(2)*puntu(2)+
     + puntv(1)*puntv(1)-puntv(2)*puntv(2)
       d=2.0d0*(puntu(3)-puntu(2))
       e=2.0d0*(puntv(3)-puntv(2))
       f=puntu(2)*puntu(2)-puntu(3)*puntu(3)+
     + puntv(2)*puntv(2)-puntv(3)*puntv(3)
       puntv(0)=((c*d/a)-f)/(e-(b*d/a))
       puntu(0)=-(puntv(0)*b+c)/a
       radi=dsqrt((puntu(1)-puntu(0))**2.+(puntv(1)-puntv(0))**2.)

c      Consider points in an horizontal segment 1-3
       if (dabs(puntu(3)-puntu(1)).ge.0.01d0) then
       xi=datan((puntv(1)-puntv(3))/(puntu(1)-puntu(3)))
       end if

       g=dsqrt(radi*radi-sfle*sfle)
       mu=datan(sfle/g)

       puntu(3)=puntu(1)+2.0d0*sfle
       puntv(3)=puntv(1)
       puntu(0)=puntu(1)+sfle
       puntv(0)=puntv(1)-g

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Arc internal
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Case extrados
c      Arc global coordinates (u,v) using 21 points
       do k=1,21
       ep=mu-(2.0d0*mu/20.0d0)*dfloat(k-1)
       parcu(k-1)=puntu(0)-radi*dsin(ep)
       parcv(k-1)=puntv(0)+radi*dcos(ep)
       end do

c      Case intrados
       if (ii.eq.-1) then
       do k=21,1,-1

       end do
       end if

c      Arc local coordinates (u',v')
       do k=0,20
       parcul(k)=parcu(k)-puntu(1)
       parcvl(k)=dfloat(is)*(parcv(k)-puntv(1))
       end do

c      Rotate local coordinates around punt 1
       do k=0,20
       parcu(k)=parcul(k)*dcos(xi)-parcvl(k)*dsin(xi)+puntu(1)
       parcv(k)=parcul(k)*dsin(xi)+parcvl(k)*dcos(xi)+puntv(1)
       end do

c      Draw rotated arc
       if (ic.ne.2) then
       do k=1,20
c       call line(psep+parcu(k-1),psey-parcv(k-1),
c     + psep+parcu(k),psey-parcv(k),1)
       end do
       end if

c      Arc length
       xlen1=0.0d0
       do k=0,20-1
       xlen1=xlen1+dsqrt((parcu(k+1)-parcu(k))**2.+
     + (parcv(k+1)-parcv(k))**2)
       end do

c      Detect kini and kfin
       xlen2=0.0d0
       do k=0,20-1
       xlen2=xlen+dsqrt((parcu(k+1)-parcu(k))**2.+
     + (parcv(k+1)-parcv(k))**2)
       if (len2.le.len1*xlenco) then
       kini=k
       kfin=k+2
       end if
       end do
c      Some arrangements...
       if (kini.ge.19) then
       kfin=20
       end if
       if (kfin.eq.20) then
       kini=18
       end if

c      Define especial points in the arc
       uu1=parcu(kini)
       vv1=parcv(kini)
       uu2=parcu(kfin)
       vv2=parcv(kfin)

       return
       end    ! ARC3P special


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE DRAW VENT WITH CONTROLS
c      Draw vent panels types
c      ic1=1 > print; ic1=2 > laser
c      ic2= vent type 1,0,-1,-2,-3
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc     
       SUBROUTINE drwvent(i,np,uf,vf,ufv,vfv,psep,psey,xupp,xupple,
     + xuppte,xkf,ic1,ic2,csi)

       real*8 uf(0:100,500,50),vf(0:100,500,50)
       real*8 ufv(0:100,500,50),vfv(0:100,500,50)
       real*8 ufa(0:100,500,50),vfa(0:100,500,50) !auxiliar
       real*8 ufb(0:100,500,50),vfb(0:100,500,50) !auxiliar
       integer np(0:100,9)
       real*8 psep,psey,xupp,xupple,xuppte,xkf,xcsi,ycsi
       real*8 cs2x,cs2y,cs1x,cs1y,alpha,alpha1,alpha2,csi(0:100,60)
       integer npi,npf,np0,npo1,i,ic1,ic2
       real*8 xru(2),xrv(2),xsu(2),xsv(2)
       real*8 xlenl,xlenlr,xlenr,xlenrr
       real*8 xcir,xdes
       real*8 pgx(100),pgy(100),param1,param2,param3
       real*8 distrel,distrel1,distrel2
       integer npol,npr,npoly,npolyl,npolyr

       real*8 xpoly(500),ypoly(500)
       real*8 x_poly,y_poly,x_poly1,y_poly1,x_poly2,y_poly2
       real*8 x_poly11,y_poly11,x_poly12,y_poly12
       real*8 xu,xv,alp
       real*8 xupplenew

c      Vent points
       npi=np(i,2)
       npf=np(i,2)+np(i,3)-1
       npo=npf-npi+1

c      Parameters
       xdes=csi(i,51)
       xcir=csi(i,50)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Parameters for translation and rotation ic2 ge 1
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (ic2.ge.1) then
       npo1=np(i,2)
       cs1x=(uf(i,npo1,9)+uf(i,npo1,10))*0.5
       cs1y=(vf(i,npo1,9)+vf(i,npo1,10))*0.5
       cs2x=(ufv(i,1,9)+ufv(i,1,10))*0.5
       cs2y=(vfv(i,1,9)+vfv(i,1,10))*0.5
       alpha=(datan((vf(i,npo1,10)-vf(i,npo1,9))/
     + (uf(i,npo1,10)-uf(i,npo1,9))))

c      Translation -cs2x
       do j=1,npo
       ufb(i,j,9)=ufv(i,j,9)-cs2x
       ufb(i,j,10)=ufv(i,j,10)-cs2x
       ufb(i,j,11)=ufv(i,j,11)-cs2x
       ufb(i,j,12)=ufv(i,j,12)-cs2x
       vfb(i,j,9)=vfv(i,j,9)
       vfb(i,j,10)=vfv(i,j,10)
       vfb(i,j,11)=vfv(i,j,11)
       vfb(i,j,12)=vfv(i,j,12)
       end do

c      Rotation alpha and traslation csx1,cs1y
       do j=1,npo
       ufa(i,j,9)=ufb(i,j,9)*dcos(alpha)-vfv(i,j,9)*dsin(alpha)+
     + cs1x
       ufa(i,j,10)=ufb(i,j,10)*dcos(alpha)-vfv(i,j,10)*dsin(alpha)+
     + cs1x
       ufa(i,j,11)=ufb(i,j,11)*dcos(alpha)-vfv(i,j,11)*dsin(alpha)+
     + cs1x
       ufa(i,j,12)=ufb(i,j,12)*dcos(alpha)-vfv(i,j,12)*dsin(alpha)+
     + cs1x
       vfa(i,j,9)=ufb(i,j,9)*dsin(alpha)+vfv(i,j,9)*dcos(alpha)+
     + cs1y
       vfa(i,j,10)=ufb(i,j,10)*dsin(alpha)+vfv(i,j,10)*dcos(alpha)+
     + cs1y
       vfa(i,j,11)=ufb(i,j,11)*dsin(alpha)+vfv(i,j,11)*dcos(alpha)+
     + cs1y
       vfa(i,j,12)=ufb(i,j,12)*dsin(alpha)+vfv(i,j,12)*dcos(alpha)+
     + cs1y
       end do

c      BRUTE FORCE redefine
       ufa(i,1,9)=csi(i,21)
       vfa(i,1,9)=csi(i,22)
       ufa(i,1,10)=csi(i,23)
       vfa(i,1,10)=csi(i,24)
       ufa(i,1,11)=csi(i,25)
       vfa(i,1,11)=csi(i,26)
       ufa(i,1,12)=csi(i,27)
       vfa(i,1,12)=csi(i,28)

       call extpoints(i,ufa,vfa,npo,xupp,xupple,xuppte,1)

       end if ! ic2 ge 1

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Parameters for translation and rotation ic2 le -1
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       If (ic2.le.-1) then

       do j=1,npo
       ufb(i,j,9)=ufv(i,j,9)
       ufb(i,j,10)=ufv(i,j,10)
       ufb(i,j,11)=ufv(i,j,11)
       ufb(i,j,12)=ufv(i,j,12)
       vfb(i,j,9)=vfv(i,j,9)
       vfb(i,j,10)=vfv(i,j,10)
       vfb(i,j,11)=vfv(i,j,11)
       vfb(i,j,12)=vfv(i,j,12)
       end do

       cs1x=(ufv(i,npo,9)+ufv(i,npo,10))*0.5
       cs1y=(vfv(i,npo,9)+vfv(i,npo,10))*0.5
       cs2x=(ufv(i,1,9)+ufv(i,1,10))*0.5
       cs2y=(vfv(i,1,9)+vfv(i,1,10))*0.5

       alpha1=(datan((vfv(i,npo,10)-vfv(i,npo,9))/
     + (ufv(i,npo,10)-ufv(i,npo,9))))
       alpha2=(datan((vfb(i,1,10)-vfb(i,1,9))/
     + (ufb(i,npo,10)-ufb(i,1,9))))

c      Translate vents from point 2 to (0,0)
             
       do j=1,npo
       ufb(i,j,9)=ufv(i,j,9)-cs1x
       ufb(i,j,10)=ufv(i,j,10)-cs1x
       ufb(i,j,11)=ufv(i,j,11)-cs1x
       ufb(i,j,12)=ufv(i,j,12)-cs1x
       vfb(i,j,9)=vfv(i,j,9)-cs1y
       vfb(i,j,10)=vfv(i,j,10)-cs1y
       vfb(i,j,11)=vfv(i,j,11)-cs1y
       vfb(i,j,12)=vfv(i,j,12)-cs1y
       end do

c      Rotation angle alpha
c      Translation using brute force (section 8.5.5) variable csi
c      TRY ANOTHER METHOD!!!!!!!!!!!!!!
c      Force last point

       alpha=-alpha1+csi(i,9)
       xcsi=(csi(i,1)+csi(i,3))*0.5
       ycsi=(csi(i,2)+csi(i,4))*0.5

       do j=1,npo
       ufa(i,j,9)=ufb(i,j,9)*dcos(alpha)-vfb(i,j,9)*dsin(alpha)+xcsi
       ufa(i,j,10)=ufb(i,j,10)*dcos(alpha)-vfb(i,j,10)*dsin(alpha)+
     + xcsi
       ufa(i,j,11)=ufb(i,j,11)*dcos(alpha)-vfb(i,j,11)*dsin(alpha)+
     + xcsi
       ufa(i,j,12)=ufb(i,j,12)*dcos(alpha)-vfb(i,j,12)*dsin(alpha)+
     + xcsi
       vfa(i,j,9)=ufb(i,j,9)*dsin(alpha)+vfb(i,j,9)*dcos(alpha)+ycsi
       vfa(i,j,10)=ufb(i,j,10)*dsin(alpha)+vfb(i,j,10)*dcos(alpha)+
     + ycsi
       vfa(i,j,11)=ufb(i,j,11)*dsin(alpha)+vfb(i,j,11)*dcos(alpha)+
     + ycsi
       vfa(i,j,12)=ufb(i,j,12)*dsin(alpha)+vfb(i,j,12)*dcos(alpha)+
     + ycsi
       end do

c      BRUTE FORCE redefine
       ufa(i,npo,9)=csi(i,1)
       vfa(i,npo,9)=csi(i,2)
       ufa(i,npo,10)=csi(i,3)
       vfa(i,npo,10)=csi(i,4)
       ufa(i,npo,11)=csi(i,5)
       vfa(i,npo,11)=csi(i,6)
       ufa(i,npo,12)=csi(i,7)
       vfa(i,npo,12)=csi(i,8)

c      USE LOW!!!
       call extpoints(i,ufa,vfa,npo,csi(i,10),csi(i,11),csi(i,12),1)

       end if ! ic1=-1

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw complete vent case ic2=1,6
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ic2.eq.1.or.ic2.eq.6) then

c      Subcase ic1=1 (Print)
c      Points vent
       if (ic1.eq.1) then
       j9=npo
       j10=npo
       call prinfpv(i,j9,j10,ufa,vfa,psep,psey,csi(i,50),csi(i,51),xkf,
     + ic1,ic2)
c      Segments
       call line(psep+ufa(i,1,9),psey-vfa(i,1,9),psep+ufa(i,1,10),
     + psey-vfa(i,1,10),1)
       call line(psep+ufa(i,npo,9),psey-vfa(i,npo,9),psep+ufa(i,npo,10),
     + psey-vfa(i,npo,10),1)
       call line(psep+ufa(i,npo,24),psey-vfa(i,npo,24),
     + psep+ufa(i,npo,25),psey-vfa(i,npo,25),3)
c      Lateral unions       
       call line(psep+ufa(i,npo,24),psey-vfa(i,npo,24),
     + psep+ufa(i,npo,11),psey-vfa(i,npo,11),3)
       call line(psep+ufa(i,npo,25),psey-vfa(i,npo,25),
     + psep+ufa(i,npo,12),psey-vfa(i,npo,12),3)
c      Corners
       call line(psep+ufa(i,npo,9),psey-vfa(i,npo,9),
     + psep+ufa(i,npo,11),psey-vfa(i,npo,11),3)
       call line(psep+ufa(i,npo,10),psey-vfa(i,npo,10),
     + psep+ufa(i,npo,12),psey-vfa(i,npo,12),3)
       call line(psep+ufa(i,npo,14),psey-vfa(i,npo,14),
     + psep+ufa(i,npo,9),psey-vfa(i,npo,9),3)
       call line(psep+ufa(i,npo,15),psey-vfa(i,npo,15),
     + psep+ufa(i,npo,10),psey-vfa(i,npo,10),3)
c      Laterals
       do j=1,npo-1
       call line(psep+ufa(i,j,9),psey-vfa(i,j,9),psep+ufa(i,j+1,9),
     + psey-vfa(i,j+1,9),1)
       call line(psep+ufa(i,j,10),psey-vfa(i,j,10),psep+ufa(i,j+1,10),
     + psey-vfa(i,j+1,10),1)
       call line(psep+ufa(i,j,11),psey-vfa(i,j,11),psep+ufa(i,j+1,11),
     + psey-vfa(i,j+1,11),3)
       call line(psep+ufa(i,j,12),psey-vfa(i,j,12),psep+ufa(i,j+1,12),
     + psey-vfa(i,j+1,12),3)
       end do
c      Case ic2=6 draw elliptical inlets
       if (ic2.eq.6) then
       pgx(1)=psep+ufa(i,1,9)
       pgy(1)=psey-vfa(i,1,9)
       pgx(2)=psep+ufa(i,1,10)
       pgy(2)=psey-vfa(i,1,10)
       pgx(4)=psep+ufa(i,npo,9)
       pgy(4)=psey-vfa(i,npo,9)
       pgx(3)=psep+ufa(i,npo,10)
       pgy(3)=psey-vfa(i,npo,10)
       param1=csi(i+1,19)
       param2=csi(i+1,20)
       call elliquad(pgx,pgy,param1,param2)
       end if

       end if ! ic1=1

c      Subcase ic1=2 (Laser)
       if (ic1.eq.2) then
c      Punts vent
c      Revisar
c      xcir,xdes aquí ja estŕ destrossat!!!!!!!!!
c       write (*,*) "HERE IS 1 ",i,csi(i,50),csi(i,51)
c       write (*,*) "HERE IS 2 ",i,xcir,xdes
c      Note csi(i,50)=xcir
c      Note csi(i,51)=xdes
       j9=npo
       j10=npo
       call prinfpv(i,j9,j10,ufa,vfa,psep,psey,csi(i,50),csi(i,51),xkf,
     + ic1,ic2)
c      Segments
       call line(psep+ufa(i,npo,24),psey-vfa(i,npo,24),
     + psep+ufa(i,npo,25),psey-vfa(i,npo,25),3)
c      Lateral unions       
       call line(psep+ufa(i,npo,24),psey-vfa(i,npo,24),
     + psep+ufa(i,npo,11),psey-vfa(i,npo,11),3)
       call line(psep+ufa(i,npo,25),psey-vfa(i,npo,25),
     + psep+ufa(i,npo,12),psey-vfa(i,npo,12),3)
c      Laterals
       do j=1,npo-1
       call line(psep+ufa(i,j,11),psey-vfa(i,j,11),psep+ufa(i,j+1,11),
     + psey-vfa(i,j+1,11),3)
       call line(psep+ufa(i,j,12),psey-vfa(i,j,12),psep+ufa(i,j+1,12),
     + psey-vfa(i,j+1,12),3)
       end do
c      Case ic2=6 draw elliptical inlets
       if (ic2.eq.6) then
       pgx(1)=psep+ufa(i,1,9)
       pgy(1)=psey-vfa(i,1,9)
       pgx(2)=psep+ufa(i,1,10)
       pgy(2)=psey-vfa(i,1,10)
       pgx(4)=psep+ufa(i,npo,9)
       pgy(4)=psey-vfa(i,npo,9)
       pgx(3)=psep+ufa(i,npo,10)
       pgy(3)=psey-vfa(i,npo,10)
       param1=csi(i+1,19)
       param2=csi(i+1,20)
       call elliquad(pgx,pgy,param1,param2)
       end if

       end if ! ic1=2

       end if ! ic2=1,6

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw complete vent case ic2=-1,-6 (intrados)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ic2.eq.-1.or.ic2.eq.-6) then

c      Subcase ic1=1 (Print)
       if (ic1.eq.1) then
c      Points vent
       j9=1
       j10=1
       call prinfpv(i,j9,j10,ufa,vfa,psep,psey,csi(i,50),csi(i,51),xkf,
     + ic1,ic2)
c      Segments
       call line(psep+ufa(i,1,9),psey-vfa(i,1,9),psep+ufa(i,1,10),
     + psey-vfa(i,1,10),1)
       call line(psep+ufa(i,npo,9),psey-vfa(i,npo,9),
     + psep+ufa(i,npo,10),psey-vfa(i,npo,10),1)
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+ufa(i,1,25),psey-vfa(i,1,25),3)
c      Lateral unions       
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+ufa(i,1,11),psey-vfa(i,1,11),3)
       call line(psep+ufa(i,1,25),psey-vfa(i,1,25),
     + psep+ufa(i,1,12),psey-vfa(i,1,12),3)
c      Corners
       call line(psep+ufa(i,1,9),psey-vfa(i,1,9),
     + psep+ufa(i,1,11),psey-vfa(i,1,11),3)
       call line(psep+ufa(i,1,10),psey-vfa(i,1,10),
     + psep+ufa(i,1,12),psey-vfa(i,1,12),3)
       call line(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,1,9),psey-vfa(i,1,9),3)
       if (ufa(i,1,25).ge.ufa(i,1,15)) then ! segment correction
       call line(psep+ufa(i,1,15),psey-vfa(i,1,15),
     + psep+ufa(i,1,10),psey-vfa(i,1,10),3)
       else
       call line(psep+ufa(i,1,25),psey-vfa(i,1,25),
     + psep+ufa(i,1,10),psey-vfa(i,1,10),3)
       end if
c      Laterals
       do j=1,npo-1
       call line(psep+ufa(i,j,9),psey-vfa(i,j,9),psep+ufa(i,j+1,9),
     + psey-vfa(i,j+1,9),1)
       call line(psep+ufa(i,j,10),psey-vfa(i,j,10),psep+ufa(i,j+1,10),
     + psey-vfa(i,j+1,10),1)
       call line(psep+ufa(i,j,11),psey-vfa(i,j,11),psep+ufa(i,j+1,11),
     + psey-vfa(i,j+1,11),3)
       call line(psep+ufa(i,j,12),psey-vfa(i,j,12),psep+ufa(i,j+1,12),
     + psey-vfa(i,j+1,12),3)
       end do
c      Case ic2=-6 draw elliptical inlets
       if (ic2.eq.-6) then
       pgx(1)=psep+ufa(i,1,9)
       pgy(1)=psey-vfa(i,1,9)
       pgx(2)=psep+ufa(i,1,10)
       pgy(2)=psey-vfa(i,1,10)
       pgx(4)=psep+ufa(i,npo,9)
       pgy(4)=psey-vfa(i,npo,9)
       pgx(3)=psep+ufa(i,npo,10)
       pgy(3)=psey-vfa(i,npo,10)
       param1=csi(i+1,19)
       param2=csi(i+1,20)
       call elliquad(pgx,pgy,param1,param2)
       end if

       end if ! ic1=1

c      Subcase ic1=2 (Laser)
       if (ic1.eq.2) then
c      Points vent
       j9=1
       j10=1
       call prinfpv(i,j9,j10,ufa,vfa,psep,psey,csi(i,50),csi(i,51),xkf,
     + ic1,ic2)
c      Segments
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+ufa(i,1,25),psey-vfa(i,1,25),3)
c      Lateral unions       
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+ufa(i,1,11),psey-vfa(i,1,11),3)
       call line(psep+ufa(i,1,25),psey-vfa(i,1,25),
     + psep+ufa(i,1,12),psey-vfa(i,1,12),3)
c      Laterals
       do j=1,npo-1
       call line(psep+ufa(i,j,11),psey-vfa(i,j,11),psep+ufa(i,j+1,11),
     + psey-vfa(i,j+1,11),3)
       call line(psep+ufa(i,j,12),psey-vfa(i,j,12),psep+ufa(i,j+1,12),
     + psey-vfa(i,j+1,12),3)
       end do
c      Case ic2=-6 draw elliptical inlets
       if (ic2.eq.-6) then
       pgx(1)=psep+ufa(i,1,9)
       pgy(1)=psey-vfa(i,1,9)
       pgx(2)=psep+ufa(i,1,10)
       pgy(2)=psey-vfa(i,1,10)
       pgx(4)=psep+ufa(i,npo,9)
       pgy(4)=psey-vfa(i,npo,9)
       pgx(3)=psep+ufa(i,npo,10)
       pgy(3)=psey-vfa(i,npo,10)
       param1=csi(i+1,19)
       param2=csi(i+1,20)
       call elliquad(pgx,pgy,param1,param2)
       end if

       end if ! ic1=2

       end if ! ic2=-1,-6

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw complete vent case ic2=-2 (intrados)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ic2.eq.-2) then

c      Redefine 24,14,15,25
       alpha=datan((vfa(i,npo,9)-vfa(i,1,10))/
     + (ufa(i,1,10)-ufa(i,npo,9)))
       ufa(i,1,14)=ufa(i,npo,9)-csi(i,12)*0.1*dsin(alpha)
       vfa(i,1,14)=vfa(i,npo,9)-csi(i,12)*0.1*dcos(alpha)
       ufa(i,1,15)=ufa(i,1,10)-csi(i,12)*0.1*dsin(alpha)
       vfa(i,1,15)=vfa(i,1,10)-csi(i,12)*0.1*dcos(alpha)

c      Point 24
       xru(1)=ufa(i,npo,11)
       xrv(1)=vfa(i,npo,11)
       xru(2)=ufa(i,npo-1,11)
       xrv(2)=vfa(i,npo-1,11)
       xsu(1)=ufa(i,1,14)
       xsu(2)=ufa(i,1,15)
       xsv(1)=vfa(i,1,14)
       xsv(2)=vfa(i,1,15)
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)
       ufa(i,1,24)=xtu
       vfa(i,1,24)=xtv

c      Point 25
       xru(1)=ufa(i,1,12)
       xru(2)=ufa(i,2,12)
       xrv(1)=vfa(i,1,12)
       xrv(2)=vfa(i,2,12)
       xsu(1)=ufa(i,1,14)
       xsv(1)=vfa(i,1,14)
       xsu(2)=ufa(i,1,15)
       xsv(2)=vfa(i,1,15)
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)
       ufa(i,1,25)=xtu
       vfa(i,1,25)=xtv

c      Subcase ic1=1 (Print)
       if (ic1.eq.1) then
c      Points vent
       j9=npo
       j10=1
       call prinfpv(i,j9,j10,ufa,vfa,psep,psey,csi(i,50),csi(i,51),xkf,
     + ic1,ic2)
c      Segments
       call line(psep+ufa(i,npo,9),psey-vfa(i,npo,9),psep+ufa(i,npo,10),
     + psey-vfa(i,npo,10),1)
       call line(psep+ufa(i,npo,9),psey-vfa(i,npo,9),psep+ufa(i,1,10),
     + psey-vfa(i,1,10),1)
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+ufa(i,1,25),psey-vfa(i,1,25),3)
c      Lateral unions       
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+ufa(i,npo,11),psey-vfa(i,npo,11),3)
       call line(psep+ufa(i,1,25),psey-vfa(i,1,25),
     + psep+ufa(i,1,12),psey-vfa(i,1,12),3)
c      Corners
       call line(psep+ufa(i,npo,9),psey-vfa(i,npo,9),
     + psep+ufa(i,npo,11),psey-vfa(i,npo,11),3)
       call line(psep+ufa(i,1,10),psey-vfa(i,1,10),
     + psep+ufa(i,1,12),psey-vfa(i,1,12),3)
       call line(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,npo,9),psey-vfa(i,npo,9),3)
       if (ufa(i,1,25).ge.ufa(i,1,15)) then ! segment correction
       call line(psep+ufa(i,1,15),psey-vfa(i,1,15),
     + psep+ufa(i,1,10),psey-vfa(i,1,10),3)
       else
       call line(psep+ufa(i,1,25),psey-vfa(i,1,25),
     + psep+ufa(i,1,10),psey-vfa(i,1,10),3)
       end if
c      Laterals
       do j=1,npo-1
       call line(psep+ufa(i,j,10),psey-vfa(i,j,10),psep+ufa(i,j+1,10),
     + psey-vfa(i,j+1,10),1)
       call line(psep+ufa(i,j,12),psey-vfa(i,j,12),psep+ufa(i,j+1,12),
     + psey-vfa(i,j+1,12),3)
       end do
       end if ! ic1=1

c      Subcase ic1=2 (Laser)
       if (ic1.eq.2) then
c      Points vent
       j9=npo
       j10=1
       call prinfpv(i,j9,j10,ufa,vfa,psep,psey,csi(i,50),csi(i,51),xkf,
     + ic1,ic2)
c      Segments
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+ufa(i,1,25),psey-vfa(i,1,25),3)
c      Lateral unions       
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+ufa(i,npo,11),psey-vfa(i,npo,11),3)
       call line(psep+ufa(i,1,25),psey-vfa(i,1,25),
     + psep+ufa(i,1,12),psey-vfa(i,1,12),3)
c      Laterals
       do j=1,npo-1
       call line(psep+ufa(i,j,12),psey-vfa(i,j,12),psep+ufa(i,j+1,12),
     + psey-vfa(i,j+1,12),3)
       end do
       end if ! ic1=2

       end if ! ic2=-2

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw complete vent case ic2=-3 (intrados)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ic2.eq.-3) then

c      !!!!!!!!!!!!!!!! RECALCULAR !!!!!!!!!!!!!!!!!!!!!!!!

c      Redefine 24,14,15,25
       alpha=datan((vfa(i,1,9)-vfa(i,npo,10))/
     + (ufa(i,npo,10)-ufa(i,1,9)))
       ufa(i,1,14)=ufa(i,1,9)-csi(i,12)*0.1*dsin(alpha)
       vfa(i,1,14)=vfa(i,1,9)-csi(i,12)*0.1*dcos(alpha)
       ufa(i,1,15)=ufa(i,npo,10)-csi(i,12)*0.1*dsin(alpha)
       vfa(i,1,15)=vfa(i,npo,10)-csi(i,12)*0.1*dcos(alpha)

c      Point 24
       xru(1)=ufa(i,1,11)
       xrv(1)=vfa(i,1,11)
       xru(2)=ufa(i,2,11)
       xrv(2)=vfa(i,2,11)
       xsu(1)=ufa(i,1,14)
       xsu(2)=ufa(i,1,15)
       xsv(1)=vfa(i,1,14)
       xsv(2)=vfa(i,1,15)
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)
       ufa(i,1,24)=xtu
       vfa(i,1,24)=xtv

c      Point 25
       xru(1)=ufa(i,npo,12)
       xru(2)=ufa(i,npo-1,12)
       xrv(1)=vfa(i,npo,12)
       xrv(2)=vfa(i,npo-1,12)
       xsu(1)=ufa(i,1,14)
       xsv(1)=vfa(i,1,14)
       xsu(2)=ufa(i,1,15)
       xsv(2)=vfa(i,1,15)
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)
       ufa(i,1,25)=xtu
       vfa(i,1,25)=xtv

c      Subcase ic1=1 (Print)
       if (ic1.eq.1) then
c      Points vent
       j9=1
       j10=npo
       call prinfpv(i,j9,j10,ufa,vfa,psep,psey,csi(i,50),csi(i,51),xkf,
     + ic1,ic2)
c      Segments
       call line(psep+ufa(i,npo,9),psey-vfa(i,npo,9),psep+ufa(i,npo,10),
     + psey-vfa(i,npo,10),1)
       call line(psep+ufa(i,1,9),psey-vfa(i,1,9),psep+ufa(i,npo,10),
     + psey-vfa(i,npo,10),1)
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+ufa(i,1,25),psey-vfa(i,1,25),3)
c      Lateral unions       
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+ufa(i,1,11),psey-vfa(i,1,11),3)
       call line(psep+ufa(i,1,25),psey-vfa(i,1,25),
     + psep+ufa(i,npo,12),psey-vfa(i,npo,12),3)
c      Corners
       call line(psep+ufa(i,1,9),psey-vfa(i,1,9),
     + psep+ufa(i,1,11),psey-vfa(i,1,11),3)
       call line(psep+ufa(i,npo,10),psey-vfa(i,npo,10),
     + psep+ufa(i,npo,12),psey-vfa(i,npo,12),3)
       call line(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,1,9),psey-vfa(i,1,9),3)
       if (ufa(i,1,15).ge.ufa(i,1,25)) then ! segment correction
       call line(psep+ufa(i,1,25),psey-vfa(i,1,25),
     + psep+ufa(i,npo,10),psey-vfa(i,npo,10),3)
       else
       call line(psep+ufa(i,1,15),psey-vfa(i,1,15),
     + psep+ufa(i,npo,10),psey-vfa(i,npo,10),3)
       end if
c      Laterals
       do j=1,npo-1
       call line(psep+ufa(i,j,9),psey-vfa(i,j,9),psep+ufa(i,j+1,9),
     + psey-vfa(i,j+1,9),1)
       call line(psep+ufa(i,j,11),psey-vfa(i,j,11),psep+ufa(i,j+1,11),
     + psey-vfa(i,j+1,11),3)
       end do
       end if ! ic1=1

c      Subcase ic1=2 (Laser)
       if (ic1.eq.2) then
c      Points vent
       j9=1
       j10=npo
       call prinfpv(i,j9,j10,ufa,vfa,psep,psey,csi(i,50),csi(i,51),xkf,
     + ic1,ic2)
c      Segments
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+ufa(i,1,25),psey-vfa(i,1,25),3)
c      Lateral unions       
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+ufa(i,1,11),psey-vfa(i,1,11),3)
       call line(psep+ufa(i,1,25),psey-vfa(i,1,25),
     + psep+ufa(i,npo,12),psey-vfa(i,npo,12),3)
c      Laterals
       do j=1,npo-1
       call line(psep+ufa(i,j,11),psey-vfa(i,j,11),psep+ufa(i,j+1,11),
     + psey-vfa(i,j+1,11),3)
       end do
       end if ! ic1=2

       end if ! ic2=-3

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw complete vent case ic2=-4,-5 (intrados)
c      Advanced generic vent...
c      Use vector csi(i,k) for transport additional interpolation data
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ic2.eq.-4.or.ic2.eq.-5) then

       if (ic2.eq.-4) then
c      Length vent left
       xlenl=0.0d0
       do j=1,npo-1
       xlenl=xlenl+dsqrt((ufa(i,j,9)-ufa(i,j+1,9))**2.+
     + (vfa(i,j,9)-vfa(i,j+1,9))**2.)
       end do
       xlenlr=xlenl*(1.-csi(i+1,19)/100.)

c      Length vent rigth
       xlenr=0.0d0
       do j=1,npo-1
       xlenr=xlenr+dsqrt((ufa(i,j,10)-ufa(i,j+1,10))**2.+
     + (vfa(i,j,10)-vfa(i,j+1,10))**2.)
       end do
       xlenrr=xlenr*(1.-csi(i+1,20)/100.)
       end if

       if (ic2.eq.-5) then
c      Length vent left
       xlenl=0.0d0
       do j=1,npo-1
       xlenl=xlenl+dsqrt((ufa(i,j,9)-ufa(i,j+1,9))**2.+
     + (vfa(i,j,9)-vfa(i,j+1,9))**2.)
       end do
       xlenlr=xlenl*(1.-csi(i+1,19)/100.)

c      Length vent rigth
       xlenr=0.0d0
       do j=1,npo-1
       xlenr=xlenr+dsqrt((ufa(i,j,10)-ufa(i,j+1,10))**2.+
     + (vfa(i,j,10)-vfa(i,j+1,10))**2.)
       end do
       xlenrr=xlenr*(1.-csi(i+1,20)/100.)

c      Deflection parameter (vent type -5)
       param3=(csi(i+1,18)/100.)*0.5*(xlenl+xlenr)
       end if

c      Interpolate new vent init
c      Left side
       do j=1,npo
       xpoly(j)=ufa(i,j,9)
       ypoly(j)=vfa(i,j,9)
       end do
       call interpoly2d(xpoly,ypoly,x_poly,y_poly,xlenlr,1,npo,npolyl,
     + distrel)
       x_poly1=x_poly
       y_poly1=y_poly
       distrel1=distrel
c      Right side
       do j=1,npo
       xpoly(j)=ufa(i,j,10)
       ypoly(j)=vfa(i,j,10)
       end do
       call interpoly2d(xpoly,ypoly,x_poly,y_poly,xlenrr,1,npo,npolyr,
     + distrel)
       x_poly2=x_poly
       y_poly2=y_poly
       distrel2=distrel

c      Points 14-15
       alpha=dabs(datan((y_poly2-y_poly1)/(x_poly2-x_poly1)))
       ufa(i,1,14)=x_poly1-csi(i,12)*0.1*dsin(alpha)
       vfa(i,1,14)=y_poly1-csi(i,12)*0.1*dcos(alpha)
       ufa(i,1,15)=x_poly2-csi(i,12)*0.1*dsin(alpha)
       vfa(i,1,15)=y_poly2-csi(i,12)*0.1*dcos(alpha)

       npoly=npolyl
       if (npolyl.eq.1) then
       npoly=2
       end if       

c      Point 24'
       xru(1)=ufa(i,npolyl+1,11)
       xrv(1)=vfa(i,npolyl+1,11)
       xru(2)=ufa(i,npolyl,11)
       xrv(2)=vfa(i,npolyl,11)
       xsu(1)=ufa(i,1,14)
       xsu(2)=ufa(i,1,15)
       xsv(1)=vfa(i,1,14)
       xsv(2)=vfa(i,1,15)
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)
       ufa(i,1,24)=xtu
       vfa(i,1,24)=xtv

c      Point 11'
       x_poly11=ufa(i,npolyl,11)+(ufa(i,npolyl+1,11)-ufa(i,npolyl,11))*
     + distrel1
       y_poly11=vfa(i,npolyl,11)+(vfa(i,npolyl+1,11)-vfa(i,npolyl,11))*
     + distrel1

c      Point 12'
       x_poly12=ufa(i,npolyr,12)+(ufa(i,npolyr+1,12)-ufa(i,npolyr,12))*
     + distrel2
       y_poly12=vfa(i,npolyr,12)+(vfa(i,npolyr+1,12)-vfa(i,npolyr,12))*
     + distrel2

       npoly=npolyr
       if (nployr.eq.1) then
       npoly=2
       end if  

c      Point 25'
       xru(1)=ufa(i,npolyr+1,12)
       xrv(1)=vfa(i,npolyr+1,12)
       xru(2)=ufa(i,npolyr,12)
       xrv(2)=vfa(i,npolyr,12)
       xsu(1)=ufa(i,1,14)
       xsu(2)=ufa(i,1,15)
       xsv(1)=vfa(i,1,14)
       xsv(2)=vfa(i,1,15)
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)
       ufa(i,1,25)=xtu
       vfa(i,1,25)=xtv

c      Subcase ic1=1 (Print)
       if (ic1.eq.1) then

c      Points vent
c      Point left
       xu=x_poly1
       xv=y_poly1
       alp=abs(datan((vfa(i,npolyl+1,9)-vfa(i,npolyl,9)/
     + (ufa(i,npolyl+1,9)-ufa(i,npolyl,9)))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)   
       call pointg(psep+xu,-xv+psey,xcir,4)
c      Point right
       xu=x_poly2
       xv=y_poly2
       alp=abs(datan((vfa(i,npolyr+1,10)-vfa(i,npolyr,10)/
     + (ufa(i,npolyr+1,10)-ufa(i,npolyr,10)))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)   
       call pointg(psep+xu,-xv+psey,xcir,4)

c      Segments
c      Line 9-10
       call line(psep+ufa(i,npo,9),psey-vfa(i,npo,9),psep+ufa(i,npo,10),
     + psey-vfa(i,npo,10),1)

       if (ic2.eq.-4) then
c      Line 9'-10'
       call line(psep+x_poly1,psey-y_poly1,psep+x_poly2,psey-y_poly2,1)
c      Line 14'-15'
       call line(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,1,15),psey-vfa(i,1,15),3)
       end if

       if (ic2.eq.-5) then
c      Line 9'-10'
       call arcfle(psep+x_poly1,psey-y_poly1,psep+x_poly2,psey-y_poly2,
     + param3,1,1)
c      Line 14'-15'
       call arcfle(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,1,15),psey-vfa(i,1,15),param3,1,3)
       end if
     
c      Corners
c      Line 14'-24' and 15-25'
       call line(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,1,24),psey-vfa(i,1,24),3)
       call line(psep+ufa(i,1,15),psey-vfa(i,1,15),
     + psep+ufa(i,1,25),psey-vfa(i,1,25),3)
c      Line 24'-11' and 25'-12'      
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+x_poly11,psey-y_poly11,3)
       call line(psep+ufa(i,1,25),psey-vfa(i,1,25),
     + psep+x_poly12,psey-y_poly12,3)
c      Line 9'-11'
       call line(psep+x_poly1,psey-y_poly1,psep+x_poly11,
     + psey-y_poly11,3)
c      Line 10'-12'
       call line(psep+x_poly2,psey-y_poly2,psep+x_poly12,
     + psey-y_poly12,3)
c      Lines 9'-14' and 10'-15'
       call line(psep+x_poly1,psey-y_poly1,psep+ufa(i,1,14),
     + psey-vfa(i,1,14),3)
       call line(psep+x_poly2,psey-y_poly2,psep+ufa(i,1,15),
     + psey-vfa(i,1,15),3)

c      Laterals right
       call line(psep+ufa(i,npolyr+1,10),psey-vfa(i,npolyr+1,10),
     + psep+x_poly2,psey-y_poly2,1)
       do j=npolyr+1,npo-1
       call line(psep+ufa(i,j,10),psey-vfa(i,j,10),psep+ufa(i,j+1,10),
     + psey-vfa(i,j+1,10),1)
       end do
       call line(psep+ufa(i,npolyr+1,12),psey-vfa(i,npolyr+1,12),
     + psep+x_poly12,psey-y_poly12,3)
       do j=npolyr+1,npo-1
       call line(psep+ufa(i,j,12),psey-vfa(i,j,12),psep+ufa(i,j+1,12),
     + psey-vfa(i,j+1,12),3)
       end do
c      Laterals left
       call line(psep+ufa(i,npolyl+1,9),psey-vfa(i,npolyl+1,9),
     + psep+x_poly1,psey-y_poly1,1)
       do j=npolyl+1,npo-1
       call line(psep+ufa(i,j,9),psey-vfa(i,j,9),psep+ufa(i,j+1,9),
     + psey-vfa(i,j+1,9),1)
       end do
       call line(psep+ufa(i,npolyl+1,11),psey-vfa(i,npolyl+1,11),
     + psep+x_poly11,psey-y_poly11,3)
       do j=npolyl+1,npo-1
       call line(psep+ufa(i,j,11),psey-vfa(i,j,11),psep+ufa(i,j+1,11),
     + psey-vfa(i,j+1,11),3)
       end do

       end if ! ic1=1

c      Subcase ic1=2 (Laser)
       if (ic1.eq.2) then

c      Points vent
c      Point left
       xu=x_poly1
       xv=y_poly1
       alp=abs(datan((vfa(i,npolyl+1,9)-vfa(i,npolyl,9)/
     + (ufa(i,npolyl+1,9)-ufa(i,npolyl,9)))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)   
       call point(psep+xu,-xv+psey,7)
c      Point right
       xu=x_poly2
       xv=y_poly2
       alp=abs(datan((vfa(i,npolyr+1,10)-vfa(i,npolyr,10)/
     + (ufa(i,npolyr+1,10)-ufa(i,npolyr,10)))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)   
       call point(psep+xu,-xv+psey,7)

c      Segments

       if (ic2.eq.-4) then
c      Line 14'-15'
       call line(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,1,15),psey-vfa(i,1,15),3)
       end if

       if (ic2.eq.-5) then
c      Line 14'-15'
       call arcfle(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,1,15),psey-vfa(i,1,15),param3,1,3)
       end if

c      Corners
c      Line 14'-24' and 15-25'
       call line(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,1,24),psey-vfa(i,1,24),3)
       call line(psep+ufa(i,1,15),psey-vfa(i,1,15),
     + psep+ufa(i,1,25),psey-vfa(i,1,25),3)
c      Line 24'-11' and 25'-12'      
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+x_poly11,psey-y_poly11,3)
       call line(psep+ufa(i,1,25),psey-vfa(i,1,25),
     + psep+x_poly12,psey-y_poly12,3)

c      Laterals right
       call line(psep+ufa(i,npolyr+1,12),psey-vfa(i,npolyr+1,12),
     + psep+x_poly12,psey-y_poly12,3)
       do j=npolyr+1,npo-1
       call line(psep+ufa(i,j,12),psey-vfa(i,j,12),psep+ufa(i,j+1,12),
     + psey-vfa(i,j+1,12),3)
       end do
c      Laterals left
       call line(psep+ufa(i,npolyl+1,11),psey-vfa(i,npolyl+1,11),
     + psep+x_poly11,psey-y_poly11,3)
       do j=npolyl+1,npo-1
       call line(psep+ufa(i,j,11),psey-vfa(i,j,11),psep+ufa(i,j+1,11),
     + psey-vfa(i,j+1,11),3)
       end do


       end if ! ic1=2


       end if ! ic2=-4,-5

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw complete vent case ic2=4,5 (extrados)
c      Advanced generic vent...
c      Use vector csi(i,k) for transport additional interpolation data
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ic2.eq.4.or.ic2.eq.5) then

c       write(*,*) "CCCCCCCC ",xupplenew


       if (ic2.eq.4) then
c      Length vent left
       xlenl=0.0d0
       do j=1,npo-1
       xlenl=xlenl+dsqrt((ufa(i,j,9)-ufa(i,j+1,9))**2.+
     + (vfa(i,j,9)-vfa(i,j+1,9))**2.)
       end do
       xlenlr=xlenl*(1.-csi(i+1,19)/100.)

c      Length vent rigth
       xlenr=0.0d0
       do j=1,npo-1
       xlenr=xlenr+dsqrt((ufa(i,j,10)-ufa(i,j+1,10))**2.+
     + (vfa(i,j,10)-vfa(i,j+1,10))**2.)
       end do
       xlenrr=xlenr*(1.-csi(i+1,20)/100.)
       end if

       if (ic2.eq.5) then
c      Length vent left
       xlenl=0.0d0
       do j=1,npo-1
       xlenl=xlenl+dsqrt((ufa(i,j,9)-ufa(i,j+1,9))**2.+
     + (vfa(i,j,9)-vfa(i,j+1,9))**2.)
       end do
       xlenlr=xlenl*(1.-csi(i+1,19)/100.)

c      Length vent rigth
       xlenr=0.0d0
       do j=1,npo-1
       xlenr=xlenr+dsqrt((ufa(i,j,10)-ufa(i,j+1,10))**2.+
     + (vfa(i,j,10)-vfa(i,j+1,10))**2.)
       end do
       xlenrr=xlenr*(1.-csi(i+1,20)/100.)

c      Deflection parameter (vent type 5)
       param3=(csi(i+1,18)/100.)*0.5*(xlenl+xlenr)
       end if

c      Interpolate new vent init
c      Left side
       do j=1,npo
       xpoly(j)=ufa(i,j,9)
       ypoly(j)=vfa(i,j,9)
       end do
       call interpoly2d(xpoly,ypoly,x_poly,y_poly,xlenlr,1,npo,npolyl,
     + distrel)
       x_poly1=x_poly
       y_poly1=y_poly
       distrel1=distrel
c      Right side
       do j=1,npo
       xpoly(j)=ufa(i,j,10)
       ypoly(j)=vfa(i,j,10)
       end do
       call interpoly2d(xpoly,ypoly,x_poly,y_poly,xlenrr,1,npo,npolyr,
     + distrel)
       x_poly2=x_poly
       y_poly2=y_poly
       distrel2=distrel

c      USE BRUTE FORCE!!!!!!!!!!!!!!
c       csi(i,13)=xupple

c      Points 14-15
       alpha=dabs(datan((y_poly2-y_poly1)/(x_poly2-x_poly1)))
       ufa(i,1,14)=x_poly1+xupple*0.1*dsin(alpha)
       vfa(i,1,14)=y_poly1+xupple*0.1*dcos(alpha)
       ufa(i,1,15)=x_poly2+xupple*0.1*dsin(alpha)
       vfa(i,1,15)=y_poly2+xupple*0.1*dcos(alpha)

       npoly=npolyl
       if (npolyl.eq.1) then
       npoly=2
       end if       

c      Point 24'
       xru(1)=ufa(i,npolyl+1,11)
       xrv(1)=vfa(i,npolyl+1,11)
       xru(2)=ufa(i,npolyl,11)
       xrv(2)=vfa(i,npolyl,11)
       xsu(1)=ufa(i,1,14)
       xsu(2)=ufa(i,1,15)
       xsv(1)=vfa(i,1,14)
       xsv(2)=vfa(i,1,15)
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)
       ufa(i,1,24)=xtu
       vfa(i,1,24)=xtv

c      Point 11'
       x_poly11=ufa(i,npolyl,11)+(ufa(i,npolyl+1,11)-ufa(i,npolyl,11))*
     + distrel1
       y_poly11=vfa(i,npolyl,11)+(vfa(i,npolyl+1,11)-vfa(i,npolyl,11))*
     + distrel1

c      Point 12'
       x_poly12=ufa(i,npolyr,12)+(ufa(i,npolyr+1,12)-ufa(i,npolyr,12))*
     + distrel2
       y_poly12=vfa(i,npolyr,12)+(vfa(i,npolyr+1,12)-vfa(i,npolyr,12))*
     + distrel2

       npoly=npolyr
       if (nployr.eq.1) then
       npoly=2
       end if  

c      Point 25'
       xru(1)=ufa(i,npolyr+1,12)
       xrv(1)=vfa(i,npolyr+1,12)
       xru(2)=ufa(i,npolyr,12)
       xrv(2)=vfa(i,npolyr,12)
       xsu(1)=ufa(i,1,14)
       xsu(2)=ufa(i,1,15)
       xsv(1)=vfa(i,1,14)
       xsv(2)=vfa(i,1,15)
       call xrxs(xru,xrv,xsu,xsv,xtu,xtv)
       ufa(i,1,25)=xtu
       vfa(i,1,25)=xtv

c      Subcase ic1=1 (Print)
       if (ic1.eq.1) then

c      Points vent
c      Point left
       xu=x_poly1
       xv=y_poly1
       alp=abs(datan((vfa(i,npolyl+1,9)-vfa(i,npolyl,9)/
     + (ufa(i,npolyl+1,9)-ufa(i,npolyl,9)))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)   
       call pointg(psep+xu,-xv+psey,xcir,4)
c      Point right
       xu=x_poly2
       xv=y_poly2
       alp=abs(datan((vfa(i,npolyr+1,10)-vfa(i,npolyr,10)/
     + (ufa(i,npolyr+1,10)-ufa(i,npolyr,10)))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)   
       call pointg(psep+xu,-xv+psey,xcir,4)

c      Segments
c      Line 9-10
       call line(psep+ufa(i,1,9),psey-vfa(i,1,9),psep+ufa(i,1,10),
     + psey-vfa(i,1,10),1)

       if (ic2.eq.4) then
c      Line 9'-10'
       call line(psep+x_poly1,psey-y_poly1,psep+x_poly2,psey-y_poly2,1)
c      Line 14'-15'
       call line(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,1,15),psey-vfa(i,1,15),3)
       end if

       if (ic2.eq.5) then
c      Line 9'-10'
       call arcfle(psep+x_poly1,psey-y_poly1,psep+x_poly2,psey-y_poly2,
     + param3,-1,1)
c      Line 14'-15'
       call arcfle(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,1,15),psey-vfa(i,1,15),param3,-1,3)
       end if
     
c      Corners
c      Line 14'-24' and 15-25'
       call line(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,1,24),psey-vfa(i,1,24),3)
       call line(psep+ufa(i,1,15),psey-vfa(i,1,15),
     + psep+ufa(i,1,25),psey-vfa(i,1,25),3)
c      Line 24'-11' and 25'-12'      
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+x_poly11,psey-y_poly11,3)
       call line(psep+ufa(i,1,25),psey-vfa(i,1,25),
     + psep+x_poly12,psey-y_poly12,3)
c      Line 9'-11'
       call line(psep+x_poly1,psey-y_poly1,psep+x_poly11,
     + psey-y_poly11,3)
c      Line 10'-12'
       call line(psep+x_poly2,psey-y_poly2,psep+x_poly12,
     + psey-y_poly12,3)
c      Lines 9'-14' and 10'-15'
       call line(psep+x_poly1,psey-y_poly1,psep+ufa(i,1,14),
     + psey-vfa(i,1,14),3)
       call line(psep+x_poly2,psey-y_poly2,psep+ufa(i,1,15),
     + psey-vfa(i,1,15),3)

c      Laterals right
       call line(psep+ufa(i,npolyr,10),psey-vfa(i,npolyr,10),
     + psep+x_poly2,psey-y_poly2,2)
       do j=1,npolyr-1
       call line(psep+ufa(i,j,10),psey-vfa(i,j,10),psep+ufa(i,j+1,10),
     + psey-vfa(i,j+1,10),1)
       end do
       call line(psep+ufa(i,npolyr,12),psey-vfa(i,npolyr,12),
     + psep+x_poly12,psey-y_poly12,2)
       do j=1,npolyr-1
       call line(psep+ufa(i,j,12),psey-vfa(i,j,12),psep+ufa(i,j+1,12),
     + psey-vfa(i,j+1,12),3)
       end do
c      Laterals left
       call line(psep+ufa(i,npolyl,9),psey-vfa(i,npolyl,9),
     + psep+x_poly1,psey-y_poly1,2)
       do j=1,npolyl-1
       call line(psep+ufa(i,j,9),psey-vfa(i,j,9),psep+ufa(i,j+1,9),
     + psey-vfa(i,j+1,9),1)
       end do
       call line(psep+ufa(i,npolyl,11),psey-vfa(i,npolyl,11),
     + psep+x_poly11,psey-y_poly11,2)
       do j=1,npolyl-1
       call line(psep+ufa(i,j,11),psey-vfa(i,j,11),psep+ufa(i,j+1,11),
     + psey-vfa(i,j+1,11),3)
       end do

       end if ! ic1=1

c      Subcase ic1=2 (Laser)
       if (ic1.eq.2) then

c      Points vent
c      Point left
       xu=x_poly1
       xv=y_poly1
       alp=abs(datan((vfa(i,npolyl+1,9)-vfa(i,npolyl,9)/
     + (ufa(i,npolyl+1,9)-ufa(i,npolyl,9)))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)   
       call point(psep+xu,-xv+psey,7)
c      Point right
       xu=x_poly2
       xv=y_poly2
       alp=abs(datan((vfa(i,npolyr+1,10)-vfa(i,npolyr,10)/
     + (ufa(i,npolyr+1,10)-ufa(i,npolyr,10)))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)   
       call point(psep+xu,-xv+psey,7)

c      Segments
       if (ic2.eq.4) then
c      Line 14'-15'
       call line(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,1,15),psey-vfa(i,1,15),3)
       end if
       if (ic2.eq.5) then
c      Line 14'-15'
       call arcfle(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,1,15),psey-vfa(i,1,15),param3,-1,3)
       end if
     
c      Corners
c      Line 14'-24' and 15-25'
       call line(psep+ufa(i,1,14),psey-vfa(i,1,14),
     + psep+ufa(i,1,24),psey-vfa(i,1,24),3)
       call line(psep+ufa(i,1,15),psey-vfa(i,1,15),
     + psep+ufa(i,1,25),psey-vfa(i,1,25),3)
c      Line 24'-11' and 25'-12'      
       call line(psep+ufa(i,1,24),psey-vfa(i,1,24),
     + psep+x_poly11,psey-y_poly11,3)
       call line(psep+ufa(i,1,25),psey-vfa(i,1,25),
     + psep+x_poly12,psey-y_poly12,3)

c      Laterals right
       call line(psep+ufa(i,npolyr,12),psey-vfa(i,npolyr,12),
     + psep+x_poly12,psey-y_poly12,3)
       do j=1,npolyr-1
       call line(psep+ufa(i,j,12),psey-vfa(i,j,12),psep+ufa(i,j+1,12),
     + psey-vfa(i,j+1,12),3)
       end do
c      Laterals left
       call line(psep+ufa(i,npolyl,11),psey-vfa(i,npolyl,11),
     + psep+x_poly11,psey-y_poly11,3)
       do j=1,npolyl-1
       call line(psep+ufa(i,j,11),psey-vfa(i,j,11),psep+ufa(i,j+1,11),
     + psey-vfa(i,j+1,11),3)
       end do

       end if ! ic1=2

       end if ! ic2=4,5

       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE DRAW PANEL WITHOUT FIRST LIMIT
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE dpanelc1(i,uf,vf,npo,psep,psey)

       real*8 uf(0:100,500,50),vf(0:100,500,50)
       real*8 psep,psey

       do j=1,npo-1
c      Sobreamples esquerra

       call line(psep+uf(i,j,9),psey-vf(i,j,9),psep+uf(i,j+1,9),
     + psey-vf(i,j+1,9),1)

c      Sobreamples dreta

       call line(psep+uf(i,j,10),psey-vf(i,j,10),psep+uf(i,j+1,10),
     + psey-vf(i,j+1,10),1)

c      Vores de costura esquerra

       call line(psep+uf(i,j,11),psey-vf(i,j,11),psep+uf(i,j+1,11),
     + psey-vf(i,j+1,11),3)

c      Vores de costura dreta

       call line(psep+uf(i,j,12),psey-vf(i,j,12),psep+uf(i,j+1,12),
     + psey-vf(i,j+1,12),3)

       end do

c      Two horizontal segments 11-9, 10-12

       call line(psep+uf(i,npo,11),psey-vf(i,npo,11),
     + psep+uf(i,npo,9),psey-vf(i,npo,9),3)

       call line(psep+uf(i,npo,10),psey-vf(i,npo,10),
     + psep+uf(i,npo,12),psey-vf(i,npo,12),3)

c      Two vertical segments 10-15, 9-14

       call line(psep+uf(i,npo,10),psey-vf(i,npo,10),
     + psep+uf(i,npo,15),psey-vf(i,npo,15),3)
       
       call line(psep+uf(i,npo,9),psey-vf(i,npo,9),
     + psep+uf(i,npo,14),psey-vf(i,npo,14),3)

c      Two horizontal lines 14-15

       call line(psep+uf(i,npo,14),psey-vf(i,npo,14),
     + psep+uf(i,npo,15),psey-vf(i,npo,15),3)

c      Draw four corner segments

       call line(psep+uf(i,npo,14),psey-vf(i,npo,14),
     + psep+uf(i,npo,24),psey-vf(i,npo,24),3)

       call line(psep+uf(i,npo,11),psey-vf(i,npo,11),
     + psep+uf(i,npo,24),psey-vf(i,npo,24),3)

       call line(psep+uf(i,npo,15),psey-vf(i,npo,15),
     + psep+uf(i,npo,25),psey-vf(i,npo,25),3)
     
       call line(psep+uf(i,npo,12),psey-vf(i,npo,12),
     + psep+uf(i,npo,25),psey-vf(i,npo,25),3)
       
c      Init extrados
       call line(psep+uf(i,1,9),psey-vf(i,1,9),
     + psep+uf(i,1,10),psey-vf(i,1,10),1)

       call line(psep+uf(i,npo,9),psey-vf(i,npo,9),
     + psep+uf(i,npo,10),psey-vf(i,npo,10),1)
      
       return
       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE DRAW PANEL WITHOUT LAST BORDER
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE dpanelc2(i,uf,vf,npo,psep,psey)

       real*8 uf(0:100,500,50),vf(0:100,500,50)
       real*8 psep,psey

       do j=1,npo-1
c      Sobreamples esquerra

       call line(psep+uf(i,j,9),psey-vf(i,j,9),psep+uf(i,j+1,9),
     + psey-vf(i,j+1,9),1)

c      Sobreamples dreta

       call line(psep+uf(i,j,10),psey-vf(i,j,10),psep+uf(i,j+1,10),
     + psey-vf(i,j+1,10),1)

c      Vores de costura esquerra

       call line(psep+uf(i,j,11),psey-vf(i,j,11),psep+uf(i,j+1,11),
     + psey-vf(i,j+1,11),3)

c      Vores de costura dreta

       call line(psep+uf(i,j,12),psey-vf(i,j,12),psep+uf(i,j+1,12),
     + psey-vf(i,j+1,12),3)

       end do

c      Two horizontal segments 11-9, 10-12

       call line(psep+uf(i,1,11),psey-vf(i,1,11),
     + psep+uf(i,1,9),psey-vf(i,1,9),3)

       call line(psep+uf(i,1,10),psey-vf(i,1,10),
     + psep+uf(i,1,12),psey-vf(i,1,12),3)

c      Two vertical segments 10-15, 9-14

       call line(psep+uf(i,1,10),psey-vf(i,1,10),
     + psep+uf(i,1,15),psey-vf(i,1,15),3)
       
       call line(psep+uf(i,1,9),psey-vf(i,1,9),
     + psep+uf(i,1,14),psey-vf(i,1,14),3)

c      One horizontal lines 14-15

       call line(psep+uf(i,1,14),psey-vf(i,1,14),
     + psep+uf(i,1,15),psey-vf(i,1,15),3)

c      Draw four corner segments

       call line(psep+uf(i,1,14),psey-vf(i,1,14),
     + psep+uf(i,1,24),psey-vf(i,1,24),3)

       call line(psep+uf(i,1,11),psey-vf(i,1,11),
     + psep+uf(i,1,24),psey-vf(i,1,24),3)

       call line(psep+uf(i,1,15),psey-vf(i,1,15),
     + psep+uf(i,1,25),psey-vf(i,1,25),3)
     
       call line(psep+uf(i,1,12),psey-vf(i,1,12),
     + psep+uf(i,1,25),psey-vf(i,1,25),3)

c      Trailing edge extrados
       call line(psep+uf(i,1,9),psey-vf(i,1,9),
     + psep+uf(i,1,10),psey-vf(i,1,10),1)
                   
       return
       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE DRAW PANEL TYPE -2  WITHOUT LAST BORDER
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE dpanelcm2(i,uf,vf,npo,psep,psey)

       real*8 uf(0:100,500,50),vf(0:100,500,50)
       real*8 psep,psey

       do j=1,npo-1
c      Sobreamples esquerra

c       call line(psep+uf(i,j,9),psey-vf(i,j,9),psep+uf(i,j+1,9),
c     + psey-vf(i,j+1,9),1)

c      Sobreamples dreta

       call line(psep+uf(i,j,10),psey-vf(i,j,10),psep+uf(i,j+1,10),
     + psey-vf(i,j+1,10),1)

c      Vores de costura esquerra

c       call line(psep+uf(i,j,11),psey-vf(i,j,11),psep+uf(i,j+1,11),
c     + psey-vf(i,j+1,11),3)

c      Vores de costura dreta

       call line(psep+uf(i,j,12),psey-vf(i,j,12),psep+uf(i,j+1,12),
     + psey-vf(i,j+1,12),3)

       end do

c      Two horizontal segments 11-9, 10-12

c       call line(psep+uf(i,1,11),psey-vf(i,1,11),
c     + psep+uf(i,1,9),psey-vf(i,1,9),3)

       call line(psep+uf(i,1,10),psey-vf(i,1,10),
     + psep+uf(i,1,12),psey-vf(i,1,12),3)

c      Two vertical segments 10-15, 9-14

c       call line(psep+uf(i,1,10),psey-vf(i,1,10),
c     + psep+uf(i,1,15),psey-vf(i,1,15),3)
       
c       call line(psep+uf(i,1,9),psey-vf(i,1,9),
c     + psep+uf(i,1,14),psey-vf(i,1,14),3)

c      One horizontal lines 14-15

c       call line(psep+uf(i,1,14),psey-vf(i,1,14),
c     + psep+uf(i,1,15),psey-vf(i,1,15),3)

c      Draw four corner segments

c       call line(psep+uf(i,1,14),psey-vf(i,1,14),
c     + psep+uf(i,1,24),psey-vf(i,1,24),3)

c       call line(psep+uf(i,1,11),psey-vf(i,1,11),
c     + psep+uf(i,1,24),psey-vf(i,1,24),3)

c       call line(psep+uf(i,1,15),psey-vf(i,1,15),
c     + psep+uf(i,1,25),psey-vf(i,1,25),3)
     
c       call line(psep+uf(i,1,12),psey-vf(i,1,12),
c     + psep+uf(i,1,25),psey-vf(i,1,25),3)

c      Trailing edge extrados
c       call line(psep+uf(i,1,9),psey-vf(i,1,9),
c     + psep+uf(i,1,10),psey-vf(i,1,10),1)
                   
       return
       end





ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE DRAW PANEL TYPE -3  WITHOUT LAST BORDER
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE dpanelcm3(i,uf,vf,npo,psep,psey)

       real*8 uf(0:100,500,50),vf(0:100,500,50)
       real*8 psep,psey

       do j=1,npo-1
c      Sobreamples esquerra

       call line(psep+uf(i,j,9),psey-vf(i,j,9),psep+uf(i,j+1,9),
     + psey-vf(i,j+1,9),1)

c      Sobreamples dreta

c       call line(psep+uf(i,j,10),psey-vf(i,j,10),psep+uf(i,j+1,10),
c     + psey-vf(i,j+1,10),1)

c      Vores de costura esquerra

       call line(psep+uf(i,j,11),psey-vf(i,j,11),psep+uf(i,j+1,11),
     + psey-vf(i,j+1,11),3)

c      Vores de costura dreta

c       call line(psep+uf(i,j,12),psey-vf(i,j,12),psep+uf(i,j+1,12),
c     + psey-vf(i,j+1,12),3)

       end do

c      Two horizontal segments 11-9, 10-12

       call line(psep+uf(i,1,11),psey-vf(i,1,11),
     + psep+uf(i,1,9),psey-vf(i,1,9),3)

c       call line(psep+uf(i,1,10),psey-vf(i,1,10),
c     + psep+uf(i,1,12),psey-vf(i,1,12),3)

c      Two vertical segments 10-15, 9-14

c       call line(psep+uf(i,1,10),psey-vf(i,1,10),
c     + psep+uf(i,1,15),psey-vf(i,1,15),3)
       
c       call line(psep+uf(i,1,9),psey-vf(i,1,9),
c     + psep+uf(i,1,14),psey-vf(i,1,14),3)

c      One horizontal lines 14-15

c       call line(psep+uf(i,1,14),psey-vf(i,1,14),
c     + psep+uf(i,1,15),psey-vf(i,1,15),3)

c      Draw four corner segments

c       call line(psep+uf(i,1,14),psey-vf(i,1,14),
c     + psep+uf(i,1,24),psey-vf(i,1,24),3)

c       call line(psep+uf(i,1,11),psey-vf(i,1,11),
c     + psep+uf(i,1,24),psey-vf(i,1,24),3)

c       call line(psep+uf(i,1,15),psey-vf(i,1,15),
c     + psep+uf(i,1,25),psey-vf(i,1,25),3)
     
c       call line(psep+uf(i,1,12),psey-vf(i,1,12),
c     + psep+uf(i,1,25),psey-vf(i,1,25),3)

c      Trailing edge extrados
c       call line(psep+uf(i,1,9),psey-vf(i,1,9),
c     + psep+uf(i,1,10),psey-vf(i,1,10),1)
                   
       return
       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE DRAW PANEL ONLY BORDERS
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE dpanelb(i,uf,vf,npo,psep,psey)

       real*8 uf(0:100,500,50),vf(0:100,500,50)
       real*8 psep,psey

       do j=1,npo-1

c      Vores de costura esquerra

       call line(psep+uf(i,j,11),psey-vf(i,j,11),psep+uf(i,j+1,11),
     + psey-vf(i,j+1,11),3)

c      Vores de costura dreta

       call line(psep+uf(i,j,12),psey-vf(i,j,12),psep+uf(i,j+1,12),
     + psey-vf(i,j+1,12),3)

       end do

c      Draw eight corner segments

       call line(psep+uf(i,1,14),psey-vf(i,1,14),
     + psep+uf(i,1,24),psey-vf(i,1,24),3)

       call line(psep+uf(i,1,11),psey-vf(i,1,11),
     + psep+uf(i,1,24),psey-vf(i,1,24),3)

       call line(psep+uf(i,1,15),psey-vf(i,1,15),
     + psep+uf(i,1,25),psey-vf(i,1,25),3)
     
       call line(psep+uf(i,1,12),psey-vf(i,1,12),
     + psep+uf(i,1,25),psey-vf(i,1,25),3)

       call line(psep+uf(i,npo,14),psey-vf(i,npo,14),
     + psep+uf(i,npo,24),psey-vf(i,npo,24),3)

       call line(psep+uf(i,npo,11),psey-vf(i,npo,11),
     + psep+uf(i,npo,24),psey-vf(i,npo,24),3)

       call line(psep+uf(i,npo,15),psey-vf(i,npo,15),
     + psep+uf(i,npo,25),psey-vf(i,npo,25),3)
     
       call line(psep+uf(i,npo,12),psey-vf(i,npo,12),
     + psep+uf(i,npo,25),psey-vf(i,npo,25),3)

c      Trailing edge extrados
       call line(psep+uf(i,1,14),psey-vf(i,1,14),
     + psep+uf(i,1,15),psey-vf(i,1,15),3)
       
c      Init extrados
       call line(psep+uf(i,npo,14),psey-vf(i,npo,14),
     + psep+uf(i,npo,15),psey-vf(i,npo,15),3)
    
       return
       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE DRAW PANEL WITHOUT FIRST LIMIT (LASER)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE dpanelb1(i,uf,vf,npo,psep,psey)

       real*8 uf(0:100,500,50),vf(0:100,500,50)
       real*8 psep,psey

       do j=1,npo-1
  
c      Vores de costura esquerra

       call line(psep+uf(i,j,11),psey-vf(i,j,11),psep+uf(i,j+1,11),
     + psey-vf(i,j+1,11),3)

c      Vores de costura dreta

       call line(psep+uf(i,j,12),psey-vf(i,j,12),psep+uf(i,j+1,12),
     + psey-vf(i,j+1,12),3)

       end do

c      Two horizontal lines 14-15

       call line(psep+uf(i,npo,14),psey-vf(i,npo,14),
     + psep+uf(i,npo,15),psey-vf(i,npo,15),3)

c      Draw four corner segments

       call line(psep+uf(i,npo,14),psey-vf(i,npo,14),
     + psep+uf(i,npo,24),psey-vf(i,npo,24),3)

       call line(psep+uf(i,npo,11),psey-vf(i,npo,11),
     + psep+uf(i,npo,24),psey-vf(i,npo,24),3)

       call line(psep+uf(i,npo,15),psey-vf(i,npo,15),
     + psep+uf(i,npo,25),psey-vf(i,npo,25),3)
     
       call line(psep+uf(i,npo,12),psey-vf(i,npo,12),
     + psep+uf(i,npo,25),psey-vf(i,npo,25),3)
             
       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE DRAW PANEL WITHOUT LAST BORDER (LASER)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE dpanelb2(i,uf,vf,npo,psep,psey)

       real*8 uf(0:100,500,50),vf(0:100,500,50)
       real*8 psep,psey

       do j=1,npo-1

c      Vores de costura esquerra

       call line(psep+uf(i,j,11),psey-vf(i,j,11),psep+uf(i,j+1,11),
     + psey-vf(i,j+1,11),3)

c      Vores de costura dreta

       call line(psep+uf(i,j,12),psey-vf(i,j,12),psep+uf(i,j+1,12),
     + psey-vf(i,j+1,12),3)

       end do

c      One horizontal lines 14-15

       call line(psep+uf(i,1,14),psey-vf(i,1,14),
     + psep+uf(i,1,15),psey-vf(i,1,15),3)

c      Draw four corner segments

       call line(psep+uf(i,1,14),psey-vf(i,1,14),
     + psep+uf(i,1,24),psey-vf(i,1,24),3)

       call line(psep+uf(i,1,11),psey-vf(i,1,11),
     + psep+uf(i,1,24),psey-vf(i,1,24),3)

       call line(psep+uf(i,1,15),psey-vf(i,1,15),
     + psep+uf(i,1,25),psey-vf(i,1,25),3)
     
       call line(psep+uf(i,1,12),psey-vf(i,1,12),
     + psep+uf(i,1,25),psey-vf(i,1,25),3)
                   
       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE JONCS
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE joncs(i,u,v,rib,xintra,xextra,xjonc,npo,atp,np)

       real*8 u(0:100,500,99),v(0:100,500,99)
       real*8 xextra(0:100,10),xintra(0:100,10)
       real*8 xjonc(0:100,500,10),k1,k2
       real*8 x1i,x1f,x2i,x2f
       real*8 x1pi,x1pf,x2pi,x2pf
       real*8 x1,x2,x3,x4,y1,y2,y3,y4
       real*8 rib(0:100,500)
       integer np(0:100,9)
       character*2 atp

       ng=int(rib(i,166))

       if (ng.ne.0) then ! Only if rod is defined

c      Read airfoil i and detect transition segments

c      Set provisional virtual point 3 "ss"
       if (atp.eq."ss".and.xintra(ng,2).gt.rib(i,12)) then 
       
       j=np(i,2)+np(i,3)-1

       x4=u(i,j+1,3) ! safe vector
       y4=v(i,j+1,3) ! safe vector

       x1=u(i,j-1,3)
       y1=v(i,j-1,3)
       x2=u(i,j,3)
       y2=v(i,j,3)
       x3=xintra(ng,2)*rib(i,5)/100.0d0
      
       call interpola(x1,y1,x2,y2,x3,y3)
  
       u(i,j+1,3)=x3 ! modification
       v(i,j+1,3)=y3 ! modification      
       end if

c      Set initial and final points
       x1f=xextra(ng,2)*rib(i,5)/100.0d0
       x1i=xextra(ng,1)*rib(i,5)/100.0d0
       x2f=xintra(ng,2)*rib(i,5)/100.0d0
       x2i=xintra(ng,1)*rib(i,5)/100.0d0

c      Set points to explore
       if (atp.eq."ss") then 
       npunts=np(i,2)+np(i,3)-1
       end if
       if (atp.ne."ss") then 
       npunts=np(i,1)-1
       end if

       do j=1,npunts! Explore airfoil

c       do j=1,np(i,2)+np(i,3)-1

c      Final point extrados
       if (u(i,j,3).ge.x1f.and.u(i,j+1,3).lt.x1f.and.v(i,j,3).ge.0) 
     + then 
       j1f=j
       x1=u(i,j+1,3)
       y1=v(i,j+1,3)
       x2=u(i,j,3)
       y2=v(i,j,3)
       x3=x1f
       call interpola(x1,y1,x2,y2,x3,y3)
       x1pf=x3
       y1pf=y3
       end if

c      Initial point extrados
       if (u(i,j,3).ge.x1i.and.u(i,j+1,3).lt.x1i.and.v(i,j,3).ge.0) 
     + then 
       j1i=j
       x1=u(i,j+1,3)
       y1=v(i,j+1,3)
       x2=u(i,j,3)
       y2=v(i,j,3)
       x3=x1i
       call interpola(x1,y1,x2,y2,x3,y3)
       x1pi=x3
       y1pi=y3
       end if

       np1=j1i-j1f+2

c      Initial point intrados
       if (u(i,j,3).le.x2i.and.u(i,j+1,3).gt.x2i.and.v(i,j,3).lt.0) 
     + then 
       j2i=j
       x1=u(i,j,3)
       y1=v(i,j,3)
       x2=u(i,j+1,3)
       y2=v(i,j+1,3)
       x3=x2i
       call interpola(x1,y1,x2,y2,x3,y3)
       x2pi=x3
       y2pi=y3
       end if

c      Final point intrados
c      Warning amb el ge.x2f 
       if (u(i,j,3).le.x2f.and.u(i,j+1,3).ge.x2f.and.v(i,j,3).lt.0) 
     + then 
       j2f=j
       x1=u(i,j,3)
       y1=v(i,j,3)
       x2=u(i,j+1,3)
       y2=v(i,j+1,3)
       x3=x2f
       call interpola(x1,y1,x2,y2,x3,y3)
       x2pf=x3
       y2pf=y3
       end if

       np2=j1f-j1i+2

       end do   ! j in airfoil  

c      Define jonc line 0 (without deflection)
       
c      Extrados segment
       xjonc(i,j1f,1)=x1pf
       xjonc(i,j1f,2)=y1pf
       do j=j1f+1,j1i
       xjonc(i,j,1)=u(i,j,3)
       xjonc(i,j,2)=v(i,j,3)
       end do

c      Nose segment
       xjonc(i,j1i+1,1)=x1pi
       xjonc(i,j1i+1,2)=y1pi
       do j=j1i+1,j2i
       xjonc(i,j+1,1)=u(i,j,3)
       xjonc(i,j+1,2)=v(i,j,3)
       end do

c      Intrados segment
       xjonc(i,j2i+2,1)=x2pi
       xjonc(i,j2i+2,2)=y2pi
       do j=j2i+1,j2f
       xjonc(i,j+2,1)=u(i,j,3)
       xjonc(i,j+2,2)=v(i,j,3)
       end do
       xjonc(i,j2f+3,1)=x2pf
       xjonc(i,j2f+3,2)=y2pf

       npo=j2f-j1f+4

c      Add jonc deflections
       k1=(xextra(ng,3)*rib(i,5)/100.0d0)/((x1f-x1i)**xextra(ng,4))
       k2=(xintra(ng,3)*rib(i,5)/100.0d0)/((x2f-x2i)**xintra(ng,4))

       do j=j1i+1,j1f,-1
       xjonc(i,j,2)=xjonc(i,j,2)-k1*((xjonc(i,j,1))-x1i)**xextra(ng,4)
       end do

       do j=j2i+2,j2f+3
       xjonc(i,j,2)=xjonc(i,j,2)+k2*((xjonc(i,j,1))-x2i)**xintra(ng,4)
       end do

c      Reformat jonc
       do j=1,npo
       xjonc(i,j,3)=xjonc(i,j+j1f-1,1)
       xjonc(i,j,4)=xjonc(i,j+j1f-1,2)
       end do

c      Reformat jonc again (change name)
       do j=1,npo
       xjonc(i,j,1)=xjonc(i,j,3)
       xjonc(i,j,2)=xjonc(i,j,4)
       end do

c      Restitution of virtual point 3
       if (atp.eq."ss".and.xintra(ng,2).gt.rib(i,12)) then 
       j=np(i,2)+np(i,3)-1
       u(i,j+1,3)=x4
       v(i,j+1,3)=y4
       end if
  
       end if ! ng.ne.0

       return
       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE JONCS TYPE 3
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE joncst3(i,u,v,rib,xintra,xextra,xjonc,npo,atp,np)

       real*8 u(0:100,500,99),v(0:100,500,99)
       real*8 xextra(0:100,10),xintra(0:100,10)
       real*8 xjonc(0:100,500,10),k1,k2
       real*8 x1i,x1f,x2i,x2f
       real*8 x1pi,x1pf,x2pi,x2pf
       real*8 x1,x2,x3,x4,y1,y2,y3,y4
       real*8 rib(0:100,500)
       integer np(0:100,9)
       character*2 atp

       ng=int(rib(i,166))

       if (ng.ne.0) then ! Only if rod is defined

c      Read airfoil i and detect transition segments

c      Set provisional virtual point 3 "ss"
       if (atp.eq."ss".and.xintra(ng,2).gt.rib(i,12)) then 
       
       j=np(i,2)+np(i,3)-1 ! vent out

       x4=u(i,j+1,3) ! safe vector
       y4=v(i,j+1,3) ! safe vector

       x1=u(i,j-1,3)
       y1=v(i,j-1,3)
       x2=u(i,j,3)
       y2=v(i,j,3)
       x3=xintra(ng,2)*rib(i,5)/100.0d0
      
       call interpola(x1,y1,x2,y2,x3,y3)
  
       u(i,j+1,3)=x3 ! modification
       v(i,j+1,3)=y3 ! modification      
       end if

c      Set initial and final points
       x1f=xextra(ng,2)*rib(i,5)/100.0d0
       x1i=xextra(ng,1)*rib(i,5)/100.0d0
       x2f=xintra(ng,2)*rib(i,5)/100.0d0
       x2i=xintra(ng,1)*rib(i,5)/100.0d0

c      Set points to explore
       if (atp.eq."ss") then ! Explore extrados and inlet
       npunts=np(i,2)+np(i,3)-1
       end if
       if (atp.ne."ss") then ! Explore all airfoil
       npunts=np(i,1)-1
       end if

       do j=1,npunts! Explore airfoil

c       do j=1,np(i,2)+np(i,3)-1

c      Final point extrados x1pf
       if (u(i,j,3).ge.x1f.and.u(i,j+1,3).lt.x1f.and.v(i,j,3).ge.0) 
     + then 
       j1f=j
       x1=u(i,j+1,3)
       y1=v(i,j+1,3)
       x2=u(i,j,3)
       y2=v(i,j,3)
       x3=x1f
       call interpola(x1,y1,x2,y2,x3,y3)
       x1pf=x3
       y1pf=y3
       end if

c      Initial point extrados x1pi
       if (u(i,j,3).ge.x1i.and.u(i,j+1,3).lt.x1i.and.v(i,j,3).ge.0) 
     + then 
       j1i=j
       x1=u(i,j+1,3)
       y1=v(i,j+1,3)
       x2=u(i,j,3)
       y2=v(i,j,3)
       x3=x1i
       call interpola(x1,y1,x2,y2,x3,y3)
       x1pi=x3
       y1pi=y3
       end if

       np1=j1i-j1f+2 ! Points in extra modificacion

c      Initial point intrados
       if (u(i,j,3).le.x2i.and.u(i,j+1,3).gt.x2i.and.v(i,j,3).lt.0) 
     + then 
       j2i=j
       x1=u(i,j,3)
       y1=v(i,j,3)
       x2=u(i,j+1,3)
       y2=v(i,j+1,3)
       x3=x2i
       call interpola(x1,y1,x2,y2,x3,y3)
       x2pi=x3
       y2pi=y3
       end if

c      Final point intrados
c      Warning amb el ge.x2f 
       if (u(i,j,3).le.x2f.and.u(i,j+1,3).ge.x2f.and.v(i,j,3).lt.0) 
     + then 
       j2f=j
       x1=u(i,j,3)
       y1=v(i,j,3)
       x2=u(i,j+1,3)
       y2=v(i,j+1,3)
       x3=x2f
       call interpola(x1,y1,x2,y2,x3,y3)
       x2pf=x3
       y2pf=y3
       end if

       np2=j1f-j1i+2 ! Points in intr modification

       end do   ! j in airfoil  

c      Define jonc line 0 (without deflection)
       
c      Extrados segment
       xjonc(i,j1f,1)=x1pf
       xjonc(i,j1f,2)=y1pf
       do j=j1f+1,j1i
       xjonc(i,j,1)=u(i,j,3)
       xjonc(i,j,2)=v(i,j,3)
       end do

c      Nose segment
       xjonc(i,j1i+1,1)=x1pi
       xjonc(i,j1i+1,2)=y1pi
       do j=j1i+1,j2i
       xjonc(i,j+1,1)=u(i,j,3)
       xjonc(i,j+1,2)=v(i,j,3)
       end do

c      Intrados segment
       xjonc(i,j2i+2,1)=x2pi
       xjonc(i,j2i+2,2)=y2pi
       do j=j2i+1,j2f
       xjonc(i,j+2,1)=u(i,j,3)
       xjonc(i,j+2,2)=v(i,j,3)
       end do
       xjonc(i,j2f+3,1)=x2pf
       xjonc(i,j2f+3,2)=y2pf

       npo=j2f-j1f+4

c      Add jonc deflections
       k1=(xextra(ng,3)*rib(i,5)/100.0d0)/((x1f-x1i)**xextra(ng,4))
       k2=(xintra(ng,3)*rib(i,5)/100.0d0)/((x2f-x2i)**xintra(ng,4))

       do j=j1i+1,j1f,-1
       xjonc(i,j,2)=xjonc(i,j,2)-k1*((xjonc(i,j,1))-x1i)**xextra(ng,4)
       end do

       do j=j2i+2,j2f+3
       xjonc(i,j,2)=xjonc(i,j,2)+k2*((xjonc(i,j,1))-x2i)**xintra(ng,4)
       end do

c      Reformat jonc
       do j=1,npo
       xjonc(i,j,3)=xjonc(i,j+j1f-1,1)
       xjonc(i,j,4)=xjonc(i,j+j1f-1,2)
       end do

c      Reformat jonc again (change name)
       do j=1,npo
       xjonc(i,j,1)=xjonc(i,j,3)
       xjonc(i,j,2)=xjonc(i,j,4)
       end do

c      Restitution of virtual point 3
       if (atp.eq."ss".and.xintra(ng,2).gt.rib(i,12)) then 
       j=np(i,2)+np(i,3)-1
       u(i,j+1,3)=x4
       v(i,j+1,3)=y4
       end if
  
       end if ! ng.ne.0

       return
       end



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE JONCS2
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE joncs2(i,u,v,rib,x21,xjonc,nparc,atp,np,m,ng)

       real*8 u(0:100,500,99),v(0:100,500,99)
       real*8 x21(20,100,20)
       real*8 xjonc(0:100,500,10),k1,k2
       real*8 x1i,x1f,x2i,x2f
       real*8 x1pi,x1pf,x2pi,x2pf
       real*8 x0,y0,x1,x2,x3,x4,y1,y2,y3,y4
       real*8 b,c,d,f,g,xp231,xp221,xp012,xp013
       real*8 dx,dy,alpha,radi,pi,xsign,xsign2
       real*8 rib(0:100,500)
       integer np(0:100,9)
       character*2 atp

       dx=(x21(m,ng,3)-x21(m,ng,1))/dfloat(nparc-1)
       dy=(x21(m,ng,4)-x21(m,ng,2))/dfloat(nparc-1)
       pi=4.0d0*datan(1.0d0)
       
c      Define straight rod
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (dabs(x21(m,ng,5)).lt.0.01) then
       do j=1,nparc
       xjonc(i,j,1)=(x21(m,ng,1)+dx*dfloat(j-1))*rib(i,5)/100.0d0
       xjonc(i,j,2)=(x21(m,ng,2)+dy*dfloat(j-1))*rib(i,5)/100.0d0
       end do
       rib(i,167)=(rib(i,5)/100.0)*dsqrt((x21(m,ng,3)-x21(m,ng,1))**2.+
     + (x21(m,ng,4)-x21(m,ng,2))**2.)
       end if

c      Define an arc jonc
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (dabs(x21(m,ng,5)).ge.0.01) then

c      Control signs
       if (x21(m,ng,5).gt.0.01) then
       xsign=1.0d0
       end if
       if (x21(m,ng,5).le.-0.01) then
       xsign=-1.0d0
       end if
       if (x21(m,ng,2).gt.x21(m,ng,4)) then
       xsign2=1.0d0
       end if
       if (x21(m,ng,2).lt.x21(m,ng,4)) then
       xsign2=-1.0d0
       end if
       if (x21(m,ng,2).gt.x21(m,ng,4).and.x21(m,ng,3).gt.x21(m,ng,1)) 
     + then
       xsign3=-1.0d0
       end if
       if (x21(m,ng,2).gt.x21(m,ng,4).and.x21(m,ng,3).lt.x21(m,ng,1))
     + then
       xsign3=1.0d0
       end if

c      Segment 1-4-2
       x1=x21(m,ng,1)
       y1=x21(m,ng,2)
       x2=x21(m,ng,3)
       y2=x21(m,ng,4)
       x4=(x1+x2)*0.5
       y4=(y1+y2)*0.5

c      Point 3 
c       x3=x4-dabs(x21(m,ng,5))*dsin(alpha)
c       y3=y4+dabs(x21(m,ng,5))*dcos(alpha)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case segmentation in y axis
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (dabs(y2-y1).gt.dabs(x2-x1)) then

       alpha=datan((y2-y1)/(x2-x1))

       if (x1.eq.x2.and.y2.gt.y1) then
       alpha=-pi/2.0d0
       end if

       if (x1.eq.x2.and.y2.lt.y1) then
       alpha=pi/2.0d0
       end if

c      Circle by tree points, geometric method
       d=0.5d0*dsqrt((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1))
       f=dabs(x21(m,ng,5))
       radi=(f*f+d*d)/(2.0d0*f)
       g=radi-f
       x0=x4+xsign*g*dsin(alpha)
       y0=y4-xsign*g*dcos(alpha)

       do j=1,nparc
       xjonc(i,j,2)=(x21(m,ng,2)+dy*dfloat(j-1))
       b=-2.*x0
       c=x0*x0+xjonc(i,j,2)*xjonc(i,j,2)-2*xjonc(i,j,2)*y0+y0*y0-
     + radi*radi
       xjonc(i,j,1)=(-b-xsign*xsign2*xsign3*dsqrt(b*b-4.*c))/2.0d0
       end do

       end if ! case y-axis

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case segmentation in x axis
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (dabs(y2-y1).le.dabs(x2-x1)) then

       alpha=datan((y2-y1)/(x2-x1))

c      Circle by tree points, geometric method
       d=0.5d0*dsqrt((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1))
       f=dabs(x21(m,ng,5))
       radi=(f*f+d*d)/(2.0d0*f)
       g=radi-f
       x0=x4+xsign*g*dsin(alpha)
       y0=y4-xsign*g*dcos(alpha)

       do j=1,nparc
       xjonc(i,j,1)=(x21(m,ng,1)+dx*dfloat(j-1))
       b=-2.*y0
       c=x0*x0+xjonc(i,j,1)*xjonc(i,j,1)-2*xjonc(i,j,1)*x0+y0*y0-
     + radi*radi
       xjonc(i,j,2)=(-b+xsign*dsqrt(b*b-4.*c))/2.0d0
       end do

       end if ! case x-axis

c      Set to scale
       do j=1,nparc
       xjonc(i,j,1)=xjonc(i,j,1)*rib(i,5)/100.0d0
       xjonc(i,j,2)=xjonc(i,j,2)*rib(i,5)/100.0d0
       end do

       end if ! case circle

       return

       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE LINEAL INTERPOLATION
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE interpola(x1,y1,x2,y2,x3,y3)

       real*8 x1,y1,x2,y2,x3,y3,xm,xb

       xm=(y2-y1)/(x2-x1)
       xb=y2-xm*x2
       y3=xm*x3+xb

       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE LINEAL INTERPOLATION AT DISTANCE D
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE interpd(x1,y1,x2,y2,x3,y3,xd)

       real*8 x1,y1,x2,y2,x3,y3
       real*8 xd,xdx,xdy,xd13,yd13,xdi

       xdx=x2-x1
       xdy=y2-y1
       xdi=dsqrt((x2-x1)**2.0d0+(y2-y1)**2.0d0)

       if (xdi.ne.0.0d0) then
       xd13=xdx*xd/xdi
       yd13=xdy*xd/xdi
       x3=x1+xd13
       y3=y1+yd13
       else
       x3=x1
       y3=y1
       end if

c       write (*,*) i,xd,xdi,x3,y3

       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE PRINT JONCS
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE pjoncs(i,xjonc,npo,sjo,sepx,sepy,rib,xkf)

       real*8 xjonc(0:100,500,10),sjo(0:100,10),sepx,sepy
       real*8 rib(0:100,500),joini(0:100,10),jofin(0:100,10)
       real*8 uo(500,2),vo(500,2)
       real*8 xo,x1,x2,x3,x4,y1,y2,y3,y4,xkf,xad4,xad7

       integer typm1(50),typm4(50)
       real*8 typm2(50),typm3(50),typm5(50),typm6(50),xcir,alpha
       common /markstypes/ typm1,typm2,typm3,typm4,typm5,typm6

       xcir=0.1d0*typm2(1)
       xad4=2530.0d0*xkf
       xad7=1260.0d0*5.0d0*xkf

       ng=rib(i,166)

c      Jonc length
       rib(i,167)=0.0d0
       do j=1,npo-1
       rib(i,167)=rib(i,167)+sqrt(((xjonc(i,j+1,1)-xjonc(i,j,1))**2)+
     + ((xjonc(i,j+1,2)-xjonc(i,j,2))**2))
       end do
       
c      Load jonc base line
       do j=1,npo+1
       uo(j,1)=xjonc(i,j,1)
       vo(j,1)=xjonc(i,j,2)
       end do

c      Print line 1 (jonc)
       xo=-sjo(ng,1)
       call loffset(uo,vo,npo,xo)
       do j=1,npo-1
       call line(sepx+uo(j,2),sepy-vo(j,2),
     + sepx+uo(j+1,2),sepy-vo(j+1,2),150)
       end do

c      Print init and final point
       call point(sepx+uo(1,2),sepy-vo(1,2),160)
       call point(sepx+uo(j,2),sepy-vo(j,2),160)
       call point(2530.*xkf+sepx+uo(1,2),sepy-vo(1,2),160)
       call point(2530.*xkf+sepx+uo(j,2),sepy-vo(j,2),160)


       x1=uo(1,2)
       y1=vo(1,2)
       x4=uo(npo,2)
       y4=vo(npo,2)

c      Print line 2 (jonc)
       xo=-(sjo(ng,1)+sjo(ng,3))
       call loffset(uo,vo,npo,xo)
       do j=1,npo-1
       call line(sepx+uo(j,2),sepy-vo(j,2),
     + sepx+uo(j+1,2),sepy-vo(j+1,2),150)
       end do

c      Print init and final point
       call point(sepx+uo(1,2),sepy-vo(1,2),160)
       call point(sepx+uo(j,2),sepy-vo(j,2),160)
       call point(2530.*xkf+sepx+uo(1,2),sepy-vo(1,2),160)
       call point(2530.*xkf+sepx+uo(j,2),sepy-vo(j,2),160)

       x2=uo(1,2)
       y2=vo(1,2)
       x3=uo(npo,2)
       y3=vo(npo,2)

c      Joncs points ini and fin
       joini(i,1)=0.5d0*(x1+x2)
       joini(i,2)=0.5d0*(y1+y2)
       jofin(i,1)=0.5d0*(x3+x4)
       jofin(i,2)=0.5d0*(y3+y4)

c      Print line 3
       xo=sjo(ng,2)-sjo(ng,1)
       call loffset(uo,vo,npo,xo)
       do j=1,npo-1
       call line(sepx+uo(j,2),sepy-vo(j,2),      ! BOX(1,2)
     + sepx+uo(j+1,2),sepy-vo(j+1,2),30)
       call line(sepx+uo(j,2)+xad7,sepy-vo(j,2), ! BOX(1,7)
     + sepx+uo(j+1,2)+xad7,sepy-vo(j+1,2),30)
       end do

       x1=uo(1,2)
       y1=vo(1,2)
       x4=uo(npo,2)
       y4=vo(npo,2)

c      Print line 4
       xo=-(sjo(ng,1)+sjo(ng,3)+sjo(ng,4))
       call loffset(uo,vo,npo,xo)
       do j=1,npo-1
       call line(sepx+uo(j,2),sepy-vo(j,2),      ! BOX(1,2)
     + sepx+uo(j+1,2),sepy-vo(j+1,2),30)
       call line(sepx+uo(j,2)+xad7,sepy-vo(j,2), ! BOX(1,7)
     + sepx+uo(j+1,2)+xad7,sepy-vo(j+1,2),30)

       end do

       x2=uo(1,2)
       y2=vo(1,2)
       x3=uo(npo,2)
       y3=vo(npo,2)

c      BOX(1,2)
       call line(sepx+x1,sepy-y1,sepx+x2,sepy-y2,30)
       call line(sepx+x3,sepy-y3,sepx+x4,sepy-y4,30)

c      Print points jonc ini and fin BOX(1,2)
c       call pointg(sepx+joini(i,1),sepy-joini(i,2),xcir,150)
c       call pointg(sepx+jofin(i,1),sepy-jofin(i,2),xcir,150)

c      Laser cuting BOX(1,4)
c       call point(sepx+joini(i,1)+xad4,sepy-joini(i,2),150)
c       call point(sepx+jofin(i,1)+xad4,sepy-jofin(i,2),150)

c      BOX(1,7)
       call line(sepx+x1+xad7,sepy-y1,sepx+x2+xad7,sepy-y2,30)
       call line(sepx+x3+xad7,sepy-y3,sepx+x4+xad7,sepy-y4,30)


c      Romano number in jonc BOX(1,7)
       if (typm5(9).gt.0.01d0) then
       ijo=dint(dfloat(npo)*0.25d0)
       alpha=datan((xjonc(i,ijo,2)-xjonc(i,ijo-1,2))/
     + (xjonc(i,ijo,1)-xjonc(i,ijo-1,1)))
       call romano(i,sepx+xad7+xjonc(i,ijo,1),sepy-xjonc(i,ijo,2),
     + alpha,typm5(9)*0.1,30)
       end if

       return
       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE PRINT JONCS2
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE pjoncs2(i,xjonc,nparc,sjo,sepx,sepy,rib,xkf)

       real*8 xjonc(0:100,500,10),sjo(0:100,10),sepx,sepy
       real*8 rib(0:100,500),joini(0:100,10),jofin(0:100,10)
       real*8 uo(500,2),vo(500,2)
       real*8 xo,x1,x2,x3,x4,y1,y2,y3,y4,xkf,xad4,xad7,alpha

       integer typm1(50),typm4(50)
       real*8 typm2(50),typm3(50),typm5(50),typm6(50),xcir
       common /markstypes/ typm1,typm2,typm3,typm4,typm5,typm6

       xcir=0.1d0*typm2(1)
       xad4=2530.0d0*xkf
       xad7=1260.0d0*5.0d0*xkf

       ng=rib(i,166)
       npo=nparc

c      Jonc length
       rib(i,167)=0.0d0
       do j=1,npo-1
       rib(i,167)=rib(i,167)+sqrt(((xjonc(i,j+1,1)-xjonc(i,j,1))**2)+
     + ((xjonc(i,j+1,2)-xjonc(i,j,2))**2))
       end do
       
c      Load jonc base line
       do j=1,npo+1
       uo(j,1)=xjonc(i,j,1)
       vo(j,1)=xjonc(i,j,2)
       end do
c      Print line 1
       xo=-sjo(ng,3)/2.0d0
       call loffset2(uo,vo,npo,xo)
       do j=1,npo-1
       call line(sepx+uo(j,2),sepy-vo(j,2),
     + sepx+uo(j+1,2),sepy-vo(j+1,2),150)
       end do

c      Print init and final point
       call point(sepx+uo(1,2),sepy-vo(1,2),160)
       call point(sepx+uo(j,2),sepy-vo(j,2),160)
       call point(2530.*xkf+sepx+uo(1,2),sepy-vo(1,2),160)
       call point(2530.*xkf+sepx+uo(j,2),sepy-vo(j,2),160)

c      Load jonc base line
       do j=1,npo+1
       uo(j,1)=xjonc(i,j,1)
       vo(j,1)=xjonc(i,j,2)
       end do
c      Print line 2
       xo=sjo(ng,3)/2.0d0
       call loffset2(uo,vo,npo,xo)
       do j=1,npo-1
       call line(sepx+uo(j,2),sepy-vo(j,2),   ! BOX(1,2)
     + sepx+uo(j+1,2),sepy-vo(j+1,2),150)
       end do

c      Print init and final point
       call point(sepx+uo(1,2),sepy-vo(1,2),160)
       call point(sepx+uo(j,2),sepy-vo(j,2),160)
       call point(2530.*xkf+sepx+uo(1,2),sepy-vo(1,2),160)
       call point(2530.*xkf+sepx+uo(j,2),sepy-vo(j,2),160)

c      Load jonc base line
       do j=1,npo+1
       uo(j,1)=xjonc(i,j,1)
       vo(j,1)=xjonc(i,j,2)
       end do
c      Print line 3
       xo=-sjo(ng,3)/2.0d0-sjo(ng,2)
       call loffset2(uo,vo,npo,xo)
       do j=1,npo-1
       call line(sepx+uo(j,2),sepy-vo(j,2),      ! BOX(1,2)
     + sepx+uo(j+1,2),sepy-vo(j+1,2),30)
       call line(sepx+uo(j,2)+xad7,sepy-vo(j,2), ! BOX(1,7)
     + sepx+uo(j+1,2)+xad7,sepy-vo(j+1,2),10)
       end do

       x1=uo(1,2)
       y1=vo(1,2)
       x4=uo(npo,2)
       y4=vo(npo,2)

c      Load jonc base line
       do j=1,npo+1
       uo(j,1)=xjonc(i,j,1)
       vo(j,1)=xjonc(i,j,2)
       end do
c      Print line 4
       xo=sjo(ng,3)/2.0d0+sjo(ng,4)
       call loffset2(uo,vo,npo,xo)
       do j=1,npo-1
       call line(sepx+uo(j,2),sepy-vo(j,2),      ! BOX(1,2)
     + sepx+uo(j+1,2),sepy-vo(j+1,2),30)
       call line(sepx+uo(j,2)+xad7,sepy-vo(j,2), ! BOX(1,7)
     + sepx+uo(j+1,2)+xad7,sepy-vo(j+1,2),10)
       end do

       x2=uo(1,2)
       y2=vo(1,2)
       x3=uo(npo,2)
       y3=vo(npo,2)

c      Print end and final segments
       call line(sepx+x1,sepy-y1,      ! BOX(1,2)
     + sepx+x2,sepy-y2,30)
       call line(sepx+x1+xad7,sepy-y1, ! BOX(1,7)
     + sepx+x2+xad7,sepy-y2,10)
       call line(sepx+x3,sepy-y3,      ! BOX(1,2)
     + sepx+x4,sepy-y4,30)
       call line(sepx+x3+xad7,sepy-y3, ! BOX(1,7)
     + sepx+x4+xad7,sepy-y4,10)

c      Joncs points ini and fin
       joini(i,1)=0.5d0*(x1+x2)
       joini(i,2)=0.5d0*(y1+y2)
       jofin(i,1)=0.5d0*(x3+x4)
       jofin(i,2)=0.5d0*(y3+y4)

c      Print points jonc ini and fin BOX(1,2)
c       call pointg(sepx+joini(i,1),sepy-joini(i,2),xcir,150)
c       call pointg(sepx+jofin(i,1),sepy-jofin(i,2),xcir,150)

c      Laser cuting BOX(1,4)
c       call point(sepx+joini(i,1)+xad4,sepy-joini(i,2),150)
c       call point(sepx+jofin(i,1)+xad4,sepy-jofin(i,2),150)

c      Print romano points BOX(1,7) -exp-
c       call romanop(i,1,sepx+uo(1,1)+xad7,sepy-vo(1,1), ! BOX(1,7)
c     + sepx+uo(npo,1)+xad7,sepy-vo(npo,1),0,0,0,xkf)


c      Romano number in jonc BOX(1,7)
       if (typm5(9).gt.0.01d0) then
       ijo=dint(dfloat(npo)*0.25d0)
       alpha=datan((xjonc(i,ijo,2)-xjonc(i,ijo-1,2))/
     + (xjonc(i,ijo,1)-xjonc(i,ijo-1,1)))
       call romano(i,sepx+xad7+xjonc(i,ijo,1),sepy-xjonc(i,ijo,2),
     + alpha,typm5(9)*0.1,10)
       end if

       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE LINE OFFSET
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE loffset(uo,vo,npo,xo)

       real*8 uo(500,2),vo(500,2)
       real*8 xo,alpha1,alpha2,alpha

       do j=1,npo

c      Angle alpha
       if (j.eq.1) then
       alpha=(datan((vo(j+1,1)-vo(j,1))/
     + (uo(j+1,1)-uo(j,1))))
       end if
       if (j.ge.2.and.j.lt.npo) then
       alpha1=(datan((vo(j+1,1)-vo(j,1))/
     + (uo(j+1,1)-uo(j,1))))
       alpha2=(datan((vo(j,1)-vo(j-1,1))/
     + (uo(j,1)-uo(j-1,1))))
       alpha=0.5*(alpha1+alpha2)
       end if
       if (j.eq.npo) then
       alpha=(datan((vo(j,1)-vo(j-2,1))/
     + (uo(j,1)-uo(j-2,1))))
       end if

c      OFFSET OTION 1 IS OK
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Offset points

       if(vo(j,1).ge.0.0d0) then
       uo(j,2)=uo(j,1)-xo*0.1d0*dsin(alpha)
       vo(j,2)=vo(j,1)+xo*0.1d0*dcos(alpha)
       end if

       if(vo(j,1).ge.0.0d0.and.uo(j,1).gt.uo(j-1,1).and.j.gt.1) then
       uo(j,2)=uo(j,1)+xo*0.1d0*dsin(alpha)
       vo(j,2)=vo(j,1)-xo*0.1d0*dcos(alpha)
       end if

       if(vo(j,1).lt.0.0d0) then
       uo(j,2)=uo(j,1)+xo*0.1d0*dsin(alpha)
       vo(j,2)=vo(j,1)-xo*0.1d0*dcos(alpha)
       end if

       if(uo(j,1).eq.0.0d0) then
       uo(j,2)=uo(j,1)-xo*0.1d0
       vo(j,2)=vo(j,1)
       end if
c       OPTION 1

c      OFFSET  OTION 2 IS IN TEST
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c       if(uo(j,1).gt.uo(j+1,1).or.uo(j,1).eq.0.0d0) then
c       uo(j,2)=uo(j,1)+xo*0.1d0*dsin(alpha)
c       vo(j,2)=vo(j,1)-xo*0.1d0*dcos(alpha)
c       end if

c       if(uo(j,1).lt.uo(j+1,1)) then
c       uo(j,2)=uo(j,1)-xo*0.1d0*dsin(alpha)
c       vo(j,2)=vo(j,1)+xo*0.1d0*dcos(alpha)
c       end if

c       if(uo(j,npo).lt.uo(npo-1,1)) then
c       uo(npo,2)=uo(npo,1)-xo*0.1d0*dsin(alpha)
c       vo(npo,2)=vo(npo,1)+xo*0.1d0*dcos(alpha)
c       end if
c      OPTION 2 TEST

c       if (j.eq.24) then
c       write (*,*) "SUP", j,uo(j,2),uo(j,1),vo(j,2),vo(j,1),alpha
c       end if

       end do ! j

       return

       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE LINE OFFSET2
c      Another version
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE loffset2(uo,vo,npo,xo)

       real*8 uo(500,2),vo(500,2)
       real*8 xo,alpha1,alpha2,alpha,alphaa,xsign
      
       xsign=-1.0d0
       pi=4.0d0*datan(1.0d0)

       do j=1,npo

c      Angle alpha definition and corrections
       if (j.eq.1) then
       alpha=(datan((vo(j+1,1)-vo(j,1))/
     + (uo(j+1,1)-uo(j,1))))
       end if
       if (j.ge.2.and.j.lt.npo) then
       alpha=(datan((vo(j+1,1)-vo(j,1))/
     + (uo(j+1,1)-uo(j,1))))
       end if
       if (j.eq.npo) then
       alpha=(datan((vo(j,1)-vo(j-1,1))/
     + (uo(j,1)-uo(j-1,1))))
       end if
c      Correction when x increasing       
       if (uo(j+1,1).ge.uo(j,1).and.j.lt.npo) then
       alpha=alpha-pi
       end if
       if (uo(j,1).ge.uo(j-1,1).and.j.eq.npo) then
       alpha=alpha-pi
       end if

c      Definition of displaced points
       uo(j,2)=uo(j,1)+xo*xsign*0.1d0*dsin(alpha)
       vo(j,2)=vo(j,1)-xo*xsign*0.1d0*dcos(alpha)
       
c       write (*,*) j," fi ",alpha,(uo(j+1,1)-uo(j,1))*1000.,
c     + uo(j,2),vo(j,2)

       end do

       return

       end




ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE PUNTS LATERALS
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE puntslat(i,pulat1x,pulat1y,pulat2x,pulat2y,npulati,
     + npulatf,latu,latv,xupp,latsgn)

       real*8 pulat1x(0:100,500),pulat1y(0:100,500),pulat2x(0:100,500),
     + pulat2y(0:100,500)
       real*8 latu(0:100,500,99),latv(0:100,500,99),xdu,xdv
       real*8 siu(0:500),siv(0:500),alplat,xupp
       integer npulati,npulatf,npulatflatsgn

c      Calcula punts esquerra (-1)

       if (latsgn.eq.-1) then

       do j=npulati,npulatf

       xdv=(pulat2y(i,j)-pulat1y(i,j))
       xdu=(pulat2x(i,j)-pulat1x(i,j))

       if (xdv.ne.0.) then
       alplat=abs(datan((pulat2y(i,j)-pulat1y(i,j))/(pulat2x(i,j)-
     + pulat1x(i,j))))
       else
       alplat=2.*datan(1.0d0)
       end if

       if (xdu.ge.0.and.xdv.ge.0) then ! case 2-I
       siu(j)=-1.
       siv(j)=1.
       end if
       if (xdu.le.0.and.xdv.ge.0) then ! case 2-II
       siu(j)=-1.
       siv(j)=-1.
       end if
       if (xdu.ge.0.and.xdv.le.0) then ! case 2-III
       siu(j)=1.
       siv(j)=1.
       end if
       if (xdu.le.0.and.xdv.le.0) then ! case 2-IV
       siu(j)=1.
       siv(j)=-1.
       end if

       latu(i,j+1,9)=pulat2x(i,j)+siu(j)*latv(i,j+1,7)*dsin(alplat)
       latv(i,j+1,9)=pulat2y(i,j)+siv(j)*latv(i,j+1,7)*dcos(alplat)

       latu(i,j+1,11)=latu(i,j+1,9)+siu(j)*xupp*0.1*dsin(alplat)
       latv(i,j+1,11)=latv(i,j+1,9)+siv(j)*xupp*0.1*dcos(alplat)

c      Set central panel
       if (i.eq.1) then
      


       end if

c      Impresió de control
c       if (j.eq.10) then
c       write (*,*) "BBB ",i,latu(i,j+1,9),latv(i,j+1,9)
c       end if

       end do ! j

c      Punt inicial

       j=npulati
       
       alplat=abs(datan((pulat2y(i,j)-pulat1y(i,j))/
     + (pulat2x(i,j)-pulat1x(i,j))))

c      Potser hauria de ser pl1x i pl1y???? Yes
       latu(i,j,9)=pulat1x(i,j)+siu(j)*latv(i,j,7)*dsin(alplat)
       latv(i,j,9)=pulat1y(i,j)+siv(j)*latv(i,j,7)*dcos(alplat)

       latu(i,j,11)=latu(i,j,9)+siu(j)*xupp*0.1*dsin(alplat)
       latv(i,j,11)=latv(i,j,9)+siv(j)*xupp*0.1*dcos(alplat)

       end if ! Punts esquerra (-1)


c      Calcula punts dreta (1)

       if (latsgn.eq.1) then

       do j=npulati,npulatf

       xdv=(pulat2y(i,j)-pulat1y(i,j))
       xdu=(pulat2x(i,j)-pulat1x(i,j))

       if (xdv.ne.0.) then
       alplat=abs(datan((pulat2y(i,j)-pulat1y(i,j))/(pulat2x(i,j)-
     + pulat1x(i,j))))
       else
       alplat=2.*datan(1.0d0)
       end if

       if (xdu.ge.0.and.xdv.ge.0) then ! case 3-I
       siu(j)=1.
       siv(j)=-1.
       end if
       if (xdu.le.0.and.xdv.ge.0) then ! case 3-II
       siu(j)=1.
       siv(j)=1.
       end if
       if (xdu.ge.0.and.xdv.le.0) then ! case 3-III
       siu(j)=-1.
       siv(j)=-1.
       end if
       if (xdu.le.0.and.xdv.le.0) then ! case 3-IV
       siu(j)=-1.
       siv(j)=1.
       end if

       latu(i,j+1,10)=pulat2x(i,j)+siu(j)*latv(i,j+1,8)*dsin(alplat)
       latv(i,j+1,10)=pulat2y(i,j)+siv(j)*latv(i,j+1,8)*dcos(alplat)

       latu(i,j+1,12)=latu(i,j+1,10)+siu(j)*xupp*0.1*dsin(alplat)
       latv(i,j+1,12)=latv(i,j+1,10)+siv(j)*xupp*0.1*dcos(alplat)

c      Impresió de control
c       if (j.eq.10) then
c       write (*,*) "BBB ",i,latu(i,j+1,9),latv(i,j+1,9)
c       end if

       end do ! j

c      Punt inicial

       j=npulati
       
       alplat=abs(datan((pulat2y(i,j)-pulat1y(i,j))/(pulat2x(i,j)-
     + pulat1x(i,j))))

       latu(i,j,10)=pulat1x(i,j)+siu(j)*latv(i,j,8)*dsin(alplat)
       latv(i,j,10)=pulat1y(i,j)+siv(j)*latv(i,j,8)*dcos(alplat)

       latu(i,j,12)=latu(i,j,10)+siu(j)*xupp*0.1*dsin(alplat)
       latv(i,j,12)=latv(i,j,10)+siv(j)*xupp*0.1*dcos(alplat)

       end if ! Punts dreta (1)


       return

       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE MYLARS
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE mylars(i,u,v,sepx,sepy,rib,xmy,np,xkf,atp)

       real*8 u(0:100,500,99),v(0:100,500,99),sepx,sepy
       real*8 rib(0:100,500),xmy(0:100,10)
       real*8 mx(20),my(20)
       real*8 x1,x2,x3,y1,y2,y3,xad4,xad7,xkf,alpha,xd
       integer np(0:100,9)
       character*2 atp

       xad7=(1260.*5.+80.)*xkf
       xad4=2530.*xkf
       ng=int(rib(i,168))
       jvi=np(i,2)           ! vent in
       jvo=np(i,2)+np(i,3)-1 ! vent out

       if (ng.ne.0) then ! Only if mylar is defined

c      Read airfoil and detect initial and final points

c      Initial i final points x-ccordinate
       mx(1)=xmy(ng,1)*rib(i,5)/100.
       mx(8)=xmy(ng,4)*rib(i,5)/100.

       do j=1,np(i,1)-1! Explore airfoil

c      Initial point

       if (u(i,j,3).ge.mx(1).and.u(i,j+1,3).lt.mx(1).and.v(i,j,3).ge.0) 
     + then 

       jini=j

       x1=u(i,j+1,3)
       y1=v(i,j+1,3)
       x2=u(i,j,3)
       y2=v(i,j,3)
       x3=mx(1)
       call interpola(x1,y1,x2,y2,x3,y3)
       my(1)=y3
       end if

c      Final point

       if (u(i,j,3).le.mx(8).and.u(i,j+1,3).gt.mx(8).and.j.ge.np(i,2)) 
     + then 

       jfin=j

       x1=u(i,j+1,3)
       y1=v(i,j+1,3)
       x2=u(i,j,3)
       y2=v(i,j,3)
       x3=mx(8)
       call interpola(x1,y1,x2,y2,x3,y3)
       my(8)=y3
       end if

       end do

c      Compute others points

       mx(3)=mx(1)+xmy(ng,2)*rib(i,5)/100.0d0
       my(3)=my(1)
       mx(6)=mx(8)
       my(6)=my(8)+xmy(ng,5)*rib(i,5)/100.0d0

c      Airfoil contour

c      Case not "pc"
       if (atp.ne."pc") then
       call line(sepx+mx(1)+xad7,sepy-my(1),
     + sepx+u(i,jini+1,3)+xad7,sepy-v(i,jini+1,3),10)
       do j=jini+1,jfin-1
       call line(sepx+u(i,j,3)+xad7,sepy-v(i,j,3),
     + sepx+u(i,j+1,3)+xad7,sepy-v(i,j+1,3),10)
       end do  
       call line(sepx+mx(8)+xad7,sepy-my(8),
     + sepx+u(i,jfin,3)+xad7,sepy-v(i,jfin,3),10)
       end if 

c      Case "pc"

       if (atp.eq."pc") then
       call line(sepx+mx(1)+xad7,sepy-my(1),
     + sepx+u(i,jini+1,3)+xad7,sepy-v(i,jini+1,3),10)
       do j=jini+1,jvi-1
       call line(sepx+u(i,j,3)+xad7,sepy-v(i,j,3),
     + sepx+u(i,j+1,3)+xad7,sepy-v(i,j+1,3),10)
       end do  
       call line(sepx+u(i,jvi,3)+xad7,sepy-v(i,jvi,3),
     + sepx+u(i,jvo,3)+xad7,sepy-v(i,jvo,3),3)  
       do j=jvo,jfin-1
       call line(sepx+u(i,j,3)+xad7,sepy-v(i,j,3),
     + sepx+u(i,j+1,3)+xad7,sepy-v(i,j+1,3),10)
       end do 
       call line(sepx+mx(8)+xad7,sepy-my(8),
     + sepx+u(i,jfin,3)+xad7,sepy-v(i,jfin,3),10)
       end if ! "pc"

c      Mylar roman number

       x1=0.5*(mx(3)+mx(6))
       y1=0.5*(my(3)+my(6))

       alpha=datan((my(6)-my(3))/(mx(6)-mx(3)))

       x2=x1+1.0*dsin(alpha)  ! Shift 1 cm
       y2=y1-1.0*dcos(alpha)

       call romano(i,sepx+x2+xad7,sepy-y2,alpha,3.0d0,7)

c      Compute additional points 2-4
c      First use one unit distance xd=1.0

       xd=1.0d0
c      Point 2
       x1=mx(3)
       y1=my(3)
       x2=mx(1)
       y2=my(1)
       call interpd(x1,y1,x2,y2,x3,y3,xd)
       mx(2)=x3
       my(2)=y3
c      Point 4
       x1=mx(3)
       y1=my(3)
       x2=mx(6)
       y2=my(6)
       call interpd(x1,y1,x2,y2,x3,y3,xd)
       mx(4)=x3
       my(4)=y3

c      Second make proportional triangles

       xdi=dsqrt((mx(2)-mx(4))**2.+(my(2)-my(4))**2.)
       if (xdi.ne.0.) then
       xd=xmy(ng,3)*rib(i,5)/(100.*xdi)
c      Point 2
       x1=mx(3)
       y1=my(3)
       x2=mx(1)
       y2=my(1)
       call interpd(x1,y1,x2,y2,x3,y3,xd)
       mx(2)=x3
       my(2)=y3
c      Point 4
       x1=mx(3)
       y1=my(3)
       x2=mx(6)
       y2=my(6)
       call interpd(x1,y1,x2,y2,x3,y3,xd)
       mx(4)=x3
       my(4)=y3
       else
       end if

c      Compute additional points 5-6
c      First use one unit distance xd=1.0

       xd=1.0d0
c      Point 5
       x1=mx(6)
       y1=my(6)
       x2=mx(3)
       y2=my(3)
       call interpd(x1,y1,x2,y2,x3,y3,xd)
       mx(5)=x3
       my(5)=y3
c      Point 7
       x1=mx(6)
       y1=my(6)
       x2=mx(8)
       y2=my(8)
       call interpd(x1,y1,x2,y2,x3,y3,xd)
       mx(7)=x3
       my(7)=y3

c      Second make proportional triangles

       xdi=dsqrt((mx(5)-mx(7))**2.+(my(5)-my(7))**2.)
       if (xdi.ne.0.) then
       xd=xmy(ng,6)*rib(i,5)/(100.*xdi)
c      Point 5
       x1=mx(6)
       y1=my(6)
       x2=mx(3)
       y2=my(3)
       call interpd(x1,y1,x2,y2,x3,y3,xd)
       mx(5)=x3
       my(5)=y3
c      Point 7
       x1=mx(6)
       y1=my(6)
       x2=mx(8)
       y2=my(8)
       call interpd(x1,y1,x2,y2,x3,y3,xd)
       mx(7)=x3
       my(7)=y3
       else
       end if

c      Draw basic mylar contour 1-8 in ribs
      
       call line(sepx+mx(1),sepy-my(1),sepx+mx(2),sepy-my(2),10)
       call line(sepx+mx(2),sepy-my(2),sepx+mx(4),sepy-my(4),10)
       call line(sepx+mx(4),sepy-my(4),sepx+mx(5),sepy-my(5),10)
       call line(sepx+mx(5),sepy-my(5),sepx+mx(7),sepy-my(7),10)
       call line(sepx+mx(7),sepy-my(7),sepx+mx(8),sepy-my(8),10)
     
c      Draw basic mylar contour 1-8 in BOX(1,7)

       call line(sepx+mx(1)+xad7,sepy-my(1),
     + sepx+mx(2)+xad7,sepy-my(2),10)
       call line(sepx+mx(2)+xad7,sepy-my(2),
     + sepx+mx(4)+xad7,sepy-my(4),10)
       call line(sepx+mx(4)+xad7,sepy-my(4),
     + sepx+mx(5)+xad7,sepy-my(5),10)
       call line(sepx+mx(5)+xad7,sepy-my(5),
     + sepx+mx(7)+xad7,sepy-my(7),10)
       call line(sepx+mx(7)+xad7,sepy-my(7),
     + sepx+mx(8)+xad7,sepy-my(8),10)

c      Draw marks in BOX(1,4)

       x1=mx(1)
       y1=my(1)
       x2=mx(1)+0.7
       y2=my(1)
       call segment101(sepx+x1+xad4,sepy-y1,sepx+x2+xad4,sepy-y2,2)
       x1=mx(8)
       y1=my(8)
       x2=mx(8)
       y2=my(8)+0.7
       call segment101(sepx+x1+xad4,sepy-y1,sepx+x2+xad4,sepy-y2,2)

       end if

       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     SUBROUTINE interpolation of polyline - linear
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

      SUBROUTINE interpolyg(n,xpoint,ypoint,xvalue,yvalue)

      real*8 xpoint(50),ypoint(50),xvalue,yvalue,xm,xb
      real*8 funsup(50),funinf(50),funval(50)

      yvalue=0.0d0

      do i=1,n-1

      if (xvalue.ge.xpoint(i).and.xvalue.le.xpoint(i+1)) then
      xm=(ypoint(i+1)-ypoint(i))/(xpoint(i+1)-xpoint(i))
      xb=ypoint(i)-xm*xpoint(i)
      yvalue=xm*xvalue+xb
      end if

      end do

      return

      end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     SUBROUTINE interpolation of polyline - lagrange
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


      SUBROUTINE lagrangeip(n,xpoint,ypoint,xvalue,yvalue)

      real*8 xpoint(50),ypoint(50),xvalue,yvalue
      real*8 funsup(50),funinf(50),funval(50)

      yvalue=0.0d0

      do i=1,n

      funsup(i)=1.
      do j=1,n
      if (j.ne.i) then
      funsup(i)=funsup(i)*(xvalue-xpoint(j))
      end if
      end do

      funinf(i)=1.
      do j=1,n
      if (j.ne.i) then
      funinf(i)=funinf(i)*(xpoint(i)-xpoint(j))
      end if
      end do
      
      funval(i)=funsup(i)/funinf(i)

      yvalue=yvalue+funval(i)*ypoint(i)

      end do

      return

      end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE FLETXA (arrow or haut)
c      Numerical calculus arrow "haut" of circular segment
c      s = segment of the arc
c      sm =length of the arc
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE fletxa(s,sm,haut)

       real*8 s,g,sm,haut,llarg,radi,pi
       real*8 beta,alpha,alp20
       pi=4.0d0*datan(1.0d0)

       g=0.0d0
       i=1

       llarg=pi*s/2.

       do while (llarg.ge.sm)

       write (*,*) i,g,llarg,pi*s/2.

       x1=llarg
       y1=g

       beta=datan(g/(0.5d0*s))
       alpha=pi-2.*beta
       alp20=alpha/20.0d0        ! Discretize arc in 20 segments
       radi=dsqrt(g*g+0.25d0*s*s)
       llarg=40.*radi*dsin(0.5d0*alp20)
      
       g=g+(s/100.)  ! increment a cent of s
       i=i+1
       
       end do

       x2=llarg
       y2=g

       haut=radi-g-s/100.
       write (*,*) i,g,llarg,pi*s/2.
       write (*,*) "haut=",haut

       write (*,*) x1,y1
       write (*,*) x2,y2

c      Interpolation

       xm=(y2-y1)/(x2-x1)
       xb=y1-xm*x1
       g=xm*sm+xb

       radi=dsqrt(g*g+0.25d0*s*s)
       haut=radi-g

       write (*,*) sm,g,haut

       return

       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     SUBROUTINE panels3d
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE panels3d(i,rib,np,u,v,w,
     + uppcuts,iupp,kiupp,lowcuts,ilow,kilow,hautok)

       integer k29d,ncuts(200),jcut(0:10),np(0:100,9)
       real*8 u(0:100,500,99),v(0:100,500,99),w(0:100,500,99)
       real*8 rib(0:100,500)
       real*8 cutamp(10),cut29(0:10,200)
       real*8 llargc,llarg(500)
       real*8 s,sm,haut,hautm,tetha,radi,scontrol
       real*8 hautmmax,hautmax,q
       real*8 hautok(0:100,500),anglok(0:100,500)

       integer iupp(10,10,200),ilow(10,10,200)
       real*8 kiupp(10,200),kilow(10,200)
       integer uppcuts(200),lowcuts(200),iflag

       real*8 punt0(3),punt1(3),punt2(3),punt3(3),punt4(3)
       real*8 aplane,bplane,cplane,dplane,xt,dp0
       real*8 aplanei(0:100),bplanei(0:100),cplanei(0:100),
     + dplanei(0:100)

       real*8 lcosd(3),mcosd(3),ncosd(3),xdis

       ng=rib(i,169)

c      1. First step: Set median airfoil between i and i-1

       do j=1,np(i,1)
       u(i,j,48)=0.5d0*(u(i-1,j,47)+u(i,j,47))
       v(i,j,48)=0.5d0*(v(i-1,j,47)+v(i,j,47))
       w(i,j,48)=0.5d0*(w(i-1,j,47)+w(i,j,47))
       end do

c      2. Second steep: Compute hautok(i,j)

       do j=1,np(i,1)

       s=dsqrt((u(i-1,j,47)-u(i,j,47))**2+(v(i-1,j,47)-v(i,j,47))**2+
     + (w(i-1,j,47)-w(i,j,47))**2)
       sm=dsqrt((u(i-1,j,69)-u(i-1,j,70))**2+(v(i-1,j,69)-v(i-1,j,70))
     + **2)

c      Numerical root finding
c      Millorar algorisme per a tensions altes, assegurar que funciona

c      (Avoid sqrt of negative numbers)
       hautmax=0.5d0*dsqrt((dabs(sm*sm-s*s)))
       q=sm*s/((8.0d0*hautmax)+0.00001d0)
       hautmmax=(q-hautmax)

       iflag=0

c       if (i.eq.1.and.j.eq.40) then
c       write (*,*) "haummax= ",hautmmax
c       end if

c      Numerical solution by increments in hautm
       do l=0,300
       hautm=((dfloat(l)+0.00001d0)/300.0d0)*hautmmax*4.0d0  ! value 4.0 experimental (!)
       tetha=datan(0.5d0*s/hautm)
       radi=sm/(2.0d0*tetha)
       haut=radi-hautm
       scontrol=2.0d0*radi*sin(tetha)
       if (scontrol.ge.s.and.iflag.eq.0) then
       hautok(i,j)=haut
       iflag=1
c      Works these if?
       if (dabs(sm-s).le.0.01) then
       hautok(i,j)=0.0d0
       end if
       end if ! scontrol

c      CONTROL
c       if (i.eq.1.and.j.eq.40) then
c       write (*,*) l,s,sm,hautm,scontrol,hautok(i,j)
c       end if

       end do ! l

       end do ! j

c      3. Compute ovalized airfoil

c      Set the plane of the airfoil
 
       punt1(1)=u(i,1,48)
       punt1(2)=v(i,1,48)
       punt1(3)=w(i,1,48)

       jjj=dint(dfloat((1+np(i,2)))/2.0d0)
       punt2(1)=u(i,jjj,48)
       punt2(2)=v(i,jjj,48)
       punt2(3)=w(i,jjj,48)
       
       punt3(1)=u(i,np(i,2),48)
       punt3(2)=v(i,np(i,2),48)
       punt3(3)=w(i,np(i,2),48)

c      Plane Ax+By+Cz+D=0
       call planeby123(punt1,punt2,punt3,aplane,bplane,cplane,
     + dplane)

       aplanei(i)=aplane
       bplanei(i)=bplane
       cplanei(i)=cplane
       dplanei(i)=dplane

c      Points 55 perpendicular to the airfoil plane
       do j=1,np(i,1)
       dp0=10.0d0
       punt0(1)=u(i,j,48)
       punt0(2)=v(i,j,48)
       punt0(3)=w(i,j,48)
       call pointp3d(punt0,aplane,bplane,cplane,dp0,punt4)
       u(i,j,55)=punt4(1)
       v(i,j,55)=punt4(2)
       w(i,j,55)=punt4(3)
       end do ! j

c      Points 49 of the ovalized airfoil
       do j=1,np(i,1)

       punt1(1)=u(i,j-1,48)
       punt1(2)=v(i,j-1,48)
       punt1(3)=w(i,j-1,48)
       punt2(1)=u(i,j+1,48)
       punt2(2)=v(i,j+1,48)
       punt2(3)=w(i,j+1,48)
       punt3(1)=u(i,j,55)
       punt3(2)=v(i,j,55)
       punt3(3)=w(i,j,55)

       if (j.eq.1) then
       punt1(1)=u(i,j,48)
       punt1(2)=v(i,j,48)
       punt1(3)=w(i,j,48)
       punt2(1)=u(i,j+1,48)
       punt2(2)=v(i,j+1,48)
       punt2(3)=w(i,j+1,48)
       punt3(1)=u(i,j,55)
       punt3(2)=v(i,j,55)
       punt3(3)=w(i,j,55)
       end if

       if (j.eq.np(i,1)) then
       punt1(1)=u(i,j-1,48)
       punt1(2)=v(i,j-1,48)
       punt1(3)=w(i,j-1,48)
       punt2(1)=u(i,j,48)
       punt2(2)=v(i,j,48)
       punt2(3)=w(i,j,48)
       punt3(1)=u(i,j-1,55)
       punt3(2)=v(i,j-1,55)
       punt3(3)=w(i,j-1,55)
       end if

c      Plane 1-2-3 perpendicular to the airfoil in point j
       call planeby123(punt1,punt2,punt3,aplane,bplane,cplane,
     + dplane)

c      Point perpendicular to the plane 1-2-3 in line passing by punt0 at dp0
       dp0=hautok(i,j)
       punt0(1)=u(i,j,48)
       punt0(2)=v(i,j,48)
       punt0(3)=w(i,j,48)
       call pointp3d(punt0,aplane,bplane,cplane,dp0,punt4)

       u(i,j,49)=punt4(1)
       v(i,j,49)=punt4(2)
       w(i,j,49)=punt4(3)

       end do ! j

c      4. Compute median airfoil in local coordinates

c      Local axes in airfoil i: 0-1,0-2,0-3

c      punt0 = nose point coordinates median airfoil
       punt0(1)=u(i,np(i,6),48)
       punt0(2)=v(i,np(i,6),48)
       punt0(3)=w(i,np(i,6),48)

c      Point1 in line perpendicular to plane 48, by point 0
       call  pointp3d(punt0,aplanei(i),bplanei(i),cplanei(i),50.0d0,
     + punt1)

c       call line3d(punt0(1),punt0(2),punt0(3),
c     + punt1(1),punt1(2),punt1(3),4)

c      Point 2 in the leading edge of median airfoil (48)
       punt2(1)=u(i,np(i,1),48)
       punt2(2)=v(i,np(i,1),48)
       punt2(3)=w(i,np(i,1),48)

c      Define plane 0-1-2
       call planeby123(punt0,punt1,punt2,aplane,bplane,cplane,
     + dplane)
       
c      Point3 in line perpendicular to plane 0-1-2, by point 0
       call pointp3d(punt0,aplane,bplane,cplane,50.0d0,punt3)

c      Now we have tree the local axys in airfoil (48) 0-1,0-2,0-3

c       call line3d(punt0(1),punt0(2),punt0(3),
c     + punt3(1),punt3(2),punt3(3),1)

c      Director cosine 0-1,0-2,0-3

       lcosd(1)=(punt1(1)-punt0(1))/50.0d0
       mcosd(1)=(punt1(2)-punt0(2))/50.0d0
       ncosd(1)=(punt1(3)-punt0(3))/50.0d0

       xdis=dsqrt((punt2(1)-punt0(1))**2+(punt2(2)-punt0(2))**2+
     + (punt2(3)-punt0(3))**2)
       lcosd(2)=(punt2(1)-punt0(1))/xdis
       mcosd(2)=(punt2(2)-punt0(2))/xdis
       ncosd(2)=(punt2(3)-punt0(3))/xdis

       lcosd(3)=(punt3(1)-punt0(1))/50.0d0
       mcosd(3)=(punt3(2)-punt0(2))/50.0d0
       ncosd(3)=(punt3(3)-punt0(3))/50.0d0

c      Compute local coordinates of the median airfoil
       call glo2loc(i,punt0,lcosd,mcosd,ncosd,u,v,w,np)
c      Return vectors u(i,j,53) > median local
c      Return vectors u(,j,54) > median ovalized


c      Define cut points

       return

       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     SUBROUTINE czinf compute zones of influence of cutts
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      REMOVE write (*,*)
c      REMOVE not used variables
c      print in lep-out.txt

       SUBROUTINE czinf(i,rib,np,u,v,w,
     + uppcuts,iupp,kiupp,lowcuts,ilow,kilow,hautok,zinf)

       integer k29d,ncuts(200),jcut(0:10),np(0:100,9)
       real*8 u(0:100,500,99),v(0:100,500,99),w(0:100,500,99)
       real*8 rib(0:100,500)
       real*8 cutamp(10),cut29(0:10,200)
       real*8 llargc,llarg(500)
       real*8 s,sm,haut,hautm,tetha,radi,scontrol
       real*8 hautmmax,hautmax,q
       real*8 hautok(0:100,500),anglok(0:100,500)

       integer iupp(10,10,200),ilow(10,10,200)
       real*8 kiupp(10,200),kilow(10,200)
       integer uppcuts(200),lowcuts(200),iflag

       real*8 punt0(3),punt1(3),punt2(3),punt3(3),punt4(3)
       real*8 aplane,bplane,cplane,dplane,xt,dp0
       real*8 aplanei(0:100),bplanei(0:100),cplanei(0:100),
     + dplanei(0:100)

       real*8 lcosd(3),mcosd(3),ncosd(3),xdis

       real*8 zinf(0:100,10,10)

       ng=rib(i,169)

c      Cases
       if (uppcuts(ng).eq.0) then
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case 1 cut extrados
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (uppcuts(ng).eq.1) then

c      Zone 1
       d1=0.0d0
       d2=0.0d0
       do j=iupp(1,2,ng),iupp(1,3,ng)-1
       d1=d1+sqrt((v(i,j,53)-v(i,j+1,53))**2.0d0+
     + (w(i,j,53)-w(i,j+1,53))**2.0d0)
       end do
       do j=iupp(1,2,ng),iupp(1,3,ng)-1
       d2=d2+sqrt((v(i,j,54)-v(i,j+1,54))**2.0d0+
     + (w(i,j,54)-w(i,j+1,54))**2.0d0)
       end do
       zinf(i,1,1)=d1
       zinf(i,2,1)=d2
       zinf(i,3,1)=0.0d0
       zinf(i,4,1)=d2-d1
       zinf(i,5,1)=zinf(i,4,1)

c      Zone 2 (not considered, beacuse j2=j3)
       zinf(i,1,2)=0.0d0
       zinf(i,2,2)=0.0d0
       zinf(i,3,2)=0.0d0
       zinf(i,4,2)=0.0d0

c      Zone 3
       d1=0.0d0
       d2=0.0d0
       do j=iupp(1,3,ng),np(i,2)-1
       d1=d1+sqrt((v(i,j,53)-v(i,j+1,53))**2.0d0+
     + (w(i,j,53)-w(i,j+1,53))**2.0d0)
       end do
       do j=iupp(1,3,ng),np(i,2)-1
       d2=d2+sqrt((v(i,j,54)-v(i,j+1,54))**2.0d0+
     + (w(i,j,54)-w(i,j+1,54))**2.0d0)
       end do
       zinf(i,1,3)=d1
       zinf(i,2,3)=d2
       zinf(i,3,3)=d2-d1
       zinf(i,4,3)=0.0d0
       zinf(i,5,3)=zinf(i,3,3)

c      Compatibility vaule in first cut
       zinf(i,6,1)=0.5d0*(zinf(i,5,3)+zinf(i,5,1))*kiupp(1,ng)

       end if ! Case 1 cut extrados

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case 2 cuts extrados
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (uppcuts(ng).eq.2) then

c      Zone 1
       d1=0.0d0
       d2=0.0d0
       do j=iupp(1,2,ng),iupp(1,3,ng)-1
       d1=d1+sqrt((v(i,j,53)-v(i,j+1,53))**2.0d0+
     + (w(i,j,53)-w(i,j+1,53))**2.0d0)
       end do
       do j=iupp(1,2,ng),iupp(1,3,ng)-1
       d2=d2+sqrt((v(i,j,54)-v(i,j+1,54))**2.0d0+
     + (w(i,j,54)-w(i,j+1,54))**2.0d0)
       end do
       zinf(i,1,1)=d1
       zinf(i,2,1)=d2
       zinf(i,3,1)=0.0d0
       zinf(i,4,1)=d2-d1
       zinf(i,5,1)=zinf(i,4,1)
       
c      Zone 2
       d1=0.0d0
       d2=0.0d0
       do j=iupp(2,2,ng),iupp(2,3,ng)-1
       d1=d1+dsqrt((v(i,j,53)-v(i,j+1,53))**2.0d0+
     + (w(i,j,53)-w(i,j+1,53))**2.0d0)
       end do
       do j=iupp(2,2,ng),iupp(2,3,ng)-1
       d2=d2+dsqrt((v(i,j,54)-v(i,j+1,54))**2.0d0+
     + (w(i,j,54)-w(i,j+1,54))**2.0d0)
       end do
       zinf(i,1,2)=d1
       zinf(i,2,2)=d2
       zinf(i,3,2)=0.5d0*(d2-d1)
       zinf(i,4,2)=0.5d0*(d2-d1)
       zinf(i,5,2)=zinf(i,3,2)*2.0d0

c      Compatibility value first cut
       zinf(i,6,1)=0.5d0*(zinf(i,5,2)*0.5d0+zinf(i,5,1))*kiupp(1,ng)

c      Zone 3
       d1=0.0d0
       d2=0.0d0
       do j=iupp(2,3,ng),np(i,2)-1
       d1=d1+sqrt((v(i,j,53)-v(i,j+1,53))**2.0d0+
     + (w(i,j,53)-w(i,j+1,53))**2.0d0)
       end do
       do j=iupp(2,3,ng),np(i,2)-1
       d2=d2+sqrt((v(i,j,54)-v(i,j+1,54))**2.0d0+
     + (w(i,j,54)-w(i,j+1,54))**2.0d0)
       end do
       zinf(i,1,3)=d1
       zinf(i,2,3)=d2
       zinf(i,3,3)=d2-d1
       zinf(i,4,3)=0.0d0
       zinf(i,5,3)=zinf(i,3,3)

c      Compatibility value second cut
       zinf(i,6,2)=0.5d0*(zinf(i,5,3)+zinf(i,5,2)*0.5d0)*kiupp(2,ng)

       end if ! Case 2 cut extrados

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case vents
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Zone 4
       d1=0.0d0
       d2=0.0d0
       do j=np(i,2),np(i,2)+np(i,3)-2
       d1=d1+sqrt((v(i,j,53)-v(i,j+1,53))**2.0d0+
     + (w(i,j,53)-w(i,j+1,53))**2.0d0)
       end do
       do j=np(i,2),np(i,2)+np(i,3)-2
       d2=d2+sqrt((v(i,j,54)-v(i,j+1,54))**2.0d0+
     + (w(i,j,54)-w(i,j+1,54))**2.0d0)
       end do
       zinf(i,1,4)=d1
       zinf(i,2,4)=d2
       zinf(i,3,4)=0.5d0*(d2-d1)
       zinf(i,4,4)=0.5d0*(d2-d1)
       zinf(i,5,4)=2.0d0*zinf(i,4,4)
 
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case 1 cut intrados
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (lowcuts(ng).eq.1) then

c      Zone 5
       d1=0.0d0
       d2=0.0d0
       do j=np(i,2)+np(i,3)-1,ilow(1,2,ng)-1
       d1=d1+sqrt((v(i,j,53)-v(i,j+1,53))**2.0d0+
     + (w(i,j,53)-w(i,j+1,53))**2.0d0)
       end do
       do j=np(i,2)+np(i,3)-1,ilow(1,2,ng)-1
       d2=d2+sqrt((v(i,j,54)-v(i,j+1,54))**2.0d0+
     + (w(i,j,54)-w(i,j+1,54))**2.0d0)
       end do
       zinf(i,1,5)=d1
       zinf(i,2,5)=d2
       zinf(i,3,5)=0.0d0
       zinf(i,4,5)=d2-d1
       zinf(i,5,5)=zinf(i,4,5)
 
c      Zone 6
       d1=0.0d0
       d2=0.0d0
       do j=ilow(1,2,ng),ilow(1,3,ng)-1
       d1=d1+sqrt((v(i,j,53)-v(i,j+1,53))**2.0d0+
     + (w(i,j,53)-w(i,j+1,53))**2.0d0)
       end do
       do j=ilow(1,2,ng),ilow(1,3,ng)-1
       d2=d2+sqrt((v(i,j,54)-v(i,j+1,54))**2.0d0+
     + (w(i,j,54)-w(i,j+1,54))**2.0d0)
       end do
       zinf(i,1,6)=d1
       zinf(i,2,6)=d2
       zinf(i,3,6)=d2-d1
       zinf(i,4,6)=0.0d0
       zinf(i,5,6)=zinf(i,3,6)

c      Compatibility value first cut intrados
       zinf(i,6,4)=0.5d0*(zinf(i,5,6)+zinf(i,5,5))*kilow(1,ng)

       end if ! Case 1 cut intrados

       return

       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     SUBROUTINE planeby123
c     Plane Ax+By+Cz+D=0 defined by points 1,2,3
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE planeby123(punt1,punt2,punt3,aplane,bplane,cplane,
     + dplane)

       real*8 punt1(3),punt2(3),punt3(3)
       real*8 aplane,bplane,cplane,dplane
       real*8 ag,bg,cg,dg
       real*8 x1,y1,z1,x2,y2,z2,x3,y3,z3

       x1=punt1(1)
       y1=punt1(2)
       z1=punt1(3)
       x2=punt2(1)
       y2=punt2(2)
       z2=punt2(3)
       x3=punt3(1)
       y3=punt3(2)
       z3=punt3(3)

       ag=(y2-y1)*(z3-z1)-(z2-z1)*(y3-y1)
       bg=(z2-z1)*(x3-x1)-(x2-x1)*(z3-z1)
       cg=(x2-x1)*(y3-y1)-(y2-y1)*(x3-x1)

       aplane=ag
       bplane=bg
       cplane=cg
       dplane=-ag*x1-bg*y1-cg*z1

       return

       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     Unitary vector and normal to plane by 123
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE unitaryto123(unitv,
     + aplane,bplane,cplane)

       real*8 unitv(3)
       real*8 aplane,bplane,cplane
       real*8 xt

       xt=dsqrt(1.0d0/(aplane*aplane+bplane*bplane+cplane*cplane))
       unitv(1)=xt*aplane
       unitv(2)=xt*bplane
       unitv(3)=xt*cplane

       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     SUBROUTINE pointp3d
c     Point by 0 perpendicular to plane Ax+By+Cz+D=0 at distance d
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


       SUBROUTINE pointp3d(punt0,aplane,bplane,cplane,dp0,punt4)

       real*8 punt0(3),punt1(3),punt2(3),punt3(3),punt4(3)
       real*8 aplane,bplane,cplane,xt,dp0

       xt=dp0/dsqrt(aplane*aplane+bplane*bplane+cplane*cplane)

       punt4(1)=punt0(1)+aplane*xt
       punt4(2)=punt0(2)+bplane*xt
       punt4(3)=punt0(3)+cplane*xt

       return

       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     SUBROUTINE glo2loc
c     Transform global 3d coordinates to local coordinates
c     Specifically applied to middle airfoil index 53 and 54
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      (x0,y0,z0) center of local axes
c      Index 48 = 3D median airfoil
c      Index 49 = 3D ovalized median airfoil
c      Index 53 = 2D median airfoil
c      Index 54 = 2D ovalized median airfoil

       SUBROUTINE glo2loc(i,punt0,lcosd,mcosd,ncosd,u,v,w,np)

       real*8 lcosd(3),mcosd(3),ncosd(3)
       real*8 punt0(3)
       real*8 u(0:100,500,99),v(0:100,500,99),w(0:100,500,99)
       integer np(0:100,9)

       x0=punt0(1)
       y0=punt0(2)
       z0=punt0(3)

       do j=1,np(i,1)
       u(i,j,53)=lcosd(1)*(u(i,j,48)-punt0(1))+
     + mcosd(1)*(v(i,j,48)-punt0(2))+ncosd(1)*(w(i,j,48)-punt0(3))
       v(i,j,53)=lcosd(2)*(u(i,j,48)-punt0(1))+
     + mcosd(2)*(v(i,j,48)-punt0(2))+ncosd(2)*(w(i,j,48)-punt0(3))
       w(i,j,53)=lcosd(3)*(u(i,j,48)-punt0(1))+
     + mcosd(3)*(v(i,j,48)-punt0(2))+ncosd(3)*(w(i,j,48)-punt0(3))

       u(i,j,54)=lcosd(1)*(u(i,j,49)-punt0(1))+
     + mcosd(1)*(v(i,j,49)-punt0(2))+ncosd(1)*(w(i,j,49)-punt0(3))
       v(i,j,54)=lcosd(2)*(u(i,j,49)-punt0(1))+
     + mcosd(2)*(v(i,j,49)-punt0(2))+ncosd(2)*(w(i,j,49)-punt0(3))
       w(i,j,54)=lcosd(3)*(u(i,j,49)-punt0(1))+
     + mcosd(3)*(v(i,j,49)-punt0(2))+ncosd(3)*(w(i,j,49)-punt0(3))
       end do
  
       return

       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     SUBROUTINE print01
c     Print TE extrados
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE print01(i,psep,psey,u,v,icase)

       real*8 u(0:100,500,99),v(0:100,500,99),w(0:100,500,99)
       real*8 psep,psey
       integer j,icase,np(0:100,9)

c      Incorpore subroutine extpoints
      
c      Segments

       j=1

c       write (*,*) i

       if (icase.eq.1) then ! case print
       call line(psep+u(i,j,9),psey-v(i,j,9),
     + psep+u(i,j,10),psey-v(i,j,10),1)
       end if

       return

       end

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Print initial i final points
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE prinifp(i,npi,npf,u,v,psep,psey,xcir,xdes,xkf)
       
       real*8 u(0:100,500,99),v(0:100,500,99),psep,psey,xcir
       real*8 xu,xv,xdes,xkf
       real*8 alp
       integer i,j,npi,npf

       j=npi
       xu=u(i,j,9)
       xv=v(i,j,9)
       alp=abs(datan((v(i,j+1,9)-v(i,j,9))/(u(i,j+1,9)-u(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)
       call pointg(psep+xu,psey-xv,xcir,4)     
       call point(psep+xu+2520.*xkf,-xv+psey,7)

       j=npf
       xu=u(i,j,9)
       xv=v(i,j,9)
       alp=abs(datan((v(i,j-1,9)-v(i,j,9))/(u(i,j-1,9)-u(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)
       call pointg(psep+xu,psey-xv,xcir,4)     
       call point(psep+xu+2520.*xkf,-xv+psey,7)

       j=npi
       xu=u(i,j,10)
       xv=v(i,j,10)
       alp=abs(datan((v(i,j+1,10)-v(i,j,10))/(u(i,j+1,10)-u(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
       call pointg(psep+xu,psey-xv,xcir,4)
       call point(psep+xu+2520.*xkf,-xv+psey,7)

       j=npf
       xu=u(i,j,10)
       xv=v(i,j,10)
       alp=abs(datan((v(i,j-1,10)-v(i,j,10))/(u(i,j-1,10)-u(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
       call pointg(psep+xu,psey-xv,xcir,4)
       call point(psep+xu+2520.*xkf,-xv+psey,7)

       return

       end

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE prinfpv - Print final points vents
c      Case print, case laser (ic1)
c      Case type vent (ic2)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE prinfpv(i,j9,j10,ufr,vfr,psep,psey,xcir,xdes,xkf,
     + ic1,ic2)
       
       real*8 ufr(0:100,500,50),vfr(0:100,500,50),psep,psey,xcir
       real*8 xu,xv,xdes,xkf
       real*8 alp
       integer i,ic1,ic2,j9,j10

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Print final points vents, case print, vent +1 +6
c      ic1=1 ic2=1
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (ic1.eq.1) then
       if (ic2.eq.1.or.ic2.eq.6) then
c      Point left
       j=j9
       xu=ufr(i,j,9)
       xv=vfr(i,j,9)
       alp=abs(datan((vfr(i,j,9)-vfr(i,j-1,9))/
     + (ufr(i,j,9)-ufr(i,j-1,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)
       call pointg(psep+xu,psey-xv,xcir,4)     
c      Point right
       j=j10
       xu=ufr(i,j,10)
       xv=vfr(i,j,10)
       alp=abs(datan((vfr(i,j,10)-vfr(i,j-1,10))/
     + (ufr(i,j,10)-ufr(i,j-1,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
       call pointg(psep+xu,psey-xv,xcir,4)
       end if
       end if
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Print final points vents, case laser, vent +1 +6
c      ic1=2 ic2=1
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (ic1.eq.2) then
       if (ic2.eq.1.or.ic2.eq.6) then
c      Point left
       j=j9
       xu=ufr(i,j,9)
       xv=vfr(i,j,9)
       alp=abs(datan((vfr(i,j,9)-vfr(i,j-1,9))/
     + (ufr(i,j,9)-ufr(i,j-1,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)   
       call point(psep+xu,-xv+psey,7)
c      Point right
       j=j10
       xu=ufr(i,j,10)
       xv=vfr(i,j,10)
       alp=abs(datan((vfr(i,j,10)-vfr(i,j-1,10))/
     + (ufr(i,j,10)-ufr(i,j-1,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
       call point(psep+xu,-xv+psey,7)
       end if
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Print final points vents, case print, vent -1 -6
c      ic1=1 ic2=-1
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ic1.eq.1) then
       if (ic2.eq.-1.or.ic2.eq.-6) then
c      Point left
       j=j9
       xu=ufr(i,j,9)
       xv=vfr(i,j,9)
       alp=abs(datan((vfr(i,j+1,9)-vfr(i,j,9))/
     + (ufr(i,j+1,9)-ufr(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)
       call pointg(psep+xu,psey-xv,xcir,4)     
c      Point right
       j=j10
       xu=ufr(i,j,10)
       xv=vfr(i,j,10)
       alp=abs(datan((vfr(i,j+1,10)-vfr(i,j,10))/
     + (ufr(i,j+1,10)-ufr(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
       call pointg(psep+xu,psey-xv,xcir,4)
       end if
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Print final points vents, case laser, vent -1 -6
c      ic1=2 ic2=-1
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (ic1.eq.2) then
       if (ic2.eq.-1.or.ic2.eq.-6) then
c      Point left
       j=j9
       xu=ufr(i,j,9)
       xv=vfr(i,j,9)
       alp=abs(datan((vfr(i,j+1,9)-vfr(i,j,9))/
     + (ufr(i,j+1,9)-ufr(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)   
       call point(psep+xu,-xv+psey,7)
c      Point right
       j=j10
       xu=ufr(i,j,10)
       xv=vfr(i,j,10)
       alp=abs(datan((vfr(i,j+1,10)-vfr(i,j,10))/
     + (ufr(i,j+1,10)-ufr(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
       call point(psep+xu,-xv+psey,7)
       end if
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Print final points vents, case print, vent -2
c      ic1=1 ic2=-2
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ic1.eq.1.and.ic2.eq.-2) then

c      Point left
       j=j9
       xu=ufr(i,j,9)
       xv=vfr(i,j,9)
       alp=abs(datan((vfr(i,j+1,9)-vfr(i,j,9))/
     + (ufr(i,j+1,9)-ufr(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)
c       call pointg(psep+xu,psey-xv,xcir,4)     
c      Point right
       j=j10
       xu=ufr(i,j,10)
       xv=vfr(i,j,10)
       alp=abs(datan((vfr(i,j+1,10)-vfr(i,j,10))/
     + (ufr(i,j+1,10)-ufr(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
       call pointg(psep+xu,psey-xv,xcir,4)
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Print final points vents, case laser, vent -2
c      ic1=2 ic2=-2
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (ic1.eq.2.and.ic2.eq.-2) then
c      Point left
       j=j9
       xu=ufr(i,j,9)
       xv=vfr(i,j,9)
       alp=abs(datan((vfr(i,j+1,9)-vfr(i,j,9))/
     + (ufr(i,j+1,9)-ufr(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)   
c       call point(psep+xu,-xv+psey,7)
c      Point right
       j=j10
       xu=ufr(i,j,10)
       xv=vfr(i,j,10)
       alp=abs(datan((vfr(i,j+1,10)-vfr(i,j,10))/
     + (ufr(i,j+1,10)-ufr(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
       call point(psep+xu,-xv+psey,7)
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Print final points vents, case print, vent -3
c      ic1=1 ic2=-3
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       if (ic1.eq.1.and.ic2.eq.-3) then

c      Point left
       j=j9
       xu=ufr(i,j,9)
       xv=vfr(i,j,9)
       alp=abs(datan((vfr(i,j+1,9)-vfr(i,j,9))/
     + (ufr(i,j+1,9)-ufr(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)
       call pointg(psep+xu,psey-xv,xcir,4)     
c      Point right
       j=j10
       xu=ufr(i,j,10)
       xv=vfr(i,j,10)
       alp=abs(datan((vfr(i,j+1,10)-vfr(i,j,10))/
     + (ufr(i,j+1,10)-ufr(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
c       call pointg(psep+xu,psey-xv,xcir,4)
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Print final points vents, case laser, vent -3
c      ic1=2 ic2=-3
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       if (ic1.eq.2.and.ic2.eq.-3) then
c      Point left
       j=j9
       xu=ufr(i,j,9)
       xv=vfr(i,j,9)
       alp=abs(datan((vfr(i,j+1,9)-vfr(i,j,9))/
     + (ufr(i,j+1,9)-ufr(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)   
       call point(psep+xu,-xv+psey,7)
c      Point right
       j=j10
       xu=ufr(i,j,10)
       xv=vfr(i,j,10)
       alp=abs(datan((vfr(i,j+1,10)-vfr(i,j,10))/
     + (ufr(i,j+1,10)-ufr(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
c       call point(psep+xu,-xv+psey,7)
       end if


       return

       end

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE llarlr
c      Computes length at left and right of the partial rectagular
c      panel i formed by npo points
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE llarlr(i,i12,i22,npo,ufr,vfr,llarl,llarr)

       real*8 ufr(0:100,500,50),vfr(0:100,500,50)
       real*8 llarl(0:100,3,100),llarr(0:100,3,100)
       integer i,j,i12,i22,npo

c      Set panel side lengths 
       llarl(i,i12,i22)=0.0d0
       llarr(i,i12,i22)=0.0d0      
       do j=1,npo-1
       llarl(i,i12,i22)=llarl(i,i12,i22)+dsqrt((ufr(i,j+1,9)-
     + ufr(i,j,9))**2.+(vfr(i,j+1,9)-vfr(i,j,9))**2.)
       llarr(i,i12,i22)=llarr(i,i12,i22)+dsqrt((ufr(i,j+1,10)-
     + ufr(i,j,10))**2.+(vfr(i,j+1,10)-vfr(i,j,10))**2.)
       end do

c       write (*,*) i,i12,i22,npo,llarl(i,i12,i22),llarr(i,i12,i22)

       return

       end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE xmarksi
c      Makes internal marks in a rectangular panel
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE xmarksi(i,i1,i2,npo,u,v,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey,xcir,xdes,xkf)

       real*8 u(0:100,500,50),v(0:100,500,50),rib(0:100,500)
       real*8 llarl(0:100,3,100),llarr(0:100,3,100)
       real*8 xmk,xmk0,xmark,xmklast,xprev,xpost,xacu(0:100)
       real*8 dist,dist1,dist2,alp,xu,xv,psep,psey,xcir,xdes,xkf
       real*8 xinil,xinir
       real*8 xfinl(0:100,3,100),xfinr(0:100,3,100)
       integer i,j,k,i1,i2,npo

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      STILL RECOMMENDED APPLY AMPLIFICATION COEFFICIENTS 
c      set in 11. rib(i,194) rib(i,195) extra
c      and        rib(i,200) rib(i,201) intra
c      Separate left and right calculus using proper coefficient
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      For extrados panels (i1=1)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc  

c      SEPARAR L i R !!!!!!!!!!!!!!!
            
       if (i1.eq.1) then
       
c      Set successive distance marks
c      WARNING!!!! Compute proper amplification coefficient!!!!!!!
c      Use amplification coefficient (panel border/rib)
c      Use different coeeficients for left and right
c      xmk=xmk*rib(i,36) ! amplificacio de segment

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw at left 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
c      Iterate in marks
       do k=1,60

       xacu(i)=0.0d0

c       write (*,*) "xinil ",i,xinil

c      Set successive distance marks
       if (k.eq.1) then
       xmk=xinil
       end if
       if (k.gt.1) then
       xmk=xmark*float(k-1)*1.0d0+xinil
       end if
      
       do j=1,npo-1
       xprev=xacu(i)
       xacu(i)=xacu(i)+sqrt((u(i,j,9)-u(i,j+1,9))**2.+((v(i,j,9)
     + -v(i,j+1,9))**2.))
       xpost=xacu(i)

c      Detect segment where is mark
       if(xmk.le.xpost.and.xmk.ge.xprev.and.xmk.le.llarl(i,i1,i2)) then

c      dibuixa marca

       dist=dsqrt((u(i,j,9)-u(i,j+1,9))**2.+((v(i,j,9)
     + -v(i,j+1,9))**2.))

       dist1=xmk-xprev

       xu=u(i,j,9)+(u(i,j+1,9)-u(i,j,9))*(dist1/dist)
       xv=v(i,j,9)+(v(i,j+1,9)-v(i,j,9))*(dist1/dist)

c      REVISSAR SIGNES DESPLAÇAMENT!!!!!!!
c      Despla a vores punts de control de costures
       alp=abs(datan((v(i,j+1,9)-v(i,j,9))/(u(i,j+1,9)-u(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)
       
       if (xinil.ge.0.01d0.or.k.gt.1) then
c      Point imp
       call pointg(psep+xu,psey-xv,xcir,3)
c      Point laser
       call point(psep+xu+2520.*xkf,-xv+psey,7)
       end if
       
       xmklast=xmk

       end if
       end do ! j left
      
       end do ! k

       xfinl(i,i1,i2)=xmark*1.0d0-(llarl(i,i1,i2)-xmklast)

c       write (*,*) "L ",i,i1,i2,xmklast,llarl(i,i1,i2),xfinl(i,i1,i2)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw at right
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       xacu(i)=xinir  

c      Iterate in marks
       do k=1,60

       xacu(i)=0.0d0

c      Set successive distance marks
       if (k.eq.1) then
       xmk=xinir
       end if
       if (k.gt.1) then
       xmk=xmark*float(k-1)*1.0d0+xinir
       end if
  
       do j=1,npo-1
       xprev=xacu(i)
       xacu(i)=xacu(i)+sqrt((u(i,j,10)-u(i,j+1,10))**2.+((v(i,j,10)
     + -v(i,j+1,10))**2.))
       xpost=xacu(i)

c      Detect segment where is mark
       if(xmk.le.xpost.and.xmk.ge.xprev.and.xmk.le.llarr(i,i1,i2)) then

c      dibuixa marca

       dist=dsqrt((u(i,j,10)-u(i,j+1,10))**2.+((v(i,j,10)
     + -v(i,j+1,10))**2.))

       dist1=xmk-xprev

       xu=u(i,j,10)+(u(i,j+1,10)-u(i,j,10))*(dist1/dist)
       xv=v(i,j,10)+(v(i,j+1,10)-v(i,j,10))*(dist1/dist)

c      REVISSAR SIGNES DESPLAÇAMENT!!!!!!!
c      I COHERENCIA AMB ALTRES MARQUES LATERALS
c      Despla a vores punts de control de costures
c      Segons verificació, aquí estŕ be!!!!!!!!
c      Veure vents i altres zones!!!!!!!!!!
       alp=abs(datan((v(i,j+1,10)-v(i,j,10))/(u(i,j+1,10)-u(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
c      SIGNE CREC QUE CORREGIT!!!! :)

       if (xinir.ge.0.01d0.or.k.gt.1) then
c      Point imp
       call pointg(psep+xu,psey-xv,xcir,3)
c      Point laser
       call point(psep+xu+2520.*xkf,-xv+psey,7)
       end if
       
       xmklast=xmk

       end if ! mark xmk
       end do ! j right

       end do ! k iteration

       xfinr(i,i1,i2)=xmark*1.0d0-(llarr(i,i1,i2)-xmklast)
c       write (*,*) "R ",i,i1,i2,xmklast,llarr(i,i1,i2),xfinr(i,i1,i2)

       end if ! i1=1 Extrados panels


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      For intrados panels (i1=2)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc              
       if (i1.eq.2) then
 

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw at left 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
c      write (*,*) i,"2 ",u(i,npo-4,9),v(i,npo-4,9)


c      Iterate in marks
       do k=1,60

       xacu(i)=0.0d0

c      Set successive distance marks
       if (k.eq.1) then
       xmk=xinil
       end if
       if (k.gt.1) then
       xmk=xmark*float(k-1)*1.0d0+xinil
       end if
      
       do j=npo-1,1,-1
       xprev=xacu(i)
       xacu(i)=xacu(i)+sqrt((u(i,j,9)-u(i,j+1,9))**2.+((v(i,j,9)
     + -v(i,j+1,9))**2.))
       xpost=xacu(i)

c      Detect segment where is mark
       if(xmk.le.xpost.and.xmk.ge.xprev.and.xmk.le.llarl(i,i1,i2)) then

c      dibuixa marca

       dist=dsqrt((u(i,j,9)-u(i,j+1,9))**2.+((v(i,j,9)
     + -v(i,j+1,9))**2.))

       dist1=xmk-xprev
       dist2=dist-dist1

       xu=u(i,j,9)+(u(i,j+1,9)-u(i,j,9))*(dist2/dist)
       xv=v(i,j,9)+(v(i,j+1,9)-v(i,j,9))*(dist2/dist)

c      REVISSAR SIGNES DESPLAÇAMENT!!!!!!!
c      Despla a vores punts de control de costures
       alp=abs(datan((v(i,j+1,9)-v(i,j,9))/(u(i,j+1,9)-u(i,j,9))))
       xu=xu-xdes*dsin(alp)
       xv=xv+xdes*dcos(alp)
       
       if (xinil.ge.0.01d0.or.k.gt.1) then
c      Point imp
       call pointg(psep+xu,psey-xv,xcir,3)
c      Point laser
       call point(psep+xu+2520.*xkf,-xv+psey,7)
       end if
       
       xmklast=xmk

       end if
       end do ! j left
      
       end do ! k

       xfinl(i,i1,i2)=xmark*1.0d0-(llarl(i,i1,i2)-xmklast)

c       write (*,*) "L ",i,i1,i2,xmklast,llarl(i,i1,i2),xfinl(i,i1,i2)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Draw at right
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       xacu(i)=xinir  

c      Iterate in marks
       do k=1,60

       xacu(i)=0.0d0

c      Set successive distance marks
       if (k.eq.1) then
       xmk=xinir
       end if
       if (k.gt.1) then
       xmk=xmark*float(k-1)*1.0d0+xinir
       end if
  
       do j=npo-1,1,-1
       xprev=xacu(i)
       xacu(i)=xacu(i)+sqrt((u(i,j,10)-u(i,j+1,10))**2.+((v(i,j,10)
     + -v(i,j+1,10))**2.))
       xpost=xacu(i)

c      Detect segment where is mark
       if(xmk.le.xpost.and.xmk.ge.xprev.and.xmk.le.llarr(i,i1,i2)) then

c      dibuixa marca

       dist=dsqrt((u(i,j,10)-u(i,j+1,10))**2.+((v(i,j,10)
     + -v(i,j+1,10))**2.))

       dist1=xmk-xprev
       dist2=dist-dist1

       xu=u(i,j,10)+(u(i,j+1,10)-u(i,j,10))*(dist2/dist)
       xv=v(i,j,10)+(v(i,j+1,10)-v(i,j,10))*(dist2/dist)

c      REVISSAR SIGNES DESPLAÇAMENT!!!!!!!
c      I COHERENCIA AMB ALTRES MARQUES LATERALS
c      Despla a vores punts de control de costures
c      Segons verificació, aquí estŕ be!!!!!!!!
c      Veure vents i altres zones!!!!!!!!!!
       alp=abs(datan((v(i,j+1,10)-v(i,j,10))/(u(i,j+1,10)-u(i,j,10))))
       xu=xu+xdes*dsin(alp)
       xv=xv-xdes*dcos(alp)
c      SIGNE CORREGIT!!!!!!!! :)

       if (xinir.ge.0.01d0.or.k.gt.1) then
c      Point imp
       call pointg(psep+xu,psey-xv,xcir,3)
c      Point laser
       call point(psep+xu+2520.*xkf,-xv+psey,7)
       end if
       
       xmklast=xmk

       end if ! mark xmk
       end do ! j right

       end do ! k iteration

       xfinr(i,i1,i2)=xmark*1.0d0-(llarr(i,i1,i2)-xmklast)
c       write (*,*) "R ",i,i1,i2,xmklast,llarr(i,i1,i2),xfinr(i,i1,i2)

       end if ! i1=2 Intrados panels

       return
       end



cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE iam
c      intrados anchor marks
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE iam(i,i1,i2,np,npo,u,v,rib,xinil,xinir,
     + xfinl,xfinr,xmark,llarl,llarr,psep,psey,xcir,xdes,xkf,
     + typm1,typm2,typm3,typm4,typm5,typm6,xrib)

       real*8 u(0:100,500,50),v(0:100,500,50),rib(0:100,500)
       real*8 llarl(0:100,3,100),llarr(0:100,3,100)
       integer np(0:100,9)
       real*8 xmk,xmk0,xmark,xmklast,xprev,xpost,xacu(0:100)
       real*8 dist,dist1,dist2,alp,xu,xv,psep,psey,xcir,xdes,xkf
       real*8 xinil,xinir
       real*8 xfinl(0:100,3,100),xfinr(0:100,3,100)
       integer i,j,k,i1,i2,npo

       integer klz
       real*8 xlen,xlenp,xequis,yequis,xdu,xdv,alpha,pi
       real*8 xanchor(100,6),yanchor(100,6)
       real*8 xanchoril(100,6),yanchoril(100,6)
       real*8 xanchorir(100,6),yanchorir(100,6)
c       real*8 xpeq,ypeq,xdesp,xdesp1x,xdesp1y,xdesp2x,xdesp2y

       integer typm1(50),typm4(50)
       real*8 typm2(50),typm3(50),typm5(50),typm6(50)
       real*8 xrib


       pi=4.*atan(1.)


c       write (*,*) i, "Ep..."

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Left side
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do klz=1,int(rib(i,15)) ! rib(i,15)=anchors number

       xlen=xinil
       j=npo
       xlenp=xlen+dsqrt((v(i,j,9)-v(i,j-1,9))**2.+
     + (u(i,j,9)-u(i,j-1,9))**2.)

       do j=npo,2,-1

c      Detect and draw anchor point
       if (rib(i,130+klz).ge.xlen.and.rib(i,130+klz).le.xlenp) then

       rib(i,107)=rib(i,130+klz)-xlen
       rib(i,108)=dsqrt((v(i,j,9)-v(i,j-1,9))**2.+(u(i,j,9)-u(i,j-1,9))
     + **2.)

c      Interpolate
       xequis=u(i,j,9)-(rib(i,107)*(u(i,j,9)-u(i,j-1,9)))/
     + rib(i,108)
       yequis=v(i,j,9)-(rib(i,107)*(v(i,j,9)-v(i,j-1,9)))/
     + rib(i,108)

c      SOLUCIÓ PROVISIONAL translació a base vent:
       if (i2.eq.4) then
       xequis=xequis-(u(i,npo,9)-u(i,1,9))
       yequis=yequis-(v(i,npo,9)-v(i,1,9))
       end if

c      Define anchor points in planar panel
       xanchoril(i,klz)=xequis
       yanchoril(i,klz)=yequis

c      Draw
       xdu=u(i,j,9)-u(i,j-1,9)
       xdv=v(i,j,9)-v(i,j-1,9)

       if (xdu.ne.0) then
       alpha=-(datan(xdv/xdu))
       end if
       if (xdu.eq.0.) then
       alpha=pi/2.
       end if
       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case imp
c      Line 4*xrib in plotting panels
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Case all
       call line(psep+xequis,psey-yequis,psep+xequis-0.4*xrib*
     + dsin(-alpha),psey-yequis-0.4*xrib*dcos(-alpha),30)
       
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case laser
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       xpeq=xequis+1.*xdes*dsin(-alpha)
       ypeq=yequis-1.*xdes*dcos(-alpha)

       xdesp=1.0*(0.5*(xrib-20.*xdes))/10.
c       xdesp=typm6(5)
c      REVISAR

       xdesp1x=xdesp*dsin(-alpha)
       xdesp1y=-xdesp*dcos(-alpha)
       xdesp2x=2.*xdesp*dsin(-alpha)
       xdesp2y=-2.*xdesp*dcos(-alpha)

c      Case 1: classic 3 orange points
       if (typm4(5).eq.1) then
       call point (psep+xpeq+2520*xkf,psey-ypeq,30)
       call point (psep+xpeq+xdesp1x+2520*xkf,psey-ypeq-xdesp1y,30)
       call point (psep+xpeq+xdesp2x+2520*xkf,psey-ypeq-xdesp2y,30)
       end if

c      Case 2: Controled 3 orange points
       if (typm4(5).eq.2) then
       xpeq=xequis+1.*typm6(5)*dsin(-alpha)
       ypeq=yequis-1.*typm6(5)*dcos(-alpha)
       xdesp1x=typm5(5)*dsin(-alpha)
       xdesp1y=-typm5(5)*dcos(-alpha)
       xdesp2x=2.*typm5(5)*dsin(-alpha)
       xdesp2y=-2.*typm5(5)*dcos(-alpha)
       call point (psep+xpeq+2520*xkf,psey-ypeq,30)
       call point (psep+xpeq+xdesp1x+2520*xkf,psey-ypeq-xdesp1y,30)
       call point (psep+xpeq+xdesp2x+2520*xkf,psey-ypeq-xdesp2y,30)
       end if

c      Case 3: triangle h mm
       if (typm4(5).eq.3) then
       xpeq=xequis-typm6(5)*dsin(alpha)
       ypeq=yequis+typm6(5)*dcos(alpha)
       call mtriangle(psep+xpeq+2520*xkf,psey-ypeq,typm5(5),-alpha,1)
       end if

       end if

       xlen=xlen+sqrt((v(i,j,9)-v(i,j-1,9))**2.+(u(i,j,9)-u(i,j-1,9))
     + **2.)
       xlenp=xlen+sqrt((v(i,j-1,9)-v(i,j-2,9))**2.+
     + (u(i,j-1,9)-u(i,j-2,9))**2.)

       end do ! j

       end do ! klz

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Right side
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       do klz=1,rib(i+1,15)

       xlen=xinir
       j=npo
       xlenp=xlen+dsqrt((v(i,j,10)-v(i,j-1,10))**2.+
     + (u(i,j,10)-u(i,j-1,10))**2.)

       do j=npo,2,-1

c      Detect and draw anchor point
       if (rib(i+1,130+klz).ge.xlen.and.rib(i+1,130+klz).le.xlenp) then

       rib(i+1,107)=rib(i+1,130+klz)-xlen
       rib(i+1,108)=dsqrt((v(i,j,10)-v(i,j-1,10))**2.+(u(i,j,10)-
     + u(i,j-1,10))**2.)

c      Interpolate
       xequis=u(i,j,10)-(rib(i+1,107)*(u(i,j,10)-u(i,j-1,10)))/
     + rib(i+1,108)
       yequis=v(i,j,10)-(rib(i+1,107)*(v(i,j,10)-v(i,j-1,10)))/
     + rib(i+1,108)

c      SOLUCIÓ PROVISIONAL translació a base vent:
       if (i2.eq.4) then
       xequis=xequis-(u(i,npo,10)-u(i,1,10))
       yequis=yequis-(v(i,npo,10)-v(i,1,10))
       end if

c      Define anchor points in planar panel
       xanchorir(i+1,klz)=xequis
       yanchorir(i+1,klz)=yequis

c      Draw
       alpha=-(datan((v(i,j,10)-v(i,j-1,10))/(u(i,j,10)-u(i,j-1,10))))

       if (alpha.lt.0.) then
       alpha=alpha+pi
       end if

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case imp
c      Line 4*xrib in plotting panels
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       call line(psep+xequis,psey-yequis,psep+xequis+0.4*xrib*
     + dsin(-alpha),psey-yequis+0.4*xrib*dcos(-alpha),30)

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Case laser
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       xpeq=xequis-1.*xdes*dsin(-alpha)
       ypeq=yequis+1.*xdes*dcos(-alpha)

       xdesp=1.0*(0.5*(xrib-20.*xdes))/10.
c      REVISAR
c       xdesp=typm6(5)

       xdesp1x=xdesp*dsin(-alpha)
       xdesp1y=-xdesp*dcos(-alpha)
       xdesp2x=2.*xdesp*dsin(-alpha)
       xdesp2y=-2.*xdesp*dcos(-alpha)

c      Case 1: classic 3 orange points
       if (typm4(5).eq.1) then
       call point (psep+xpeq+2520*xkf,psey-ypeq,30)
       call point (psep+xpeq-xdesp1x+2520*xkf,psey-ypeq+xdesp1y,30)
       call point (psep+xpeq-xdesp2x+2520*xkf,psey-ypeq+xdesp2y,30)
       end if

c      Case 2: controled 3 orange points
       if (typm4(5).eq.2) then
       xpeq=xequis+1.*typm6(5)*dsin(-alpha)
       ypeq=yequis-1.*typm6(5)*dcos(-alpha)
       xdesp1x=typm5(5)*dsin(-alpha)
       xdesp1y=-typm5(5)*dcos(-alpha)
       xdesp2x=2.*typm5(5)*dsin(-alpha)
       xdesp2y=-2.*typm5(5)*dcos(-alpha)
       call point (psep+xpeq+2520*xkf,psey-ypeq,30)
       call point (psep+xpeq-xdesp1x+2520*xkf,psey-ypeq+xdesp1y,30)
       call point (psep+xpeq-xdesp2x+2520*xkf,psey-ypeq+xdesp2y,30)
       end if

c      Case 3: triangle 2 mm
       if (typm4(5).eq.3) then
       xpeq=xequis-typm6(5)*dsin(-alpha)
       ypeq=yequis+typm6(5)*dcos(-alpha)
       call mtriangle(psep+xpeq+2520*xkf,psey-ypeq,typm5(5),-alpha+pi,1)
       end if

       end if

       xlen=xlen+dsqrt((v(i,j,10)-v(i,j-1,10))**2.+(u(i,j,10)-
     + u(i,j-1,10))**2.)
       xlenp=xlen+dsqrt((v(i,j-1,10)-v(i,j-2,10))**2.+
     + (u(i,j-1,10)-u(i,j-2,10))**2.)

       end do ! j

       end do ! klz right side

       return
       end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUROUTINE ROMANO POINT I LINE 1-2
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE romanop(i,is,x1,y1,x2,y2,y3,psep,psey,xkf)

       real*8 x1,x2,x3,x4,y1,y2,y3,y4,xkf,psep,psey
       integer typm1(50),typm4(50),is
       real*8 typm2(50),typm3(50),typm5(50),typm6(50)
       real*8 alpha1,alpha2
       real*8 xu,xv,horz,vert,hipo
       real*8 u1,v1,u2,v2
       common /markstypes/ typm1,typm2,typm3,typm4,typm5,typm6

c      is=1    Extrados
c      is=-1   Intrados
       if (is.eq.1) then
       alpha1=-datan((y2-y1)/(x2-x1))
       end if
       if (is.eq.-1) then
       alpha1=-datan((y2-y1)/(x2-x1))+4.*atan(1.)
       end if
       horz=typm2(8)*dsqrt((x2-x1)**2.+(y2-y1)**2.)
       vert=typm3(8)*0.10d0
       hipo=dsqrt(horz*horz+vert*vert)
       alpha2=2.*datan(1.0d0)+alpha1

       u1=hipo*dcos(alpha1)
       v1=-hipo*dsin(alpha1)
       u2=u1-vert*dcos(alpha2)
       v2=v1+vert*dsin(alpha2)

       call romano(i+1,psep+x1+u2,y1+v2+psey,alpha1,typm6(8)*0.1,7)
       call romano(i+1,psep+x1+u2+2520.*xkf,y1+v2+psey,alpha1,
     + typm6(8)*0.1,7)

       return
       end





cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUROUTINE ROMANO POINT IN ARC using points 1-2
c      call subroutine arc3parc
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE romanoparc(i,iq,npunt,uf,vf,dfle,is,psep,psey,ic,xkf)

c      SUBROUTINE romanoparc(i,uu1,vv1,uu2,vv2,y3,psep,psey,xkf)


       real*8 uf(0:100,500,50),vf(0:100,500,50)
       real*8 psep,psey,dfle,sfle,tetha,omega,puntu(0:10),puntv(0:10)
       real*8 a,b,c,d,e,f,ep,eps,ep1,ep3,radi,epinc,bv,cv,xupp
       real*8 g,mu,xi,parcu(0:21),parcv(0:21),parcul(0:21),parcvl(0:21)
       real*8 parcve(0:21),parcue(0:21)
       real*8 xru(2),xrv(2),xsu(2),xsv(2)
       real*8 uu1,vv1,uu2,vv2,xlen1,xlen2,xlenco
       integer npunt,j,iq,ic,is,isn,kini,kfin,ii

       real*8 xkf
       integer typm1(50),typm4(50)
       real*8 typm2(50),typm3(50),typm5(50),typm6(50)
       real*8 alpha1,alpha2
       real*8 vert,hipo
       real*8 u1,v1,u2,v2
       common /markstypes/ typm1,typm2,typm3,typm4,typm5,typm6

c      Parameters interpretation:
c      iq=1  extrados
c      iq=-1 intrados
c      is=1  fletxa +
c      is=-1 fletxa -
c      ic=1  case print
c      ic=2  case laser


c      Sign control (negative 3D)
       isn=is
       ii=1
       if (dfle.lt.0.) then
       ii=-1
       end if
       isn=isn*ii

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      1. Selection points in the arc (based in subroutine arc3p)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       
       xlenco=typm2(8)  ! fraction of arc
       xupp=1.0d0 ! (no cal aquí)
       j=npunt

c      Evita radi infinit
       if (dabs(dfle).lt.0.000001d0) then
       dfle=0.00001d0 ! :)
       end if

c      ic=1 draw complete borders
c      ic=2 draw only external borders

c      Set basic points 1-2-3-4

       puntu(1)=uf(i,j,9)
       puntv(1)=vf(i,j,9)
       puntu(3)=uf(i,j,10)
       puntv(3)=vf(i,j,10)
       puntu(4)=0.5d0*(puntu(1)+puntu(3))
       puntv(4)=0.5d0*(puntv(1)+puntv(3))
       puntu(9)=puntu(3)
       puntv(9)=puntv(3)

       sfle=0.5d0*dsqrt((puntu(1)-puntu(3))**2.+(puntv(1)-puntv(3))**2.)
       tetha=datan(dfle/sfle)
       omega=datan((puntv(1)-puntv(3))/(puntu(3)-puntu(1)))
       if (isn.eq.1) then
       puntu(2)=puntu(4)+dfle*dsin(omega)
       puntv(2)=puntv(4)+dfle*dcos(omega)
       end if
       if (isn.eq.-1) then
       puntu(2)=puntu(4)-dfle*dsin(omega)
       puntv(2)=puntv(4)-dfle*dcos(omega)
       end if

c      Circle by 1-2-3 analytical solution
       a=2.0d0*(puntu(2)-puntu(1))
       b=2.0d0*(puntv(2)-puntv(1))
       c=puntu(1)*puntu(1)-puntu(2)*puntu(2)+
     + puntv(1)*puntv(1)-puntv(2)*puntv(2)
       d=2.0d0*(puntu(3)-puntu(2))
       e=2.0d0*(puntv(3)-puntv(2))
       f=puntu(2)*puntu(2)-puntu(3)*puntu(3)+
     + puntv(2)*puntv(2)-puntv(3)*puntv(3)
       puntv(0)=((c*d/a)-f)/(e-(b*d/a))
       puntu(0)=-(puntv(0)*b+c)/a
       radi=dsqrt((puntu(1)-puntu(0))**2.+(puntv(1)-puntv(0))**2.)

c      Consider points in an horizontal segment 1-3
       if (dabs(puntu(3)-puntu(1)).ge.0.01d0) then
       xi=datan((puntv(1)-puntv(3))/(puntu(1)-puntu(3)))
       end if

       g=dsqrt(radi*radi-sfle*sfle)
       mu=datan(sfle/g)

       puntu(3)=puntu(1)+2.0d0*sfle
       puntv(3)=puntv(1)
       puntu(0)=puntu(1)+sfle
       puntv(0)=puntv(1)-g

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Arc internal
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c      Arc global coordinates (u,v) using 21 points
       if (iq.eq.1) then ! extrados orientation
       do k=1,21
       ep=mu-(2.0d0*mu/20.0d0)*dfloat(k-1)
       parcu(k-1)=puntu(0)-radi*dsin(ep)
       parcv(k-1)=puntv(0)+radi*dcos(ep)
       end do
       end if
       if (iq.eq.-1) then ! intrados orientation
       do k=1,21
       ep=mu-(2.0d0*mu/20.0d0)*dfloat(k-1)
       parcu(21-k)=puntu(0)-radi*dsin(ep)
       parcv(21-k)=puntv(0)+radi*dcos(ep)
       end do
       end if

c      Arc local coordinates (u',v')
       do k=0,20
       parcul(k)=parcu(k)-puntu(1)
       parcvl(k)=dfloat(isn)*(parcv(k)-puntv(1))
       end do

c      Rotate local coordinates around punt 1
       do k=0,20
       parcu(k)=parcul(k)*dcos(xi)-parcvl(k)*dsin(xi)+puntu(1)
       parcv(k)=parcul(k)*dsin(xi)+parcvl(k)*dcos(xi)+puntv(1)
       end do

c      Draw rotated arc
       do k=1,20
c       call line(psep+parcu(k-1),psey-parcv(k-1)-5.,
c     + psep+parcu(k),psey-parcv(k)-5.,2)
       end do

c      Arc length
       xlen1=0.0d0
       do k=0,20-1
       xlen1=xlen1+dsqrt((parcu(k+1)-parcu(k))**2.+
     + (parcv(k+1)-parcv(k))**2.)
       end do

c      Detect kini and kfin
       xlen2=0.0d0
       do k=0,20-1
       xlen2=xlen2+dsqrt((parcu(k+1)-parcu(k))**2.+
     + (parcv(k+1)-parcv(k))**2.)
       if (xlen2.le.xlen1*xlenco) then
       kini=k
       kfin=k+2
       end if
       end do

c       write (*,*) i,kini,kfin,xlen1,xlen1*xlenco

c      Some arrangements...
       if (kini.ge.19) then
       kfin=20
       end if
       if (kfin.eq.20) then
       kini=18
       end if

c      Define especial points in the arc
       uu1=parcu(kini)
       vv1=parcv(kini)
       uu2=parcu(kfin)
       vv2=parcv(kfin)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      2. Romano calculus
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       alpha1=datan((vv2-vv1)/(uu2-uu1))
       vert=typm3(8)*0.10d0
       alpha2=2.*datan(1.0d0)+alpha1

       if (iq.eq.1) then
       u1=uu1
       v1=vv1
       u2=u1-vert*dcos(alpha2)
       v2=v1-vert*dsin(alpha2)
       end if

       if (iq.eq.-1) then
       u1=uu1
       v1=vv1
       u2=u1+vert*dcos(alpha2)
       v2=v1+vert*dsin(alpha2)
       alpha1=alpha1+4.*atan(1.)
       end if
       
       call romano(i+1,psep+u2,psey-v2,alpha1,typm6(8)*0.1,7)
       call romano(i+1,psep+u2+2520.*xkf,psey-v2,alpha1,typm6(8)*0.1,7)

       return
       end





cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUROUTINE REFORMAT DAT AIRFOILS
c      call subroutine datair
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

      SUBROUTINE datair(i,rib,np,u,v)

      integer np(0:100,9),kini(0:100),kfin(0:100),npini,npfin
      integer jkini,jkfin
      real*8 u(0:100,500,99),v(0:100,500,99)
      real*8 rib(0:100,500),xini,xfin,yini,yfin,d0,d1,d2,d3,dm
      real*8 ucont(500),vcont(500)

c     Read and count airfoil points

      rewind (24)

      read (24,*)

c      Read up to 1000 points and exit if end of file

       k=1

       do 100 j=1,1000

       read (24,*,IOSTAT=io) u(i,j,1),v(i,j,1)

       write (*,*) i,k,u(i,j,1),v(i,j,1)

       k=k+1

c      Exit if end of file
       if (io.lt.0) goto 200

 100   continue

 200   continue

       np(i,1)=k-2
      
       write (*,*) "Num punts initial",np(i,1)

c      Set inlet points

       xini=rib(i,11)/100.
       xfin=rib(i,12)/100.
       kini(i)=0
       kfin(i)=0

       do j=1,np(i,1)

c      Detect xini and reasign if necesary

       if (u(i,j,1).le.xini.and.u(i,j+1,1).gt.xini.and.v(i,j,1).
     + le.0.0d0.and.rib(i,11).ge.0.0d0) then
       jkini=j
       write (*,*) "jkini= ",j

       d0=dsqrt((u(i,j,1)-u(i,j-1,1))**2.+(v(i,j,1)-v(i,j-1,1))**2.)
       xm=(v(i,j+1,1)-v(i,j,1))/(u(i,j+1,1)-u(i,j,1))
       xb=v(i,j,1)-xm*u(i,j,1)
       yini=xm*xini+xb
       d1=dsqrt((xini-u(i,j,1))**2.+(yini-v(i,j,1))**2.)
       d2=dsqrt((xini-u(i,j+1,1))**2.+(yini-v(i,j+1,1))**2.)
       d3=dsqrt((u(i,j+2,1)-u(i,j+1,1))**2.+(v(i,j+2,1)-v(i,j+1,1))**2.)
       dm=(d0+d1+d2+d3)/3.0d0

       write (*,*) "Ep ini"
       write (*,*) u(i,j,1),xini
       write (*,*) v(i,j,1),yini
       write (*,*) d0,d1,d2,d3,dm

       if (d1.lt.(dm/5.0)) then ! move point j to xini
       u(i,j,1)=xini
       v(i,j,1)=yini
       endif

       if (d2.lt.(dm/5.0)) then ! move point j+1 to xini
       u(i,j+1,1)=xini
       v(i,j+1,1)=yini
       endif

       if (d1.ge.(dm/5.0).and.d2.ge.(dm/5)) then ! add point
       kini=1
       endif

       end if ! xini

c      A verificar grŕficament (!!!!) cas inici extrados
c      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       if (u(i,j,1).ge.xini.and.u(i,j+1,1).lt.xini.and.v(i,j,1).
     + gt.0.0d0.and.rib(i,11).lt.0.0d0) then
       jkini=j
       write (*,*) "jkini= ",j
       end if

c      Detect xfin and reasign if necesary

       if (u(i,j,1).le.xfin.and.u(i,j+1,1).gt.xfin.and.v(i,j,1).
     + le.0.0d0) then
       jkfin=j
       write (*,*) "jkfin= ",j

       d0=dsqrt((u(i,j,1)-u(i,j-1,1))**2.+(v(i,j,1)-v(i,j-1,1))**2.)
       xm=(v(i,j+1,1)-v(i,j,1))/(u(i,j+1,1)-u(i,j,1))
       xb=v(i,j,1)-xm*u(i,j,1)
       yfin=xm*xfin+xb
       d1=dsqrt((xfin-u(i,j,1))**2.+(yfin-v(i,j,1))**2.)
       d2=dsqrt((xfin-u(i,j+1,1))**2.+(yfin-v(i,j+1,1))**2.)
       d3=dsqrt((u(i,j+2,1)-u(i,j+1,1))**2.+(v(i,j+2,1)-v(i,j+1,1))**2.)
       dm=(d0+d1+d2+d3)/3.0d0

       write (*,*) "Ep fin"
       write (*,*) u(i,j,1),xfin
       write (*,*) v(i,j,1),yfin
       write (*,*) d0,d1,d2,d3,dm

       if (d1.lt.(dm/5.0)) then ! move point j to xini
       u(i,j,1)=xfin
       v(i,j,1)=yfin
       endif

       if (d2.lt.(dm/5.0)) then ! move point j+1 to xini
       u(i,j+1,1)=xfin
       v(i,j+1,1)=yfin
       endif

       if (d1.ge.(dm/5.0).and.d2.ge.(dm/5)) then ! add point
       kfin(i)=1
       endif

       end if ! xfin

       end do ! j

c      Points counting
       np(i,1)=np(i,1)+kini(i)+kfin(i)
       np(i,2)=jkini+kini(i)
       np(i,3)=jkfin-jkini+1
       np(i,4)=np(i,1)-jkfin+1+kfin(i)

       write (*,*) "np(i,1)= ",np(i,1)
       write (*,*) "np(i,2)= ",np(i,2)
       write (*,*) "np(i,3)= ",np(i,3)
       write (*,*) "np(i,4)= ",np(i,4)

c      Reasign airfoil points

    
c      Remap airfoils using predefined points

       npini=1
       npfin=np(i,2)
       npobj=66

       do j=npini,npfin
       ucont(j)=u(i,j,1)
       vcont(j)=v(i,j,1)
       end do

       call remapcont(npini,npfin,npobj,ucont,vcont)

       return
       end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE REMAP CONTOUR
c      call subroutine remapcont
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE remapcont (npini,npfin,npobj,ucont,vcont)

       integer npini,npfin,npobj
       real*8 ucont(500),vcont(500),dx(500),dy(500),da(0:500),ds(500)
       real*8 dxn(0:500),dyn(0:500),dsn(0:500),dan(0:500)
       real*8 xl,dm,dmn,dyy,xln


c      Remap airfoils using predefined points

c      Law of points distribution

       xl=0.0d0
       da(npini-1)=0.0d0

c      Contour length
       do j=npini,npfin-1
       xl=xl+dsqrt((ucont(j)-ucont(j+1))**2.0+(vcont(j)
     + -vcont(j+1))**2.0)
       end do

       dm=xl/dfloat(npfin-npini)

       write (*,*) "Ep reformat"
       write (*,*) npini,npfin

c      Law of points distribution
       do j=npini,npfin-1
       dy(j)=dsqrt((ucont(j)-ucont(j+1))**2.+(vcont(j)-vcont(j+1))**2.)
     + /dm
       ds(j)=dsqrt((ucont(j)-ucont(j+1))**2.0+(vcont(j)
     + -vcont(j+1))**2.0)
       da(j)=da(j-1)+ds(j)
       dx(j)=da(j-1)/xl
       write (*,*) j,ds(j)*100.,da(j)*100.,dx(j)
       end do
       dx(npfin)=1.0d0
       dy(npfin)=dy(npfin-1)
       write (*,*) xl*100.

       write (*,*) "Law of points distribution"
       do j=npini,npfin
       write (*,*) j,dx(j),dy(j)
       end do

c      Reformat unitari segment

       dmn=1.0d0/dfloat(npobj-1)
       dan(0)=0.0d0
       dsn(0)=0.0d0
       xln=0.0d0

       do k=1,npobj-1

       dsn(k)=dmn*dyy

       dxn(k)=dmn*dfloat(k-1)

c       write (*,*) k,dxn(k)

c      Detect point
       do j=npini,npfin
       if (dxn(k).ge.dx(j).and.dxn(k).lt.dx(j+1)) then
       dyn(k)=dy(j)
       end if
       end do 

       dsn(k)=dmn*dyn(k)
       dan(k)=dan(k-1)+dsn(k-1)

       xln=xln+dsn(k-1)

       write (*,*) k,dsn(k)*100.,dan(k)*100.

       

       end do ! k

       write (*,*) "XLN= ",xln*100.

c      Scale contour

c      Old contour (xl)
c      New contor  (xln)
c      Scale factor xl/xln

c      Reformat contour

       do k=1,npobj-1

c      Detect point
       do j=npini,npfin-1
       if (dan(k).ge.da(j).and.dan(k).lt.da(j+1)) then
       dyn(k)=dy(j)
       end if

      
       end do


       end do ! k


       return
       end



cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE xyzt
c      Rotates points in airfoils in tree axes and moves
c      to absolute ccordinates
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE xyzt(i,j,u,v,w,rib,np,u_aux,v_aux,w_aux)

       real*8 u(0:100,500,99),v(0:100,500,99),w(0:100,500,99) ! airfoil 3D
       real*8 rib(0:100,500)
       real*8 u_aux(0:100,500,10),v_aux(0:100,500,10),
     + w_aux(0:100,500,10)
       real*8 pi,tetha,rot_z,pos
       integer np(0:100,9)

       pi=4.0d0*datan(1.0d0)
       tetha=rib(i,8)*pi/180.0d0
       rot_z=rib(i,250)*pi/180.0d0
       pos=rib(i,5)*rib(i,251)/100.0d0

c      Starts with scaled and Z DISPLACED coordinates (i,j,3)

c      Washin rotation around X-axis
       u_aux(i,j,2)=(u_aux(i,j,1)-(rib(i,10)/100.)*rib(i,5))*
     + dcos(tetha)+(v_aux(i,j,1))*dsin(tetha)+(rib(i,10)/100.)*rib(i,5)
       v_aux(i,j,2)=(-u_aux(i,j,1)+(rib(i,10)/100.)*rib(i,5))*
     + dsin(tetha)+(v_aux(i,j,1))*dcos(tetha)
       w_aux(i,j,2)=0.0d0

c      Rotation around Z-axis
       w_aux(i,j,3)=-u_aux(i,j,2)*dsin(rot_z)+pos*dsin(rot_z)
       u_aux(i,j,3)=u_aux(i,j,2)*dcos(rot_z)+pos*(1-dcos(rot_z))
       v_aux(i,j,3)=v_aux(i,j,2)

c      Rotation around Y-axis
       w_aux(i,j,4)=-w_aux(i,j,3)*dcos(rib(i,9)*pi/180.)-
     + v_aux(i,j,3)*dsin(rib(i,9)*pi/180.)
       u_aux(i,j,4)=u_aux(i,j,3)
       v_aux(i,j,4)=-w_aux(i,j,3)*dsin(rib(i,9)*pi/180.)+
     + v_aux(i,j,3)*dcos(rib(i,9)*pi/180.)

c      Move to absolute coordinates
       w_aux(i,j,5)=rib(i,6)-w_aux(i,j,4)
       u_aux(i,j,5)=rib(i,3)+u_aux(i,j,4)
       v_aux(i,j,5)=rib(i,7)-v_aux(i,j,4)

       return
       end

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE elliquad
c      Draw ellipses inside quadrilaters
c      Use in vents type 6 and -6
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE elliquad(pgx,pgy,param1,param2)

       real*8 pgx(100),pgy(100) ! generic point
       real*8 param1,param2
       real*8 pi,tetha,angle1,angleinc
       real*8 xp1,yp1,x1,y1,xp2,yp2,x2,y2
       real*8 a,b,distance,distance1,distance2

       pi=4.0d0*datan(1.0d0)

c      Auxiliar points in the quadrilater P1-P2-P3-P4
       pgx(5)=0.5*(pgx(1)+pgx(4))
       pgy(5)=0.5*(pgy(1)+pgy(4))
       pgx(6)=0.5*(pgx(2)+pgx(3))
       pgy(6)=0.5*(pgy(2)+pgy(3))
       pgx(9)=0.5*(pgx(5)+pgx(6))
       pgy(9)=0.5*(pgy(5)+pgy(6))

c      Ellipse angle
       tetha=datan((pgy(6)-pgy(5))/(pgx(6)-pgx(5)))

c      Distance P9-P8
       call distpr(pgx(1),pgy(1),pgx(2),pgy(2),pgx(9),pgy(9),distance)
       distance1=distance
c      Distance P9-P7
       call distpr(pgx(4),pgy(4),pgx(3),pgy(3),pgx(9),pgy(9),distance)
       distance2=distance

c      Definition of ellipse semiaxis
       a=(param1/200.)*dsqrt((pgx(5)-pgx(6))*(pgx(5)-pgx(6))+
     + (pgy(5)-pgy(6))*(pgy(5)-pgy(6)))
       b=(param2/200.)*(distance1+distance2)

c      Draw ellipses in 50 points
       angleinc=2.0d0*pi/dfloat(50)
       do i=1,50
       angle1=angleinc*dfloat(i-1)
       xp1=a*dcos(angle1)
       yp1=b*dsin(angle1)
       x1=xp1*dcos(tetha)-yp1*dsin(tetha)
       y1=xp1*dsin(tetha)+yp1*dcos(tetha)
       xp2=a*dcos(angle1+angleinc)
       yp2=b*dsin(angle1+angleinc)
       x2=xp2*dcos(tetha)-yp2*dsin(tetha)
       y2=xp2*dsin(tetha)+yp2*dcos(tetha)
       call line(pgx(9)+x1,pgy(9)+y1,pgx(9)+x2,pgy(9)+y2,3)
       end do

       return
       end

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE distpr
c      Distance between point P3 and line r (P1-P2)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE distpr(p1x,p1y,p2x,p2y,p3x,p3y,distance)

       real*8 p1x,p1y,p2x,p2y,p3x,p3y,distance
       real*8 A,B,C

c      Line Ax+By+C=0 by points P1,P2
       A=(p2y-p1y)/(p2x-p1x)
       B=-1.0d0
       C=(p2x*p1y-p1x*p2y)/(p2x-p1x)

c      Manage case A*A+B*B=0 !!!!!!!

c      Distance point P3 to line P1-P2
       distance=dabs((A*p3x+B*p3y+C)/dsqrt(A*A+B*B))

c      Manage special cases
c      Case p2x=p1x
       if (dabs(p2x-p1x).lt.0.001d0) then
       distance=dabs(p3x-p1x)
       end if

       return
       end

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE arcfle
c      Draw arc known the segment 1-2 and the arrow flet
c      Arc between points P1-P2, arrow flet, sign, and color
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE arcfle(p1x,p1y,p2x,p2y,flet,iflet,isvet)

       real*8 p1x,p1y,p2x,p2y,p3x,p3y,p4x,p4y,p5x,p5y,flet
       real*8 p6x,p6y,p7x,p7y
       real*8 R,h,s,tethaa
       real*8 tetha,omega,angle,angle0,incangle,pi,sgn
       integer iflet,isvet

       pi=4.0d0*datan(1.0d0)

c      Anticipate the case fle=0.0
       if (flet.le.0.01d0) then
       flet=0.01d0
       end if

c      Solve the circle x^2+y^2=R^2
       s=dsqrt((p2y-p1y)*(p2y-p1y)+(p2x-p1x)*(p2x-p1x))
       h=((s*s/4.)-flet*flet)/(2.*flet)
       R=flet+h

c      Draw arc
       sgn=dfloat(iflet)
       tethaa=datan((p2y-p1y)/(p2x-p1x))
       p3x=0.5*(p1x+p2x)
       p3y=0.5*(p1y+p2y)
       p4x=p3x+sgn*flet*dsin(tethaa)
       p4y=p3y-sgn*flet*dcos(tethaa)
       p5x=p3x-sgn*h*dsin(tethaa)
       p5y=p3y+sgn*h*dcos(tethaa)
       omega=datan(0.5d0*s/h)

       incangle=2.*omega/20.0d0
       angle0=0.5*pi-(tethaa+omega)

c       call line(p1x,p1y,p2x,p2y,3)
c       call line(p3x,p3y,p4x,p4y,2)
c       call line(p3x,p3y,p5x,p5y,1)

       do k=1,20
       angle=angle0+incangle*dfloat(k-1)
       p6x=p5x+sgn*R*dcos(angle)
       p6y=p5y-sgn*R*dsin(angle)
       p7x=p5x+sgn*R*dcos(angle+incangle)
       p7y=p5y-sgn*R*dsin(angle+incangle)
       call line(p6x,p6y,p7x,p7y,isvet)
       end do

       return
       end

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE interpoly2D
c      Interpolate a point in a 2D polyline
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE interpoly2d(xpoly,ypoly,x_poly,y_poly
     + ,xpolylen,npoly1,npoly2,npoly3,distrel)

       real*8 xpoly(500),ypoly(500),x_poly,y_poly,xpolylen
       real*8 xacum1,xacum2,angle,pi,dist,distrel
       integer npoly1,npoly2,npoly3

       pi=4.0d0*datan(1.0d0)

       xacum1=0.0d0
       xacum2=0.0d0

       do j=npoly1,npoly2-1

       xacum2=xacum2+dsqrt((xpoly(j+1)-xpoly(j))*(xpoly(j+1)-xpoly(j))+
     + (ypoly(j+1)-ypoly(j))*(ypoly(j+1)-ypoly(j)))

c      Detect segment and interpolate easy (without angles!)
       if (xpolylen.ge.xacum1.and.xpolylen.le.xacum2) then

       dist=xpolylen-xacum1
       distrel=dist/(xacum2-xacum1) ! Relative distance in interpolation segment
       x_poly=xpoly(j)+distrel*(xpoly(j+1)-xpoly(j))
       y_poly=ypoly(j)+distrel*(ypoly(j+1)-ypoly(j))

       npoly3=j

       end if

       xacum1=xacum2
  
       end do

       return
       end

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      SUBROUTINE interpoly3D
c      Interpolate a point in a 2D polyline
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE interpoly3d(xpoly,ypoly,zpoly,x_poly,y_poly,z_poly,
     + xpolylen,npoly1,npoly2,npoly3,distrel)

       real*8 xpoly(500),ypoly(500),zpoly(500),x_poly,y_poly,z_poly
       real*8 xpolylen,xacum1,xacum2,angle,pi,dist,distrel
       integer npoly1,npoly2,npoly3

       pi=4.0d0*datan(1.0d0)

       xacum1=0.0d0
       xacum2=0.0d0

       do j=npoly1,npoly2-1

       xacum2=xacum2+dsqrt((xpoly(j+1)-xpoly(j))*(xpoly(j+1)-xpoly(j))+
     + (ypoly(j+1)-ypoly(j))*(ypoly(j+1)-ypoly(j))+
     + (zpoly(j+1)-zpoly(j))*(zpoly(j+1)-zpoly(j)))

c      Detect segment and interpolate easy (without angles!)
       if (xpolylen.ge.xacum1.and.xpolylen.le.xacum2) then

       dist=xpolylen-xacum1
       distrel=dist/(xacum2-xacum1) ! Relative distance in interpolation segment
       x_poly=xpoly(j)+distrel*(xpoly(j+1)-xpoly(j))
       y_poly=ypoly(j)+distrel*(ypoly(j+1)-ypoly(j))
       z_poly=zpoly(j)+distrel*(zpoly(j+1)-zpoly(j))

       npoly3=j

       end if

       xacum1=xacum2

       end do

       return
       end



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c     SUBROUTINE eo (even odd detection)
c     evenodd = 1 ---> odd (parell 28)
c     evenodd = 0 ---> even (senar 29)
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE eo(ncells,evenodd)

       integer evenodd,nribss,ncells

       control=((float(ncells))/2.)-float(int(float(ncells)/2.))
       
       if (control.eq.0.) then  ! even-parell
       nribss=int((float(ncells)/2.)+1.)
c      nribss=(ncells/2)+1
       evenodd=0
       end if

       if (control.ne.0) then  ! odd-senar
       nribss=int(((float(ncells)+1.)/2.))
c      nribss=(ncells+1)/2
       evenodd=1
       end if

       return
       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c     SUBROUTINE distanceabc(x1,y1,z1,x2,y2,z2,x3,y3,z3,distance)
c     Calcules point 3 at a distance from 1, in segment between points 1 and 2
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE distance123(x1,y1,z1,x2,y2,z2,x3,y3,z3,distance)

       real*8 x1,y1,z1,x2,y2,z2,x3,y3,z3,distance,distot,distu

       distot=dsqrt((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)+(z2-z1)*(z2-z1))
       distu=distance/distot

       x3=x1+distu*(x2-x1)
       y3=y1+distu*(y2-y1)
       z3=z1+distu*(z2-z1)

       return
       end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c     SUBROUTINE tessella(x1,y1,z1,x2,y2,z2,x3,y3,z3,distance)
c     
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE tessella(i,rib,np,u,v,w,hautok,nsegments,tesse3d)

       real*8 x0,y0,z0,x1,y1,z1,x2,y2,z2,x3,y3,z3,distance,distot,distu
       real*8 x4,y4,z4,x5,y5,z5,x6,y6,z6,x7,y7,z7
       integer np(0:100,9),nsegments
       real*8 u(0:100,500,99),v(0:100,500,99),w(0:100,500,99)
       real*8 rib(0:100,500)
       real*8 hautok(0:100,500),d,q,R,theta,omega,pi,alpha
       real*8 tesse3d(3,0:100,500,99)

       pi=4.0d0*datan(1.0d0)
       
c      Start loop for each airfoil point
       do j=1,np(i,1)

c      1. Calcule arc local points

       d=dsqrt((u(i-1,j,47)-u(i,j,47))**2+(v(i-1,j,47)-v(i,j,47))**2+
     + (w(i-1,j,47)-w(i,j,47))**2)

       q=(d*d/(8.0*hautok(i,j)))-0.5*hautok(i,j)
       R=q+hautok(i,j)

       theta=datan(q/(0.50d0*d))
       omega=pi-(2.0d0*theta)

c      Start tessellation points

c      Local tessellation
c      Case hautok < 0.01
       if (hautok(i,j).ge.0.01d0) then
       do k=1,nsegments+1
       alpha=theta+(omega/dfloat(nsegments))*dfloat(k-1)
       x0=0.5*d-R*dcos(alpha)
       z0=R*dsin(alpha)-q

c      Interpolate points in space
       x1=u(i,j,47)
       y1=v(i,j,47)
       z1=w(i,j,47)
       x2=u(i-1,j,47)
       y2=v(i-1,j,47)
       z2=w(i-1,j,47)
       distance=x0
       call distance123(x1,y1,z1,x2,y2,z2,x3,y3,z3,distance)
       x5=x3
       y5=y3
       z5=z3

       x1=u(i,j,48)
       y1=v(i,j,48)
       z1=w(i,j,48)
       x2=u(i,j,49)
       y2=v(i,j,49)
       z2=w(i,j,49)
       distance=z0
       call distance123(x1,y1,z1,x2,y2,z2,x3,y3,z3,distance)
       x7=x3
       y7=y3
       z7=z3

       x4=x1
       y4=y1
       z4=z1

       x6=x5+(x7-x4)
       y6=y5+(y7-y4)
       z6=z5+(z7-z4)

c      Define tessellation points
       tesse3d(1,i,j,k)=x6
       tesse3d(2,i,j,k)=y6
       tesse3d(3,i,j,k)=z6

       end do !k segments
       end if ! hautok

c      Case hautok >= 0.01
       if (hautok(i,j).lt.0.01d0) then
       do k=1,nsegments+1
       x0=dfloat(k-1)*d/dfloat(nsegments)
       z0=0.0d0

c      Interpolate points in space
       x1=u(i,j,47)
       y1=v(i,j,47)
       z1=w(i,j,47)
       x2=u(i-1,j,47)
       y2=v(i-1,j,47)
       z2=w(i-1,j,47)
       distance=x0
       call distance123(x1,y1,z1,x2,y2,z2,x3,y3,z3,distance)
       x5=x3
       y5=y3
       z5=z3

c      Define tessellation points
       tesse3d(1,i,j,k)=x5
       tesse3d(2,i,j,k)=y5
       tesse3d(3,i,j,k)=z5

       end do ! k
       end if ! hautok

       end do !j

       return
       end


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c     SUBROUTINE        interpseg(jini,jfin,jc,ldif,
c                       useg,vseg,linter,upoint,vpoint)
c     
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

       SUBROUTINE interpseg(jini,jfin,jc,ldif,
     + useg,vseg,ltotal,linter,upoint,vpoint)

       real*8 useg(1000),vseg(1000)
       real*8 lsegment,lsegmentc,ltotal,linter,pi
       real*8 lparcial,lparcial1,lparcial2,ldif
       real*8 xk,xb,upoint(100),vpoint(100)
       integer npunts,i,jini,jfin,jc

       pi=4.0d0*datan(1.0d0)

c      Polyline lenght
       ltotal=0.0d0
       do j=jini,jfin-1
       lsegment=dsqrt((useg(j+1)-useg(j))**2.+(vseg(j+1)-vseg(j))**2.)
       ltotal=ltotal+lsegment
       end do

c      Detect segment
       lparcial=0.0d0
       lparcial1=0.0d0
       lparcial2=0.0d0
       do j=jini,jfin-1
       lsegment=dsqrt((useg(j+1)-useg(j))**2.+(vseg(j+1)-vseg(j))**2.)
       lparcial1=lparcial
       lparcial2=lparcial+lsegment
       if (linter.ge.lparcial1.and.linter.le.lparcial2) then
       jc=j  ! control point
       ldif=linter-lparcial1
       lsegmentc=lsegment
       end if
       lparcial=lparcial2
       end do

c      Interpolation point upoint(1),vpoint(1)
       xk=(vseg(jc+1)-vseg(jc))/(useg(jc+1)-useg(jc))
       xb=vseg(jc)-xk*useg(jc)
       upoint(1)=useg(jc)+(ldif/lsegmentc)*(useg(jc+1)-useg(jc))
       vpoint(1)=xk*upoint(1)+xb

       return
       end



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c     SUBROUTINE        nonan(filename)
c     The answer by DeepSeek at my question:
c     "Translate these bash code: 
c     sed -i 's/NaN/0.0/g' leparagliding.dxf"
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c     DXF not working!!! :-(



      SUBROUTINE NONAN(FNAME)
C     Direct sed replacement: s/NaN/0.0/g
      
      CHARACTER*(*) FNAME
      CHARACTER*204 LINE
      CHARACTER*204 OUTLINE
      INTEGER I, J, L, N
      LOGICAL DONE
      
C     Process to temporary file
      OPEN(1, FILE=FNAME)
      OPEN(2, FILE='temp_fix.dxf')
      
      DONE = .FALSE.
      DO WHILE (.NOT. DONE)
          READ(1, '(A)', IOSTAT=I) LINE
          IF (I .LT. 0) THEN
              DONE = .TRUE.
          ELSE
C             Get actual line length
              L = 0
              DO N = 1, 204
                  IF (LINE(N:N) .NE. ' ') THEN
                      L = N
                  ENDIF
              END DO
              
C             Initialize output line
              OUTLINE = ' '
              J = 1
              I = 1
              
C             Process character by character
              DO WHILE (I .LE. L-2)
                  IF (LINE(I:I+2) .EQ. 'NaN') THEN
C                     Copy characters before NaN
                      IF (J .LT. I) THEN
                          OUTLINE(J:I-1) = LINE(J:I-1)
                          J = I
                      ENDIF
C                     Add replacement
                      OUTLINE(J:J+2) = '0.0'
                      J = J + 3
                      I = I + 3
                  ELSE
                      OUTLINE(J:J) = LINE(I:I)
                      J = J + 1
                      I = I + 1
                  ENDIF
              END DO
              
C             Copy remaining characters
              DO WHILE (I .LE. L)
                  OUTLINE(J:J) = LINE(I:I)
                  J = J + 1
                  I = I + 1
              END DO
              
C             Write the line
              WRITE(2, '(A)') OUTLINE(1:J-1)
          ENDIF
      END DO
      
      CLOSE(1)
      CLOSE(2)
      
C     Copy back to original
      OPEN(1, FILE='temp_fix.dxf')
      OPEN(2, FILE=FNAME, STATUS='REPLACE')
      
      DONE = .FALSE.
      DO WHILE (.NOT. DONE)
          READ(1, '(A)', IOSTAT=I) LINE
          IF (I .LT. 0) THEN
              DONE = .TRUE.
          ELSE
              WRITE(2, '(A)') TRIM(LINE)
          ENDIF
      END DO
      
      CLOSE(1)
      CLOSE(2)
      
C     Clean up
      OPEN(1, FILE='temp_fix.dxf')
      CLOSE(1, STATUS='DELETE')
      
      return
      END


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


      SUBROUTINE FIX_DXF_NAN(FILENAME)
C     Complete fix for AutoCAD DXF with NaN replacement
      
      CHARACTER*(*) FILENAME
      CHARACTER*2048 LINE, TEMPFILE
      INTEGER I, J, L, IOS
      LOGICAL HAS_EOF, PROCESSING
      
      TEMPFILE = 'dxf_fixed.tmp'
      
C     First pass: replace NaN and check structure
      OPEN(10, FILE=FILENAME, STATUS='OLD')
      OPEN(11, FILE=TEMPFILE, STATUS='NEW')
      
      HAS_EOF = .FALSE.
      PROCESSING = .TRUE.
      
      DO WHILE (PROCESSING)
          READ(10, '(A)', IOSTAT=IOS) LINE
          
          IF (IOS .LT. 0) THEN
              PROCESSING = .FALSE.
          ELSE
C             Check if this is EOF marker
              L = LEN_TRIM(LINE)
              IF (L .GE. 3) THEN
                  IF (LINE(1:3) .EQ. '  0') THEN
                      IF (INDEX(LINE, 'EOF') .GT. 0) THEN
                          HAS_EOF = .TRUE.
                      ENDIF
                  ENDIF
              ENDIF
              
C             Replace NaN in this line
              CALL REPLACE_IN_STRING(LINE, 'NaN', '0.0')
              
C             Write processed line
              WRITE(11, '(A)') TRIM(LINE)
          ENDIF
      END DO
      
      CLOSE(10)
      CLOSE(11)
      
C     Second pass: ensure proper EOF and copy back
      OPEN(10, FILE=TEMPFILE, STATUS='OLD')
      OPEN(11, FILE=FILENAME, STATUS='REPLACE')
      
      PROCESSING = .TRUE.
      DO WHILE (PROCESSING)
          READ(10, '(A)', IOSTAT=IOS) LINE
          
          IF (IOS .LT. 0) THEN
              PROCESSING = .FALSE.
              
C             Add EOF if missing
              IF (.NOT. HAS_EOF) THEN
                  WRITE(11, '(A)') '  0'
                  WRITE(11, '(A)') 'EOF'
              ENDIF
          ELSE
              WRITE(11, '(A)') TRIM(LINE)
          ENDIF
      END DO
      
      CLOSE(10)
      CLOSE(11)
      
C     Clean up
      OPEN(10, FILE=TEMPFILE)
      CLOSE(10, STATUS='DELETE')
      
      END
      
      SUBROUTINE REPLACE_IN_STRING(STR, OLD, NEW)
C     Replace all occurrences of OLD with NEW in STR
      
      CHARACTER*(*) STR, OLD, NEW
      CHARACTER*2048 RESULT
      INTEGER I, J, L, OLDLEN, NEWLEN, POS
      
      OLDLEN = LEN_TRIM(OLD)
      NEWLEN = LEN_TRIM(NEW)
      L = LEN_TRIM(STR)
      RESULT = ' '
      J = 1
      I = 1
      
      DO WHILE (I .LE. L)
          IF (I .LE. L-OLDLEN+1) THEN
              IF (STR(I:I+OLDLEN-1) .EQ. OLD(1:OLDLEN)) THEN
                  IF (J .LT. I) THEN
                      RESULT(J:I-1) = STR(J:I-1)
                      J = I
                  ENDIF
                  RESULT(J:J+NEWLEN-1) = NEW(1:NEWLEN)
                  J = J + NEWLEN
                  I = I + OLDLEN
              ELSE
                  RESULT(J:J) = STR(I:I)
                  J = J + 1
                  I = I + 1
              ENDIF
          ELSE
              RESULT(J:J) = STR(I:I)
              J = J + 1
              I = I + 1
          ENDIF
      END DO
      
      STR = RESULT(1:J-1)
      
      END


c     DXF not working!!! :-(  ^^^^^^







ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c     SUBROUTINE loc2glo2D(n,xloc,yloc,xglo,yglo,x0,y0,angle)
c     Local to global coordinates 2D by translation and rotation
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

      SUBROUTINE loc2glo2D(n,xloc,yloc,xglo,yglo,x0,y0,angle)

c     Local coordinates xloc, yloc
      real*8 xloc(0:3000),yloc(0:3000)
      real*8 xglo(0:3000),yglo(0:3000)
      real*8 x0,y0,angle,pi,c,s

      pi=4.0d0*datan(1.0d0)

      s=dsin(angle*pi/180.)
      c=dcos(angle*pi/180.)

      do k=1,n
      xglo(k)=c*xloc(k)-s*yloc(k)+x0
      yglo(k)=s*xloc(k)+c*yloc(k)+y0
      end do

      return
      end




