如何在Fortran中更好地解析变量时间戳信息

Question

我正在gfortran中编写代码，将变量时间戳分为年、月和日的不同部分。我写了这段代码，这样用户就可以输入时间戳的格式（例如，YEAR/MON/DAY、DAY/MON/YEAR等）。这总共创建了6个可能的组合。我写过一些代码试图处理这个问题，但我认为它很丑陋，做得很糟糕。

我当前的代码使用了大量的"if"one_answers"goto"语句。用户提供时间戳格式"tsfo"ts是一个包含时间戳数据（多达100000个时间戳）的字符数组tsdelim'是年、月和日之间的分隔符。我必须从"frd"（第一个时间戳）循环到"nlines"（最后的时间戳）。

这是相关代码。

* Choose which case to go to. 
first = INDEX(tsfo,tsdelim)
second = INDEX(tsfo(first+1:),tsdelim) + first
if (INDEX(tsfo(1:first-1),'YYYY') .ne. 0) THEN
   if (INDEX(tsfo(first+1:second-1),'MM') .ne. 0) THEN
      goto 1001
   else
      goto 1002
   end if
else if (INDEX(tsfo(1:first-1),'MM') .ne. 0) THEN
   if (INDEX(tsfo(first+1:second-1),'DD') .ne. 0) THEN
      goto 1003
   else
      goto 1004
   end if
else if (INDEX(tsfo(1:first-1),'DD') .ne. 0) THEN
   if (INDEX(tsfo(first+1:second-1),'MM') .ne. 0) THEN
      goto 1005
   else
      goto 1006
   end if
end if
first = 0
second = 0
* Obtain the Julian Day number of each data entry. 
* Acquire the year, month, and day of the time stamp. 
* Find 'first' and 'second' and act accordingly. 
* Case 1: YYYY/MM/DD
1001    do i = frd,nlines
       first = INDEX(ts(i),tsdelim)
       second = INDEX(ts(i)(first+1:),tsdelim) + first
       read (ts(i)(1:first-1), '(i4)') Y
       read (ts(i)(first+1:second-1), '(i2)') M
       read (ts(i)(second+1:second+2), '(i2)') D
* Calculate the Julian Day number using a function. 
       temp1(i) = JLDYNUM(Y,M,D)
end do
goto 1200
* Case 2: YYYY/DD/MM
1002    do i = frd,nlines
       first = INDEX(ts(i),tsdelim)
       second = INDEX(ts(i)(first+1:),tsdelim) + first
       read (ts(i)(1:first-1), '(i4)') Y
       read (ts(i)(second+1:second+2), '(i2)') M
       read (ts(i)(first+1:second-1), '(i2)') D
* Calculate the Julian Day number using a function. 
       temp1(i) = JLDYNUM(Y,M,D)
end do
goto 1200
* Onto the next part of the code
1200 blah blah blah

我相信这个代码会起作用，但我认为这不是一个很好的方法。有更好的方法吗？

需要注意的是，必须为每个时间戳计算指数"first"one_answers"second"，因为月份和日期都可以用1或2个整数表示。年份总是用4表示。

Answer 1

如果只需要处理六个排列，我只需要构建一个查找表，以整个tsfo字符串为键，以年、月和日（第一、第二或第三）的位置为值。任何不受支持的格式都会产生一个错误，我在下面没有对此进行编码。随后，当您循环查看ts列表并拆分项目时，您知道将哪个位置转换为年、月和日整数变量：

PROGRAM timestamp
  IMPLICIT NONE
  CHARACTER(len=10) :: ts1(3) = ["2000/3/4  ","2000/25/12","2000/31/07"] 
  CHARACTER(len=10) :: ts2(3) = ["3/4/2000  ","25/12/2000","31/07/2000"] 
  CALL parse("YYYY/DD/MM",ts1)
  print*
  CALL parse("DD/MM/YYYY",ts2)
CONTAINS
  SUBROUTINE parse(tsfo,ts)
    IMPLICIT NONE
    CHARACTER(len=*),INTENT(in) :: tsfo, ts(:)
    TYPE sti
       CHARACTER(len=10) :: stamp = "1234567890"
       INTEGER :: iy = -1, im = -1, id = -1
    END TYPE sti
    TYPE(sti),PARAMETER :: stamps(6) = [sti("YYYY/MM/DD",1,2,3), sti("YYYY/DD/MM",1,3,2),&
                                        sti("MM/DD/YYYY",2,3,1), sti("DD/MM/YYYY",3,2,1),&
                                        sti("MM/YYYY/DD",2,1,3), sti("DD/YYYY/MM",3,1,2)]
    TYPE(sti) :: thisTsfo
    INTEGER :: k, k1, k2
    INTEGER :: y, m, d
    CHARACTER(len=10) :: cc(3)
    DO k=1,SIZE(stamps)
      IF(TRIM(tsfo) == stamps(k)%stamp) THEN
        thisTsfo = stamps(k)
        EXIT
      ENDIF
    ENDDO
    print*,thisTsfo
    DO k=1,SIZE(ts)
      k1 = INDEX(ts(k),"/")
      k2 = INDEX(ts(k),"/",BACK=.TRUE.)
      cc(1) = ts(k)(:k1-1)
      cc(2) = ts(k)(k1+1:k2-1)
      cc(3) = ts(k)(k2+1:)
      READ(cc(thisTsfo%iy),'(i4)') y
      READ(cc(thisTsfo%im),'(i2)') m
      READ(cc(thisTsfo%id),'(i2)') d
      PRINT*,ts(k),y,m,d
    ENDDO
  END SUBROUTINE parse
END PROGRAM timestamp

Answer 2

我会用另一种方式对不同的情况进行编码，如下所示：

module foo
  implicit none
  private
  public encode_datecode
contains
  integer function encode_datecode(datestr, sep)
    character(len=*), intent(in) :: datestr, sep
    integer :: first, second
    character(len=1) :: c1, c2, c3
    first = index(datestr, sep)
    second = index(datestr(first+1:), sep) + first
    c1 = datestr(1:1)
    c2 = datestr(first+1:first+1)
    c3 = datestr(second+1:second+1)
    foo = num(c1) + 3*num(c2) + 9*num(c3)
  end function encode_datecode
  integer function num(c)
    character(len=1) :: c
    if (c == 'Y') then
        num = 0
    else if (c == 'M') then
        num = 1
    else if (c == 'D') then
        num = 2
    else
        stop "Illegal character"
    end if
  end function num
end module foo

然后在SELECT语句中处理法律案件（21、15、19、7、11、5）。

这利用了这样一个事实，即不会有"YDDY/MY/YM"格式。

如果你喜欢更好的二进制或十进制可读性，你也可以乘以4或10，而不是3。