c Date conversion function (part of DTC), derived from DATMUN,
c except decodes the values directly into DEFDAT and shrinks LINE,
c rather than schlep LINE back and forth to kingdom come.
c
c Modified 850422, CG, to restrict values of month/day/year
c
c modified 850325, 850726 & 850731, CG, to allow any of the following:
c	d{d}/m{m}/{y}y, d, dd, dmm, ddmm, dmmyy, ddmmyy, dmmyyyy, ddmmyyyy
c							for D or W functions
c	m{m}/{y}y, m, mm, myy, mmyy, mmyyyy, myyyy	for M
c	y, yy, yyy, yyyy				for Y
c
c plus dd-mon-yy, dd-mm-yy, dd-xii-yy formats
c
c function:
c  Convert a line starting with a date of form
c	mmddyy OR mm/dd/yy OR dd-mon-yy OR dd-romn-yy
c  to binary equivalents, and remove from line, copying binary values
c  to DEFDAT in common.
c
c  Leaves whatever follows the date alone.
c  Added for DTC to not have to use such a crock date
c  format as the original; too hard to use otherwise.

	Subroutine dtcdatcvt (nf)		! (line,nf)
c
	implicit none
c
	integer nf				! Number of fields expected
c
	include 'comdtc.inc/nolist'
c
	byte nb, l1, l2, l3, l4, lxx(4), work(icmln), tb6(6), ln1  !,
c
	integer lm(12)		! lengths of months (30 days hath Sept ...)
	1 /31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/
c
	integer minln(12)	! Min chars to recognize month names
	1 /2, 1, 3, 2, 3, 3, 3, 2, 1, 1, 1, 1/

	character*4 rch, ! Decode month names, or European style w/ Roman months
	1 mab(12) / 'JANU', 'FEBR', 'MARC', 'APRI', 'MAY ', 'JUNE',
	2	    'JULY', 'AUGU', 'SEPT', 'OCTO', 'NOVE', 'DECE'/,
	3 rom(12) / 'I   ', 'II  ', 'III ', 'IV  ', 'V   ', 'VI  ',
	4	    'VII ', 'VIII', 'IX  ', 'X   ', 'XI  ', 'XII '/

	integer i, k, kkk, n, nn, ix, ixyr, ixmo, ixdy, nfd,
	1	ifnb, lnb, lcount

	logical longyr			! If year entered as 3 chars or more

	integer*2 iwk(42), lw1		! 2 chars at a time
c
	integer*4 ll1

	equivalence (line, ln1, lw1),
	1 (ll1, rch, lxx), (work, iwk)
c
	integer icvt10, icur
	byte ich

	include 'stmtfunc.for/nolist'

	icvt10(icur, ich) = (icur * 10) + icvtbn1(ich) ! conversion function stage

c Begin code

	longyr = .false.		! set default of century calculation

c Initialize default values for omitted fields

	ixyr = ibigyr			! Copy current values
	ixmo = idmo			! from common
	ixdy = iddy

	if (numeric(ln1)) then		! Dates must start with number

	    work(1) = ln1		! Copy first character
	    ix = icvtbn1(ln1)		! Compute value on the fly
c
	    do n = 2, (nf * 2) + 2	! Allow [mm][dd][yyyy]
