!$Author: wagner $ !$Date: 2005-02-11 16:49:11 $ !$Revision: 1.6 $ !$Source: /weru/cvs/weps/weps.src/util/date/caldat.for,v $ ! ! CALDAT is taken from _Numerical_Recipes:_The_Art_of_Scientific_Computing_ ! subroutine caldat (ijulian, dd, mm, yyyy) include 'm1sim.inc' ! ! + + + PURPOSE + + + ! Inverse of the function JULDAY. Here 'julian' is input as a Julian Day ! Number, and the routine outputs the dd, mm, and yyyy on which the ! specified Julian Day started at noon. ! ! + + + KEYWORDS + + + ! date, utility ! ! + + + ARGUMENT DECLARATIONS + + + integer ijulian, dd, mm, yyyy integer igreg, julian ! ! ! + + + ARGUMENT DEFINITIONS + + + ! mm - integer value of mm in the range 1-12 ! dd - dd in the range 1-31 ! yyyy - yyyy (negative A.D., positive B.C.) ! julian - integer value equal to Julian Day Number ! ! + + + PARAMETERS + + + ! Gregorian Calendar was adopted on Oct. 15, 1582. parameter (igreg=2299161) ! ! + + + LOCAL VARIABLES + + + integer jalpha, ja, jb, jc, jd, je real c,e, alpha ! ! + + + END SPECIFICATIONS + + + ! ! if the date is -1 then use the simulation date. julian = ijulian if (julian.eq.-1) julian = am0jd if (julian.ge.igreg) then alpha = (dble(julian-1867216)-dble(0.25))/dble(36524.25) jalpha = int(alpha) ja = julian+1+jalpha - int (dble(0.25)*jalpha) else ja=julian endif jb=ja+1524 c = dble(6680.0)+((jb-2439870)-dble(122.1))/dble(365.25) jc = int(c) jd=365*jc+int (dble(0.25)*jc) e = (jb-jd)/dble(30.6001) je = int(e) dd=jb-jd-int (dble(30.6001)*je) mm=je-1 if (mm.gt.12) mm=mm-12 yyyy=jc-4715 if (mm.gt.2) yyyy=yyyy-1 if (yyyy.le.0) yyyy=yyyy-1 return end ! !$Log: not supported by cvs2svn $ !Revision 1.5 2002/09/04 20:22:17 wagner !allow free format src compilation ! !Revision 1.4 2002/05/02 23:14:12 fredfox !added command line argument to call subroutine which creates a stand alone erosion input file !based on either an input date or input simulation day. Since this erosion input is called in !erosion, dates before the warmup years will not be called since erosion is not called. if code !is changed to call erosion at all times, then this will work during that itme as well. Also, !some files were cleaned up and comments and header information only changed ! !Revision 1.3 2000/01/29 22:23:24 wjr !moved lentrim in util/misc !combined decini & decoinit into one file, decoinit !removed wepdgb from weps.for !removed grad and moved calc into getcli !moved several vars into getwin & getcli from weps !moved *dbug.for into respective subdirs !modified caldat to reference am0jd if arg == -1 and removed params appropriately ! !Revision 1.2 1999/04/26 20:16:19 wagner !changes due to combining include files ([cdb]1glob.inc), etc ! !Revision 1.1.1.1 1999/03/12 17:05:31 wagner !Baseline version of WEPS with Bill Rust's modifications ! ! Revision 1.1.1.1 1995/01/18 04:20:06 wagner ! Initial checkin ! ! Revision 2.3 1992/04/03 23:24:58 wagner ! Removed extraneous test print statements. ! ! Revision 2.2 1992/04/03 23:15:54 wagner ! Added some typecasts from floats to doubles (dble) ! to hopefully eliminate some roundoff error problems ! with the MS FORTRAN 5.1 compiler. ! Later, we determined that the problem was occuring ! in the julday function and not the caldat subroutine. ! However, these changes should not bother anything ! so the changes have been kept. ! ! Revision 2.1 1992/03/27 17:22:53 wagner ! Version 2 code. !