new label_date should give good results in most cases, even if some k…

…eywords are not yet supported.

This time the procedure should be the good one, not an old version!

src/pro/label_date.pro

@@ -1,4 +1,4 @@
-FUNCTION LABEL_DATE, axis, index, x, level, DATE_FORMAT = format, MONTHS = months
+FUNCTION LABEL_DATE, axis, index, x, level, DATE_FORMAT = date_format, MONTHS = months, AM_PM=ampm,  DAYS_OF_WEEK=dow, OFFSET=offset, ROUND_UP=rndup
 ;+
 ; NAME:
 ;	LABEL_DATE
@@ -40,6 +40,7 @@ FUNCTION LABEL_DATE, axis, index, x, level, DATE_FORMAT = format, MONTHS = month
 ;	None.
 ; RESTRICTIONS:
 ;	Only one date axis may be simultaneously active.
+;       ROUND_UP, OFFSET currently not implemented.
 ; PROCEDURE:
 ;	Straightforward.
 ; EXAMPLE:
@@ -53,39 +54,72 @@ FUNCTION LABEL_DATE, axis, index, x, level, DATE_FORMAT = format, MONTHS = month
 ;	
 ; MODIFICATION HISTORY:
 ;	DMS, RSI.	April, 1993.	Written.
-;       GD              March 2021 added level
+;       GD              March 2021 added level & many options.
 ;-
 
-COMMON label_date_com, fmt, month_chr
-
-if keyword_set(format) then begin	;Save format string?
-   if keyword_set(months) then month_chr = months else month_chr = ['Jan','Feb','Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec']
-   fmt = format
+COMMON label_date_com, fmt, month_chr, dow_chr, ampm_chr, defmonth, defdow, defampm
+COMPILE_OPT idl2, hidden
+ON_ERROR, 2
+; NOTE: it will be more efficient to rewrite internally 'fmt' as a string
+; with Time Format Codes (CMOI etc) and use this format code for all
+; values of X. (This is what IDL does.)
+if n_elements(date_format) gt 0 then begin ;Save format string?
+   fmt = date_format
+
+   if n_elements(months) gt 0 then month_chr = months else month_chr=0
+   defmonth = ['Jan','Feb','Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec']
+   if n_elements(dow) gt 0 then dow_chr=dow else dow_chr=0
+   defdow = ['Mon','Tue','Wed','Thu','Fri','Sat','Sun']
+   if n_elements(ampm) gt 0 then ampm_chr=ampm else ampm=0
+   defampm = ['am','pm']
+
    return, 0
 endif
 
 IF (n_elements(level) lt 1) then level = 0
 
-if n_elements(month_chr) ne 12 or n_elements(fmt) le 0 then $
-   message,' Not initialized.'
-
-caldat, long(x), month, day, year ;Get the calendar date from julian
-n = strlen(fmt[level])
+;Get the calendar date from julian
+; GDL_DOW and ICAP options are undocumented (!) GDL expensions 
+caldat, long(x), month, day, year, hour , minute , second, gdl_dow=dow, gdl_icap=icap
+level_index=level mod n_elements(fmt)
+curr_fmt=fmt[level_index]
+n = strlen(curr_fmt)
+if n eq 0 then begin
+   curr_fmt='%W %M %D %H:%I:%S %Y'
+   n = strlen(curr_fmt)
+endif
 out = ''
 
 for i=0, n-1 do begin           ;Each format character...
-   c = strmid(fmt[level], i, 1)        ;The character.
+   c = strmid(curr_fmt, i, 1)        ;The character.
    if c eq '%' then begin
       i = i + 1
-      c = strmid(fmt[level], i, 1)     ;The function
-      case c of                 ;format character?
-         'M' : out = out + month_chr(month-1)
-         'N' : out = out + string(format='(i2.2)', month)
-         'D' : out = out + string(format='(i2.2)', day)
-         'Y' : out = out + string(format='(i4)', year)
-         'Z' : out = out + string(format='(i2.2)', year  mod 100)
+      c = strmid(curr_fmt, i, 1)     ;The function
+      case c of                        ;format character?
+         'M' : if n_elements(month_chr) eq 12 then out+=month_chr(month-1) else out+=defmonth(month-1) 
+         'N' : out += string(format='(i2.2)', month)
+         'D' : out += string(format='(i2.2)', day)
+         'Y' : out += string(format='(i5)', year)
+         'Z' : out += string(format='(i3.3)', year  mod 100)
+         'H' : out = out + string(format='(i2.2)', hour)
+         'I' : out = out + string(format='(i2.2)', minute)
+         'S' : begin
+            if strmid(curr_fmt,i+1,1) eq '%' then begin
+               ndigits= strmid(curr_fmt,i+2,1)
+               test = strpos('O123456789', ndigits)
+               if test ge 0 then begin
+                  i+=2
+                  subformat='(f'+strtrim(3+test,2)+'.'+strtrim(test,2)+')'
+                  out = out + string(format=subformat, second)
+               endif
+            endif else  out = out + string(format='(i2.2)', fix(second))
+          end
+
+
+         'W' : if n_elements(dow_chr) eq 7 then out+=dow_chr(dow-1) else out+=defdow(dow-1) 
+         'A' : if n_elements(ampm_chr) eq 2 then out+=ampm_chr(icap) else out+=defampm(icap)
          '%' : out = out + '%'
-         else : message, 'Illegal character in date format string: '+fmt[level]
+         else : out = out + ""
       endcase
    endif else out = out + c
 endfor