subroutine fordate(dtime,yrflag, iyear,month,iday,ihour) implicit none c double precision dtime integer yrflag, iyear,month,iday,ihour c c --- converts model day to "calendar" date (year,month,day,hour). c integer jday,k,m c integer month0(13,3) data month0 / 1, 31, 61, 91, 121, 151, 181, + 211, 241, 271, 301, 331, 361, + 1, 32, 60, 91, 121, 152, 182, + 213, 244, 274, 305, 335, 366, + 1, 32, 61, 92, 122, 153, 183, + 214, 245, 275, 306, 336, 367 / c call forday(dtime,yrflag, iyear,jday,ihour) c if (yrflag.eq.3) then if (mod(iyear,4).eq.0) then k = 3 else k = 2 endif elseif (yrflag.eq.0) then k = 1 else k = 3 endif do m= 1,12 if (jday.ge.month0(m, k) .and. + jday.lt.month0(m+1,k) ) then month = m iday = jday - month0(m,k) + 1 endif enddo return end subroutine forday(dtime,yrflag, iyear,iday,ihour) implicit none c double precision dtime integer yrflag, iyear,iday,ihour c c --- converts model day to "calendar" date (year,julian-day,hour). c integer lp common/linepr/ lp save /linepr/ c double precision dtim1,day integer iyr,nleap c if (yrflag.eq.0) then c --- 360 days per model year, starting Jan 16 iyear = int((dtime+15.001d0)/360.d0) + 1 iday = mod( dtime+15.001d0 ,360.d0) + 1 ihour = (mod( dtime+15.001d0 ,360.d0) + 1.d0 - iday)*24.d0 c elseif (yrflag.eq.1) then c --- 366 days per model year, starting Jan 16 iyear = int((dtime+15.001d0)/366.d0) + 1 iday = mod( dtime+15.001d0 ,366.d0) + 1 ihour = (mod( dtime+15.001d0 ,366.d0) + 1.d0 - iday)*24.d0 c elseif (yrflag.eq.2) then c --- 366 days per model year, starting Jan 01 iyear = int((dtime+ 0.001d0)/366.d0) + 1 iday = mod( dtime+ 0.001d0 ,366.d0) + 1 ihour = (mod( dtime+ 0.001d0 ,366.d0) + 1.d0 - iday)*24.d0 c elseif (yrflag.eq.3) then c --- model day is calendar days since 01/01/1901 iyr = (dtime-1.d0)/365.25d0 nleap = iyr/4 dtim1 = 365.d0*iyr + nleap + 1.d0 day = dtime - dtim1 + 1.d0 if (dtim1.gt.dtime) then iyr = iyr - 1 elseif (day.ge.367.d0) then iyr = iyr + 1 elseif (day.ge.366.d0 .and. mod(iyr,4).ne.3) then iyr = iyr + 1 endif nleap = iyr/4 dtim1 = 365.d0*iyr + nleap + 1.d0 c iyear = 1901 + iyr iday = dtime - dtim1 + 1 ihour = (dtime - dtim1 + 1.d0 - iday)*24.d0 c else write(lp,*) write(lp,*) 'error in forday - unsupported yrflag value' write(lp,*) call flush(lp) stop '(forday)' endif return end