fait_fond_rpws.pro (Kronos IDL library)

;+
; Contains the fait_fond_rpws procedure
; and associated procedures
;
; :Author:
;    Philippe Zarka
;
; :History:
;    2004/06/17: Created
;
;    2004/06/17: Last Edit
;-
;
;+
; liste des frequences utilisees (frequency index table)
;
; :Params:
;    aaaajjjd:   in, required, type=syting
;       date de debut
;    hd:   in, required, type=int
;       heure de debut
;    aaaajjjf:   in, required, type=string
;       date de fin
;    hf:   out, required, type=int
;       heure de fin
;-
pro LISTE_FREQ, aaaajjjd, hd, aaaajjjf, hf, xf

xf=[0.]

  openr, d, 'liste.scratch', /get_lun, error=err
  if err ne 0 then begin
    print,'Fichier liste.scratch inexistant'
    stop
  endif
  on_ioerror,suite
  fichier=''

encore:
  err=0
  readf, d, fichier
  f = DELPATH(fichier)
  faaaajjj = long(strmid(f,1,7))
  fh = long(strmid(f,9,2))
  if (faaaajjj lt aaaajjjd) or ((faaaajjj eq aaaajjjd) and (fh lt hd)) $
    then goto,encore
  if (faaaajjj gt aaaajjjf) or ((faaaajjj eq aaaajjjf) and (fh ge hf)) $
    then goto,suite
  path=EXTPATH(fichier)
  path=strmid(path,0,strlen(path)-2)
  nomfich = path+'n2/P'+strtrim(faaaajjj,2)+'.'+string(format='(i2.2)',fh)
  
  READ_DATA_N2, nomfich,data
  print,nomfich
  n=n_elements(data)
  for i=0L,n-1L do begin
    w=where(abs(xf-data(i).f) le 0.01)
    if w(0) eq -1 then begin
      xf=[xf,data(i).f]
      print,n_elements(xf)-1
    endif
  endfor

  goto,encore

suite:
  close,d & free_lun,d

xf=xf(1:*)
xf=xf(sort(xf))
help,xf

return
end

;+
; fon/sig(nxf,4) avec 0=Z, 1=+X, 2=-X, 3=D
;
; :Uses:
;    delpath, dyn, extpath, fond
;
; :Params:
;    aaaajjjd: in, required, type=string
;       date de debut
;    hd:   in, required, type=int
;       heure de debut
;    aaaajjjf: in, required, type=string
;       date de fin
;    hf:       in, required, type=int
;       heure de fin
;    fon:      out, required, type=sometype
;       A parameter named fon
;    sig:      out, required, type=sometype
;       A parameter named sig
;    fon5:     out, required, type=sometype
;       A parameter named fon5
;    fon10:    out, required, type=sometype
;       A parameter named fon10
;    bt:       out, required, type=sometype
;       bt = <df*dt>
;    xf:       out, required, type=sometype
;       A parameter named xf
;-
pro FAIT_FOND_RPWS, aaaajjjd, hd, aaaajjjf, hf, fon,sig, fon5,fon10,bt,xf

print,'LISTE_FREQ ...'
LISTE_FREQ, aaaajjjd, hd, aaaajjjf, hf, xf

;restore,'xf.idl',/verb

nxf=n_elements(xf)
h=lonarr(nxf,1601,4)			; 1601 pas de 0.05 dB dans [-170, -90] dB
fon=fltarr(nxf,4) & sig=fon & fon5=fon & fon10=fon
bt=fon & nbt=bt

print,'FAIT_FOND_RPWS ...'

  openr, d, 'liste.scratch', /get_lun, error=err
  if err ne 0 then begin
    print,'Fichier liste.scratch inexistant'
    stop
  endif
  on_ioerror,suite
  fichier=''

encore:
  err=0
  readf, d, fichier
  f = DELPATH(fichier)
  faaaajjj = long(strmid(f,1,7))
  fh = long(strmid(f,9,2))
  if (faaaajjj lt aaaajjjd) or ((faaaajjj eq aaaajjjd) and (fh lt hd)) $
    then goto,encore
  if (faaaajjj gt aaaajjjf) or ((faaaajjj eq aaaajjjf) and (fh ge hf)) $
    then goto,suite
  path=EXTPATH(fichier)
  path=strmid(path,0,strlen(path)-2)
  nomfich = path+'n2/P'+strtrim(faaaajjj,2)+'.'+string(format='(i2.2)',fh)
  READ_DATA_N2, nomfich,data

for i=0,nxf-1 do begin
  for j=1,3 do begin
    w=where(abs(data.f-xf(i)) le 0.01 and (data.ant mod 10) eq j and data.autoX ne 0.)
    if w(0) ne -1 then begin
      x=(fix((10.*alog10(data(w).autoX)+170)*20) < 1600) > 0
      for k=0L,n_elements(x)-1L do h(i,x(k),j)=h(i,x(k),j)+1L
      bt(i,j)=bt(i,j)+ total(data(w).df*data(w).dt)
      nbt(i,j)=nbt(i,j)+ n_elements(w)
    endif
  endfor
  j=0
  w=where(abs(data.f-xf(i)) le 0.01 and data.autoZ ne 0.)
  if w(0) ne -1 then begin
    x=(fix((10.*alog10(data(w).autoZ)+170)*20) < 1600) > 0
    for k=0L,n_elements(x)-1L do h(i,x(k),j)=h(i,x(k),j)+1L
    bt(i,j)=bt(i,j)+ total(data(w).df*data(w).dt)
    nbt(i,j)=nbt(i,j)+ n_elements(w)
  endif
endfor

  print,nomfich, max(h)
;save, aaaajjjd, hd, aaaajjjf, hf,h, bt,nbt,xf,nomfich,file='fait_fond_rpws_temp.idl'
  goto,encore

suite:
  close,d & free_lun,d

for i=0,nxf-1 do begin
  for j=0,3 do begin
  if total(h(i,*,j)) gt 1 then begin
    x=[0.]
    for k=0,1600 do if h(i,k,j) ne 0 then x=[x,fltarr(h(i,k,j))+k*1./20.+0.025]
    x=x(1:*)
    FOND, x, f,s
    fon(i,j)=10.^((f-170.)/10.)
    sig(i,j)=10.^((f+s-170.)/10.)-fon(i,j)
    DYN, x, 0.05,1,f,buf
    fon5(i,j)=10.^((f-170.)/10.)
    DYN, x, 0.10,1,f,buf
    fon10(i,j)=10.^((f-170.)/10.)
  endif
  endfor
endfor

bt=bt/(nbt > 1)

save, aaaajjjd, hd, aaaajjjf, hf,h, fon,sig, fon5,fon10,bt,nbt,xf,file='fait_fond_rpws.idl'

return
end