c
		l1 = line(n)		! Copy current character

		if (l1 .eq. '/')	! Field separators: slash
	1	    go to 100		! for mm/dd/yy form

		if (l1 .eq. '-')	! .. dash
	1	    go to 200		! for dd-mmm-yy form

		if ((l1 .eq. ':') .or. (l1 .eq. '>'))
	1	    go to 999		! hour-string first, return default values

		if (.not. numeric(l1))	! anything else:
	1	    go to 300		! mmddyy, minus some characters, fake whatever is required

		work(n) = l1		! Don't recopy
		ix = icvt10(ix, l1)	! continue conversion 

	    end do

	    n = (nf * 2) + 3		! Set shrink value if no delimiter

	    go to 300			! Go convert it

	else if ((ln1 .eq. '+') .or. (ln1 .eq. '-')) then
	    k = incmod			! Save current value
	    call dtcdatinc		! Convert incremental date
	    incmod = k			! Restore
	else if (ln1 .eq. '=') then
	    kkk = 1			! Place holder, strip only, date n/c
	    go to 950
	end if				! (don't want to reformat whole file)

	go to 999			! All done here

c handle mm/dd or mm/dd/yy{yy} (for D, W, M or Y)
c or mm/yy{yy} (for M or Y)

 100	continue	! Here for '/' encountered in first scan loop

	k = n + 1	! next character to look at
	l1 = line(k)
	if (.not. numeric(l1)) go to 300	! nnnn/x ???

	ixmo = ix		! First field is always month in "/" notation

	ix = icvtbn1(l1)	! Start 2nd conversion

	do n = k + 1, 20	! should be plenty

	    l1 = line(n)	! get character
	    if (l1 .eq. '/') go to 110	! Found second /
	    if (.not. numeric(l1)) go to 120	! End of scan
	    ix = icvt10(ix, l1)	! convert

	end do

	n = 21			! Set it

 120	if (nf .eq. 3) then
	    ixdy = ix		! 2nd field is day
	else
	    ixyr = ix		! .. year
	    longyr = ((n - k) .gt. 2)
	end if	

	go to 900

 110	l1 = line(n+1)		! Found 2nd slash, check for third field
	if (.not. numeric(l1)) go to 120	! left field!

	k = n + 1

	ixdy = ix			! 2nd has to be day

	ixyr = icvtbn1(l1)		! Start 3rd conversion (year)

	do n = k + 1, 20		! get more numerics

	    l1 = line(n)
	    if (.not. numeric(l1)) go to 910
	    ixyr = icvt10(ixyr, l1)

	end do

	n = 21				! mark next character

	go to 910			! set for SHRINK

c handle dd-mon-yy, dd-mm-yy, or dd-roman-yy

 200	continue	! Here for '-' in first scan loop

	ixdy = ix	! Copy converted day field

	rch = '    '	! initialize for alpha month name, or Roman numerals

	k = n + 1	! next char after "-"

	l1 = line(k)

	if (numeric(l1)) then		! European format dd-mm-yy

	    ixmo = icvtbn1(l1)		! go for it directly

	    do n = k + 1, 20

		l1 = line(n)

		if (.not. numeric(l1)) go to 210

		ixmo = icvt10(ixmo, l1)

	    end do

	    n = 21

	else if (alpha(l1)) then

	    lxx(1) = l1 .and. '5F'X	! Set first char for name or roman

	    lcount = 1

	    do nn = k + 1, k + 6		! should find "-" by then

		l1 = line(nn)
		if (l1 .eq. '-') go to 230	! Start search
		if (.not. alpha(l1)) go to 230	! also terminate
		if (lcount .lt. 4) then		! room for at least one more
		    lcount = lcount + 1
		    lxx(lcount) = l1 .and. '5F'X ! Copy character
		end if
	    end do

	    nn = k + 6

 230	    continue

	    do i = 1, 12			! Loop over months
		if (rch .eq. rom(i)) go to 250	! Found match in roman set
		if (lcount .ge. minln(i)) then
		    if (rch(1:lcount) .eq. mab(i)(1:lcount))
	1		go to 250		! Found match in alpha names
		end if

C Note: last two IF statements above replace original horrendous sequence of
c IF-THEN-ELSEs to see if month was J then A, or F, or M then A then R, etc !

	    end do

c Fell out of loop, leave current month

	    go to 300		! Unknown month or roman seq, back up before "-"

 250	    ixmo = i		! iwk(1) = icvtbcd(i)
	    n = nn		! Accept characters

	else			! "-" followed by non alphanumeric
	    go to 300

	end if

 210	if (l1 .ne. '-') go to 900	! See if year follows

	k = n + 1
	l1 = line (k)

	if (.not. numeric(l1)) go to 910	! First dash is left
	ixyr = icvtbn1(l1)

	do n = k + 1, 30

	    l1 = line (n)

	    if (.not. numeric(l1)) go to 910

	    ixyr = icvt10(ixyr, l1)

	end do

	n = 31

 910	longyr = ((n - k) .gt. 2)	! Set logic value

	go to 900

 300	continue			! Short string found, fix it up

	nfd = n/2			! Number of 2-char groups found

	longyr = (nfd .gt. nf)		! check for default or forced century

	if ((n .and. 1) .eq. 0) then	! Example: n = 5 for 4 chars found (0 mod 2)
	    work(1) = '0'		! Force even number of characters
	    do i = 2, n
		work(i) = line(i - 1)	! Shift line over by 1
	    end do
	end if

	go to (310, 320, 330) nf	! Dispatch on # expected fields
	go to 900			! Bad value ???

 310	ixyr = ix			! take year: Y [yy]
	go to 900			! End case

 320	ixmo = icvtbin(iwk(1))		! M mm
	if (nfd .eq. 2) ixyr = icvtbin(iwk(2))	! M {m}myy
	if (nfd .eq. 3) ixyr = mod(ix, 10000)	! M {m}myyyy
	go to 900			! End case

 330	if (nfd .eq. 1) ixdy = icvtbin(iwk(1)) ! D {d}d {only}

	if (nfd .ge. 2) then		! D [mm]dd[yy]
	    ixmo = icvtbin(iwk(1))	! D {m}mdd
	    ixdy = icvtbin(iwk(2))	! D {m}mdd
	end if

	if (nfd .eq. 3) ixyr = icvtbin(iwk(3))	! D {m}mddyy
	if (nfd .eq. 4) ixyr = mod(ix, 10000)	! D {m}mddyyyy

 900	continue			! common clean-up & return

	if ((ixyr .lt. 100) .and. (.not. longyr)) ! Check for 1-99 AD
	1   ixyr = ixyr + ((ibigyr/100)*100)	! add "current" century

	if (islpyr(ixyr))
	1 then
	    lm(2) = 29	! Set for Leap Years
	  else
	    lm(2) = 28	! reset for "common" years
	end if

	ibigyr = ixyr				! Explicit year
	idmo = min0(max0(ixmo, 1), 12)		! Limit values
	iddy = min0(max0(ixdy, 1), lm(idmo))	! ..

	kkk = n - 1			! Change index of next char to count

 950	idyr = mod(ibigyr, 100)			! Set value

	if (kkk .gt. 0)
	1 call shrink (kkk, ifnb, lnb)	! Unload the stuff we used

 999	return				! Miscellaneous exits

	end