c Date munger function (part of DTC)
c
c modified 850325, CG, to allow any of the following
c	d{d}/m{m}/yy, d, dd, dmm, ddmm, dmmyy, ddmmyy	for D or W functions
c	m{m}/yy, m, mm, myy, mmyy 			for M
c	y, yy						for Y
c
	Subroutine datmun (nf)	! (line,nf)
c
	include 'comdtc.inc'
c
	integer nf			! Number of fields expected
	logical numeric			! Statement function
c
	byte nb, l1, l2, l3, lxx(3), work(icmln), hwk(20), ch,
	1 num(0:9) /'0', '1', '2', '3', '4', '5', '6', '7', '8', '9'/
c
	character*3 lch,		! for dd-mon-yy format
	1 mab(12) / 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN',
	2	    'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'/
c
	integer*2 iwk(42)		! 2 chars at a time
c
	equivalence(lch, lxx, l1), (lxx(2), l2), (lxx(3), l3),
	1 (work, iwk)
c
c statement functions for quick binary to 2-digit bcd conversion,
c and vice versa
c
	icvtbcd(inum) = (num(imod(inum, 10)) * 256)
	1 .or. num(inum/10)
	icvtbin(ich2) = (((ich2 .and. '7f'x) - '0') * 10)
	1 + ((ich2/256) - '0')
	numeric(ch) = (ch .ge. '0') .and. (ch .le. '9')
c
c end statement functions
c

c
c Initialize default values for omitted fields
c
	ixyr = idyr			! Copy current values
	ixmo = idmo			! (use idate instead?)
	ixdy = iddy
c
c function:
c  edit a line starting with a date of form
c	mm/dd/yy
c  into one starting with a date of form
c	mmddyy
c
c  also if the line starts with a date of form
c	dd-mmm-yy
c  edit back into mmddyy from that form.
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.
c  if mmddyy form already exists, leave line alone.
c
	mi = 0				! Preset for nothing in HWK

	do 1 n=1, nf * 2		! 3 for D or W, 2 for M, 1 for Y
c
	l1 = line(n)			! Copy current character

	if (l1 .eq. '/') go to 100
c 100 is for mm/dd/yy form
c
	if (l1 .eq. '-') go to 200
c 200 is for dd-mmm-yy form
c
	if (l1 .eq. '>') go to 280	! Hours-only range

	if (l1 .eq. ':') go to 290	! Hour stuff for D, U, X
c 290 for hour-string first, insert current day
c
	if (numeric(l1)) go to 300
c 300 mmddyy, minus some characters, fake whatever is required
c
	work(n) = l1			! Don't recopy
c
 1	continue
c
c if format looks OK already, just return and leave line alone.
	Return
c
 100	continue	! Assumes 'n' = 2 or 3
c handle mm/dd/yy and turn into mmddyy
c
	if(line(2).eq.'/') then
	    work(1)='0'
	    work(2)=line(1)
	    k=3
	else
	    work(1)=line(1)
	    work(2)=line(2)
	    k=4
	end if
c
	if (numeric(line(k+1))) then
	    work(3)=line(k)
	    work(4)=line(k+1)
	    kk=k+3
	else 
	    work(3)='0'
	    work(4)=line(k)
	    kk=k+2
	end if
c
	if (line(kk-1) .eq. '/') then
	    work(5)=line(kk)		! Copy (assumed) 2-digit year
	    work(6)=line(kk+1)
	    kkk=kk+2
	else
	    iwk(3) = icvtbcd(ixyr)	! Create a year value
	    kkk=kk
	end if
c
c Pointers to next element of line (i.e., kkk) are now set up
c for copy of rest of stuff.
c
	go to 900
c
 200	continue	! Assumes 'n' = 2 or 3
c handle dd-mmm-yy and turn into mmddyy
	if(line(2).eq.'-')then
	    work(3)='0'
	    work(4)=line(1)
	    k=3
	else
	    work(3)=line(1)
	    work(4)=line(2)
	    k=4
	end if
c
	if (line(k+3) .eq. '-') then
	    work(5)=line(k+4)		! Assume the user typed yy
	    work(6)=line(k+5)		! after 2nd dash
	    kkk=k+6
	else
	    iwk(3) = icvtbcd(ixyr)	! Fudge the year
	    kkk = k+3			! and where to start copying
	end if
c
c now have pointers, but month needs to be filled in.
c note we assume year always is entered as 2 digits
c and month is 3 chars...
c
c	if(line(k+3).ne.'-')then
c
c zero stuff to pass if not 3 char month
c
c	    work(1)=0
c	    work(2)=0
c	    go to 900
c	end if
c
	kk=k+3
	iii = 0
	do 220 n=k,kk
	    nb=line(n)
c mask off 32 (dec) bit to
c make letters uppercase
	    nb = nb .and. '5f'x				!223
	    line(n)=nb
	    iii = iii + 1
	    lxx(iii) = nb
 220	continue
