program ncsn2cnss
c
c	programmer: david oppenheimer (2/8/99)
c
c	usage: ncsn2cnss <hypoinverse_archive_file > cnss_phase_file
c
c	creates cnss format data (cnss-catalog-ver-1.0.3).
c	identical to hinv2cnss, except all calls to phs2cnss are commented out 
c	and the phase output file (ounit) is a scratch file that disappears
c	at termination

	implicit none
	integer		eunit				! logical unit number of error output
	integer		iunit				! logical unit number of phase file input
	integer		ounit				! logical unit number of phase output
	integer		sunit				! logical unit number of summary (catalog) output
	integer		mxphs				! maximum number of phases allowed in an event
c
	parameter (eunit=3, iunit=5, ounit=4, sunit=6, mxphs = 3000)
c
        real                    amag                    ! Eaton amplitude magnitude 
	real			ampmag			! station coda magnitude
	character*200           card(mxphs)		! phase cards
        real                    cmag                    ! Eaton coda magnitude 
	character*8		date			! date string
	character*17            dollar			! scratch variable to test for presence of shadow card & y2k
	real			durmag			! station duration magnitude
	logical                 erflag			! flag: true=errors found
	character*41            filnme			! error output file name
	character*100           filnmp			! cnss phase output file name
	integer			id(3)			! numeric m/d/y date fields returned by system function
	integer                 i			! loop index
	integer                 iawt			! amplitude magnitude weight
	integer                 icwt			! coda magnitude weight
	integer                 ierr			! error return flag
	integer                 ios			! iostat variable
	integer                 iline			! line # of file
        integer                 iday			! day of origin time
        integer                 ihour			! hour of origin time
        integer                 imin			! minute of origin time
        integer                 imonth			! month of origin time
        integer                 iyear			! year of origin time
        real                    lmag                    ! WA mag
	integer                 nampl			! number of WA amp readings used in Eaton amplitude magnitude
	integer                 nampx			! number of S amp readings used in local (ML) amplitude magnitude
	integer                 ncodv			! number of coda readings used in high-gain magnitude
	integer                 ncodz			! number of coda readings used in low-gain magnitude
	integer                 np			! number of phase cards
	character*200		shadow(mxphs)		! shadow card
	logical                 shdo			! flag:t(f)=do(not) read shadow card
        real                    sec                     ! sec of origin time
	character*2		typmag			! CNSS magnitude type
	character*1             vrep			! flag:y(n)=do(not) replace a space in 4th column of station with a "v"
        real                    wmag                    ! Moment mag
	logical			y2k			! y2k format found for hypoinverse file
        real                    zmag                    ! Hirshorn Z coda mag

c	filnam = 'none'
c10	call askc ('enter name of archive file', filnam)
c	open (iunit, file = filnam, status = 'old', blank =
c     & 'zero', err = 10)

	filnme = 'ncsn2cnss.err'
	open (eunit, file = filnme, status = 'unknown')
	np = 2
	read (iunit, '(a)', end =200) dollar
	if (dollar(9:9) .ne. ' ' .and.
     1 (dollar(17:17) .eq. ' ' .or. dollar(17:17) .eq. 's')) then
	  y2k = .false.
	elseif (dollar(12:12) .ne. ' ' .and. dollar(17:17).ne.' ')then
	  y2k = .true.
	else
	  write (eunit, *) 'rdeq2 error: y2k format is unclear'
	  stop
	endif

	read (iunit, '(a)', end =200) dollar
	if (dollar(1:1) .eq. '$') then
	  shdo = .true.
	else
	  shdo = .false.
	endif
	rewind(iunit)
	filnmp = 'cnss.phase'
	open (ounit, file = filnmp, status = 'scratch') 
	write (ounit, '(a)') '$fmt cnss-catalog-ver-1.0.3'
	write (sunit, '(a)') '$fmt cnss-catalog-ver-1.0.3'
	vrep = 'n'
	erflag = .false.
        call idate(id)
        write (date, '(i4, 2i2.2)'), id(3), id(2), id(1)
	iline = 0

c	next event; reset counter

20	np = 0
	ncodv = 0
	ncodz = 0
	nampx = 0
	nampl = 0
	ierr = 0
30	np = np + 1
	if (np .gt. 3000) then
	  write (eunit, *) 'number of phases in event exceeds ', mxphs
	  stop
	endif
        iline = iline + 1

