Skip to content

Commit

Permalink
Adds 360_day calendar support to ww3_prnc (#1193)
Browse files Browse the repository at this point in the history
  • Loading branch information
@ukmo-ccbunney
ukmo-ccbunney authored Mar 13, 2024
1 parent 9d3799f commit e064dbf
Show file tree
Hide file tree
Showing 2 changed files with 101 additions and 43 deletions.
97 changes: 64 additions & 33 deletions model/src/w3timemd.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ MODULE W3TIMEMD
!/ | WAVEWATCH III NOAA/NCEP |
!/ | H. L. Tolman |
!/ | FORTRAN 90 |
!/ | Last update : 12-Jan-2021 |
!/ | Last update : 23-Feb-2024 |
!/ +-----------------------------------+
!/
!/ Copyright 2009 National Weather Service (NWS),
Expand Down Expand Up @@ -1233,6 +1233,7 @@ SUBROUTINE D2J(DAT,JULIAN,IERR)
!/ +-----------------------------------+
!/
!/ 04-Jan-2018 : Origination from m_time library ( version 6.04 )
!/ 23-Feb-2024 : Updated to handle 360_day calendar ( version 7.14 )
!/
! 1. Purpose :
!
Expand All @@ -1251,6 +1252,8 @@ SUBROUTINE D2J(DAT,JULIAN,IERR)
! * There is no year zero
! * Julian Day must be non-negative
! * Julian Day starts at noon; while Civil Calendar date starts at midnight
! * If CALTYPE is "360_day" a simpler calculation is used (30 days in every
! month) with a reference date of 1800-01-01.
!
! 3. Parameters :
!
Expand Down Expand Up @@ -1313,6 +1316,21 @@ SUBROUTINE D2J(DAT,JULIAN,IERR)

JULIAN = -HUGE(99999) ! this is the date if an error occurs and IERR is < 0

! Special case for 360 day climate calendar; return a pseudo-Julian day
! Assumes a reference date of 1800-01-01 00:00:00
IF( CALTYPE .EQ. "360_day" ) THEN
JULIAN = (YEAR - 1800) * 360.0 + & ! Years since 1800
(MONTH - 1) * 30.0 + &
(DAY - 1) + &
HOUR / 24.0_8 + &
MINUTE / 1440.0_8 + &
SECOND / 86400.0_8

IERR = 0
RETURN
ENDIF

! Standard/Gregorian calendar - return standard Julian day calculation:
IF(YEAR==0 .or. YEAR .lt. -4713) THEN
IERR=-1
RETURN
Expand Down Expand Up @@ -1356,6 +1374,7 @@ SUBROUTINE J2D(JULIAN,DAT,IERR)
!/ +-----------------------------------+
!/
!/ 04-Jan-2018 : Origination from m_time library ( version 6.04 )
!/ 23-Feb-2024 : Upated to handle 360_day calendar ( version 7.14 )
!/
! 1. Purpose :
!
Expand All @@ -1364,6 +1383,8 @@ SUBROUTINE J2D(JULIAN,DAT,IERR)
! * There is no year zero
! * Julian Day must be non-negative
! * Julian Day starts at noon; while Civil Calendar date starts at midnight
! * If CALTYPE is "360_day" a simpler calculation is used (30 days in every
! month) with a reference date of 1800-01-01.
!
! 3. Parameters :
!
Expand Down Expand Up @@ -1397,7 +1418,7 @@ SUBROUTINE J2D(JULIAN,DAT,IERR)
DOUBLE PRECISION,INTENT(IN) :: JULIAN ! Julian Day (non-negative, but may be non-integer)
INTEGER,INTENT(OUT) :: DAT(8) ! array like returned by DATE_AND_TIME(3f)
INTEGER,INTENT(OUT) :: IERR ! Error return, 0 for successful execution
! Otherwise returnb 1
! ! otherwise return 1
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
Expand All @@ -1417,27 +1438,31 @@ SUBROUTINE J2D(JULIAN,DAT,IERR)
#ifdef W3_S
CALL STRACE (IENT, 'J2D')
#endif

!
IF(JULIAN.LT.0.d0) THEN ! Negative Julian Day not allowed
IF(CALTYPE .EQ. 'standard' .AND. JULIAN .LT. 0.d0) THEN
! Negative Julian Day not allowed
IERR=1
RETURN
ELSE
IERR=0
END IF

!CALL DATE_AND_TIME(values=TIMEZONE) ! Get the timezone
!TZ=TIMEZONE(4)
TZ=0 ! Force to UTC timezone

! Calculation for time (hour,min,sec) same for Julian
! and 360_day calendars:
IJUL=IDINT(JULIAN) ! Integral Julian Day
SECOND=SNGL((JULIAN-DBLE(IJUL))*SECDAY) ! Seconds from beginning of Jul. Day
SECOND=SECOND+(tz*60)

IF(SECOND.GE.(SECDAY/2.0d0)) THEN ! In next calendar day
IJUL=IJUL+1
SECOND=SECOND-(SECDAY/2.0d0) ! Adjust from noon to midnight
ELSE ! In same calendar day
SECOND=SECOND+(SECDAY/2.0d0) ! Adjust from noon to midnight
IF(CALTYPE .EQ. "standard") THEN
IF(SECOND.GE.(SECDAY/2.0d0)) THEN ! In next calendar day
IJUL=IJUL+1
SECOND=SECOND-(SECDAY/2.0d0) ! Adjust from noon to midnight
ELSE ! In same calendar day
SECOND=SECOND+(SECDAY/2.0d0) ! Adjust from noon to midnight
END IF
END IF

IF(SECOND.GE.SECDAY) THEN ! Final check to prevent time 24:00:00
Expand All @@ -1450,31 +1475,38 @@ SUBROUTINE J2D(JULIAN,DAT,IERR)
HOUR=MINUTE/60 ! Integral hours from beginning of day
MINUTE=MINUTE-HOUR*60 ! Integral minutes from beginning of hour

!---------------------------------------------
JALPHA=IDINT((DBLE(IJUL-1867216)-0.25d0)/36524.25d0) ! Correction for Gregorian Calendar
JA=IJUL+1+JALPHA-IDINT(0.25d0*DBLE(JALPHA))
!---------------------------------------------
IF(CALTYPE .EQ. '360_day') THEN
! Calculate date parts for 360 day climate calendar
YEAR = INT(JULIAN / 360) + 1800 ! (base year is 1800)
MONTH = MOD(INT(JULIAN / 30), 12) + 1
DAY = MOD(INT(JULIAN), 30) + 1
ELSE ! Stardard Julian day calculation
!---------------------------------------------
JALPHA=IDINT((DBLE(IJUL-1867216)-0.25d0)/36524.25d0) ! Correction for Gregorian Calendar
JA=IJUL+1+JALPHA-IDINT(0.25d0*DBLE(JALPHA))
!---------------------------------------------

JB=JA+1524
JC=IDINT(6680.d0+(DBLE(JB-2439870)-122.1d0)/365.25d0)
JD=365*JC+IDINT(0.25d0*DBLE(JC))
JE=IDINT(DBLE(JB-JD)/30.6001d0)
DAY=JB-JD-IDINT(30.6001d0*DBLE(JE))
MONTH=JE-1
JB=JA+1524
JC=IDINT(6680.d0+(DBLE(JB-2439870)-122.1d0)/365.25d0)
JD=365*JC+IDINT(0.25d0*DBLE(JC))
JE=IDINT(DBLE(JB-JD)/30.6001d0)
DAY=JB-JD-IDINT(30.6001d0*DBLE(JE))
MONTH=JE-1

IF(MONTH.GT.12) THEN
MONTH=MONTH-12
END IF

YEAR=jc-4715
IF(MONTH.GT.2) THEN
YEAR=YEAR-1
END IF

IF(YEAR.LE.0) THEN
YEAR=YEAR-1
END IF
IF(MONTH.GT.12) THEN
MONTH=MONTH-12
END IF

YEAR=jc-4715
IF(MONTH.GT.2) THEN
YEAR=YEAR-1
END IF

IF(YEAR.LE.0) THEN
YEAR=YEAR-1
END IF
ENDIF

DAT(1)=YEAR
DAT(2)=MONTH
DAT(3)=DAY
Expand All @@ -1487,7 +1519,6 @@ SUBROUTINE J2D(JULIAN,DAT,IERR)
!
RETURN
!/
!/ End of J2D ----------------------------------------------------- /
!/
END SUBROUTINE J2D

Expand Down
47 changes: 37 additions & 10 deletions model/src/ww3_prnc.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -766,6 +766,9 @@ PROGRAM W3PRNC
CALL STME21 ( TIMESTOP , IDTIME )
IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2931) IDTIME
END IF
IF(CALTYPE .NE. 'standard') THEN
IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2932) CALTYPE
ENDIF
END IF
IF (.NOT. FLTIME) THEN
CALL STME21 ( TIMESHIFT , IDTIME )
Expand Down Expand Up @@ -797,11 +800,26 @@ PROGRAM W3PRNC
CALL CHECK_ERR(IRET)
IRET=NF90_GET_ATT(NCID,VARIDTMP,"calendar",CALENDAR)
IF ( IRET/=NF90_NOERR ) THEN
! No calendar attribute - default to "standard"
WRITE(NDSE,1028)
ELSE IF ((INDEX(CALENDAR, "standard").EQ.0) .AND. &
(INDEX(CALENDAR, "gregorian").EQ.0)) THEN
WRITE(NDSE,1029)
CALENDAR = "standard"
ELSE IF ((INDEX(CALENDAR, "standard") .GT. 0) .OR. &
(INDEX(CALENDAR, "gregorian") .GT. 0)) THEN
CALENDAR = "standard"
ELSE IF (INDEX(CALENDAR, "360_day") .GT. 0) THEN
CALENDAR = "360_day"
ELSE
! Calendar attribute set, but not a recognised calendar.
WRITE(NDSE,1029) CALENDAR
CALL EXTCDE( 25 )
END IF

