mo_year.f90

      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_year


Info Section
uses: mo_julian, mo_start_dataset calls: cd2dat, yd, ymd
back to top
ECHAM 4 vf90 (C) 1998 Max-Planck-Institut für Meteorologie, Hamburg
Wed Nov 24 01:25:21 CST 1999

HTML derived from FORTRAN source by f2html.pl v0.3 (C) 1997,98 Beroud Jean-Marc.