c
	program xcdks
c
c Extract header files (common decks) from update source (file_in),
c creating .h files, and create source for compiler with fortran
c include statements. (file_in created by update in mksrc script)
c   
c 5/96: Adapted from Ken Hansen's "lazy.f", to add .h suffix on end
c       of all header (common deck) files.
c
	character*100 in, out
	character*16 file_in, file_out
	character*16  name
	character*1 mc
	integer unit

	character*8 acc, fmt, fname
	logical nmd,ex, od

c Master character
	data mc /'*'/

	data file_in  /'twod.src'/
	data file_out /'twod.f'/

	open(1,file = file_in, status = 'old')
	open(2,file = file_out)

	do i = 1, 100000
	  read(1,'(a)',end=100)in
	  irec = irec + 1
	  out(1:) = in(1:)

c Check for master character
	  if(in(1:1) .eq. mc)then

c Is a COMDK still open?  If so, close it.
	  inquire(3,   named=nmd, name=fname, exist=ex, opened=od,
     *    access=acc, form=fmt)

c**         write(6,201) nmd, ex, od, acc, fname, unit
	    if(od)then

c check for "*IF DEF" conditional
	      If(in(1:7).eq. mc // 'IF DEF')then
		elseif(in(1:11).eq. mc // 'ELSEIF DEF')then
		elseif(in(1:7) .eq. mc // 'ENDIF ')then
		elseif(in(1:7) .eq. mc // 'ELSE  ')then
	      else
		close(3)
		write(6,'(''comdeck - '',a,2x,i4)')name,krec
		krec = 0
	      endif
	    endif

c *CA
	    If(in(1:4).eq. mc // 'CA ')then
	      idx = index(in(5:),' ') + 3
	      out(1:) = '      include ''' // in(5:idx) // '.h' // ''''
	      out(70:100) = in(70:)
	      unit = 2
c**           write(6,'(a)')out

c *CALL
	    elseif(in(1:6).eq. mc // 'CALL ')then
c**           write(6,'(i6,3x,a,5x,a)')irec,in(1:20),in(70:100)
	      idx = index(in(7:),' ') + 5
	      out(1:) = '      include ''' // in(7:idx) // ''''
	      out(70:100) = in(70:)
	      unit = 2
c**           write(6,'(a)')out

c *CDK DK_NAME
	    elseif(in(1:5).eq. mc // 'CDK ')then
	      idx = index(in(6:),' ') + 4
	      name(1:) = in(6:idx) // '.h'
              write(6,'(a,i5,2x,''&'',a,''&'')')in(1:idx),idx,name(1:)
	      open (3, file=name)
	      unit = 3
	      krec = 0

c *COMDECK DK_NAME
c 12345678901234567890
	    elseif(in(1:9).eq. mc // 'COMDECK ')then
	      idx = index(in(10:),' ') + 8
	      name(1:) = in(10:idx)
              write(6,'(a,i5,2x,''&'',a,''&'')')in(1:idx),idx,name(1:)

	      open (3, file=name)
	      unit = 3
	      krec = 0

c *DK, DECK,..
	    elseif(in(1:6).eq. mc // 'DECK ')then
	      write(6,'(a)')out
	      unit = 2
	      krec = 0

	    elseif(in(1:4).eq. mc // 'DK ')then
	      write(6,'(a)')out
	      unit = 2
	      krec = 0

	      unit = 2
	      krec = 0

	    else
	      write(6,'('' Unsupported Directive '',a)')out(1:20)
	    endif

	  endif

	krec = krec + 1
	write(unit,'(a)')out

c        if(unit.eq.3)then
c          write(6,'(2i5)')unit,krec
c        endif

	enddo
	close(1)
	close(2)
	close(3)
	stop

100     print *,' EOF on input, irec ,',irec
	close(2)
	close(3)

201     format(1x,L8/1x,'     EXISTS ',l8/
     1               1x,'     OPENED ',l8/
     3               1x,'     ACCESS ',a/
     4               1x,'     F_NAME ',a/
     5               1x,'     UNIT   ',i3)
	end