functionstrftime

function strftime(format) result(out)
    character(len=*), intent(in) :: format  !! the format
    character(len=:), allocatable :: out
    character(len=*), parameter :: MONTHS(12) = [character(len=9) :: 'January', 'February', 'March', 'April', 'May', 'June', &
                                                 'July', 'August', 'September', 'October', 'November', 'December']
    character(len=*), parameter :: DAYS(0:6) = [character(len=9) :: 'Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', &
                                                'Friday', 'Saturday']
    character(len=32) :: buf
    integer :: t(8), i, off, yday, wday
    character :: c

    call date_and_time(values=t)
    yday = day_of_year(t(1), t(2), t(3))
    wday = weekday(t(1), t(2), t(3))
    out = ''
    i = 1
    do while (i <= len(format))
        c = format(i:i)
        if (c /= '%' .or. i == len(format)) then
            out = out//c
            i = i + 1
            cycle
        end if
        i = i + 1
        c = format(i:i)
        i = i + 1
        select case (c)
        case ('Y'); write (buf, '(i4.4)') t(1)
        case ('y'); write (buf, '(i2.2)') mod(t(1), 100)
        case ('m'); write (buf, '(i2.2)') t(2)
        case ('d'); write (buf, '(i2.2)') t(3)
        case ('H'); write (buf, '(i2.2)') t(5)
        case ('I'); write (buf, '(i2.2)') merge(12, mod(t(5), 12), mod(t(5), 12) == 0)
        case ('M'); write (buf, '(i2.2)') t(6)
        case ('S'); write (buf, '(i2.2)') t(7)
        case ('f'); write (buf, '(i6.6)') t(8)*1000
        case ('j'); write (buf, '(i3.3)') yday
        case ('p'); buf = merge('AM', 'PM', t(5) < 12)
        case ('B'); buf = MONTHS(t(2))
        case ('b'); buf = MONTHS(t(2)) (1:3)
        case ('A'); buf = DAYS(wday)
        case ('a'); buf = DAYS(wday) (1:3)
        case ('z')
            off = abs(t(4))
            write (buf, '(a,i2.2,i2.2)') merge('+', '-', t(4) >= 0), off/60, mod(off, 60)
        case ('%'); buf = '%'
        case default; buf = '%'//c
        end select
        out = out//trim(buf)
    end do
end function strftime