Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | String | |||
integer, | intent(out) | :: | NumTokens | |||
integer, | intent(out) | :: | TokenDay | |||
integer, | intent(out) | :: | TokenMonth | |||
integer, | intent(out) | :: | TokenWeekDay | |||
integer, | intent(out) | :: | DateType | |||
logical, | intent(inout) | :: | ErrorsFound | |||
integer, | intent(out), | optional | :: | TokenYear |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE DetermineDateTokens(String,NumTokens,TokenDay,TokenMonth,TokenWeekday,DateType,ErrorsFound,TokenYear)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN August 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is invoked for date fields that appear to be strings (give
! error when ProcessNumber is used).
! METHODOLOGY EMPLOYED:
! Delete everything that is extraneous to the date information needed. Process what
! is left.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: MaxNameLength
USE DataInterfaces, ONLY: ShowSevereError
USE InputProcessor, ONLY: FindItemInList,ProcessNumber
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: String
INTEGER, INTENT(OUT) :: NumTokens ! Number of tokens found in string
INTEGER, INTENT(OUT) :: TokenDay ! Value of numeric field found
INTEGER, INTENT(OUT) :: TokenMonth ! Value of Month field found (1=Jan, 2=Feb, etc)
INTEGER, INTENT(OUT) :: TokenWeekDay ! Value of Weekday field found (1=Sunday, 2=Monday, etc), 0 if none
INTEGER, INTENT(OUT) :: DateType ! DateType found (-1=invalid, 1=month/day, 2=nth day in month, 3=last day in month)
LOGICAL, INTENT(INOUT) :: ErrorsFound ! Set to true if cannot process this string as a date
INTEGER, INTENT(OUT), OPTIONAL :: TokenYear ! Value of Year if one appears to be present and this argument is present
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=1), PARAMETER :: Blank=' '
INTEGER, PARAMETER :: NumSingleChars=3
CHARACTER(len=1), PARAMETER, DIMENSION(NumSingleChars) :: SingleChars=(/"/",":","-"/)
INTEGER, PARAMETER :: NumDoubleChars=6
CHARACTER(len=3), PARAMETER, DIMENSION(NumDoubleChars) :: DoubleChars=(/"ST ","ND ","RD ","TH ","OF ","IN "/)
CHARACTER(len=*), PARAMETER, DIMENSION(12) :: Months=(/"JAN","FEB","MAR","APR","MAY", &
"JUN","JUL","AUG","SEP","OCT","NOV","DEC"/)
CHARACTER(len=*), PARAMETER, DIMENSION(7) :: Weekdays=(/"SUN","MON","TUE","WED","THU","FRI","SAT"/)
CHARACTER(len=*), PARAMETER :: Numbers="0123456789"
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=MaxNameLength) :: CurrentString
INTEGER Pos
INTEGER Loop
CHARACTER(len=15), DIMENSION(3) :: Fields
INTEGER NumField1
INTEGER NumField2
INTEGER NumField3
LOGICAL ErrFlag
LOGICAL InternalError
LOGICAL :: WkDayInMonth
CurrentString=String
NumTokens=0
TokenDay=0
TokenMonth=0
TokenWeekday=0
DateType=-1
InternalError=.false.
WkDayInMonth=.false.
IF (PRESENT(TokenYear)) TokenYear=0
! Take out separator characters, other extraneous stuff
DO Loop=1,NumSingleChars
Pos=INDEX(CurrentString,SingleChars(Loop))
DO WHILE (Pos > 0)
CurrentString(Pos:Pos)=' '
Pos=INDEX(CurrentString,SingleChars(Loop))
ENDDO
ENDDO
DO Loop=1,NumDoubleChars
Pos=INDEX(CurrentString,DoubleChars(Loop))
DO WHILE (Pos > 0)
CurrentString(Pos:Pos+1)=' '
Pos=INDEX(CurrentString,DoubleChars(Loop))
WkDayInMonth=.true.
ENDDO
ENDDO
CurrentString=ADJUSTL(CurrentString)
IF (CurrentString == Blank) THEN
CALL ShowSevereError('Invalid date field='//TRIM(String))
ErrorsFound=.true.
ELSE
Loop=0
DO WHILE (Loop < 3) ! Max of 3 fields
IF (CurrentString == Blank) EXIT
Pos=INDEX(CurrentString,' ')
Loop=Loop+1
Fields(Loop)=CurrentString(1:Pos-1)
CurrentString=CurrentString(Pos:)
CurrentString=ADJUSTL(CurrentString)
ENDDO
IF (CurrentString /= Blank) THEN
CALL ShowSevereError('Invalid date field='//TRIM(String))
ErrorsFound=.true.
ELSEIF (Loop == 2) THEN
! Field must be Day Month or Month Day (if both numeric, mon / day)
InternalError=.false.
NumField1=INT(ProcessNumber(Fields(1),ErrFlag))
IF (ErrFlag) THEN
! Month day, but first field is not numeric, 2nd must be
NumField2=INT(ProcessNumber(Fields(2),ErrFlag))
IF (ErrFlag) THEN
CALL ShowSevereError('Invalid date field='//TRIM(String))
InternalError=.true.
ELSE
TokenDay=NumField2
ENDIF
TokenMonth=FindItemInList(Fields(1)(1:3),Months,12)
CALL ValidateMonthDay(String,TokenDay,TokenMonth,InternalError)
IF (.not. InternalError) THEN
DateType=1
ELSE
ErrorsFound=.true.
ENDIF
ELSE
! Month Day, first field was numeric, if 2nd is, then it's month<num> day<num>
NumField2=INT(ProcessNumber(Fields(2),ErrFlag))
IF (.not. ErrFlag) THEN
TokenMonth=NumField1
TokenDay=NumField2
CALL ValidateMonthDay(String,TokenDay,TokenMonth,InternalError)
IF (.not. InternalError) THEN
DateType=1
ELSE
ErrorsFound=.true.
ENDIF
ELSE ! 2nd field was not numeric. Must be Month
TokenDay=NumField1
TokenMonth=FindItemInList(Fields(2)(1:3),Months,12)
CALL ValidateMonthDay(String,TokenDay,TokenMonth,InternalError)
IF (.not. InternalError) THEN
DateType=1
NumTokens=2
ELSE
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ELSEIF (Loop == 3) THEN
! Field must be some combination of <num> Weekday Month (if WkDayInMonth true)
IF (WkDayInMonth) THEN
NumField1=INT(ProcessNumber(Fields(1),ErrFlag))
IF (.not. ErrFlag) THEN ! the expected result
TokenDay=NumField1
TokenWeekDay=FindItemInList(Fields(2)(1:3),Weekdays,7)
IF (TokenWeekDay == 0) THEN
TokenMonth=FindItemInList(Fields(2)(1:3),Months,12)
TokenWeekDay=FindItemInList(Fields(3)(1:3),Weekdays,7)
IF (TokenMonth == 0 .or. TokenWeekDay == 0) InternalError=.true.
ELSE
TokenMonth=FindItemInList(Fields(3)(1:3),Months,12)
IF (TokenMonth == 0) InternalError=.true.
ENDIF
DateType=2
NumTokens=3
IF (TokenDay < 0 .or. TokenDay > 5) InternalError=.true.
ELSE ! first field was not numeric....
IF (Fields(1) == 'LA ') THEN
DateType=3
NumTokens=3
TokenWeekDay=FindItemInList(Fields(2)(1:3),Weekdays,7)
IF (TokenWeekDay == 0) THEN
TokenMonth=FindItemInList(Fields(2)(1:3),Months,12)
TokenWeekDay=FindItemInList(Fields(3)(1:3),Weekdays,7)
IF (TokenMonth == 0 .or. TokenWeekDay == 0) InternalError=.true.
ELSE
TokenMonth=FindItemInList(Fields(3)(1:3),Months,12)
IF (TokenMonth == 0) InternalError=.true.
ENDIF
ELSE ! error....
CALL ShowSevereError('First date field not numeric, field='//TRIM(String))
ENDIF
ENDIF
ELSE ! mm/dd/yyyy or yyyy/mm/dd
NumField1=INT(ProcessNumber(Fields(1),ErrFlag))
NumField2=INT(ProcessNumber(Fields(2),ErrFlag))
NumField3=INT(ProcessNumber(Fields(3),ErrFlag))
DateType=1
! error detection later..
IF (NumField1 > 100) THEN
IF (PRESENT(TokenYear)) THEN
TokenYear=NumField1
ENDIF
TokenMonth=NumField2
TokenDay=NumField3
ELSEIF (NumField3 > 100) THEN
IF (PRESENT(TokenYear)) THEN
TokenYear=NumField3
ENDIF
TokenMonth=NumField1
TokenDay=NumField2
ENDIF
ENDIF
ELSE
! Not enough or too many fields
CALL ShowSevereError('Invalid date field='//TRIM(String))
ErrorsFound=.true.
ENDIF
ENDIF
IF (InternalError) THEN
DateType=-1
ErrorsFound=.true.
ENDIF
RETURN
END SUBROUTINE DetermineDateTokens