c
c ***	l1=line(k)
c ***	l2=line(k+1)
c ***	l3=line(k+2)
c ***	work(1)='0'
c ***	work(2)='0'
c
c decode months the hard way		!!! You said it !!!
c
c ***	IF(L1.EQ.'J'.AND.L2.EQ.'A')THEN
c ***		WORK(2)='1'
c ***	ELSE IF(L1.EQ.'F')THEN
c ***		WORK(2)='2'
c ***	ELSE IF(L1.EQ.'M'.AND.L2.EQ.'A'.AND.L3.EQ.'R')THEN
c ***		WORK(2)='3'
c ***	ELSE IF(L1.EQ.'A'.AND.L2.EQ.'P')THEN
c ***		WORK(2)='4'
c ***	ELSE IF(L1.EQ.'M'.AND.L2.EQ.'A'.AND.L3.EQ.'Y')THEN
c ***		WORK(2)='5'
c ***	ELSE IF(L1.EQ.'J'.AND.L2.EQ.'U'.AND.L3.EQ.'N')THEN
c ***		WORK(2)='6'
c ***	ELSE IF(L1.EQ.'J'.AND.L2.EQ.'U'.AND.L3.EQ.'L')THEN
c ***		WORK(2)='7'
c ***	ELSE IF(L1.EQ.'A'.AND.L2.EQ.'U')THEN
c ***		WORK(2)='8'
c ***	ELSE IF(L1.EQ.'S')THEN
c ***		WORK(2)='9'
c ***	ELSE IF(L1.EQ.'O')THEN
c ***		WORK(1)='1'
c ***	ELSE IF(L1.EQ.'N')THEN
c ***		WORK(1)='1'
c ***		WORK(2)='1'
c ***	ELSE IF(L1.EQ.'D')THEN
c ***		WORK(1)='1'
c ***		WORK(2)='2'
c ***	ELSE
c ***		WORK(1)=0
c ***		WORK(2)=0
C UNRECOGNIZED MONTH -- SCREW IT...
c ***	END IF
c
	do 240 i = 1, 12		! Loop over months
	if (lch .eq. mab(i)) go to 250	! Exit if found
 240	continue
c ***	WORK(1)=0
c ***	WORK(2)=0
	iwk(1) = '99'			! Phony month
	go to 900
c
 250	iwk(1) = icvtbcd(i)
c
c	work(1) = num(i/10)
c	work(2) = num(imod(i, 10))
c
	go to 900
c
 280	continue			! '>' found, insert day string
	if (n .eq. 1) go to 300		! not leading numeric, copy & exit
	mi = 1				! Set other work index
	if (n .eq. 2) then
	    mi = 2
	    hwk(1) = '0'
	end if
	do i = 1, n - 1
	    hwk(mi) = work(i)
	    mi = mi + 1
	end do

	hwk(3) = ':'			! Could initialize 3, 6, 9 as constants
	hwk(4) = '0'
	hwk(5) = '0'

 283	if (numeric(line(n+1))) then	! (here if '>' after ':' in first scan)
	    hwk(6) = '>'		! but they could be overwritten
	    hwk(9) = ':'		! so set them as we go along
	    mi = 11
	    if (numeric(line(n+2))) then
		hwk(7) = line(n+1)
 285		hwk(8) = line(n+2)	! Back here after force leading 0
		if (line(n+3) .eq. ':') then
		    hwk(10) = line(n+4)	! Assume stuff is there
		    hwk(11) = line(n+5)
		    n = n + 5
		else
		    hwk(10) = '0'
		    hwk(11) = '0'
		    n = n + 2
		end if
	    else
		hwk(7) = '0'
		n = n - 1
		go to 285
	    end if
	else
	    mi = 5
	    n = n + 2
	end if

	go to 295
c
 290	continue			! ':' found, insert day string
	if (n .eq. 1) go to 300		! not leading numeric, copy & exit
	mi = 1				! Set other work index
	if (n .eq. 2) then
	    mi = 2
	    hwk(1) = '0'
	end if
	do i = 1, n + 2			! Assume mm after :
	    hwk(mi) = work(i)
	    mi = mi + 1
	end do

	if (line(n+3) .eq. '>') then
	    n = n + 3			! Adjust index
	    go to 283			! Don't duplicate second scan
	end if

	mi = 5

 295	n = 1	
c
 300	continue			! Short string found, fix it up
	kkk = n				! Where to start copying
c
	nfd = n/2			! Number of 2-char groups found
c
	if (imod(n, 2) .eq. 0) then	! Note: n = 5 for 4 chars found
	    work(1) = '0'		! Force even number of characters
	    do i = 2, n
		work(i) = line(i-1)	! Shift stuff over by 1
	    end do
	end if
c
	go to (310, 320, 330) nf	! Dispatch on # expected fields
	go to 900			! Bad value ???
c
 310	if (nfd .eq. 0) iwk(1) = icvtbcd(ixyr) ! Add year: Y [yy]
	go to 900			! End case
c
 320	if (nfd .eq. 0) iwk(1) = icvtbcd(ixmo) ! M {only}
	if (nfd .le. 1) iwk(2) = icvtbcd(ixyr) ! M mm[yy]
	go to 900			! End case
c
 330	if (nfd .eq. 0) iwk(1) = icvtbcd(ixdy) ! empty line
c
	if (nfd .le. 1) then		! D [mm]dd[yy]
	    iwk(2) = iwk(1)		! Copy day of month (see above)
	    iwk(1) = icvtbcd(ixmo)	! Generate month
	end if
c
	if (nfd .le. 2) iwk(3) = icvtbcd(ixyr) ! Generate year
c
 900	continue			! common clean-up & return
c
	kk = (nf*2) + 1
	if (mi .ne. 0) then
	    work(kk) = ' '
	    do i = 1, mi
		kk = kk + 1
		work(kk) = hwk(i)
	    end do
	end if

	if (line(kkk) .gt. ' ') then	! if no separator after date string
	    work(kk) = ' '		! force a space in 7th position
	    kk = kk + 1			! Change where to start copying
	end if
c
	do 910 n=kk,icmln
	work(n)=line(kkk)
	if (kkk .lt. icmln) kkk=kkk+1
 910	continue
c
	work(icmln) = "0		! Force end of string if shifted off
c
	do 920 n=1,icmln		! copy edited string back
 920	line(n)=work(n)			! for further work
c
	return
c
	end
