- Timestamp:
- 04/26/06 16:29:38 (18 years ago)
- Location:
- trunk
- Files:
-
- 4 added
- 1 deleted
- 9 copied
Legend:
- Unmodified
- Added
- Removed
-
trunk/Calendar/date2string.pro
r7 r9 3 3 ;------------------------------------------------------------ 4 4 ;+ 5 ; NAME: 5 ; NAME: date2string 6 6 ; 7 ; PURPOSE: 7 ; PURPOSE: create a nice and readable format to print a date 8 8 ; 9 ; CATEGORY: 9 ; CATEGORY: calendar/string 10 10 ; 11 ; CALLING SEQUENCE: 11 ; CALLING SEQUENCE: nice_date = date2string(yyyymmdd) 12 12 ; 13 ; INPUTS: 13 ; INPUTS: yyyymmdd the date in the format 14 ; yearyearyearyearmonthmonthdayday 14 15 ; 15 ; KEYWORD PARAMETERS: 16 ; KEYWORD PARAMETERS:those of string fonction to specify the 17 ; format of the month (the C format) 16 18 ; 17 ; OUTPUTS: 19 ; OUTPUTS: a string containing the date in a easy readable format 18 20 ; 19 ; COMMON BLOCKS: 21 ; COMMON BLOCKS:none 20 22 ; 21 ; SIDE EFFECTS: 23 ; SIDE EFFECTS:? 22 24 ; 23 ; RESTRICTIONS: 25 ; RESTRICTIONS:? 24 26 ; 25 27 ; EXAMPLE: 26 28 ; 29 ; IDL> print, date2string(19900123) 30 ; Jan 23, 1990 31 ; IDL> print, date2string(19900123, format = '(C(CMOA))') 32 ; JAN 23, 1990 33 ; 27 34 ; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr) 28 ; 35 ; Creation ??? 36 ; update/review June 2005 Sebastien Masson. 29 37 ;- 30 38 ;------------------------------------------------------------ 31 39 ;------------------------------------------------------------ 32 40 ;------------------------------------------------------------ 33 FUNCTION date2string, date41 FUNCTION date2string, yyyymmdd, _EXTRA = ex 34 42 ; 35 @common 36 ; 37 s_date = strtrim(date, 2) 38 length = strlen(s_date) 39 sday = strtrim(fix(strmid(s_date,length-2)), 1) 40 smonth = strmid(s_date,length-4, 2) 41 syear = strmid(s_date, 0 ,length-4) 42 ; res = syear+' '+string(format='(C(CMoA0))',31*(fix(smonth)-1))+' 43 ; '+sday 44 if n_elements(langage) EQ 0 then langage = 'gb' 45 case langage of 46 'gb':BEGIN 47 truc = long(sday) 48 truc = truc-truc/10*10 49 case truc of 50 2:truc = 'nd' 51 3:truc = 'rd' 52 ELSE:truc = 'th' 53 endcase 54 res = string(format='(C(CMoA0))',31*(fix(smonth)-1))+' the '+sday+truc+' '+syear 55 END 56 ELSE:res = sday+' '+string(format='(C(CMoA0))',31*(fix(smonth)-1))+' '+syear 57 endcase 43 sday = strtrim(long(yyyymmdd) MOD 100, 1) 44 smonth = strtrim((long(yyyymmdd)/100) MOD 100, 2) 45 syear = strtrim(long(yyyymmdd)/10000, 2) 46 res = string(format = '(C(CMoa))', 31*(fix(smonth)-1), _EXTRA = ex) $ 47 + ' ' + sday + ', ' + syear 58 48 return, res 59 49 end -
trunk/Calendar/leapyr.pro
r7 r9 1 1 ;----------------------------------------------------------------- 2 function leapyr,year2 function leapyr, year 3 3 ;+ 4 4 ; NAME: leapyr … … 13 13 ; 14 14 ; INPUTS: year = test if year is a leap year 15 ; year may be a vector and may be in the16 ; form MCDU eg. 1788 else defaults to 19XX17 15 ; 18 16 ; OUTPUTS: result = 0 then not a leap year 19 17 ; = 1 then year is a leap year 20 ; = (399+(yr mod 400))/400 - (3+(yr mod 4))/421 18 ; 22 ; COMMON BLOCKS: 23 ; none.19 ; COMMON BLOCKS: cm_4cal 20 ; 24 21 ; SIDE EFFECTS: 25 22 ; none. 26 23 ; MODIFICATION HISTORY: 27 ; Written by: Trevor Harris, Physics Dept., University of Adelaide, 24 ; 25 ; Originally Written by: Trevor Harris, Physics Dept., University of Adelaide, 28 26 ; 20/09/88 29 27 ; 28 ; November 2004: correction for century years... S. Masson; 29 ; 30 ; Every year divisible by 4 is a leap year. 31 ; But every year divisible by 100 is NOT a leap year 32 ; Unless the year is also divisible by 400, then it is still a 33 ; leap year. 34 ; This means that year 1800, 1900, 2100, 2200, 2300 and 2500 are 35 ; NOT leap years, while year 2000 and 2400 are leap years. 36 ; + supress the automatic change 89 -> 1989 37 ; 38 ; June 2005 update for new commons, Sebastien Masson. 39 ; 30 40 ;- 41 ;------------------------------------------------------------ 42 ; include commons 43 @cm_4cal 44 ;------------------------------------------------------------ 45 yr = long(year) 46 IF n_elements(key_caltype) EQ 0 THEN key_caltype = 'greg' 47 ; 48 IF key_caltype NE 'greg' THEN BEGIN 49 sd = size(yr, /dimensions) 50 IF sd[0] EQ 0 THEN return, 0b ELSE return, bytarr(size(yr, /dimensions)) 51 ENDIF ELSE return, (yr MOD 4 EQ 0)*((yr MOD 100 NE 0) + (yr MOD 400 EQ 0)) 31 52 32 ; this function returns with an I*4 value of :- 33 ; 1 if year is a leap year 34 ; 0 if year is not a leap year 35 ; T.J.H. 20/09/88 36 37 ; Note: year must be in the form MCDU eg. 1788 else defaults to 19XX 38 39 40 yr = year 41 tmp = where(yr lt 100,count) 42 if (count gt 0) then yr(tmp) = yr(tmp)+1900 ;make it the 20th century 43 44 return,(399+(yr mod 400))/400 - (3+(yr mod 4))/4 45 46 end 53 end -
trunk/Obsolete/jourdsmois.pro
r7 r9 5 5 ; NAME:jourdsmois 6 6 ; 7 ; PURPOSE:donne le nombre de jours ds le mois month de l'annee year 8 ; 9 ; CATEGORY: 10 ; 11 ; CALLING SEQUENCE:result=jourdsmois() 12 ; 13 ; INPUTS:optionnels 14 ; mois et annee 15 ; 16 ; KEYWORD PARAMETERS: 17 ; 18 ; OUTPUTS: 19 ; 20 ; COMMON BLOCKS: 21 ; common.pro leapyr.pro 22 ; 23 ; SIDE EFFECTS: 24 ; 25 ; RESTRICTIONS: 26 ; 27 ; EXAMPLE: 7 ; PURPOSE: 8 ; obsolete, used daysinmonth instead... 28 9 ; 29 10 ; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr) 30 ; 2/7/9831 11 ;- 12 ; June 2005: Sebastien Masson, english version 32 13 ;------------------------------------------------------------ 33 14 ;------------------------------------------------------------ 34 15 ;------------------------------------------------------------ 35 function jourdsmois, mois,annee 36 @common 37 ;------------------------------------------------------------ 38 case n_params() of 39 1:month=mois 40 2:begin 41 month=mois 42 year=annee 43 end 44 else: 16 function jourdsmois, mois, annee 17 18 case n_params() OF 19 0:return, daysinmonth() 20 1:return, daysinmonth(mois) 21 2:return, daysinmonth(mois, annee) 45 22 endcase 46 ;------------------------------------------------------------ 47 days_in_mth = [31,28+leapyr(year),31,30,31,30,31,31,30,31,30,31] 48 return, days_in_mth[month-1] 49 ;------------------------------------------------------------ 23 50 24 end -
trunk/Obsolete/juldate.pro
r7 r9 4 4 ;+ 5 5 ; NAME: juldate 6 ; 7 ; OBSOLETE: you better use date2jul 6 8 ; 7 9 ; PURPOSE: gives julian date equivalent of a date in vairmer … … 17 19 ; KEYWORD PARAMETERS: 18 20 ; 19 ; VRAIDATE: pour ne pasa transformer l''annnee 01 en 1901 21 ; /VRAIDATE: pour ne pas transformer l''annnee 01 en 1901 22 ; /GRADS: if 1 le year le 49 then year = 2000+year 23 ; if 50 le year le 99 then year = 1900+year 20 24 ; 21 25 ; OUTPUTS:date en jour julien -
trunk/Obsolete/vairdate.pro
r7 r9 4 4 ;+ 5 5 ; NAME: vairdate 6 ; 7 ; OBSOLETE: you better use jul2date 6 8 ; 7 9 ; PURPOSE: gives vairmer date equivalent of a date in julian format -
trunk/Obsolete/vraidate.pro
r7 r9 5 5 ; NAME:vraidate 6 6 ; 7 ; PURPOSE:donne la date en long et avec le siecle s'il n'est pas specifie.7 ; PURPOSE:donne la date en long 8 8 ; 9 ; CATEGORY: compatibile an 2000 bien-sur9 ; CATEGORY: 10 10 ; 11 ; CALLING SEQUENCE:res=v aridate(date)11 ; CALLING SEQUENCE:res=vraidate(date) 12 12 ; 13 ; INPUTS:date:une date vairmer du type yymmdd ouyyyymmdd13 ; INPUTS:date:une date du type yyyymmdd 14 14 ; 15 15 ; KEYWORD PARAMETERS: 16 ; VRAIDATE: pour ne pasa transformer l''annnee 01 en 1901 16 ; 17 ; /GRADS: if 1 le year le 49 then year = 2000+year 18 ; if 50 le year le 99 then year = 1900+year 17 19 ; 18 20 ; OUTPUTS:une date vairmer du type yyyymmdd … … 24 26 ; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr) 25 27 ; 3/7/98 28 ; remove automatic change from year 1 to 1901... Aug 2004 26 29 ;- 27 30 ;------------------------------------------------------------ 28 31 ;------------------------------------------------------------ 29 32 ;------------------------------------------------------------ 30 function vraidate, date, VRAIDATE = vraidate, _EXTRA = ex33 function vraidate, date, GRADS = grads, _EXTRA = ex 31 34 ;------------------------------------------------------------ 32 date=long(date) 33 annee=date/10000 34 if keyword_set(VRAIDATE) then return, date ELSE $ 35 return, date+19000000*(annee ne 0 and annee ne -1 and date lt 1000000 and date GT 0) 35 IF NOT keyword_set(GRADS) THEN return, long(date) 36 ; 37 date = long(date) 38 annee = date/10000 39 return, date+19000000L*(annee GE 50 and date lt 1000000)+20000000L*(annee LT 50 and date lt 1000000) 36 40 ;------------------------------------------------------------ 37 41 end -
trunk/ToBeReviewed/CALENDRIER/caldat.pro
r7 r9 1 1 ; $Id$ 2 2 ; 3 ; Copyright (c) 1992- 1998, Research Systems, Inc. All rights reserved.3 ; Copyright (c) 1992-2003, Research Systems, Inc. All rights reserved. 4 4 ; Unauthorized reproduction prohibited. 5 5 ; … … 20 20 ; 21 21 ; INPUTS: 22 ; JULIAN contains the Julian Day Number (which begins at noon) of the 22 ; JULIAN contains the Julian Day Number (which begins at noon) of the 23 23 ; specified calendar date. It should be a long integer. 24 ;25 ; KEYWORD PARAMETERS:26 ;27 ; NDAYSPM: developpe par eric, ca veut dire: nombre de jours par mois!28 ; par defaut c''est 30, sinon le specifier en donnant29 ; une valeur a ndayspm30 ; pour passer a un calendrier avec un nombre de jours constant par31 ; mois. Utilise en particulier ds julday et caldat32 ;33 24 ; OUTPUTS: 34 25 ; (Trailing parameters may be omitted if not required.) … … 43 34 ; Second: Second (and fractions) of the day. 44 35 ; 45 ; COMMON BLOCKS: 46 ; None. 36 ; KEYWORD PARAMETERS: 37 ; 38 ; NDAYSPM: for using a calendar with fixed number of days per 39 ; months. defaut value of NDAYSPM=30 40 ; 41 ; COMMON BLOCKS: cm_4cal 47 42 ; 48 43 ; SIDE EFFECTS: … … 61 56 ; DMS, April 1996, Added HOUR, MINUTE and SECOND keyword 62 57 ; AB, 7 December 1997, Generalized to handle array input. 58 ; 63 59 ; Eric Guilyardi, June 1999 64 60 ; Added key_work ndayspm for fixed number of days per months 61 ; 62 ; AB, 3 January 2000, Make seconds output as DOUBLE in array output. 65 63 ;- 66 64 ; 65 pro CALDAT, julian, month, day, year, hour, minute, second, NDAYSPM = ndayspm 66 ;------------------------------------------------------------ 67 @cm_4cal 68 ;------------------------------------------------------------ 69 COMPILE_OPT idl2 67 70 71 ON_ERROR, 2 ; Return to caller if errors 68 72 69 pro caldat_scalar, Julian, Month, Day, Year, Hour, Minute, Second, NDAYSPM = ndayspm 70 ; Internal variant of CALDAT that does the actual work on a single 71 ; value. 73 IF n_elements(key_caltype) EQ 0 THEN key_caltype = 'greg' 74 if keyword_set(ndayspm) then key_caltype = '360d' 75 CASE key_caltype OF 76 'greg':BEGIN 72 77 73 ON_ERROR, 2 ; Return to caller if errors 78 nParam = N_PARAMS() 79 IF (nParam LT 1) THEN MESSAGE, 'Incorrect number of arguments.' 74 80 75 IF NOT keyword_set(ndayspm) THEN BEGIN 81 min_julian = -1095 82 max_julian = 1827933925 83 minn = MIN(julian, MAX = maxx) 84 IF (minn LT min_julian) OR (maxx GT max_julian) THEN MESSAGE, $ 85 'Value of Julian date is out of allowed range.' 76 86 77 IGREG = 2299161L ;Beginning of Gregorian calendar 87 igreg = 2299161L ;Beginning of Gregorian calendar 88 julLong = FLOOR(julian + 0.5d) ;Better be long 89 minJul = MIN(julLong) 78 90 79 IF julian GE 0 THEN jul = long(julian + .5d) $ ;Better be long 80 ELSE jul = long(julian - .5d) 81 f = julian + .5d - jul 82 if f ne 0.0 then begin ;Get hours, minutes, seconds. 83 hour = floor(f * 24.) 84 f = f - hour / 24.d 85 minute = floor(f*1440) 86 second = (f - minute/1440.d0) * 86400.0d0 87 endif else begin 88 hour = 0L 89 minute = 0L 90 second = 0L 91 endelse 92 93 94 if jul ge igreg then begin 95 jalpha = long(((jul - 1867216) - 0.25d0) / 36524.25) 96 ja = jul + 1 + jalpha - long(0.25d0 * jalpha) 97 endif else ja = jul 98 99 jb = ja + 1524l 100 jc = long(6680.0 + ((jb-2439870)-122.1d0)/365.25) 101 jd = long(365 * jc + (0.25 * jc)) 102 je = long((jb - jd) / 30.6001) 103 104 day = jb - jd - long(30.6001d * je) 105 month = je -1 106 if (month gt 12) then month = month - 12 107 year = jc - 4715 108 if month gt 2 then year = year - 1 109 if year le 0 then year = year - 1 91 IF (minJul GE igreg) THEN BEGIN ; all are Gregorian 92 jalpha = LONG(((julLong - 1867216L) - 0.25d) / 36524.25d) 93 ja = julLong + 1L + jalpha - long(0.25d * jalpha) 94 ENDIF ELSE BEGIN 95 ja = julLong 96 gregChange = WHERE(julLong ge igreg, ngreg) 97 IF (ngreg GT 0) THEN BEGIN 98 jalpha = long(((julLong[gregChange] - 1867216L) - 0.25d) / 36524.25d) 99 ja[gregChange] = julLong[gregChange] + 1L + jalpha - long(0.25d * jalpha) 100 ENDIF 101 ENDELSE 102 jalpha = -1 ; clear memory 110 103 111 ENDIF ELSE BEGIN 104 jb = TEMPORARY(ja) + 1524L 105 jc = long(6680d + ((jb-2439870L)-122.1d0)/365.25d) 106 jd = long(365d * jc + (0.25d * jc)) 107 je = long((jb - jd) / 30.6001d) 112 108 113 jul = long(julian) 114 f = (jul - floor(jul)) 115 IF f NE 0.0 THEN BEGIN ;Get hours, minutes, seconds. 109 day = TEMPORARY(jb) - TEMPORARY(jd) - long(30.6001d * je) 110 month = TEMPORARY(je) - 1L 111 month = ((TEMPORARY(month) - 1L) MOD 12L) + 1L 112 year = TEMPORARY(jc) - 4715L 113 year = TEMPORARY(year) - (month GT 2) 114 year = year - (year LE 0) 115 116 ; see if we need to do hours, minutes, seconds 117 IF (nParam GT 4) THEN BEGIN 118 fraction = julian + 0.5d - TEMPORARY(julLong) 119 hour = floor(fraction * 24d) 120 fraction = TEMPORARY(fraction) - hour/24d 121 minute = floor(fraction*1440d) 122 second = (TEMPORARY(fraction) - minute/1440d) * 86400d 123 ENDIF 124 125 ; if julian is an array, reform all output to correct dimensions 126 IF (SIZE(julian, /N_DIMENSION) GT 0) THEN BEGIN 127 dimensions = SIZE(julian, /DIMENSION) 128 month = REFORM(month, dimensions) 129 day = REFORM(day, dimensions) 130 year = REFORM(year, dimensions) 131 IF (nParam GT 4) THEN BEGIN 132 hour = REFORM(hour, dimensions) 133 minute = REFORM(minute, dimensions) 134 second = REFORM(second, dimensions) 135 ENDIF 136 ENDIF 137 138 END 139 '360d':BEGIN 140 141 jul = long(julian) 142 f = (jul - floor(jul)) 143 IF total(f NE 0.0) GT 0 THEN BEGIN ;Get hours, minutes, seconds. 116 144 hour = floor(f*24.) 117 145 f = f - hour / 24.d 118 146 minute = floor(f*1440) 119 147 second = (f - minute/1440.d0) * 86400.0d0 120 ENDIF ELSE BEGIN121 hour = 0L122 minute = 0L123 second = 0L124 ENDELSE148 ENDIF ELSE BEGIN 149 hour = replicate(0L, n_elements(julian)) 150 minute = replicate(0L, n_elements(julian)) 151 second = replicate(0L, n_elements(julian)) 152 ENDELSE 125 153 126 IF ndayspm EQ 1 THEN ndayspm = 30 154 IF keyword_set(ndayspm) THEN BEGIN 155 IF ndayspm EQ 1 THEN ndayspm = 30 156 ENDIF ELSE ndayspm = 30 127 157 128 Z = floor(julian) 129 X = Z / ndayspm 130 day = Z - X*ndayspm 131 year = X / 12 132 month = X - year*12 + 1 133 year = year + 1 158 ndayspm = long(ndayspm) 159 Z = floor(julian) 160 year = z/(12*ndayspm)+1 161 month = (z-(12*ndayspm)*(year-1))/ndayspm+1 162 day = z-(12*ndayspm)*(year-1)-ndayspm*(month-1) 163 WHILE total(day LT 1) GT 0 DO BEGIN 164 tochange = where(day LT 1) 165 month[tochange] = month[tochange]-1 166 day[tochange] = day[tochange]+ndayspm 167 ENDWHILE 168 WHILE total(month LT 1) GT 0 DO BEGIN 169 tochange = where(month LT 1) 170 year[tochange] = year[tochange]-1 171 month[tochange] = month[tochange]+12 172 ENDWHILE 173 ; year 0 does not exist... 174 neg = where(year LT 0) 175 IF neg[0] NE -1 THEN year[neg] = year[neg]-1 176 END 177 'noleap':BEGIN 178 END 179 ELSE:BEGIN 180 ng = report('only 3 types of calendar are accepted: greg, 360d and noleap') 181 return 182 END 183 ENDCASE 184 ; 185 return 134 186 135 ENDELSE 136 137 end 138 139 140 141 142 pro caldat, Julian, Month, Day, Year, Hour, Minute, Second, NDAYSPM = ndayspm 143 144 ON_ERROR, 2 ; Return to caller if errors 145 146 ; Determine shape of input and construct longword output variables of 147 ; the same shape. 148 149 s = size(julian) 150 if (s[0] eq 0) then begin 151 ; Julian is scalar. Just call CALDAT_SCALAR and pass our arguments through. 152 caldat_scalar, Julian, Month, Day, Year, Hour, Minute, Second, NDAYSPM = ndayspm 153 return 154 endif 155 156 ; It's an array. Construct result variables 157 ndim = s[0] ; Number or array dimensions 158 n = s[ndim + 2] ; # of elements 159 s[ndim + 1] = 3 ; Change the type to LONG 160 MONTH = (DAY = (YEAR = (HOUR = (MINUTE = (SECOND = MAKE_ARRAY(SIZE=s)))))) 161 162 ; Loop over the input 163 for i = 0, n-1 do begin 164 caldat_scalar, julian[i], month_tmp, day_tmp, year_tmp, $ 165 hour_tmp, minute_tmp, second_tmp, NDAYSPM = ndayspm 166 month[i] = month_tmp 167 day[i] = day_tmp 168 year[i] = year_tmp 169 hour[i] = hour_tmp 170 minute[i] = minute_tmp 171 second[i] = second_tmp 172 endfor 173 end 187 END -
trunk/ToBeReviewed/CALENDRIER/julday.pro
r7 r9 1 1 ; $Id$ 2 2 ; 3 ; Copyright (c) 1988- 1998, Research Systems, Inc. All rights reserved.3 ; Copyright (c) 1988-2003, Research Systems, Inc. All rights reserved. 4 4 ; Unauthorized reproduction prohibited. 5 5 6 function JULDAY, MONTH, DAY, YEAR, Hour, Minute, Second, NDAYSPM = ndayspm, _extra=ex7 6 ;+ 8 7 ; NAME: … … 13 12 ; This is the inverse of the library function CALDAT. 14 13 ; See also caldat, the inverse of this function. 14 ; 15 15 ; CATEGORY: 16 16 ; Misc. 17 17 ; 18 18 ; CALLING SEQUENCE: 19 ; Result = JULDAY( Month, Day, Year)19 ; Result = JULDAY([[[[Month, Day, Year], Hour], Minute], Second]) 20 20 ; 21 21 ; INPUTS: … … 24 24 ; DAY: Number of day of the month. 25 25 ; 26 ; YEAR: Number of the desired year. 26 ; YEAR: Number of the desired year.Year parameters must be valid 27 ; values from the civil calendar. Years B.C.E. are represented 28 ; as negative integers. Years in the common era are represented 29 ; as positive integers. In particular, note that there is no 30 ; year 0 in the civil calendar. 1 B.C.E. (-1) is followed by 31 ; 1 C.E. (1). 27 32 ; 28 33 ; HOUR: Number of the hour of the day. … … 30 35 ; MINUTE: Number of the minute of the hour. 31 36 ; 32 ; SECOND: 37 ; SECOND: Number of the second of the minute. 38 ; 39 ; Note: Month, Day, Year, Hour, Minute, and Second can all be arrays. 40 ; The Result will have the same dimensions as the smallest array, or 41 ; will be a scalar if all arguments are scalars. 33 42 ; 34 43 ; OPTIONAL INPUT PARAMETERS: … … 37 46 ; KEYWORD PARAMETERS: 38 47 ; 39 ; NDAYSPM: developpe par eric, ca veut dire: nombre de jours par mois! 40 ; par defaut c''est 30, sinon le specifier en donnant 41 ; une valeur a ndayspm 42 ; pour passer a un calendrier avec un nombre de jours constant par 43 ; mois. Utilise en particulier ds julday et caldat 48 ; NDAYSPM: for using a calendar with fixed number of days per 49 ; months. defaut value of NDAYSPM=30 44 50 ; 45 51 ; OUTPUTS: 46 ; JULDAY returns the Julian Day Number (which begins at noon) of the 47 ; specified calendar date. If the time of day (Hr, Min, Sec), is 0,48 ; the result will be a long integer, otherwise the result is a52 ; JULDAY returns the Julian Day Number (which begins at noon) of the 53 ; specified calendar date. If Hour, Minute, and Second are not specified, 54 ; then the result will be a long integer, otherwise the result is a 49 55 ; double precision floating point number. 50 56 ; 51 ; COMMON BLOCKS: 52 ; None. 57 ; COMMON BLOCKS: cm_4cal 53 58 ; 54 59 ; SIDE EFFECTS: … … 57 62 ; RESTRICTIONS: 58 63 ; Accuracy using IEEE double precision numbers is approximately 59 ; 1/10000th of a second. 64 ; 1/10000th of a second, with higher accuracy for smaller (earlier) 65 ; Julian dates. 60 66 ; 61 67 ; MODIFICATION HISTORY: … … 69 75 ; Eric Guilyardi, June 1999 70 76 ; Added key_work ndayspm for fixed number of days per months 77 ; + change to accept year 0 78 ; 79 ; Sebastien Masson, Aug. 2003 80 ; fix bug for negative and large values of month values 81 ; eg. julday(349,1,1970) 82 ; 83 ; CT, April 2000, Now accepts vectors or scalars. 71 84 ;- 72 85 ; 73 ON_ERROR, 2 ; Return to caller if errors 74 75 MONTHS = ['JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG', $ 76 'SEP','OCT','NOV','DEC'] 77 78 IF NOT keyword_set(ndayspm) THEN BEGIN 86 function JULDAY, MONTH, DAY, YEAR, Hour, Minute, Second, NDAYSPM = ndayspm 87 ;------------------------------------------------------------ 88 @cm_4cal 89 ;------------------------------------------------------------ 90 91 COMPILE_OPT idl2 92 93 ON_ERROR, 2 ; Return to caller if errors 94 95 IF n_elements(key_caltype) EQ 0 THEN key_caltype = 'greg' 96 if keyword_set(ndayspm) then key_caltype = '360d' 97 ; 98 CASE key_caltype OF 99 'greg':BEGIN 100 79 101 80 102 ; Gregorian Calander was adopted on Oct. 15, 1582 81 GREG = 15L + 31L * (10L + 12L * 1582L) 103 ; skipping from Oct. 4, 1582 to Oct. 15, 1582 104 GREG = 2299171L ; incorrect Julian day for Oct. 25, 1582 82 105 83 106 ; Process the input, if all are missing, use todays date. 84 107 NP = n_params() 85 if NP eq 0 then begin 86 DATE = systime() 87 L_MONTH = long(where(strupcase(strmid(DATE, 4, 3)) eq MONTHS)) 88 L_MONTH = L_MONTH[0] + 1 ; Scalarize it... 89 L_DAY = long(strmid(DATE, 8, 2)) 90 L_YEAR = long(strmid(DATE, 20, 4)) 91 endif else if np ge 3 then begin 92 L_MONTH = LONG(MONTH) 93 L_DAY = LONG(DAY) 94 L_YEAR=LONG(YEAR) 95 ; 96 ;*************************************************** 97 ; Change test to allow year 0 for climatological data 98 ;******************************************************** 99 ; if (L_YEAR eq 0) then message, 'There is no year zero.' 100 endif else message, 'Wrong number of parameters.' 101 ; 102 ;*************************************************** 103 ; Change test to allow year 0 for climatological data 104 ;******************************************************** 105 ; if (L_YEAR lt 0) then L_YEAR = L_YEAR + 1 106 if (L_YEAR le 0) then L_YEAR = L_YEAR + 1 107 if (L_MONTH gt 2) then begin 108 JY = L_YEAR 109 JM = L_MONTH + 1 110 endif else begin 111 JY = L_YEAR - 1 112 JM = L_MONTH + 13 113 endelse 114 115 JUL = floor(365.25 * JY) + floor(30.6001 * JM) + L_DAY + 1720995 108 IF (np EQ 0) THEN RETURN, SYSTIME(/JULIAN) 109 IF (np LT 3) THEN MESSAGE, 'Incorrect number of arguments.' 110 111 ; Find the dimensions of the Result: 112 ; 1. Find all of the input arguments that are arrays (ignore scalars) 113 ; 2. Out of the arrays, find the smallest number of elements 114 ; 3. Find the dimensions of the smallest array 115 116 ; Step 1: find all array arguments 117 nDims = [SIZE(month, /N_DIMENSIONS), SIZE(day, /N_DIMENSIONS), $ 118 SIZE(year, /N_DIMENSIONS), SIZE(hour, /N_DIMENSIONS), $ 119 SIZE(minute, /N_DIMENSIONS), SIZE(second, /N_DIMENSIONS)] 120 arrays = WHERE(nDims GE 1) 121 122 nJulian = 1L ; assume everything is a scalar 123 IF (arrays[0] GE 0) THEN BEGIN 124 ; Step 2: find the smallest number of elements 125 nElement = [N_ELEMENTS(month), N_ELEMENTS(day), $ 126 N_ELEMENTS(year), N_ELEMENTS(hour), $ 127 N_ELEMENTS(minute), N_ELEMENTS(second)] 128 nJulian = MIN(nElement[arrays], whichVar) 129 ; step 3: find dimensions of the smallest array 130 CASE arrays[whichVar] OF 131 0: julianDims = SIZE(month, /DIMENSIONS) 132 1: julianDims = SIZE(day, /DIMENSIONS) 133 2: julianDims = SIZE(year, /DIMENSIONS) 134 3: julianDims = SIZE(hour, /DIMENSIONS) 135 4: julianDims = SIZE(minute, /DIMENSIONS) 136 5: julianDims = SIZE(second, /DIMENSIONS) 137 ENDCASE 138 ENDIF 139 140 d_Second = 0d ; defaults 141 d_Minute = 0d 142 d_Hour = 0d 143 ; convert all Arguments to appropriate array size & type 144 SWITCH np OF ; use switch so we fall thru all arguments... 145 6: d_Second = (SIZE(second, /N_DIMENSIONS) GT 0) ? $ 146 second[0:nJulian-1] : second 147 5: d_Minute = (SIZE(minute, /N_DIMENSIONS) GT 0) ? $ 148 minute[0:nJulian-1] : minute 149 4: d_Hour = (SIZE(hour, /N_DIMENSIONS) GT 0) ? $ 150 hour[0:nJulian-1] : hour 151 3: BEGIN ; convert m,d,y to type LONG 152 L_MONTH = (SIZE(month, /N_DIMENSIONS) GT 0) ? $ 153 LONG(month[0:nJulian-1]) : LONG(month) 154 L_DAY = (SIZE(day, /N_DIMENSIONS) GT 0) ? $ 155 LONG(day[0:nJulian-1]) : LONG(day) 156 L_YEAR = (SIZE(year, /N_DIMENSIONS) GT 0) ? $ 157 LONG(year[0:nJulian-1]) : LONG(year) 158 END 159 ENDSWITCH 160 161 162 min_calendar = -4716 163 max_calendar = 5000000 164 minn = MIN(l_year, MAX = maxx) 165 IF (minn LT min_calendar) OR (maxx GT max_calendar) THEN MESSAGE, $ 166 'Value of Julian date is out of allowed range.' 167 ; change to accept year 0 168 ; if (MAX(L_YEAR eq 0) NE 0) then message, $ 169 ; 'There is no year zero in the civil calendar.' 170 ; 171 ; by seb Aug 2003 172 tochange = where(L_MONTH LT 0) 173 IF tochange[0] NE -1 THEN BEGIN 174 L_YEAR[tochange] = L_YEAR[tochange]+L_MONTH[tochange]/12-1 175 L_MONTH[tochange] = 12 + L_MONTH[tochange] MOD 12 176 ENDIF 177 tochange = where(L_MONTH GT 12) 178 IF tochange[0] NE -1 THEN BEGIN 179 L_YEAR[tochange] = L_YEAR[tochange]+L_MONTH[tochange]/12 180 L_MONTH[tochange] = L_MONTH[tochange] MOD 12 181 ENDIF 182 ; by seb Aug 2003 - end 183 ; 184 ; 185 bc = (L_YEAR LT 0) 186 L_YEAR = TEMPORARY(L_YEAR) + TEMPORARY(bc) 187 inJanFeb = (L_MONTH LE 2) 188 JY = L_YEAR - inJanFeb 189 JM = L_MONTH + (1b + 12b*TEMPORARY(inJanFeb)) 190 191 192 JUL = floor(365.25d * JY) + floor(30.6001d*TEMPORARY(JM)) + L_DAY + 1720995L 193 194 116 195 ; Test whether to change to Gregorian Calandar. 117 if ((L_DAY + 31L * (L_MONTH + 12L * L_YEAR)) ge GREG) then begin 118 JA = long(0.01 * JY) 119 JUL = JUL + 2 - JA + long(0.25 * JA) 120 endif 121 122 if n_elements(Hour) + n_elements(Minute) + n_elements(Second) eq 0 then $ 123 return, JUL 124 if n_elements(Hour) eq 0 then Hour = 0 125 if n_elements(Minute) eq 0 then Minute = 0 126 if n_elements(Second) eq 0 then Second = 0 127 128 return, JUL + (Hour / 24.0d0 - .5d0) + (Minute/1440.0d0) + (Second / 86400.0d0) 129 130 ENDIF ELSE BEGIN 196 IF (MIN(JUL) GE GREG) THEN BEGIN ; change all dates 197 JA = long(0.01d * TEMPORARY(JY)) 198 JUL = TEMPORARY(JUL) + 2L - JA + long(0.25d * JA) 199 ENDIF ELSE BEGIN 200 gregChange = WHERE(JUL ge GREG, ngreg) 201 IF (ngreg GT 0) THEN BEGIN 202 JA = long(0.01d * JY[gregChange]) 203 JUL[gregChange] = JUL[gregChange] + 2L - JA + long(0.25d * JA) 204 ENDIF 205 ENDELSE 206 207 208 ; hour,minute,second? 209 IF (np GT 3) THEN BEGIN ; yes, compute the fractional Julian date 210 ; Add a small offset so we get the hours, minutes, & seconds back correctly 211 ; if we convert the Julian dates back. This offset is proportional to the 212 ; Julian date, so small dates (a long, long time ago) will be "more" accurate. 213 eps = (MACHAR(/DOUBLE)).eps 214 eps = eps*ABS(jul) > eps 215 ; For Hours, divide by 24, then subtract 0.5, in case we have unsigned ints. 216 jul = TEMPORARY(JUL) + ( (TEMPORARY(d_Hour)/24d - 0.5d) + $ 217 TEMPORARY(d_Minute)/1440d + TEMPORARY(d_Second)/86400d + eps ) 218 ENDIF 219 220 ; check to see if we need to reform vector to array of correct dimensions 221 IF (N_ELEMENTS(julianDims) GT 1) THEN $ 222 JUL = REFORM(TEMPORARY(JUL), julianDims) 223 224 RETURN, jul 225 226 END 227 '360d':BEGIN 131 228 ; 132 229 ; Fixed number of days per month (default=30) : 133 230 ; 134 IF ndayspm EQ 1 THEN ndayspm = 30 231 IF keyword_set(ndayspm) THEN BEGIN 232 IF ndayspm EQ 1 THEN ndayspm = 30 233 ENDIF ELSE ndayspm = 30 135 234 136 235 L_MONTH = LONG(MONTH) 137 236 L_DAY = LONG(DAY) 138 L_YEAR=LONG(YEAR) 139 140 JUL = ((L_YEAR-1)*12. + (L_MONTH-1))* ndayspm + L_DAY 237 L_YEAR = LONG(YEAR) 238 239 neg = where(L_YEAR LT 0) 240 IF neg[0] NE -1 THEN L_YEAR[neg] = L_YEAR[neg]+1 241 242 JUL = ((L_YEAR-1)*12 + (L_MONTH-1))* ndayspm + L_DAY 141 243 if n_elements(Hour) + n_elements(Minute) + n_elements(Second) eq 0 then $ 142 return, JUL244 return, JUL 143 245 if n_elements(Hour) eq 0 then Hour = 0 144 246 if n_elements(Minute) eq 0 then Minute = 0 145 247 if n_elements(Second) eq 0 then Second = 0 146 248 147 return, JUL + (Hour / 24.0d0) + (Minute/1440.0d0) + (Second / 86400.0d0) 148 149 ENDELSE 150 end 249 IF Hour+Minute+Second EQ 0 THEN return, JUL ELSE $ 250 return, JUL + (Hour / 24.0d0) + (Minute/1440.0d0) + (Second / 86400.0d0) 251 252 END 253 'noleap':BEGIN 254 END 255 ELSE:return, report('only 3 types of calendar are accepted: greg, 360d and noleap') 256 ENDCASE 257 258 END
Note: See TracChangeset
for help on using the changeset viewer.