Adds 360_day calendar support to ww3_prnc (#1193)

model/src/w3timemd.F90

@@ -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),
@@ -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 :
  !
@@ -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 :
  !
@@ -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
@@ -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 :
  !
@@ -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 :
  !
@@ -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
@@ -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
@@ -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
@@ -1487,7 +1519,6 @@ SUBROUTINE J2D(JULIAN,DAT,IERR)
  !
  RETURN
  !/
- !/ End of J2D ----------------------------------------------------- /
  !/
  END SUBROUTINE J2D
 

model/src/ww3_prnc.F90

@@ -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 )
@@ -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)
@@ -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
@@ -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)'/ &
@@ -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 : '/ &