C ********************************************************** SUBROUTINE TYPE3(TIME,XIN,OUT,T,DTDT,PAR,INFO,ICNTRL,*) C ********************************************************** C C This subroutine is a calendar for determining rate and load schedules. C It has two parameters -- the initial year and hour of the simulation. C This information, along with the simulation time, is used to determine C hour of day, day of year, month, date, and day of week. Output flags for C bank holidays and weekends are also included. The component includes a C schedule of ten standard American work holidays. These may be used if C desired, and additional calendar holidays may be defined. C C ********************************************************** C C PARAMETERS and OUTPUTS (no INPUTS for this component) C C PAR(1) Mode: C 0=Standard 10 holidays only C 1=Standard holidays + user-defined holidays C 2=User-defined holidays only C PAR(2) Year at start of simulation C PAR(3) Time at start of simulation C PAR(4) Flag to use daylight savings time C PAR(5,7...) Month of user-defined holidays C PAR(6,8...) Date of user-defined holidays C C OUT(1) Hour of Day C OUT(2) Hour of Year C OUT(3) Day of Year C OUT(4) Day of Week C OUT(5) Month C OUT(6) Day of Month C OUT(7) Year C OUT(8) Weekend Flag C OUT(9) Holiday Flag C C C C C ********************************************************** C C VARIABLES IN MAIN PROGRAM C C CUMHRS Cumulative hours elapsed in past years C DATE Day of Month (1-31) C DAY Day of Year (1-366) C DCUSTHOL(1...NCUSTHOL) Array with days of month user-defined holidays C DIV C DSADJ Daylight savings hour adjustment C DSFLAG Flag for using daylight savings time C DSDAY0 Day of year to start daylight savings C DSDAYF Day of year to end daylight savings C HOLFLAG Holiday Flag (1=Holiday, 0=No Holiday) C HOLIDAY(1...NUMHOL) Array with dya of year for holidays C HOUR Hour of day (0-24) C HOUR0 Initial hour C HRYEAR Hour of Year C LEAP Leap year flag C M C MCUSTHOL(1...NCUSTHOL) Array with months for custom holidays C MLEN(1...12) Array with lengths of months (in days) C MO C MODE Component mode (0-2) C MONTH Month of year (1-12) C N Value for occurance of weekday in month C (ex: N=2 for second Monday in month) C NCUSTHOL Number of user-defined holidays C NUMHOL Number of holidays C OLDHOUR Hour at previous timestep C SLOC Index in S-array C WDAY Day of week (0=Sunday, 6=Saturday) C WEFLAG Weekend flag C YEAR Year (1998, etc.) C YLEN Length of year (365 or 366) C C ********************************************************** C C SUBROUTINES/FUNCTIONS C C DAYINWEEK(YR,MO,DAYINYEAR) Returns day of the week (0-6) C DEFHOL(YEAR,YLEN,HOLIDAY) Fills up the HOLIDAY array at beginning of year C MDAY(DAY) Returns date (1-31) C MYEAR(DAY) Returns month (1-12) C NOCCDAY(WEEKDAY,N,YEAR,MO) Returns day in year (1-366) of Nth C occurance of WEEKDAY (0-6) in the month C C ********************************************************** C C Declaration of Variables C IMPLICIT NONE COMMON /SIM/ TIME0,TFINAL,DELT,IWARN COMMON /MONTHARRAY/ MLEN COMMON /LUNITS/ LUR,LUW,IFORM,LUK COMMON /HOLSTUFF/NUMHOL,NCUSTHOL,MCUSTHOL,DCUSTHOL,MODE COMMON /STORE/SLOC/IAV/S(5000) REAL PAR,TIME,T,DTDT,ICNTRL,TIME0,TFINAL,DELT,IWARN DOUBLE PRECISION YEAR,HOUR0,MLEN,DAY,DATE,A,Y,M,MONTH, &D1,D,WEFLAG,HOLFLAG,LEAP,YLEN,HOUR,N,HOLIDAY,WDAY,MCUSTHOL, &DCUSTHOL,XIN, OUT, MDAY, MYEAR, DAYINWEEK, NOCCDAY, OLDHOUR, &DSADJ,DSDAY0,DSDAYF,HRYEAR,CUMHRS INTEGER INFO,NP,NUMHOL,J,MODE,NCUSTHOL,NSTORE,MONFLIP,DSFLAG DIMENSION OUT(9), INFO(15), PAR(40), MLEN(12), HOLIDAY(50), &MCUSTHOL(40),DCUSTHOL(40) C**** Initial Call of Simulation IF (INFO(7).EQ.-1) THEN NP=INFO(4) NUMHOL=10 INFO(6)=8 INFO(9)=2 INFO(10)=1 INFO(11)=0 CALL TYPECK(1,INFO,0,NP,0) SLOC=INFO(10) MODE=INT(PAR(1)+0.1) YEAR=INT(PAR(2)+0.1) HOUR0=PAR(3) DSFLAG=INT(PAR(4)+0.1) MFLIP=0 C Check Mode IF ((MODE.LT.0).OR.(MODE.GT.2)) THEN WRITE(LUW,4) 251,INFO(1),INFO(2) 4 FORMAT(//,1X,'***** ERROR *****',8X,'TRNSYS ERROR # ',I3, . /1X,'UNIT ',I3,' TYPE ',I3,' SCHEDULE CALENDAR',/1X, . 'UNRECOGNIZED MODE (PARAMETER #1)') CALL MYSTOP(251) ENDIF C Mode 0 -- use only standard American holiday calendar IF (MODE.EQ.0) THEN IF (NP.GT.4) THEN WRITE(LUW,5) 250,INFO(1),INFO(2) 5 FORMAT(//,1X,'***** ERROR *****',8X,'TRNSYS ERROR # ',I3, . /1X,'UNIT ',I3,' TYPE ',I3,' SCHEDULE CALENDAR',/1X, . 'NUMBER OF PARAMETERS INCONSISTENT WITH SELECTED MODE . ') CALL MYSTOP(250) ENDIF NCUSTHOL=0 ENDIF C Mode 1 -- Standard Calendar + Additional Custom Holidays C Mode 2 -- Custom Holidays without Standard Calendar IF ((MODE.EQ.1).OR.(MODE.EQ.2)) THEN IF (MOD(NP,2).EQ.1) THEN WRITE(LUW,6) 250,INFO(1),INFO(2) 6 FORMAT(//,1X,'***** ERROR *****',8X,'TRNSYS ERROR # ',I3, . /1X,'UNIT ',I3,' TYPE ',I3,' SCHEDULE CALENDAR',/1X, . 'NUMBER OF PARAMETERS INCONSISTENT WITH SELECTED MODE . ') CALL MYSTOP(250) ENDIF C Read in Custom Holidays NCUSTHOL=(NP-4)/2 DO 7 J=1,NCUSTHOL MCUSTHOL(J)=PAR(3+(J*2)) DCUSTHOL(J)=PAR(4+(J*2)) 7 CONTINUE IF (MODE.EQ.1) NUMHOL=10+NCUSTHOL IF (MODE.EQ.2) NUMHOL=NCUSTHOL ENDIF C Check for leap year and define lengths of months IF (MOD(YEAR,4.0).LT.0.1) THEN LEAP=1 ELSE LEAP=0 ENDIF YLEN=365+LEAP MLEN(1)=31 MLEN(2)=28+LEAP MLEN(3)=31 MLEN(4)=30 MLEN(5)=31 MLEN(6)=30 MLEN(7)=31 MLEN(8)=31 MLEN(9)=30 MLEN(10)=31 MLEN(11)=30 MLEN(12)=31 S(SLOC)=0 C Set initial calendar information C Initial hour does not include daylight savings HOUR=MOD((TIME-1.0),24.0) DAY=1+MOD(HOUR,24.0) IF (DAY.LT.1.0) DAY=1.0 DATE=MDAY(DAY) MONTH=MYEAR(DAY) WDAY=DAYINWEEK(YEAR,MONTH,DAY) CUMHRS=0 C Set up the HOLIDAY array CALL DEFHOL(YEAR,YLEN,HOLIDAY) C Set up daylight savings start and endtimes CALL DEFDSTIME(YEAR,YLEN,DSDAY0,DSDAYF) C Check for daylight savings at initial time DSADJ=0 IF (DSFLAG.EQ.1) THEN IF ((DAY.EQ.DSDAY0).AND.(NOT(HOUR.LT.2.0))) DSADJ=1 IF ((DAY.EQ.DSDAYF).AND.(HOUR+1.0.LT.3.0)) DSADJ=1 IF ((DAY.GT.DSDAY0).AND.(DAY.LT.DSDAYF)) DSADJ=1 HOUR=HOUR+DSADJ ENDIF C Weekend? IF ((INT(WDAY+0.01).EQ.0).OR.(INT(WDAY+0.01).EQ.6)) THEN WEFLAG=1 ELSE WEFLAG=0 ENDIF C Holiday? HOLFLAG=0 DO 10 J=1,NUMHOL IF (INT(DAY+0.01).EQ.INT(HOLIDAY(J)+0.01)) HOLFLAG=1 10 CONTINUE C Exit first component call of simulation GOTO 1000 ENDIF C Update HOUR, check for change in DAY and YEAR SLOC=INFO(10) OLDHOUR=S(SLOC) HOUR=MOD(TIME-1.0,24.0)+DSADJ IF (((HOUR.GT.24)).OR.(HOUR.EQ.24)) HOUR=HOUR-24 IF (HOUR+2.0.LT.OLDHOUR) THEN DAY=DAY+1 IF (DAY.GT.YLEN) THEN DAY=DAY-YLEN CUMHRS=CUMHRS+(24*YLEN) YEAR=YEAR+1 IF (MOD(YEAR,4.0).EQ.0) THEN LEAP=1 ELSE LEAP=0 ENDIF YLEN=365+LEAP MLEN(2)=28+LEAP CALL DEFDSTIME(YEAR,YLEN,DSDAY0,DSDAYF) CALL DEFHOL(YEAR,YLEN,HOLIDAY) ENDIF C Find new calendar info if DAY has changed DATE=MDAY(DAY) MONTH=MYEAR(DAY) WDAY=DAYINWEEK(YEAR,MONTH,DAY) C Weekend? IF ((INT(WDAY+0.01).EQ.0).OR.(INT(WDAY+0.01).EQ.6)) THEN WEFLAG=1 ELSE WEFLAG=0 ENDIF C Holiday? HOLFLAG=0 DO 20 J=1,NUMHOL IF (INT(DAY+0.01).EQ.INT(HOLIDAY(J)+0.01)) HOLFLAG=1 20 CONTINUE ENDIF C Find hour in year HRYEAR=TIME-1-CUMHRS IF (DSFLAG.EQ.1) THEN C Start of daylight savings? IF ((DAY.EQ.DSDAY0).AND.((HOUR.EQ.2.0.OR.HOUR.GT.2.0)). & AND.(DSADJ.EQ.0.0)) THEN DSADJ=1.0 HOUR=HOUR+1.0 ENDIF C End of daylight savings? IF ((DAY.EQ.DSDAYF).AND.((HOUR.EQ.3.0.OR.HOUR.GT.3.0)). & AND.(DSADJ.EQ.1.0)) THEN DSADJ=0.0 HOUR=HOUR-1.0 ENDIF ENDIF C Set Outputs and storage from previous hour 1000 OUT(1)=HOUR OUT(2)=HRYEAR OUT(3)=DAY OUT(4)=WDAY OUT(5)=MONTH OUT(6)=DATE OUT(7)=YEAR OUT(8)=WEFLAG OUT(9)=HOLFLAG S(SLOC)=HOUR RETURN 1 END FUNCTION DAYINWEEK(YR,MO,DAYINYEAR) C Function returns the day of the week C Algorithm from website: http://cssa.stanford.edu/~marcos/ushols.html IMPLICIT NONE DOUBLE PRECISION DAYINWEEK,DAYINYEAR,YR,MO,A,Y,M,D1,DATE,MDAY DATE=MDAY(DAYINYEAR) A=INT((14-MO)/12) Y=YR-A M=MO+(12*A)-2 D1=DATE+Y+INT(Y/4)-INT(Y/100)+INT(Y/400)+INT((31*M)/12) DAYINWEEK=MOD(D1,7.0) END FUNCTION MDAY(DAY) C Function returns the date (day in month) IMPLICIT NONE COMMON /MONTHARRAY/ MLEN DOUBLE PRECISION MDAY,MLEN,DAY,MO DIMENSION MLEN(12) MDAY=DAY MO=1 DO WHILE (MDAY-MLEN(INT(MO+0.01)).GT.0.1) MDAY=MDAY-MLEN(INT(MO+0.01)) MO=MO+1 END DO END FUNCTION MYEAR(DAY) C Function returns the month IMPLICIT NONE COMMON /MONTHARRAY/MLEN DOUBLE PRECISION MYEAR,MLEN,D,MO,DAY DIMENSION MLEN(12) D=DAY MO=1 DO WHILE (D-MLEN(INT(MO+0.01)).GT.0.1) D=D-MLEN(INT(MO+0.01)) MO=MO+1 END DO MYEAR=MO END FUNCTION NOCCDAY (WEEKDAY,N,YEAR,MO) C Function returns the day of year for the Nth occurance of a particular C weekday in the month. C Algorithm from website: http://cssa.stanford.edu/~marcos/ushols.html IMPLICIT NONE COMMON /MONTHARRAY/MLEN DOUBLE PRECISION NOCCDAY,WEEKDAY,N,YEAR,DIV,BASEDAY, & DAYINWEEK,MLEN,MO INTEGER J DIMENSION MLEN(12) BASEDAY=INT(1.01+(7*(N-1.0))) DIV=MOD(WEEKDAY-DAYINWEEK(YEAR,MO,BASEDAY),7.0) IF (DIV.LT.0) THEN DIV=DIV+7 ENDIF NOCCDAY=BASEDAY+DIV C At this point NOCCDAY is the date (day in month) of the holiday C Add days from elapsed months to get day of year J=1 DO WHILE (J+0.01.LT.MO) NOCCDAY=NOCCDAY+MLEN(J) J=J+1 END DO END C Procedure to define days of year to start and end daylight savings time SUBROUTINE DEFDSTIME(YEAR,YLEN,DSDAY0,DSDAYF) IMPLICIT NONE COMMON /MONTHARRAY/MLEN DOUBLE PRECISION YEAR,YLEN,DSDAY0,DSDAYF,D,N,M,MLEN, & NOCCDAY DIMENSION MLEN(12) C Daylight savings starts with the first Sunday in April D=0.0 N=1.0 M=4.0 DSDAY0=NOCCDAY(D,N,YEAR,M) C Daylight savings ends with the last Sunday in October D=0.0 N=5.0 M=10.0 DSDAYF=NOCCDAY(D,N,YEAR,M) IF (DSDAYF.GT.(MLEN(1)+MLEN(2)+MLEN(3)+MLEN(4)+MLEN(5) & +MLEN(6)+MLEN(7)+MLEN(8)+MLEN(9)+MLEN(10))) DSDAYF=DSDAYF-7 END SUBROUTINE DEFDSTIME C Procedure defines the HOLIDAY array. It is called at the beginning of the simulation C and at the beginning of a new year. SUBROUTINE DEFHOL(YEAR,YLEN,HOLIDAY) IMPLICIT NONE COMMON /MONTHARRAY/MLEN COMMON /HOLSTUFF/NUMHOL,NCUSTHOL,MCUSTHOL,DCUSTHOL,MODE DOUBLE PRECISION YEAR,HOLIDAY,D,M,N,MLEN,YLEN,NOCCDAY,DAYINWEEK, & CUMDAYS,DCUSTHOL,MCUSTHOL INTEGER NCUSTHOL,J,K,NUMHOL,MODE DIMENSION HOLIDAY(50),MLEN(12),MCUSTHOL(40),DCUSTHOL(40) IF ((MODE.EQ.0).OR.(MODE.EQ.1)) THEN C Set Standard Holidays for Year C Some holidays (President's Day, etc.) fall on the Nth Monday or Thursday C in the month. Others (Christmas, etc.) fall on a particular date. If this C date is a Saturday the bank holiday occurs on Friday instead. If it is a C Sunday the holiday then falls on Monday. C New Year's: January 1st HOLIDAY(NCUSTHOL+1)=1 M=1.0 D=DAYINWEEK(YEAR,M,HOLIDAY(NCUSTHOL+1)) IF (D.EQ.0) HOLIDAY(NCUSTHOL+1)=HOLIDAY(NCUSTHOL+1)+1 IF (D.EQ.6) HOLIDAY(NCUSTHOL+1)=HOLIDAY(NCUSTHOL+1)-1 C Martin Luther King: 3rd Monday in January D=1.0 N=3.0 M=1.0 HOLIDAY(NCUSTHOL+2)=NOCCDAY(D,N,YEAR,M) C Presidents Day: 3rd Monday in February D=1.0 N=3.0 M=2.0 HOLIDAY(NCUSTHOL+3)=NOCCDAY(D,N,YEAR,M) C Memorial Day: Last Monday in May, make sure not to set in June D=1.0 N=5.0 M=5.0 HOLIDAY(NCUSTHOL+4)=NOCCDAY(D,N,YEAR,M) IF (HOLIDAY(NCUSTHOL+4).GT.MLEN(1)+MLEN(2)+MLEN(3)+MLEN(4) & +MLEN(5)) THEN HOLIDAY(NCUSTHOL+4)=HOLIDAY(NCUSTHOL+4)-7 ENDIF C Independence Day: July 4th HOLIDAY(NCUSTHOL+5)=MLEN(1)+MLEN(2)+MLEN(3)+MLEN(4)+ & MLEN(5)+MLEN(6)+4 M=7.0 D=DAYINWEEK(YEAR,M,HOLIDAY(NCUSTHOL+5)) IF (D.EQ.0) HOLIDAY(NCUSTHOL+5)=HOLIDAY(NCUSTHOL+5)+1 IF (D.EQ.6) HOLIDAY(NCUSTHOL+5)=HOLIDAY(NCUSTHOL+5)-1 C Labor Day: 1st Monday in September D=1.0 N=1.0 M=9.0 HOLIDAY(NCUSTHOL+6)=NOCCDAY(D,N,YEAR,M) C Columbus Day: 2nd Monday in October D=1.0 N=2.0 M=10.0 HOLIDAY(NCUSTHOL+7)=NOCCDAY(D,N,YEAR,M) C Veteran's Day: November 11 HOLIDAY(NCUSTHOL+8)=YLEN-MLEN(12)-MLEN(11)+11 M=11.0 D=DAYINWEEK(YEAR,M,HOLIDAY(NCUSTHOL+8)) IF (D.EQ.0) HOLIDAY(NCUSTHOL+8)=HOLIDAY(NCUSTHOL+8)+1 IF (D.EQ.6) HOLIDAY(NCUSTHOL+8)=HOLIDAY(NCUSTHOL+8)-1 C Thanksgiving Day: 4th Thursday in November D=4.0 N=4.0 M=11.0 HOLIDAY(NCUSTHOL+9)=NOCCDAY(D,N,YEAR,M) C Christmas: December 25th HOLIDAY(NCUSTHOL+10)=YLEN-MLEN(12)+25 M=12.0 D=DAYINWEEK(YEAR,M,HOLIDAY(NCUSTHOL+10)) IF (D.EQ.0) HOLIDAY(NCUSTHOL+10)=HOLIDAY(NCUSTHOL+10)+1 IF (D.EQ.6) HOLIDAY(NCUSTHOL+10)=HOLIDAY(NCUSTHOL+10)-1 ENDIF IF ((MODE.EQ.1).OR.(MODE.EQ.2)) THEN C Set user-defined holidays. All user defined holidays are set C to fall on a particular date. If the date occurs on a weekend C then holiday is set to the previous Friday or following Monday. DO 8 J=1,NCUSTHOL HOLIDAY(J)=DCUSTHOL(J) IF (MCUSTHOL(J).GT.1) THEN DO 9 K=1,MCUSTHOL(J)-1 HOLIDAY(J)=HOLIDAY(J)+MLEN(K) 9 CONTINUE ENDIF C Check for weekend D=DAYINWEEK(YEAR,MCUSTHOL(J),HOLIDAY(J)) IF (D.EQ.0) HOLIDAY(J)=HOLIDAY(J)+1 IF (D.EQ.6) HOLIDAY(J)=HOLIDAY(J)-1 8 CONTINUE ENDIF END SUBROUTINE DEFHOL