c	read a line 

        read (iunit, '(a)', iostat = ios, end = 200) card(np)
	if (ios .ne. 0) then
	  write (eunit, 40) iline
40	  format (/, 1x, '***** error reading archive file at line', i)
	  stop
	end if

	if (shdo) then
	  iline = iline + 1
	  read (iunit, '(a)', iostat = ios) shadow(np)
	  if (ios .ne. 0) then
	    write (eunit, 41) iline
41	    format (/, 1x, '***** error shadow card at line', i)
	    stop
	  end if
	end if

c	end of event

	if (card(np)(1:4) .eq. '    ') then
          goto 45
	else

c	Reconstruct count of number of coda, amplitude readings for cnss output.  
c	Hypoinverse reports weighted number. CNSS needs unweighted count

	  if (np .gt. 1) then
	    if (.not. y2k) then
	      read (card(np), 42, iostat = ierr) icwt, durmag
42	      format (t67, i1, t79, f2.1)
	    else
	      read (card(np), 422, iostat = ierr) icwt, durmag
422	      format (t83, i1, t95, f3.2)
	    endif
	    if (ierr .ne. 0) then
	      write (eunit, 43) iline
43	      format ('***** error decoding card at line', i)
	      stop
	    end if
            if (durmag .gt. 0. .and. icwt .lt. 4) then
	      if (.not. y2k) then
	        if (card(np)(93:93) .eq. 'D') ncodv = ncodv + 1
	        if (card(np)(93:93) .eq. 'Z') ncodz = ncodz + 1
	      else
	        if (card(np)(110:110) .eq. 'D') ncodv = ncodv + 1
	        if (card(np)(110:110) .eq. 'Z') ncodz = ncodz + 1
	      endif
	    endif
	    if (.not. y2k) then
	      read (card(np), 44, iostat = ierr) iawt, ampmag
44	      format (t66, i1, t81, f2.1) 
	    else
	      read (card(np), 444, iostat = ierr) iawt, ampmag
444	      format (t82, i1, t98, f3.2) 
	    endif
	    if (ierr .ne. 0) then
	      write (eunit, 43) iline
	      stop
	    end if
            if (ampmag .gt. 0. .and. iawt .lt. 4) then
	      if (.not. y2k) then
	        if (card(np)(94:94) .eq. 'L') nampl = nampl + 1
	        if (card(np)(94:94) .eq. 'X') nampx = nampx + 1
	      else
	        if (card(np)(111:111) .eq. 'L') nampl = nampl + 1
	        if (card(np)(111:111) .eq. 'X') nampx = nampx + 1
	      endif
	    endif
	  endif
	  goto 30
	endif

c	summary card

45	ierr = 0
	write (ounit, '(a4)') '$beg'
	write (sunit, '(a4)') '$beg'
	call sum2cnss (card(1), ounit, sunit, eunit, date, cmag, amag, 
     1 zmag, lmag, wmag, iyear, imonth, iday, ihour, imin, sec, ncodv, 
     2 ncodz, nampl, nampx, y2k, ierr, typmag)

	if (ierr .eq. 1) then
	  if (shdo) then
	    i = iline - 2*np +1
	  else
	    i = iline - np +1
	  endif
	  write (eunit, 50) i
	  write (eunit, 50) i
50	  format ('Error on summary card on line ', i)
	  write (eunit, '(a)') card(1)
	  write (eunit, '(a)') card(1)
	  stop
	endif

c	phase/shadow card

c	do i = 2, np - 1
c	  ierr = 0
c	  call phs2cnss (card(i), ounit, eunit, shdo, shadow(i),
c     2 cmag, amag, zmag, lmag, wmag, iyear, imonth, iday, ihour, 
c     3 imin, sec, y2k, ierr)
c	  if (ierr .eq. 1) then
c	    if (shdo) then
c	      j = iline - 2*np + 2*i - 1
c	    else
c	      j = iline - np + i - 1
c	    endif
c	    write (eunit, '(a, i)') 'Skipping card on line ', j
c	    write (eunit, '(a)') card(i)
c	    write (eunit, '(a, i)') 'Error occurred on line ', j
c	    write (eunit, '(a)') card(i)
c	  endif
c	end do

	write (ounit, '(a4)') '$end'
	write (sunit, '(a4)') '$end'
	goto 20

c	end of file

200	if (np .gt. 1 ) write (eunit, *) 'unexpected EOF'
	close (eunit)
c	close (iunit)
	close (ounit)
c	close (sunit)
	stop
	end