Changeset 9


Ignore:
Timestamp:
04/26/06 16:29:38 (18 years ago)
Author:
pinsard
Message:

upgrade of CALENDRIER/Calendar according to cerbere.lodyc.jussieu.fr:/usr/home/smasson/SAXO_RD/ : files

Location:
trunk
Files:
4 added
1 deleted
9 copied

Legend:

Unmodified
Added
Removed

  • trunk/Calendar/date2string.pro

    r7 r9  
    33;------------------------------------------------------------ 
    44;+ 
    5 ; NAME: 
     5; NAME: date2string 
    66; 
    7 ; PURPOSE: 
     7; PURPOSE: create a nice and readable format to print a date 
    88; 
    9 ; CATEGORY: 
     9; CATEGORY: calendar/string 
    1010; 
    11 ; CALLING SEQUENCE: 
     11; CALLING SEQUENCE: nice_date = date2string(yyyymmdd) 
    1212;  
    13 ; INPUTS: 
     13; INPUTS: yyyymmdd the date in the format  
     14;         yearyearyearyearmonthmonthdayday 
    1415; 
    15 ; KEYWORD PARAMETERS: 
     16; KEYWORD PARAMETERS:those of string fonction to specify the 
     17;                    format of the month (the C format) 
    1618; 
    17 ; OUTPUTS: 
     19; OUTPUTS: a string containing the date in a easy readable format 
    1820; 
    19 ; COMMON BLOCKS: 
     21; COMMON BLOCKS:none 
    2022; 
    21 ; SIDE EFFECTS: 
     23; SIDE EFFECTS:? 
    2224; 
    23 ; RESTRICTIONS: 
     25; RESTRICTIONS:? 
    2426; 
    2527; EXAMPLE: 
    2628; 
     29;    IDL> print, date2string(19900123) 
     30;    Jan 23, 1990 
     31;    IDL> print, date2string(19900123, format = '(C(CMOA))') 
     32;    JAN 23, 1990 
     33; 
    2734; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr) 
    28 ; 
     35; Creation ??? 
     36; update/review June 2005 Sebastien Masson. 
    2937;- 
    3038;------------------------------------------------------------ 
    3139;------------------------------------------------------------ 
    3240;------------------------------------------------------------ 
    33 FUNCTION date2string, date 
     41FUNCTION date2string, yyyymmdd, _EXTRA = ex 
    3442; 
    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 
    5848   return, res 
    5949end 

  • trunk/Calendar/leapyr.pro

    r7 r9  
    11;----------------------------------------------------------------- 
    2         function leapyr,year 
     2function leapyr, year 
    33;+ 
    44; NAME:                 leapyr 
    … …  
    1313; 
    1414; INPUTS:               year    = test if year is a leap year  
    15 ;                                 year may be a vector and may be in the   
    16 ;                                 form MCDU eg. 1788 else defaults to 19XX 
    1715; 
    1816; OUTPUTS:              result  = 0 then not a leap year 
    1917;                               = 1 then year is a leap year 
    20 ;                               = (399+(yr mod 400))/400 - (3+(yr mod 4))/4 
    2118; 
    22 ; COMMON BLOCKS: 
    23 ;       none. 
     19; COMMON BLOCKS: cm_4cal 
     20; 
    2421; SIDE EFFECTS: 
    2522;       none. 
    2623; MODIFICATION HISTORY: 
    27 ;       Written by: Trevor Harris, Physics Dept., University of Adelaide, 
     24; 
     25;       Originally Written by: Trevor Harris, Physics Dept., University of Adelaide, 
    2826;               20/09/88 
    2927; 
     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; 
    3040;- 
     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)) 
    3152 
    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 
     53end 

  • trunk/Obsolete/jourdsmois.pro

    r7 r9  
    55; NAME:jourdsmois 
    66; 
    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... 
    289; 
    2910; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr) 
    30 ;                       2/7/98 
    3111;- 
     12; June 2005: Sebastien Masson, english version 
    3213;------------------------------------------------------------ 
    3314;------------------------------------------------------------ 
    3415;------------------------------------------------------------ 
    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: 
     16function jourdsmois, mois, annee 
     17 
     18case n_params() OF 
     19  0:return, daysinmonth() 
     20  1:return, daysinmonth(mois) 
     21  2:return, daysinmonth(mois, annee) 
    4522endcase 
    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 
    5024end 

  • trunk/Obsolete/juldate.pro

    r7 r9  
    44;+ 
    55; NAME: juldate 
     6; 
     7;       OBSOLETE: you better use date2jul 
    68; 
    79; PURPOSE:  gives julian date equivalent of a date in vairmer  
    … …  
    1719; KEYWORD PARAMETERS: 
    1820; 
    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 
    2024; 
    2125; OUTPUTS:date en jour julien 

  • trunk/Obsolete/vairdate.pro

    r7 r9  
    44;+ 
    55; NAME: vairdate 
     6; 
     7;       OBSOLETE: you better use jul2date 
    68; 
    79; PURPOSE:  gives vairmer date equivalent of a date in julian format 

  • trunk/Obsolete/vraidate.pro

    r7 r9  
    55; NAME:vraidate 
    66; 
    7 ; PURPOSE:donne la date en long et avec le siecle s'il n'est pas specifie. 
     7; PURPOSE:donne la date en long 
    88; 
    9 ; CATEGORY:compatibile an 2000 bien-sur 
     9; CATEGORY: 
    1010; 
    11 ; CALLING SEQUENCE:res=varidate(date) 
     11; CALLING SEQUENCE:res=vraidate(date) 
    1212; 
    13 ; INPUTS:date:une date vairmer du type yymmdd ou yyyymmdd 
     13; INPUTS:date:une date du type yyyymmdd 
    1414; 
    1515; 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 
    1719; 
    1820; OUTPUTS:une date vairmer du type yyyymmdd 
    … …  
    2426; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr) 
    2527;                       3/7/98 
     28; remove automatic change from year 1 to 1901... Aug 2004 
    2629;- 
    2730;------------------------------------------------------------ 
    2831;------------------------------------------------------------ 
    2932;------------------------------------------------------------ 
    30 function vraidate, date, VRAIDATE = vraidate, _EXTRA = ex 
     33function vraidate, date, GRADS = grads, _EXTRA = ex 
    3134;------------------------------------------------------------ 
    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) 
    3640;------------------------------------------------------------ 
    3741end 

  • trunk/ToBeReviewed/CALENDRIER/caldat.pro

    r7 r9  
    11; $Id$ 
    22; 
    3 ; Copyright (c) 1992-1998, Research Systems, Inc.  All rights reserved. 
     3; Copyright (c) 1992-2003, Research Systems, Inc.  All rights reserved. 
    44;       Unauthorized reproduction prohibited. 
    55; 
    … …  
    2020; 
    2121; 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 
    2323;       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 donnant 
    29 ;                une valeur a ndayspm 
    30 ;                pour passer a un calendrier avec un nombre de jours constant par 
    31 ;                mois. Utilise en particulier ds julday et caldat 
    32 ; 
    3324; OUTPUTS: 
    3425;       (Trailing parameters may be omitted if not required.) 
    … …  
    4334;       Second: Second (and fractions) of the day. 
    4435; 
    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 
    4742; 
    4843; SIDE EFFECTS: 
    … …  
    6156;       DMS, April 1996, Added HOUR, MINUTE and SECOND keyword 
    6257;       AB, 7 December 1997, Generalized to handle array input. 
     58; 
    6359;       Eric Guilyardi, June 1999 
    6460;       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. 
    6563;- 
    6664; 
     65pro CALDAT, julian, month, day, year, hour, minute, second, NDAYSPM = ndayspm 
     66;------------------------------------------------------------ 
     67@cm_4cal 
     68;------------------------------------------------------------ 
     69  COMPILE_OPT idl2 
    6770 
     71  ON_ERROR, 2                   ; Return to caller if errors 
    6872 
    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 
    7277 
    73   ON_ERROR, 2           ; Return to caller if errors 
     78      nParam = N_PARAMS() 
     79      IF (nParam LT 1) THEN MESSAGE, 'Incorrect number of arguments.' 
    7480 
    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.' 
    7686 
    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) 
    7890 
    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 
    110103 
    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) 
    112108 
    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. 
    116144        hour = floor(f*24.) 
    117145        f = f - hour / 24.d 
    118146        minute = floor(f*1440) 
    119147        second = (f - minute/1440.d0) * 86400.0d0 
    120      ENDIF ELSE BEGIN 
    121         hour = 0L 
    122         minute = 0L 
    123         second = 0L 
    124      ENDELSE 
     148      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 
    125153 
    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 
    127157 
    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 
    134186 
    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 
     187END 

  • trunk/ToBeReviewed/CALENDRIER/julday.pro

    r7 r9  
    11; $Id$ 
    22; 
    3 ; Copyright (c) 1988-1998, Research Systems, Inc.  All rights reserved. 
     3; Copyright (c) 1988-2003, Research Systems, Inc.  All rights reserved. 
    44;       Unauthorized reproduction prohibited. 
    55 
    6 function JULDAY, MONTH, DAY, YEAR, Hour, Minute, Second, NDAYSPM = ndayspm, _extra=ex 
    76;+ 
    87; NAME: 
    … …  
    1312;       This is the inverse of the library function CALDAT. 
    1413;       See also caldat, the inverse of this function. 
     14; 
    1515; CATEGORY: 
    1616;       Misc. 
    1717; 
    1818; CALLING SEQUENCE: 
    19 ;       Result = JULDAY(Month, Day, Year) 
     19;       Result = JULDAY([[[[Month, Day, Year], Hour], Minute], Second]) 
    2020; 
    2121; INPUTS: 
    … …  
    2424;       DAY:    Number of day of the month. 
    2525; 
    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). 
    2732; 
    2833;       HOUR:   Number of the hour of the day. 
    … …  
    3035;       MINUTE: Number of the minute of the hour. 
    3136; 
    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. 
    3342; 
    3443; OPTIONAL INPUT PARAMETERS: 
    … …  
    3746; KEYWORD PARAMETERS: 
    3847; 
    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 
    4450; 
    4551; 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 a  
     52;       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 
    4955;       double precision floating point number. 
    5056; 
    51 ; COMMON BLOCKS: 
    52 ;       None. 
     57; COMMON BLOCKS: cm_4cal 
    5358; 
    5459; SIDE EFFECTS: 
    … …  
    5762; RESTRICTIONS: 
    5863;       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. 
    6066; 
    6167; MODIFICATION HISTORY: 
    … …  
    6975;       Eric Guilyardi, June 1999 
    7076;       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. 
    7184;- 
    7285; 
    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  
     86function 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 
    79101 
    80102; 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 
    82105 
    83106; Process the input, if all are missing, use todays date. 
    84107      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 
    116195; 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 
    131228; 
    132229; Fixed number of days per month (default=30) : 
    133230; 
    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 
    135234 
    136235      L_MONTH = LONG(MONTH) 
    137236      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  
    141243      if n_elements(Hour) + n_elements(Minute) + n_elements(Second) eq 0 then $ 
    142        return, JUL 
     244        return, JUL 
    143245      if n_elements(Hour) eq 0 then Hour = 0 
    144246      if n_elements(Minute) eq 0 then Minute = 0 
    145247      if n_elements(Second) eq 0 then Second = 0 
    146248       
    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 
     258END 
Note: See TracChangeset for help on using the changeset viewer.