Upload New File

NDACC_Lidar_Lib.pro

+;Set of library routines used in the conversion of NDACC Lidar files to HDF
+;Created 20110817 ISB
+
+;Routines:
+;  Function JulVar
+;  Function StrJul
+;  Function StrTL
+;  Function SysDate
+
+Function JulVar,jul ,doy=doy,xdoy=xdoy,year=year,month=month,day=day,hour=hour,minute=minute,second=second
+
+; keywords:
+;  doy  = day-of-year (integer)
+;  xdoy = fractional day-of-year (real)
+
+caldat,jul ,imth,iday,iyr,ihr,imin,isec
+
+if keyword_set(year) then begin
+  var=iyr
+endif else if keyword_set(month) then begin
+  var=imth
+endif else if keyword_set(day) then begin
+  var=iday
+endif else if keyword_set(hour) then begin
+  var=ihr
+endif else if keyword_set(minute) then begin
+  var=imin
+endif else if keyword_set(second) then begin
+  var=isec
+endif else if keyword_set(doy) then begin
+  var=fix(jul-julday(1,1,iyr,0,0,0)+1)
+endif else if keyword_set(xdoy) then begin
+  var=jul-julday(1,1,iyr,0,0,0)+1
+endif else begin
+  var=[iyr,imth,iday,ihr,imin,isec]
+endelse
+
+return ,var
+end
+
+
+Function StrJul,strng ,short=short,legal=legal,french=french,alpha=alpha,time=time,yr4dg=yr4dg
+
+nj=n_elements(strng) & jul=dblarr(nj)
+monthname=['Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec']
+
+for j=0L,nj-1 do begin
+
+str=strng(j) & ihr=0. & imin=0. & isec=0. & iy=-1 & amth=''
+
+if keyword_set(short) then begin
+
+  if not keyword_set(yr4dg) then reads,str ,iy,imth,iday,format='(3(i2))'
+  if keyword_set(yr4dg) and not keyword_set(time) then reads,str ,iyy,imth,iday,format='(i4,2(i2))'
+  if keyword_set(yr4dg) and keyword_set(time)     then reads,str ,iyy,imth,iday,ihr,imin,isec,format='(i4,2(i2),1x,3(i2))'
+  if not keyword_set(yr4dg) and keyword_set(time) then reads,str ,iy,imth,iday,ihr,imin,isec,format='(3(i2),1x,3(i2))'
+  if keyword_set(legal)  then reads,str ,imth,iday,iy,format='(3(i2))'
+  if keyword_set(french) then reads,str ,iday,imth,iy,format='(3(i2))'
+
+endif else if keyword_set(legal) then begin
+
+  if strlen(str) eq  8 then reads,str ,imth,iday,iy                ,format='(i2,1x,i2,1x,i2)'
+  if strlen(str) eq 17 then reads,str ,imth,iday,iy,ihr,imin,isec  ,format='(i2,1x,i2,1x,i2,3(1x,i2))'
+  if strlen(str) eq 10 then reads,str ,imth,iday,iyy               ,format='(i2,1x,i2,1x,i4)'
+  if strlen(str) eq 19 then reads,str ,imth,iday,iyy,ihr,imin,isec ,format='(i2,1x,i2,1x,i4,3(1x,i2))'
+
+endif else if (keyword_set(french) or keyword_set(alpha)) then begin
+
+  if strlen(str) eq  8 then reads,str ,iday,imth,iy                ,format='(i2,1x,i2,1x,i2)'
+  if strlen(str) eq 17 then reads,str ,iday,imth,iy,ihr,imin,isec  ,format='(i2,1x,i2,1x,i2,3(1x,i2))'
+  if strlen(str) eq 10 then reads,str ,iday,imth,iyy               ,format='(i2,1x,i2,1x,i4)'
+  if strlen(str) eq 19 then reads,str ,iday,imth,iyy,ihr,imin,isec ,format='(i2,1x,i2,1x,i4,3(1x,i2))'
+
+  if strlen(str) eq  9 then reads,str ,iday,amth,iy                ,format='(i2,1x,a3,1x,i2)'
+  if strlen(str) eq 18 then reads,str ,iday,amth,iy,ihr,imin,isec  ,format='(i2,1x,a3,1x,i2,3(1x,i2))'
+  if strlen(str) eq 11 then reads,str ,iday,amth,iyy               ,format='(i2,1x,a3,1x,i4)'
+  if strlen(str) eq 20 then reads,str ,iday,amth,iyy,ihr,imin,isec ,format='(i2,1x,a3,1x,i4,3(1x,i2))'
+
+endif else begin
+
+  if strlen(str) eq  8 then reads,str ,iy,imth,iday                ,format='(i2,1x,i2,1x,i2)'
+  if strlen(str) eq 17 then reads,str ,iy,imth,iday,ihr,imin,isec  ,format='(i2,1x,i2,1x,i2,3(1x,i2))'
+  if strlen(str) eq 10 then reads,str ,iyy,imth,iday               ,format='(i4,1x,i2,1x,i2)'
+  if strlen(str) eq 19 then reads,str ,iyy,imth,iday,ihr,imin,isec ,format='(i4,1x,i2,1x,i2,3(1x,i2))'
+
+endelse
+
+if iy ne -1 then begin
+  if iy gt 50 and iy le 99 then iyy=1900+iy else iyy=2000+iy
+endif
+if amth ne '' then imth=min(where(monthname eq amth))+1
+
+jul(j)=julday(imth,iday,iyy,ihr,imin,isec)
+
+endfor
+
+if nj eq 1 then jul=min(jul)
+
+return ,jul
+end
+
+
+Function StrTL,a ,format=format,trim=trim
+
+na=n_elements(a) & atemp=strarr(na)
+if keyword_set(format) then begin
+  for ia=0,na-1 do begin
+    atemp0=''
+    atemp0=string(a(ia),format=format)
+    while (((i=strpos(atemp0,' '))) ne -1) do strput,atemp0,'0',i
+    atemp(ia)=atemp0
+  endfor
+endif else begin
+  for ia=0,na-1 do begin
+    atemp0=''
+    atemp0=string(a(ia))
+    while (((i=strpos(atemp0,' '))) ne -1) do strput,atemp0,'0',i
+    atemp(ia)=atemp0
+  endfor
+endelse
+
+aout=''
+if na eq 1 then aout=atemp(0) else aout=atemp
+
+if keyword_set(trim) then begin
+  atemp0=aout
+  trimagain:
+  length=strlen(atemp0)
+  if strmid(atemp0,i,1) ne '0' then goto,endtrim
+  atemp0=strmid(atemp0,1,length-1)
+  goto,trimagain
+  endtrim:
+  aout=atemp0
+endif
+
+return,aout
+end
+
+
+Function SysDate ,julian=julian,year=year,month=month,day=day,notime=notime,nodate=nodate,short=short,time=time,alpha=alpha,yr2dg=yr2dg
+
+; *** Gets sytem date and time ***
+;     Defaut output is YYYY/MM/DD HH:MM:SS  (a19)
+; Keywords:
+;    julian: output is julian day
+;    notime: output is date only   (a10)            or (a8)
+;    nodate: output is time only   (a8)
+;    short:  output is in format YYMMDD   (a6)
+;    alpha:  output is in format DD-Mmm-YYYY   (a9) or (a7)
+;    year:   output is year only   (a4)             or (a2)
+;    month:  output is month only   (a2)
+;    day:    output is day only   (a2)
+;    yr2dg:  output is in 2-digit format for year
+
+sys0=systime(0)
+
+mthname=['Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec']
+imth=min(where(mthname eq strmid(sys0,4,3)))+1
+reads,sys0 ,iday,ihr,imin,isec,iyr ,format='(7x,4(1x,i2),1x,i4)'
+
+if keyword_set(julian) then return,julday(imth,iday,iyr,ihr,imin,isec)
+
+if keyword_set(yr2dg) then ayr=string((iyr mod 2000 < iyr mod 1900),format='(i2)') else ayr=string(iyr,format='(i4)')
+amth=string(imth,format='(i2)') & aday=string(iday,format='(i2)')
+ahr=string(ihr,format='(i2)') & amin=string(imin,format='(i2)') & asec=string(isec,format='(i2)')
+
+while (((i=strpos(ayr,' '))) ne -1) do strput,ayr,'0',i & while (((i=strpos(amth,' '))) ne -1) do strput,amth,'0',i & while (((i=strpos(aday,' '))) ne -1) do strput,aday,'0',i
+while (((i=strpos(ahr,' '))) ne -1) do strput,ahr,'0',i & while (((i=strpos(amin,' '))) ne -1) do strput,amin,'0',i & while (((i=strpos(asec,' '))) ne -1) do strput,asec,'0',i
+
+if keyword_set(short) then begin
+  sys=strmid(ayr,2,2)+amth+aday
+  if keyword_set(time) then sys=sys+'_'+ahr+amin+asec
+endif else if keyword_set(nodate) then begin
+  sys=ahr+':'+amin+':'+asec
+endif else if keyword_set(notime) then begin
+  if keyword_set(alpha) then sys=aday+'-'+mthname(imth-1)+'-'+ayr else sys=ayr +'/'+amth    +'/'+aday
+endif else if keyword_set(year) then begin
+  sys=ayr
+endif else if keyword_set(month) then begin
+  sys=amth
+endif else if keyword_set(day) then begin
+  sys=aday
+endif else begin
+  if keyword_set(alpha) then sys=aday+'-'+mthname(imth-1)+'-'+ ayr+' '+ahr+':'+amin+':'+asec $
+                        else sys=ayr+'/'+amth+'/'+aday+' '+ahr+':'+amin+':'+asec
+endelse
+
+return ,sys
+end
+
+
+pro NDACC_Lidar_Lib
+
+end
\ No newline at end of file