c
c reformat NCSN mech files into CNSS unified format
c
	implicit none
        character*8     date
	integer		id(3)
	integer		i
	integer		iunit
	character*36	line
	character*2	mectyp
	integer		ounit
	character*3	src
	integer		iline
	character*45	file
	character*1	pref
	character*141	sumcrd1
	character*141	sumcrd2
	logical		y2k
c
	parameter (iunit = 15, ounit = 16)
c
        call idate(id)
        write (date, '(i4, 2i2.2)'), id(3), id(2), id(1)
	mectyp = 'F0'
	src = 'NC'
c
	call askc ('enter input fps filename', file)
	open (iunit, file=file, status='old')
c
c  y2k format?
c
        read (iunit, '(a)') line
        if (line(15:15) .eq. '.' .and. line(34:34) .eq. '.') then
          y2k = .false.
        elseif (line(17:17) .eq. '.' .and. line(36:36) .eq. '.') then
          y2k = .true.
        else
          write (*, '(a)')
     1 'Unable to determine whether file is y1k or y2k format'
          stop
        end if
        rewind (iunit)
	file = 'j.out'
	call askc ('enter output cnss file name', file)
	open (ounit, file=file, status='unknown')
	write (ounit, '(a)') '$fmt cnss-catalog-ver-1.0.3'
c
	pref = ' '
	i = 0
	iline =0
	read (iunit, '(a)', end = 100) sumcrd1
10	iline = iline + 1
	read (iunit, '(a)', end = 100) sumcrd2
	if (sumcrd2(1:80) .ne. sumcrd1(1:80)) then
	  if (iline .gt. 1 .and. i .eq. 0) write (ounit, '(a)') '$end'
          if (i .eq. 0) then
	    write (ounit, '(a)') '$beg'
	    pref = 'P'
	    call mech2cnss (sumcrd1, ounit, src, mectyp, y2k, date,pref)
c	    write (ounit, '(a1, 1x, a)') pref, sumcrd1
	  endif
	  sumcrd1 = sumcrd2
	  i = 0
	else
	  pref = ' '
	  if (i .eq. 0) then
	    if (iline .gt. 1) write (ounit, '(a)') '$end'
            write (ounit, '(a)') '$beg'
c	    write (ounit, '(a1, 1x, a)') pref, sumcrd1
	    call mech2cnss (sumcrd1, ounit, src, mectyp, y2k, date,pref)
	  endif
	  i = 1
c	  write (ounit, '(a1, 1x, a)') pref, sumcrd2
	  call mech2cnss (sumcrd2, ounit, src, mectyp, y2k, date, pref)
	endif
	goto 10
100	if (i .eq. 0) then
	  write (ounit, '(a)') '$end'
	  write (ounit, '(a)') '$beg'
c	  write (ounit, '(a1, 1x, a)') pref, sumcrd1
	  call mech2cnss (sumcrd1, ounit, src, mectyp, y2k, date, pref)
	endif
	write (ounit, '(a)') '$end'
	close(iunit)
	close(ounit)
	stop
	end