MODULE mo_year USE mo_julian 5: ! Different treatment for years with 360 or 365/366 days IMPLICIT NONE INTEGER, PARAMETER :: idays(12)=(/0,31,59,90,120,151,181,212,243,273,304,334/) 10: INTEGER, PARAMETER :: jdays(12)=(/0,31,60,91,121,152,182,213,244,274,305,335/) INTEGER, PARAMETER :: kdays(12)=(/31,28,31,30,31,30,31,31,30,31,30,31/) ! cd2dat - convert century day/julian day to standard date ! cd2dy - convert century day/julian day to day of year and year 15: ! ic2ymd - returns an integer yymmdd/yyyymmdd given the ! century day/julian day ! iymd2c - returns the century day/julian day given an ! integer yymmdd/yyyymmdd ! idat2c - returns forecast day starting at 1st of Jan of first 20: ! - forecast-year ! isec2hms - convert seconds of day into HHMMSS format ! ihms2sec - convert HHMMSS format in seconds of day CONTAINS 25: FUNCTION idat2c(kd,km,ky) ! Description: ! 30: ! This function returns forecast day ! starting at 1st of jan of first forecast-year ! kd day ! km month ! ky year 35: ! ! Authors: ! ! U. Schlese, DKRZ, March 1989 ! L. Kornblueh, MPI, May 1998 40: ! U. Schulzweida, MPI, May 1998 USE mo_start_dataset, ONLY: ly365 IMPLICIT NONE 45: ! Function return value INTEGER :: idat2c ! Scalar arguments 50: INTEGER :: kd, km, ky ! Local scalars: INTEGER :: iy, iyday, ily 55: ! Intrinsic functions INTRINSIC MOD ! External statements 60: IF (ly365) THEN ! 365 days per year iy=MOD(ky,100) iyday=idays(km)+kd IF (MOD(iy,4) == 0) iyday=jdays(km)+kd 65: ily=(iy-1)/4 idat2c=iy*365+ily+iyday ELSE ! 360 days per year iy = MOD(ky,100) iyday = (km-1)*30 + kd 70: idat2c = (iy-1)*360 + iyday ENDIF END FUNCTION idat2c 75: SUBROUTINE cd2dat(kcd,kd,km,ky) ! Description: ! ! This subroutine converts 80: ! kcd either century day or julian day ! back to ! kd day ! km month ! ky year 85: ! ! Authors: ! ! U. Schulzweida, MPI, July 1998 ! L. Kornblueh, MPI, December 1998 90: ! USE mo_start_dataset, ONLY: ly365 IMPLICIT NONE 95: ! Scalar arguments INTEGER, INTENT(IN) :: kcd INTEGER, INTENT(OUT) :: kd, km, ky 100: ! Intrinsic functions INTRINSIC MOD ! Local scalars TYPE (julian_date) :: julian_day REAL :: zfraction 105: INTEGER :: idays ! Executable statements IF (ly365) THEN 110: ! to modify for noon shifting of julian date julian_day%day = REAL(kcd-0.5) julian_day%fraction = 0.0 115: CALL YMD (julian_day, ky, km, kd, zfraction) ELSE 120: ky = (kcd-1)/360 + 1 idays = MOD(kcd-1,360) + 1 km = (idays-1)/30 + 1 kd = MOD(idays-1,30) + 1 125: ENDIF END SUBROUTINE cd2dat SUBROUTINE cd2dy(kcd,kd,ky) 130: ! Description: ! ! This subroutine converts ! kcd either century day or julian day in day of year 135: ! back to ! kd day ! ky year ! ! Authors: 140: ! ! U. Schulzweida, MPI, July 1998 ! L. Kornblueh, MPI, December 1998 ! 145: USE mo_start_dataset, ONLY: ly365 IMPLICIT NONE ! Scalar arguments 150: INTEGER, INTENT(IN) :: kcd INTEGER, INTENT(OUT) :: kd, ky ! Intrinsic functions INTRINSIC MOD 155: ! Local scalars TYPE (julian_date) :: julian_day REAL :: zfraction 160: ! Executable statements IF (ly365) THEN ! to modify for noon shifting of julian date 165: julian_day%day = REAL(kcd-0.5) julian_day%fraction = 0.0 CALL YD (julian_day, ky, kd, zfraction) 170: ELSE ky = (kcd-1)/360 + 1 kd = MOD(kcd-1,360) + 1 175: ENDIF END SUBROUTINE cd2dy 180: FUNCTION ic2ymd(kcd) ! Description: ! ! This function returns an integer yymmdd given the century day 185: ! where yy is the year ! mm is the month ! dd is the day ! ! Authors: 190: ! ! U. Schlese, DKRZ, March 1989 ! L. Kornblueh, MPI, May 1998 ! U. Schulzweida, MPI, May 1998 ! H.-S. Bauer, MPI, July 1998 195: IMPLICIT NONE ! Function Return Value INTEGER :: ic2ymd 200: ! Scalar arguments INTEGER :: kcd ! Local scalars: 205: INTEGER :: id, im, iy ! Executable Statements 210: CALL cd2dat(kcd,id,im,iy) ic2ymd = id + (im+iy*100)*100 END FUNCTION ic2ymd 215: FUNCTION iymd2c(kymd) ! Description: ! This function returns the century day given an integer yymmdd/yyyymmdd 220: ! where yy is the year ! mm is the month ! dd is the day ! USE mo_julian 225: USE mo_start_dataset, ONLY: ly365 IMPLICIT NONE 230: ! Function return value INTEGER :: iymd2c ! Scalar arguments INTEGER :: kymd 235: ! Local types: TYPE (julian_date) :: julian_day 240: ! Intrinsic functions INTRINSIC MOD ! Executable Statements 245: IF (ly365) THEN julian_day = SetYMD(kymd/10000,MOD(kymd/100,100),MOD(kymd,100)) iymd2c = INT(julian_day%day+julian_day%fraction+0.5) ELSE iymd2c = idat2c(MOD(kymd,100),MOD(kymd/100,100),kymd/10000) 250: ENDIF END FUNCTION iymd2c FUNCTION im2day(km,ky) 255: ! Description: ! ! Returns number of days of a given month ! 260: ! km month ! ky year (19xx or xx) ! ! Authors: ! 265: ! U. Schlese, DKRZ, Jan 1996 ! L. Kornblueh, MPI, May 1998 ! U. Schulzweida, MPI, May 1998 ! 270: IMPLICIT NONE ! Function return value INTEGER :: im2day 275: ! Scalar arguments INTEGER :: km,ky ! Intrinsic functions INTRINSIC MOD 280: ! Executable statements IF (km /= 2) THEN im2day = kdays(km) ELSE 285: ! ! check for a leap year ! IF(MOD(ky,400) == 0) THEN im2day=29 290: ELSE IF (MOD(ky,100) == 0) THEN im2day=28 ELSE IF (MOD(ky,4) /= 0) THEN im2day=28 ELSE 295: im2day=29 ENDIF ENDIF END FUNCTION im2day 300: FUNCTION isec2hms(isec) ! convert seconds of day into HHMMSS format 305: IMPLICIT NONE INTEGER :: isec, isec2hms, ihh, imm, iss ! Intrinsic functions 310: INTRINSIC MOD ihh = isec/3600 imm = MOD(isec,3600)/60 iss = MOD(isec,60) 315: isec2hms = ihh*10000 + imm*100 + iss END FUNCTION isec2hms 320: FUNCTION ihms2sec(hms) ! convert HHMMSS format into seconds of day IMPLICIT NONE 325: INTEGER :: hms, ihms2sec, ihh, imm, iss ! Intrinsic functions INTRINSIC MOD 330: ihh = hms/10000 imm = MOD(hms,10000)/100 iss = MOD(hms,100) 335: ihms2sec = ihh*3600 + imm*60 + iss END FUNCTION ihms2sec END MODULE mo_yearback to top
Info Section uses: mo_julian, mo_start_dataset calls: cd2dat, yd, ymd
HTML derived from FORTRAN source by f2html.pl v0.3 (C) 1997,98 Beroud Jean-Marc.