c c *************************** c *** Subroutine YDcGR *** c *** 1984/12/07/08-55 *** c *************************** c Subroutine YDcGR(iyear,idayy,fdayy, imon,iday,ihr,imin,seci) *********************************************************************** * * * Purpose: Given is the (actual) year and the (actual!) day * * and fractional parts of the actual day from * * beginning of year. * * * * Compute the Gregorian date (i.e., the present day * * calendar date) represented by * * iyear, imon, iday, ihr, imin, seci. * * * * * * Parameters Type I/O Function * * * * iyear i*4 I actual year * * idayy i*4 I actual day (of the year) * * cf. examples * * fdayy r*8 I fractional part of the actual * * day (of the year) * * * * imon i*4 O month * * iday i*4 O day * * ihr i*4 O hours * * imin i*4 O minutes * * seci r*8 O seconds * * * * * * Examples (watch carefully!): * * * * Input: iyear = 83 idayy = 365 fdayy = 0.9999898548239468 * * Represents: 1983/12/31/23/59/59.1234567890 * * Output: imon = 12, iday = 31, ihr = 23, imin = 59, * * seci = 59.1234567890 * * * * Input: iyear = 84 idayy = 1 fdayy = 0.0 * * Represents: 1984/01/01/00/00/00.0 * * Output: imon = 1, iday = 1, ihr = 0, imin = 0, * * seci = 0.0000000000 * * * * Input: iyear = 84 idayy = 1 fdayy = 0.0000115740740741 * * Represents: 1984/01/01/00/00/01.0000000000 * * Output: imon = 1, iday = 1, ihr = 0, imin = 0, * * seci = 1.0000000000 * * * * Input: iyear = 84 idayy = 281 fdayy = 0.6459736511202435 * * Represents: 1984/10/07/15/30/12.1234567890 * * Output: imon = 10, iday = 7, ihr = 15, imin = 30, * * seci = 12.1234567890 * * * * Thus you can see: idayy never may be 0! This means we start * * the year with Jan. 1.0, or using other words, idayy = 1 * * and fdayy = 0.0 means we are at the precise beginning of * * the first day of a year (idayy = 1) and nothing (fdayy = 0.0) * * of this day is over! * * * * * * B. Hofmann-Wellenhof, B. Remondi * * * *********************************************************************** implicit real*8(a-h,o-z) dimension isumd(12) isumd(1) = 0 isumd(2) = 31 isumd(3) = 59 isumd(4) = 90 isumd(5) = 120 isumd(6) = 151 isumd(7) = 181 isumd(8) = 212 isumd(9) = 243 isumd(10) = 273 isumd(11) = 304 isumd(12) = 334 c c Input data test. c if(iyear .lt. 0 .or. iyear .gt. 199) + stop ' YDcGR: "iyear" must be 0 <= iyear <= 199' if(idayy .lt. 1 .or. idayy .gt. 366) + stop ' YDcGR: "idayy" must be 1 <= idayy <= 366' if(fdayy .lt. 0.d0 .or. fdayy .ge. 1.d0) + stop ' YDcGR: "fdayy" must be 0.0 <= fdayy < 1.0' c I changed value below from 366 to 367. b.remondi if(idayy+fdayy .gt. 367.) + stop ' YDcGR: "idayy + fdayy" must be <= 367' c iy19 = iyear + 1900 leap = 0 if(mod(iy19, 4) .ne. 0) goto 3000 leap = 1 if(mod(iy19, 100) .ne. 0) goto 3000 if(mod(iy19, 400) .ne. 0) leap = 0 3000 continue if(leap .eq. 0) goto 3010 do 10 j=3,12 isumd(j) = isumd(j) + 1 10 continue 3010 continue if(leap .eq. 1) goto 3020 c c No leap year, thus mostly 365 days c c I changed the values in the line below from 365 to 366. b.remondi if(idayy+fdayy .gt. 366.) stop + ' YDcGR: No leap year, thus "idayy + fdayy" must be <= 366' if(idayy .gt. 365) stop + ' YDcGR: "iyear" no leap year, thus "idayy" must be <= 365' c 3020 continue do 20 j=1,12 if(idayy .gt. isumd(j)) imon=j 20 continue iday = idayy - isumd(imon) ahrs = fdayy*24.0d0 ihr = ahrs imin = (ahrs - ihr)*60.0d0 seci = ahrs*3600.0d0 - ihr*3600.d0 - imin*60.d0 return c c End of Subroutine YDcGR c c ***************************************************************** end