! Check input calendar compatible with expected calendar
IF(CALENDAR .NE. CALTYPE) THEN
WRITE(NDSE,1027) CALTYPE, CALENDAR
CALL EXTCDE( 26 )
ENDIF

IRET=NF90_GET_ATT(NCID,VARIDTMP,"units",TIMEUNITS)
CALL CHECK_ERR(IRET)
CALL U2D(TIMEUNITS,REFDATE,IERR)
Expand All @@ -821,7 +839,7 @@ PROGRAM W3PRNC
END DO
IRET=NF90_GET_ATT(NCID,VARIDF(I),"_FillValue", FILLVALUE)
IF ( IRET/=NF90_NOERR ) THEN
WRITE(NDSE,1027) TRIM(FIELDSNAME(I))
WRITE(NDSE,1026) TRIM(FIELDSNAME(I))
CALL EXTCDE ( 27 )
END IF
END DO
Expand Down Expand Up @@ -2317,6 +2335,7 @@ PROGRAM W3PRNC
2930 FORMAT ( ' Field corrected for energy conservation.')
1931 FORMAT ( ' Start time : ',A)
2931 FORMAT ( ' Stop time : ',A)
2932 FORMAT ( ' Calendar : ',A)
3931 FORMAT ( ' Shifted time : ',A)
932 FORMAT (/' Input grid dim. :',I9,3X,I5)
1933 FORMAT ( ' Longitude range :',2F8.2,' (deg)'/ &
Expand Down Expand Up @@ -2404,15 +2423,23 @@ PROGRAM W3PRNC
1011 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
' NO GRID SELECTED'/)
!
1027 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
1026 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
' _FillValue ATTRIBUTE NOT DEFINED FOR : ',A/)
!
!
1027 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
' INCOMPATIBLE CALENDARS:' / &
' MODEL CALENDAR : ', A / &
' INPUT FILE CALENDAR : ', A /)
1028 FORMAT (/' *** WAVEWATCH III WARNING IN W3PRNC : '/ &
' calendar ATTRIBUTE NOT DEFINED'/ &
' IT MUST RESPECT STANDARD OR GREGORIAN CALENDAR')
1029 FORMAT (/' *** WAVEWATCH III WARNING IN W3PRNC : '/ &
' CALENDAR ATTRIBUTE NOT MATCH'/ &
' IT MUST RESPECT STANDARD OR GREGORIAN CALENDAR')
' DEFAULTING TO "standard" CALENDAR'/ &
' INPUT FILE MUST RESPECT STANDARD/GREGORIAN CALENDAR')
1029 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
' UNKNOWN CALENDAR TYPE: ', A / &
' "calendar" ATTRIBUTE MUST BE ONE OF: '/ &
' - standard'/ &
' - gregorian'/ &
' - 360_day'/ )
1030 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
' ILLEGAL FIELD ID -->',A,'<--'/)
1031 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
Expand Down

0 comments on commit e064dbf

Please sign in to comment.