c--2000arc converts older non-y2k hypoinverse archive (phase) files to y2000.
c--It is a simplified version of the general purpose 2000conv program.
c--This is a standard i/o (filter) version, ie
c  2000arc <infile >outfile

c--converts station, arc and summary files to year 2000 format
	character li*170, lo*170, c1*1
c	dimension cal(7),id(7), cor(6), iatn(7)

c--get file type
c	write (6,1000)
c1000	format ('File types to convert to 2000 format:'/
c	2 'jf=1 calsta2.loc to calsta2000.loc'/
c	3 'jf=2 all2.cal    to all2000.cal'/
c	3 'jf=3 all2.xmc    to all2000.xmc'/
c	3 'jf=4 all2.fmc    to all2000.fmc'/
c	3 'jf=5 all2.atn    to all2000.atn'/
c	3 'jf=6 x.sum       to x2000.sum'/
c	4 'jf=7 x.arc       to x2000.arc')
c	jf=jask('File format',6)

	jf=7

c--set line length
c	if (jf.eq.6) llo=164

c--open files
c	call iofl

c--read a line and branch
c2	read (2,'(a)',end=110) li
2	read (5,'(a)',end=110) li
	lli=leng(li)
	lo=' '
c	goto (10,20,30,40,50,60,70), jf

c================ arc files =========================
70	lli=leng(li)
	c1=li
c	lo=' '

c--shadow lines always begin with a $ and need no translation
	if (c1.eq.'$') then
	  lo=li
	  llo=lli
	  goto 100
	end if

c--sum lines always begin with a number. use same code as above
	ic=ichar(c1)
	if (ic.gt.47 .and. ic.lt.58) then
	  lo=('19' //li(1:36) //'0' //li(37:69)
	2 //'0' //li(70:78)//' '
	2 //li(79:88) //' ' //li(89:90)//' '
	3 //li(91:93)// ' ' //li(94:142) //' ' //li(143:149)
	4 //' ' //li(150:154))

	  llo=164
	  goto 100
	end if

c--terminator lines begin with 4 blanks, and dont change
	if (li(1:4).eq.'    ') then
	  lo=li
	  llo=lli
	  goto 100
	end if

c--it must be a regular archive line
c	lo(1:4)=li(1:4)			!SITE CODE
c	lo(5:5)=li(95:95)		!SITE CODE
c	lo(6:7)=li(99:100)		!NET CODE
c	lo(8:8)=' '
c	lo(9:9)=li(9:9)			!1l COMP CODE
c	lo(10:12)=li(96:98)		!3l COMP CODE
c	lo(13:13)=' '
c	lo(14:17)=li(5:8)		!P RMK
c	lo(18:19)='19'			!CENTURY
c	lo(20:34)=li(10:24)		!DATE, P TIME
c	lo(35:41)=li(25:31)		!P resid, weight
c	lo(42:50)=li(32:40)		!S TIME, S RMK
c	lo(51:54)=li(41:44)		!S resid
c	lo(55:63)=('  '//li(45:47)//'00 0')	!AMP & UNITS CODE
c	lo(64:94)=li(48:78)		!delays, WEIGHT CODE, dur etc.
c	lo(95:97)=(li(79:80)//'0')	!dur MAG 
c	lo(98:100)=(li(81:82)//'0')	!amp MAG
c	lo(101:108)=li(83:90)		!importance
c	lo(109:111)=li(92:94)		!label codes

c--this is faster
	lo=(li(1:4)// li(95:95)// li(99:100)// ' '// li(9:9)// 			!1l COMP CODE
	2 li(96:98)// ' '// li(5:8)// '19'// li(10:44)// 
	3 '  '// li(45:47)// '00 0'// li(48:80)// '0'// 
	4 li(81:82)// '0'// li(83:90)// li(92:94))

c--insert zeroes in date
	if (lo(22:22).eq.' ') lo(22:22)='0'
	if (lo(24:24).eq.' ') lo(24:24)='0'
	if (lo(26:26).eq.' ') lo(26:26)='0'
	if (lo(28:28).eq.' ') lo(28:28)='0'

	llo=111

c	goto 100

c--write output line
c100	write (3,'(a)') lo(1:llo)
100	write (6,'(a)') lo(1:llo)
	goto 2
110	stop
	end

      INTEGER FUNCTION LENG (STRING)
C
C THE NON-BLANK LENGTH OF STRING WHOSE PHYSICAL LENGTH IS MAXLEN
C (RETURNS THE POSITION OF THE LAST NON-BLANK CHARACTER)
C
      CHARACTER         STRING*(*)	! STRING
C
      INTEGER           I		! CHARACTER POSITION
      INTEGER           MAXLEN		! LENGTH OF STRING

      MAXLEN = LEN(STRING)
      DO 10 I = MAXLEN,1,-1
        IF (STRING(I:I) .NE. ' ') GOTO 20
10    CONTINUE
      I = 0
20    LENG = I
      RETURN
      END