ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      AIR 2 DXF
c      Converts any .dat airfoil to .dxf
c      by Pere Casellas
c      Laboratori d'envol
c      FORTRAN g77 (GNU/Linux)
c      Version 20130814
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

      program airfoiltodxf

      integer ncolor, ct
      integer linecolor,pointcolor

c     real p1x,p1y,p2x,p2y

      real xa(2000), ya(2000)

      character*50 nomair

      ncolor=1

      open(unit=20,file='airfoil.dxf')
      open(unit=22,file='airfoil.dat')
      open(unit=23,file='new.dat')

      rewind (22)

      read (22,*) nomair

c     Curious CLS command
      write (*,10) char(27)
10    format (A,'[2J')

c     Read up to 2000 points

      npunts=0

      do 100 i=1,2000

      read (22,*,IOSTAT=io) xa(i), ya(i)

      npunts=npunts+1

c     Exit if end of file
      if (io.lt.0) goto 200

 100  continue

 200  continue

      npunts=npunts-2

c     Basic
      
      xq=1.0
      write (*,*) "Laboratori d'envol"
      write (*,*) "AIRFOIL to DXF "
      write (*,*)
      write (*,*) "Converts and normalize any .dat standard file to "
      write (*,*) ".dxf airfoil, and scale thickness if necessary"
c      write (*,*) "Name of the airfoil is ", nomair
      write (*,*) "Points number is ", npunts
      write (*,*)
      write (*,*) "Enter new thickness factor K i.e. 1.0 : "
      read (5,*) xq

c     Normalize airfoil
      write (23,*) "New_airfoil"
      xk=1.
      if (xa(1).gt.1) then
      xk=xa(1)
      end if
      do i=1, npunts
      xa(i)=xa(i)/xk
      ya(i)=xq*ya(i)/xk
      write (*,'(I4,4x,F10.8,4x,F10.8)') i, xa(i), ya(i)
      write (23,'(F10.8,4x,F10.8)') xa(i), ya(i)
      end do

      call dxfinit(20)

      do i=1,npunts-1

      call line(100.*xa(i),100.*ya(i),100.*xa(i+1),100.*ya(i+1),ncolor)

      end do

      call line(0.,0.,100.,0.,3)

c     Close the output .dxf file

      call dxfend(20)

c     Close units

      close (20)
      close (22)
      close (23)

      end

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     Graphical SUBROUTINES
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

      SUBROUTINE line(p1x,p1y,p2x,p2y,linecolor)
c     line P1-P2
      integer linecolor
      real p1x,p2x,p2y,p1y

c     write (*,'(4(F6.2),3x))') p1x,p1y,p2x,p2y

      write(20,'(A,/,I1,/,A)') "LINE",8,"default"
      write(20,'(I1,/,A)') 6,"CONTINUOUS"
      write(20,'(I2,/,F9.3,/,I2,/,F9.3)') 10,p1x,20,p1y
      write(20,'(I2,/,F9.3,/,I2,/,F9.3)') 11,p2x,21,p2y
      write(20,'(I2,/,I2,/,I2,/,I2,/,I2)') 39,0,62,linecolor,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,-900.,20,90.
       write(nunit,'(I1,/,A)') 9,"$EXTMIN"
       write(nunit,'(I2,/,F12.3,/,I2,/,F12.3)') 10,5000.,20,-3000.
       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